[Date Prev] [Date Index] [Date Next]
[Thread Prev] [Thread Index] [Thread Next]

[xyzzy:02444] popup-menu

須田です。どなたか、以下のコード、特に bookmark-menu を添削
してください。お願いします。

------------------------------------------------------------------
;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;; Is this file part of xyzzy?
;;;
;;; bookmark.l

;;; version 0.0  Wed Apr 28 21:28:37 1999
;;;              gamrk を改造して bookmark.l にするぞと決意。
;;;              bookmark-add, bookmark-jump、すらすら。
;;;              version 0.0 にして、一応使えるから公開。
;;;
;;; version 0.1  Thu Apr 29 09:40:19 1999
;;;              global-mark との関係をきちんと処理しようと決意。
;;;              bookmark-delete, bookmark-clearを導入。
;;;              キーとの関係でコマンド名を変更。
;;;
;;; version 0.2  Thu Apr 29 10:42:39 1999
;;;              しおりをはさむ際、point からの word を拾ってデフォル
;;;              トのしおり名にすることにした。

;;; version 0.3  Thu Apr 29 12:15:53 1999
;;;              popup-menu を導入。

;;; Todo         save, load, メニュの階層化


(provide "bookmark")

(in-package "editor")

(require 'gmark)

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

(defvar *bookmark-global-mark-list* nil)

(defun bookmark-add-new-bookmark (name)
  (interactive "sしおり: " :default0 (save-excursion
									   (buffer-substring
										(point)
										(progn (forward-word) (point)))))
  (let ((l (cons name (set-marker (make-marker))))
		(x (car *bookmark-global-mark-list*)))
	(unless (eq l x)
	  (push l *bookmark-global-mark-list*)
	  (setq *bookmark-last-global-mark* nil)
	  (let ((exceed (- (length *bookmark-global-mark-list*) *global-mark-max*)))
		(when (> exceed 0)
		  (setq *bookmark-global-mark-list* (nbutlast *bookmark-global-mark-list* exceed))))))
  t)

(defun bookmark-jump-to-bookmark (name)
  (interactive "sしおり: ")
  (let ((marker (cdr (assoc name *bookmark-global-mark-list* :test #'equal))))
	(bookmark-goto marker)))

(defun bookmark-goto (marker)
  (set-buffer (marker-buffer marker))
  (goto-char (marker-point marker)))

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

(defun bookmark-clear-all ()
  (interactive)
  (dolist (x *bookmark-global-mark-list*)
	(delete-marker (cdr x)))
  (setq *bookmark-global-mark-list* nil)
  t)

(defvar *bookmark-popup-menu* nil)
(setq *bookmark-popup-menu* (create-popup-menu nil))
(defvar *bookmark-popup-menu-1* nil)
(setq *bookmark-popup-menu-1* (create-popup-menu nil))


(defun bookmark-menu ()
  (interactive)
  (while (get-menu-position *bookmark-popup-menu* 'position)
	(delete-menu *bookmark-popup-menu* 'position))
  (while (get-menu-position *bookmark-popup-menu* :tag)
	(delete-menu *bookmark-popup-menu* :tag))
  (continue-pre-selection)
  (let ((how-many (length *bookmark-global-mark-list*)) ;;マークのリストの長さ
		(n 0)
		(popup (create-popup-menu :tag)))
	(multiple-value-bind (how-great rest) (floor how-many 10)
	  (if (> how-many 10)
		  (save-excursion
			(dotimes (i how-great)
			  (let ((string (format nil "Bookmark-~d" i)))
				(add-popup-menu *bookmark-popup-menu* popup string)
				(while (< n (* how-great 10))
				  (dolist (bookmark (subseq *bookmark-global-mark-list*
											n (+ n 10)))
					(let ((menu-item (car bookmark))
						  (marker (cdr bookmark)))
					  (add-menu-item popup 'position
									 menu-item
									 #'(lambda ()
										 (interactive)
										 (bookmark-goto marker)))))
				  (setq n (+ n 10)))))
			(dolist (bm (subseq *bookmark-global-mark-list*
								(* how-great 10)))
			  (let ((menu-item (car bm))
					(marker (cdr bm)))
				(add-menu-item *bookmark-popup-menu* 'position
							   menu-item
							   #'(lambda ()
								   (interactive)
								   (bookmark-goto marker))))))
		(save-excursion
		  (dolist (bookmark *bookmark-global-mark-list*)
			(let ((menu-item (car bookmark))
				  (marker (cdr bookmark)))
			  (add-menu-item *bookmark-popup-menu* 'position
							 menu-item
							 #'(lambda ()
								 (interactive)
								 (bookmark-goto marker)))))))))
  (track-popup-menu *bookmark-popup-menu*))

#|
(defun bookmark-menu ()
  (interactive)
  (while (get-menu-position *bookmark-popup-menu* 'bookmark)
	(delete-menu *bookmark-popup-menu* 'bookmark))
  (continue-pre-selection)
  (save-excursion
	(dolist (bookmark *bookmark-global-mark-list*)
	  (let ((menu-item (car bookmark))
			(marker (cdr bookmark)))
		  (add-menu-item *bookmark-popup-menu* 'bookmark
						 menu-item
						 #'(lambda ()
							 (interactive)
							 (bookmark-goto marker))))))
  (track-popup-menu *bookmark-popup-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/
Index Home