lisp ライブラリ集 > buffer & file 関連 lispサンプルライブラリ集

buffer & file 関連 lispサンプルライブラリ

目次(*はおすすめ度)

ミニバッファの補完で .../ に対応

(defun minibuffer-complete-cc ()
 (interactive)
  (goto-char(point-max))
  (pp-comp)
  (minibuffer-complete)
 )

(defun minibuffer-complete-word-cc ()
 (interactive)
  (goto-char(point-max))
  (pp-comp)
  (minibuffer-complete-word)
 )

(defun pp-comp ()
 (let ((num 1))
 (save-excursion

  (while (> num 0)
   (goto-char(point-min))
   (setq num (replace-buffer ".../" "../../"))
   )
  )
  )
 )

(define-key minibuffer-local-completion-map #\TAB 'minibuffer-complete-cc)
(define-key minibuffer-local-completion-map #\TAB 'minibuffer-complete-word-cc)

	

ミニバッファに入ったときIME(FEP)をOFFにする

;(provide "minibuffer")
;(in-package "editor")

(export '(*ime-mode-into-minibuffer*))
(defvar *ime-mode-into-minibuffer* nil)

(defun ime-state-get-and-setoff (bef-buffer file-name)
 (interactive)
 (setq *ime-mode-into-minibuffer* (get-ime-mode)
  )
 (toggle-ime nil)
  )

(defun ime-state-set (bef-buffer file-name)
 (interactive)
 (toggle-ime *ime-mode-into-minibuffer*
  )
  )

(add-hook '*enter-minibuffer-hook* 'ime-state-get-and-setoff)
(add-hook '*exit-minibuffer-hook* 'ime-state-set)
	

ファイル開くとき確認

でっかいファイルをオープンすると確認する。

ちょっと直した(hookがらみの変更と新規作成時の対処)

ファイルサイズ確認ツールはこちらに独立させた


(defvar *file-open-ask-bound-kilo* 500);500 Kbyte 以上の時聞いてくる
(defun myf-bff (file-full-path)
 (interactive)
 (let (fs)
  (handler-case
  (if file-full-path
   (progn
  (setq fs (file-length file-full-path))
  ;(msgbox "before find file ~A ~D kjfjkdjfkfjkdjk " file-full-path fs)
  (if (and file-full-path fs (> fs (* *file-open-ask-bound-kilo* 1024)))
   (if (yes-or-no-p "file name: ~A \n(size: ~D M byte/~D k byte/ ~D byte)\n 開いて見ちゃう?" file-full-path (truncate fs (* 1024 1024)) (truncate fs 1024) fs)
	  nil
   (selected-buffer))
	nil
   )
	)
	nil
   )
	(condition (c) nil))
  )
 )

(defvar *file-open-ask-bound-kilo* (* 1024 3))
(add-hook '*before-find-file-hook* 'myf-bff)
;(delete-hook '*before-find-file-hook* 'myf-bff)
	

check_buffer_mode

ファイルの拡張子からモードを直す。
(defun check-buffer-mode ()
 (let (cb cbfn)
  (setq cb (selected-buffer) cbfn (get-buffer-file-name cb))
  	(dolist (x *auto-mode-alist*)
	 (when (string-matchp (car x) cbfn)
	    (if (get (cdr x) 'decode-auto-mode)
		(funcall (cdr x) cb)
	      (funcall (cdr x)))
	    (return)))
  ))

(add-hook '*after-save-buffer-hook* 'check-buffer-mode)

今カーソルのあるバッファ以外を閉じる

手を抜いているので セーブしてしまう機能付き。
(defun close-all-buffers-except-this()
  "今カーソルのあるバッファ以外を閉じる"
  (interactive)
  (let (tb)
	(setq tb (get-buffer-file-name))
	(close-session-dialog)
   (find-file tb)
  )
)
Version 0.2.2.229 で kill-all-buffersのサポート

特定のbufferを消す

(defun clear-temp-buffers()
  "*の付いたバッファーを削除"
(interactive)
 (let ((fn))
  (dolist (bf (buffer-list))
	(setq fn (buffer-name bf))
	(when (and fn
		   (equal (schar fn 0) #\*)
		   (not (equal "*scratch*" fn)))
	 ;(msgbox(format nil "<~A>" fn))
	 (delete-buffer bf);否応なしに
     ;(erase-buffer bf);尋ねてくる
	  )
   ))

	

最後のバッファが削除されたら、*initial-buffer-mode*をfuncallするようにした。Version 0.2.1.163)

スクラッチバッファーの復活

モードは適当に直して
(defun make-scratch-buffer ()
  (interactive)
  (set-buffer
	(switch-to-buffer "*scratch*")
  )
  (execute-extended-command 'lisp-interaction-mode)
  (setq need-not-save t)
)
Version 0.2.2.207で*scratch*は kill-bufferでもerase-bufferによる中身の削除なったので、あまり使うケースはないかも Version 0.2.2.209 で 変数*kill-buffer-kills-scratch*がnon-nilの時 *scratchが消える

カレントバッファーまるまるインデント

(defun indent-current-buffer ()
  (interactive)
  (save-excursion
;   (widen)
	 (indent-region (point-min) (point-max))))

カレントバッファーを評価

(たぶん対象ファイルはセーブしなくても良いと思ってる。カレントバッファーをコンパイルするやつそのまま)
(defun eval-current-buffer ()
  (interactive)
  "byte compile current buffer if lisp file / カレントバッファーを評価"
  (if (selected-buffer)
      (let ((now-point (point)) (error-occur t))
         (when
             (save-excursion (eval-region (point-min) (point-max)))
              (message "eval CORRECTLY : (current buffer : ~A)" (buffer-name (selected-buffer)))
               (setq error-occur nil)

#|
;siteinit.l なら dump チェックも
           (let (bfname (get-buffer-file-name (selected-buffer)))
             (if (and bfname
                      (path-equal bfname
                                  (concat (si:system-root) "site-lisp/siteinit.l"))
                      (byte-compile-file bfname))
                 (delete-dump-file)
               ))
|#
           )
        (if error-occur
            (message "ERROR!! buffer : ~A" (buffer-name(selected-buffer))))
        )
    (message "buffer が見つからないようさっ"))
  )
;from perhaps Toy を少し改造
(defun delete-dump-file()
  (let (dumpfile (get-dump-file-name))
	(and dumpfile
		 (file-exist-p dumpfile)
		 (delete-file dumpfile))))


(defun get-dump-file-name ()
  (concat (si:system-root) "xyzzy.w"
		  (case (os-platform)
			(windows-2000 "2k")
			(windows-nt "nt")
			(windows-98 "98")
			(windows-95 "95")
			(t "nt"))))
;XP未対応
  ;追記
  ;(si:dump-image-path)
  ;の方が確実っぽい。


delete-buffer の カレントバッファー用

(ちょっと危ない)
(defun delete-current-buffer-force ()
  (interactive)
  "カレントバッファーを有無をいわさず消去"
  (if (selected-buffer)
	  (delete-buffer (selected-buffer))
	(message "失敗してもうた")
  ))

実行するだけ

html ファイルが NN に対応されていると、今開いているhtml ファイルが NN に OSごしに 渡されます。*.txt だと xyzzy とか
(defun execute-current-buffer ()
  (interactive)
  (shell-execute (buffer-name (selected-buffer))))

emacs-write-file

の ディレクトリィー対応版(ただ作るだけ)

[xyzzy:08055]の方法の方がいい。(これ頭悪い) また、(06/21/2004)やっぱり書き直した。

(defun emacs-write-file-set-default-file (filename)
  (interactive "FWrite file: "
    :title0 "Write File" :default0
    (let ((fn))
      (setq fn  (get-buffer-file-name (selected-buffer)))
      (concat
       ;ディレクトリ
       (or
        *default-write-file-directory*
        (if  fn
         (directory-namestring fn)
          nil
          )
        (map-backslash-to-slash (concat (get-special-folder-location :personal) "/"))
        ;(si::system-root)
        ;(default-directory)
        )
       ;ファイル
       (or
        (if fn
            (progn
             (setq fn (file-namestring fn))
              (cond ((equal (char fn 0) #\ )(setq fn nil))
                    ((equal (char fn 0) #\*)(setq fn nil))
                    ((equal (char fn 1) #\*)(setq fn nil))
                    )
              fn)
          nil
          )

        (progn
          (setq fn (buffer-name(selected-buffer)) )
          (cond ((equal (char fn 0) #\ ) (setq fn nil))
                ((equal (char fn 0) #\*) (setq fn nil))
                ((equal (char fn 1) #\*) (setq fn nil))
                )
          fn)

        ))
     )
    )
    (and (or (make-directory-unless-directory-exists filename) t)
         (rename filename)
         (save-buffer))
  )


;[xyzzy:8052,78,77] 8055 YANASE Kengo
;;; find-file時にディレクトリが作れるように
  (defun make-directory-unless-directory-exists (filename)
    (let ((d (directory-namestring filename)))
      (unless (check-valid-pathname d)
        (when (yes-or-no-p "~a~%ディレクトリがないけど作る?"  d)
          (create-directory d))))
    nil)


;;; ファイルを開く前に
(add-hook '*before-find-file-hook*
          'make-directory-unless-directory-exists)

;(global-set-key '(#\C-x #\C-w) 'emacs-write-file-with-directory)
;(global-set-key '(#\C-x #\C-w) 'emacs-write-file)
(global-set-key '(#\C-x #\C-w) 'emacs-write-file-set-default-file)

if が入り組んでしまった。抜け方が解らなかった。

(大文字小文字を区別したいときは 下の rename 系も一緒に)

emacsでファイルをリネームした時などバッファのモードを再チェックしてくれるツールはこちら



rename-file , rename 用(まだ自信なし)


(defun rename-file-with-char-case (file new-file-name)
  (interactive)
  (if (and (path-equal file new-file-name)
		   (string-equal file new-file-name)
		   (not (string-greaterp file new-file-name)))
	  (let ((t-r-f-n (concat file "___xyzzy_temp_rename_file")))
		(and (rename file t-r-f-n); rename-file でなく rename だった
			 (not (sleep-for 2));  < ---wait
			 (rename t-r-f-n new-file-name))
	  )
	(rename file new-file-name))
)

(defun rename-with-char-case (&optional filename)
  (interactive)
  (if (not filename)
	  (setq filename (read-file-name "rename+: " &key (get-buffer-file-name ))))
  (if (file-exist-p filename)
		(and (no-or-yes-p "~Sは既に存在します。リネームしますか。" filename)
			 (rename-file-with-char-case filename filename)
			 (rename filename t)
		)
	(rename filename)
  )
)

#|
(rename-file "temp.txt" "tEMP.TXT")
(rename-file-with-char-case "temp.txt" "tEMP.tXt")
(rename-file-with-char-case "tEMP.tXt___xyzzy_temp_rename_file" "temp.txt")
|#
(global-set-key '(#\C-x #\C-n) 'rename-with-char-case)


emacsでファイルをリネームした時などバッファのモードを再チェックしてくれるツールはこちら

ディレクトリィーを開く。

カレントにも対応 (filer ではない)
(defun open-directory-where-buffer-file-be (&optional buffer-name)
  (interactive)
  (let (b-f-name d-name)
	(if buffer-name
		(and
		 (setq b-f-name (get-buffer-file-name buffer-name))
		 (setq d-name (directory-namestring b-f-name)))
	  (setq d-name (read-directory-name "open direcory: " &key (get-buffer-file-name ))))
	(shell-execute d-name)
  )
)
(defun open-directory-where-current-buffer-file-be ()
  (interactive)
  (let ((name  (get-buffer-file-name)))
    (shell-execute (if name (directory-namestring name) "~/"))))

まだちょっと ファイラーの操作になれてないので、急いでいるとき 私はwindows フォルダーを出してしまう。


Dump チェック

起動時に "siteini.lをチェックしてダンプし直す" ツール フック関数に設定しておきます。
;引数なしで起動の時だけ
; (get-dump-file-name)関数を必要とします
;これと関数を .xyzzy にでも書いて置いてください
;(add-hook *post-startup-hook* #'check-dumpfile-automatically)
  
(defun check-dumpfile-automatically ()
  "siteini.lをチェックしてダンプし直す"
  ;引数なしで起動の時だけ
  ; need (get-dump-file-name)
 (unless (pop si:*command-line-args*)
  (let ((sd)(f1)(f2))
	(setq sd (merge-pathnames "site-lisp" (si:system-root)))
	(setq f1(concat sd "/siteinit.l"))
	(setq f2(concat sd "/siteinit.lc"))
   (if (and
		(valid-path-p f1)
		(file-exist-p f1)
		(or
		 (and
		  (valid-path-p f2)
		  (file-exist-p f2)
		  (> (file-write-time f1) (file-write-time f2)))
		 (not (file-exist-p f2))
		 ))
	   (progn
		 (byte-compile-file f1)
		 (message "checked siteinit.l")
		 )
	 (message "checked siteinit.l")
	 )
	(setq f2 (get-dump-file-name))
	(if (or
		(and (valid-path-p f2)
			 (file-exist-p f2)
			 (> (file-write-time f1) (file-write-time f2))
			 )
		(not (file-exist-p f2)))
	 (progn
	  (setq f1 (concat (si:system-root) "xyzzy.exe"))
	  (message "checked dump file & rename")
	   ;rename to xyzzzy.w98_20XX_10_10
	   (setq f3 (concat f2 (format-date-string "_%Y_%m_%d" (get-universal-time))))
	  (if (and (file-exist-p f2)
		   (not (file-exist-p f2)))
		  (rename-file f2 (concat f2 (format-date-string "_%Y_%m_%d" (get-universal-time))
								  )))
	  (message "open xyzzy")
	  (dump-xyzzy)
	  (shell-execute f1)
	  (message "kill this xyzzy")
	  (kill-xyzzy)
	  ;(save-all-buffers-kill-xyzzy)
	  )
	  (message "not modified setting files.")
	  )
	)
  ;write this in .xyzzy with hook
;(add-hook *post-startup-hook* #'check-dumpfile-automatically)
  )
  )
	


特定のファイルを消す

default で xyzzy のバックアップファイルを再帰的に消す directory を指定する。(interactive でやってないけど)
(defun delete-file-regexp
  (&optional start-directory  file-name-regp search-recursive ask-flag)
  "delete file which is matched 'one regexp' with recursively"
 ;  "正規表現にマッチしたファイルを 再帰的 に消す"
  (interactive)
   ;(setq ask-flag t);temp
  (if (not start-directory)
	  (setq start-directory (read-directory-name "start directory: " &key "."))) ; お好みで 聞かなくても良い
  (if (not file-name-regp)
	  (setq file-name-regp "^#.*#$")) ;xyzzy の一時ファイルだと思う
  (let ( (delete-file-num 0) (search-file-num 0))
	(dolist (i (directory start-directory
		   :absolute t :recursive search-recursive :file-only t))
	  (incf search-file-num)
	  (when (and
		   (file-exist-p i)
		   (not (file-directory-p i))
		   (string-match file-name-regp (file-namestring i))
		  )
		(when (or
			   (and ask-flag (yes-or-no-p "delete this file: ~A" (file-namestring i)))
			   (not ask-flag))
		  (incf delete-file-num)
		  (message "delete-file~A" i)
		  (delete-file i)
		)
	  )
	)
	(message "done:(delete files number ~D / ~D)" delete-file-num search-file-num)
  )
if not は unlessで

拡張子変更

使い方は 'Directory' '前の拡張子' '変更後の拡張子'を 聞かれる順番に入れてください。
拡張子は lzh から zip に直したいときは 'lzh' 'zip' の それぞれ3文字 を順番に入れてください。
プログラム的には 前とか後ろとか見てません。 .lzh などをチェックしています。

;from "config" by toy san
(defun replace-file-extention-name (&key target-folder from-ext to-ext iter-p)
  "特定のフォルダの拡張子 を変更する"
  (interactive)
  (let (pattern replacement)
	 (unless target-folder
		(setq target-folder (read-directory-name "change extention/target folder: " :default(default-directory))))
  ;check-exist?
	 (unless from-ext
		(setq from-ext (read-string "change ext(e.g. 'lzh'->): ")))
	 (setq pattern (concat "\\(.*\\)\\." from-ext))
;  (message "accept pattern is [~A]" pettern)
	 (unless to-ext
		(setq to-ext (read-string "replacement (e.g. 'lzh'<-): ")));"
	 ;  (message "accept replacement is [~A]" pettern)
	 (setq replacement (concat "\\1." to-ext))

	 (change-file-name target-folder pattern replacement :iter-p iter-p)
  ))


(defun change-file-name (target-folder pattern replacement &key iter-p)

  ;check target-folder
  (dolist (one-list (directory target-folder :absolute t :recursive iter-p )) ;show-dots t
	 (cond ((file-directory-p one-list)
;			  (msgbox "file is ~A" one-list)
			  (if iter-p
					(change-file-name one-list pattern replace-file-extention-name :iter-p iter-p)))
			 (t (let (f-name f-after-name)
					(setq f-name (file-namestring one-list))
					(setq f-after-name
							(substitute-string f-name pattern replacement  :case-fold t))
					(unless (string-equal f-name f-after-name)
					  (setq f-after-name (merge-pathnames f-after-name (directory-namestring one-list)))
;					  (msgbox "check after file [~A] to [~A]" one-list f-after-name)
					  (rename-file one-list f-after-name))
				 )
			 ))
  )
)

ファイラーを使えば楽かも C-c C-f で 出して、 ファイルを複数選択した後 R
上(置換前) \(.*\).zip
下(置換後) \1.lzh
その後確認画面まで出ます。

clear buffer

セッションを閉じるを選んでください。 <!-- 削除 -->
存在しないファイルを探しファイル名を返す。
back up 用ファイル で使うため作った。数字をあげていくやつ hogehoge.txt2とか

(defun check-not-exist-file-by-string (file-name last-file-name #|&optional maxtime|#)
  (let ((time 0)
		(save-file-name (concat file-name last-file-name)))
	(loop
	  (if (file-exist-p save-file-name)
		(progn
		  (setq save-file-name
				(concat file-name last-file-name (format nil "~d" time)))
		  (setq time (1+ time))
		)
		(return save-file-name))
	)
  )
)

バッファーの種類チェック用(全然使えないかも)

(defun minibuffer-from-name-p (buffer-name)
	;minibuffer
  (if (stringp buffer-name) nil
	(char= (char buffer-name 0) #\ )))

(defun tempbuffer-from-name-p (buffer-name)
	;temporary buffer
  (if (stringp buffer-name) nil
	(char= (char buffer-name 0) #\*)))

コンパイル

拡張子で判別

;パスが通っていることが必須条件
;通ってなければ execute-subprocess の第一引数に パスごと指定すれば多分動く
;一応セーブする様にした。

(defun compile-current-file ()
  "拡張子によって コンパイル"
  (interactive)
  (let ((current-file-name (get-buffer-file-name(selected-buffer)))
		  (output-buf-name "*compile-process*")
		  (file-extension-name) (out-buffer) (file-name)
		 )
	 (unless current-file-name
		(exit))
	 (setq current-file-name (file-namestring current-file-name))
	 (setq file-extension-name (pathname-type current-file-name))
	 (setq file-name-without-ext (pathname-name current-file-name))
	 (cond ((string-equal "java" file-extension-name)
			  (setq out-buffer (compile-command-with-message "javac"  (list current-file-name) output-buf-name )))
			 ((string-match "htm+" file-extension-name)
			  (setq out-buffer(compile-command-with-message "appletviewer" (list current-file-name)output-buf-name)))
			 ;cygwin
			  ((string-equal "c" file-extension-name)
				(setq out-buffer(compile-command-with-message "gcc" (list "-o" file-name-without-ext cucurrent-file-name)output-buf-name)))
			  ((string-equal "cpp" file-extension-name)
				(setq out-buffer(compile-command-with-message "g++" (list "-o" file-name-without-ext cucurrent-file-name)output-buf-name)))
			 ;MS VCPP
#|			  ((string-equal "c" file-extension-name)
				(setq out-buffer(compile-command-with-message "cl" (list cucurrent-file-name)output-buf-name)))
			  ((string-equal "cpp" file-extension-name)
				(setq out-buffer(compile-command-with-message "cl" (list "-GX" cucurrent-file-name)output-buf-name)))
|#
			 ((string-equal "l" file-extension-name)
			  (setq out-buffer(byte-compile-current-buffer)))
			 ;(t (setq out-buffer(set-buffer "*compile-test*")))
	 )
	 (when
		  (bufferp out-buffer)
		(pop-to-buffer out-buffer)
		;(if (< (buffer-size) 10)
		;	 (insert "\nend-process"))
		;(ding)
		)
  )t)

;return buffer
(defun compile-command-with-message (cmd arg output-buf-name)
  (save-buffer)
  (setq cmd(format nil "~a ~{ ~a~}" cmd arg))
  (message cmd)
  (execute-subprocess cmd nil output-buf-name))
bufferら(*.l)をコンパイル
(defun byte-compile-open-buffers()
  (interactive)
  (let ((b-n) (error-msges))
	 (with-output-to-temp-buffer ("*byte-compile*" nil)
	 (dolist (a-b (buffer-list))
		(setq b-n  (get-buffer-file-name a-b))
		;(pathname-type(file-namestring b-n))
		(if(and b-n
				  (string= "l" (pathname-type b-n)))
			 (if ;(msgbox "do ~A" b-n)
				  (byte-compile-file b-n)
				(setq error-msges (concat error-msges "\n compiled:" b-n))
				;(setq error-msges (concat error-msges "\n not :" b-n))
				)
		  )))
	 (msgbox "do compile\n~A" error-msges)))


minibuffer で補完時に固定文字列挿入


;; C-x C-f (ファイルを開く)時などにショートカットで固定文字列を挿入
; by masahito henmi  [xyzzy:02669]

;上のものを少し改良したもの
;ディレクトリの部分を消し、ファイル名の部分は残すようにしただけ

;例では C-x C-f のときさらに C-s で ~xyzzy/site-lisp/ を挿入

(define-key minibuffer-local-completion-map #\C-s
    #'(lambda () (interactive)
		  (replace-directory-path-only
		   (concat (merge-pathnames "site-lisp" (si:system-root)) "/"))))

;home directory
(define-key minibuffer-local-completion-map #\C-l
    #'(lambda () (interactive)
		  (replace-directory-path-only
		   (concat (merge-pathnames "~/" (si:system-root)) "/"))))

;homepage
(define-key minibuffer-local-completion-map #\C-w
    #'(lambda () (interactive)
		(replace-directory-path-only "D://homepage/")))

;今度は逆にファイル名の部分を消す
(define-key minibuffer-local-completion-map #\C-f
			#'(lambda ()(interactive)
				(let (fn)
				  (setq fn (buffer-substring (point-min)(point-max)))
				  (delete-all)
				  (insert (directory-namestring fn)))))

;
(defun replace-directory-path-only (replace-directory-path-name)
  (let (fn)
	(setq fn (buffer-substring (point-min)(point-max)))
	(delete-all)
	(insert-strings-and-filename replace-directory-path-name fn)))

(defun insert-strings-and-filename (one filename)
  (insert one)
  (if filename (insert (file-namestring filename))))

(defun delete-all ()
  (delete-region (point-min)(point-max)))


ちょっと進化して C-v(M-vは逆?) でどんどん入れ替える。 (上のを作ったが、自分の記憶力の無さを実行力でカバーするために作った)
(Jan 10 2002)
(define-key minibuffer-local-completion-map #\C-v
            #'(lambda ()(interactive)
                (minibuffer-local-completion 1)))
(define-key minibuffer-local-completion-map #\M-v
            #'(lambda ()(interactive)
                (minibuffer-local-completion -1)))

(defvar minibuffer-local-completion-type t)

(defun minibuffer-local-completion (increment)
  (unless (boundp 'completion-list)
    (set-completion-list))
  (unless (boundp 'completion-list-index)
    (setq completion-list-index (- 0 increment)))

  (if minibuffer-local-completion-type
      (popup-list completion-list 'completion-list-cb)
    (progn

      (setq completion-list-index (mod (+ increment completion-list-index) (length completion-list)))
      (replace-directory-path-only (nth completion-list-index completion-list))
      (let ((i)(tpl))
        (setq tpl "" i 0)
        (dolist (li completion-list)
          (setq tpl (concat tpl
                            (if (= i completion-list-index)
                                "> "
                              "  ")
                            (format nil "~3D: " i)
                            li
                            (if (= i (- (length completion-list) 1))
                                ""
                              "\n"
                              )
                            ))
          (incf i)
          )
        (popup-string tpl (point))
        )
      )
    );if
  )

(defun completion-list-cb (&optional ret)
  (replace-directory-path-only ret)
  (setq completion-list-index (position ret completion-list :test 'equal))
  (refresh-screen)
  )
;此処のリストを適当に変えて楽しんで
(defun set-completion-list ()
  (setq completion-list
        (list "C:/"
              "D:/"
              (si:system-root)
              (merge-pathnames "~/" (si:system-root))
              (concat (merge-pathnames "lisp" (si:system-root)) "/")
              (concat (merge-pathnames "site-lisp" (si:system-root)) "/")
              "C:/homapage/"
              )))

Gresreg 改良版

; 特徴
; read-only のエラー対策
; *gresreg* バッファに そのファイル名を表示します



; gresreg 改良版
;パッケージの関係で
;これより後ろに書かないでください。


; .xyzzy でも 違うファイルに書いてください
; siteint.lならそれから呼んでダンプし直してください
;(load-library "GresregTKI.l")
;とか
;(load-library (concat my-folder "GresregTKI.l"))
;-----------------------------
lisp/gresredg.lをちょっといじってエラー対策しただけ lisp file

current buffer を filer に設定

  ;実行する前 filer をとじないといけないっぽい。
(defun set-filler-current-directory(&optional secondp)
  (interactive)
  "filer の カレントドライブを変える"
(let (cfd)
  (ignore-errors (setq  cfd (directory-namestring (get-buffer-file-name))))
 (if cfd
  (progn
	 (if secondp
		 (progn
		   (setq *filer-secondary-directory* cfd)
		   (message "set current directory to secondary filer: ~A" cfd)
		   )
	   (progn
		 (setq *filer-primary-directory* cfd)
		 (message "set current directory to secondary filer: ~A" cfd)))
	(open-filer))
   (message "current directory is null."))
  ))

;update できないならこっちの方が良いかも
(defun foo ()
  (interactive)
  (let ((*filer-primary-directory* nil)
	(*filer-secondary-directory* nil))
    (open-filer)))

リージョンを目立たせる

どっちかというとこちらをお使いください

(defvar *do-reverse-region* t)
(defun region-reverse ()
 (interactive)
 (when *do-reverse-region*
 (let (p)
  (ignore-errors (setq p (mark t)))
  (if p
   (reverse-region (point) (mark) t);反転させる
   ;(popup-string (buffer-substring (point)(mark)) (point));ポップアップさせる場合
   )
  )))
;おまけ
(setq *do-reverse-region* t)
(setq *do-reverse-region* nil)


;何かしたとき常に表示
(add-hook '*post-command-hook* 'region-reverse)
;外す
(delete-hook '*post-command-hook* 'region-reverse)

;7秒ごとに表示
(start-timer 7 'region-reverse)
;外す
(stop-timer 'region-reverse)

mark-hole-buffer

バッファー全体をリージョンに
windowsの(C-a)みたいに行う。
(defun mark-hole-buffer ()
  "buffer 全体に リージョンを設定"
 (interactive)
 (goto-char (point-min))
 (set-mark)
 (goto-char (point-max))
  )


;設定のおまけ
(global-set-key '(#\C-x #\h) 'mark-hole-buffer)


buffer rename

同名のファイルの場合 バッファーの名前が<2>な感じになるのでディレクトリを付けてしまう。(library/index.html みたいなー) (12/22/2003)

index.htmlがたくさんできてしまう人向けかなぁ



(defun rename-buffer-with-directory (&optional BUFFER)
  "buffer に dir付きで名前を変える"
 (interactive)
 (unless BUFFER
  (setq BUFFER (selected-buffer)))
 (let ((tbn)(bn)(fl)(fln)(id)(idmax))
   (setq tbn (get-buffer-file-name BUFFER))
   (setq bn (buffer-name BUFFER))
  (setq idmax 2)
  (while
   (string-match "<[0-9]+>" bn)
   (setq bn (substring bn 0 (string-match "<[0-9]+>" bn)))
   (setq fl (split-string tbn "/"))
   (setq fln (length fl))
   (setq id idmax)
   (while (not (rename-buffer (abbreviate-display-string (setq bn (concat (nth (- fln id) fl) "/" bn)) 35) BUFFER))
   (decf id)
	)
   (setq bn (buffer-name BUFFER))
   (incf idmax)
   )
  ))

(add-hook '*find-file-hooks* 'rename-buffer-with-directory)
;(delete-hook '*find-file-hooks* 'rename-buffer-with-directory)



しょぼしょぼすくりぷと xyzzy編 トップへ