[xyzzy:02451] Re: popup-menu

[Seiya Suda <seiya.suda@xxxxxxxxxxx>]

亀井さん、こんにちは。

        Sat, 1 May 1999 18:19:58 +0900 の
        [xyzzy:02449] Re: popup-menu
        に関するメールにお答えします。

> こんな感じ? それと、bookmark-add-new-bookmark の (eq l x) は絶対
> に一致しませんが、そういうもんでしょうか?

考えときます(^^;

ちょっと根本的な変更があったので、すみませんが、も一回見ていただけ
ませんか。menu のところは、bookmark が10個以上になったら、まとめて
popup の箱の中に入れるという仕様なのですが。

--------------------------------------------------------------
;;; version 0.4  Sat May 01 14:04:03 1999
;;;              save する関係上大幅に書き換えた。

;;; Todo         メニュの階層化のバグ
;;;              ファイルを書き換えたときのしおり位置の update


(provide "bookmark")

(in-package "editor")

(export '(bookmark-jump-to-bookmark bookmark-add-new-bookmark
		  bookmark-clear-this-bookmark bookmark-clear-all bookmark-menu
		  *bookmark-list*))

(define-history-variable *bookmark-list* nil)
(defvar *bookmark-max* 30)

(defun bookmark-add-new-bookmark (name)
  (interactive "sしおり: " :default0 (save-excursion
									   (buffer-substring
										(point)
										(progn (forward-word) (point)))))
  (let* ((filename (get-buffer-file-name (selected-buffer)))
		 (point (point))
		 (bookmark (cons name (cons filename point))))
	(push bookmark *bookmark-list*)
	(let ((exceed (- (length *bookmark-list*) *bookmark-max*)))
	  (when (> exceed 0)
		(setq *bookmark-list* (nbutlast *bookmark-list* exceed)))))
  t)

(defun bookmark-jump-to-bookmark (name)
  (interactive "sしおり: ")
  (let* ((filename (cadr (assoc name *bookmark-list* :test #'string-equal)))
		 (point (cddr (assoc name *bookmark-list* :test #'equal)))
		 (buffername (file-namestring filename)))
	(if (find-buffer buffername)
		(progn
		  (set-buffer (find-buffer buffername))
		  (goto-char point))
	  (progn
		(find-file filename)
		(goto-char point)))))

(defun bookmark-clear-this-bookmark (name)
  (interactive "sしおり: ")
  (let ((n (assoc name *bookmark-list* :test #'string-equal)))
	(setq *bookmark-list* (delete n *bookmark-list* :test #'eq)))
  t)

(defun bookmark-clear-all ()
  (interactive)
  (setq *bookmark-list* nil)
  t)

(defun bookmark-menu ()
  (interactive)
  (continue-pre-selection)
  (let ((menu (create-popup-menu))
		(l *bookmark-list*))
	(if (> (length l) 10)
		(progn
		  (dotimes (i (floor (length l) 10))
			(let ((popup (create-popup-menu)))
			  (add-popup-menu menu popup (format nil "Bookmark-~d" i))
			  (dotimes (i 10)
				(dolist (bm l)
				  (let ((menu-item (car bm))
						(buffer (cadr bm))
						(point (cddr bm)))
					(add-menu-item popup nil menu-item
								   #'(lambda ()
									   (interactive)
									   (bookmark-jump-to-bookmark menu-item))))
				  (pop l)))))
		  (dolist (b l)
			(let ((menu-item (car b))
				  (buffer (cadr b))
				  (point (cddr b)))
			  (add-menu-item menu nil
							 menu-item
							 #'(lambda ()
								 (interactive)
								 (bookmark-jump-to-bookmark menu-item))))))
	  (progn
		(dolist (bookmark l)
		  (let ((menu-item (car bookmark))
				(buffer (cadr bookmark))
				(point (cddr bookmark)))
			(add-menu-item menu nil
						   menu-item
						   #'(lambda ()
							   (interactive)
							   (bookmark-jump-to-bookmark menu-item)))))))
	(track-popup-menu menu)))

(global-set-key '(#\C-x #\b #\n) 'bookmark-add-new-bookmark)
(global-set-key '(#\C-x #\b #\b) 'bookmark-jump-to-bookmark)
(global-set-key '(#\C-x #\b #\c) 'bookmark-clear-this-bookmark)
(global-set-key '(#\C-x #\b #\g) 'bookmark-clear-all)
(global-set-key '(#\C-x #\b #\m) 'bookmark-menu)
(global-set-key #\S-F2 'bookmark-menu)


--------
須田誠也(suda seiya)
seiya.suda@xxxxxxxxxxx
http://member.nifty.ne.jp/seiya-suda/