emacsにsave-pointを作った。

emacs

anythingのcandidate-trasraterが便利そうなので使ってみたかったのです＞＜。

説明

emacsの現在の位置とバッファを保存することができます。
(C-x C-xでカーソルをregionの開始位置に戻る操作のようなものを繰り返すことができます）

使い方

  • save-current-point　現在の位置などを保存する
  • pop-save-point　一番最後に保存した位置に移動する（保存していた位置は消える）
  • load-save-point 保存してある位置のリストが表示される。選択した位置に移動する。
    • （保存していた位置は消えない）
    • （呼び出したbufferが一番最後に保存したバッファと異なれば、現在の位置を保存する）

コード

;;save-point
;;deleteのactionを加えて、その後継続的に利用できるようにする。
(defun princ-element (x) 
  (cond ((null x) (princ "nil"))
	((consp x) 
	 (princ "(")
	 (princ-element (car x)) (princ " . ") (princ-element (cdr x))
	 (princ ")"))
	((stringp x) (princ (concat "\\\"" x "\\\"")))
	(t (princ x)
	   )))

 (defun xlist->candidate-list (l) 
  (let ((buf "*t*"))
    (with-output-to-temp-buffer buf
      (princ "(")
      (dolist (e l)
	(progn
	  (princ "\"")
	  (princ-element e))
	  (princ "\""))
      (princ ")"))
      (let ((re (read (get-buffer buf))))
	(kill-buffer buf)
	re)))

(defvar my-save-points nil)

(setq anything-c-source-save-point 
      '((name . "savepoint")
	(candidates . my-save-points)
	(candidate-transformer . xlist->candidate-list)
	(action . (("load" . (lambda (c)
			      (print (read c))
			      (goto-save-point (read c))))
		   ("delete" . (lambda (c)
				 (setq my-save-points (delete (read c) my-save-points))))))))

(defun save-current-point (&optional pred) (interactive)
  (let ((current-point (cons (buffer-name) (point))))
    (if pred
	(unless (equal (caar my-save-points) (buffer-name))
	  (push current-point my-save-points)
	  (message "this point is saved"))
      (progn
	(push current-point my-save-points)
	(message "this point is saved")))
  ))

(defun load-save-point () (interactive)
  (unless (equal (current-buffer) (caar my-save-points))
    (save-current-point t))
  (let ((anything-sources (list anything-c-source-save-point)))
    (anything)))

(defun goto-save-point (save-point)
    (let ((buf (car save-point))
	  (p (cdr save-point)))
      (switch-to-buffer (get-buffer buf))
      (goto-char p)))
  
(defun pop-save-points () (interactive)
  (goto-save-point (car my-save-points))
  (setq my-save-points (cdr my-save-points)))

(global-set-key "\C-c\C-]" 'save-current-point)
(global-set-key "\C-c]" 'pop-save-points)
(global-set-key [?\C-}] 'load-save-point)

追記

こんな風にするとさらに豪華になるかもしれない。
（移動する位置にある内容が少しだけみれる）

(defvar my-save-points-separator "  ::")
(setq anything-c-source-save-point 
      '((name . "savepoint")
	(candidates . my-save-points)
	(candidate-transformer . (lambda (save-points)
					;  (setq auto-save-buffers-active-p nil)
					;  (let ((re
				   (mapcar* (lambda (sp str-sp) ;sp = save-point
					      (set-buffer (car sp))
					      (goto-char (cdr sp))	     
					      (let* ((p (point-at-bol))
						     (fill (+ p fill-column))
						     (end (if (< fill (point-at-eol)) fill (point-at-eol)))
						     (line-content
						      (buffer-substring-no-properties p end)))
						(concat str-sp  my-save-points-separator line-content)))
					    save-points
					    (xlist->candidate-list save-points))))
				    ; (setq auto-save-buffers-active-p t)
				    ; re)))
	(action . (("load" . (lambda (c)
			       (let ((sp (read (car (split-string c my-save-points-separator)))))
			       (goto-save-point sp))))
		   ("delete" . (lambda (c)
				 (setq my-save-points (delete (read c) my-save-points))))))))