unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* menu interface for registers
@ 2004-03-18 12:10 Masatake YAMATO
  2004-03-20  4:49 ` Richard Stallman
  0 siblings, 1 reply; 4+ messages in thread
From: Masatake YAMATO @ 2004-03-18 12:10 UTC (permalink / raw)


I have thought register may be useful for ten years.
However it is not easy to use for me. One of the biggest reason is
that I cannot remember what I have stored to which register; register's 
size of emacs is enough but that of my brain is not enough.
Then I have written a menu interface for registers(regmenu.el).
I think it is worth to distribute regmenu.el with emacs.
I would like to have your comments.

Features:
- Used registers holding a point have menu items: "Jump to" and "Exchange Point with" with help-echo.
- Used registers holding text have menu items: "Insert String" and "Edit String" with help-echo.

Masatake YAMATO
-------------------------------------------------------------------------------------------
(Before trying, Please apply the patch I posted with Subject: "Using overlay in register".)
;; regmenu.el --- menu interface for registers.

(defgroup register-menu ()
  "Menu interface for registers."
  :group 'register
  :prefix "register-menu-")

(defcustom register-menu-position 'top-level
  "Register menu posiiton in menu bar."
  :group 'register-menu
  :type '(choice (const top-level) (const nested)))
  
(defvar register-menu-base-menu
  (let ((menu (make-sparse-keymap "Registers")))
    (define-key-after menu [point-to] 
      '(menu-item "Store Point to..." point-to-register))
    (define-key-after menu [copy-to] 
      '(menu-item "Store Text to..."  copy-to-register))
    (define-key-after menu [copy-rectangle-to]
      '(menu-item "Store Rectangle to..." copy-rectangle-to-register))
    menu))
  
(defun register-menu-clear-register (register)
  "Clear the contents of REGISTER."
  (interactive "cClear register: ")
  (set-register register nil))

(defun register-menu-exchange-point-and-register (register &optional delete)
  "Do `jump-to-register' and store the last point or window/frame configuration to REGISTER."
  (interactive "cExchange with register: \nP")
  (let ((val (get-register register)))
    (cond
     ((and (consp val) (frame-configuration-p (car val)))
      (frame-configuration-to-register register)
      (set-frame-configuration (car val) (not delete))
      (goto-char (cadr val)))
     ((and (consp val) (window-configuration-p (car val)))
      (window-configuration-to-register register)
      (set-window-configuration (car val))
      (goto-char (cadr val)))
     ((overlayp val)
      (or (overlay-buffer val)
	  (error "That register's buffer no longer exists"))
      (setq val (copy-overlay val))
      (point-to-register register)
      (switch-to-buffer (overlay-buffer val))
      (goto-char (min (overlay-start val) (overlay-end val)))
      (delete-overlay val))
     (t
      (error "Register doesn't contain a buffer position or configuration")))))

(defun register-menu-edit-register (register)
  "Edit the text contents of REGISTER in minibuffer."
  (interactive "cEdit register: ")
  (let ((val (get-register register)))
    (unless (stringp val)
      (error "Register doesn't contain a string"))
    (set-register register (read-from-minibuffer 
			    (format "Edit text for register[%s]: "
				    (single-key-description register))
			    val))))

;;
;; Dynamic menu items setup
;;
(defun register-menu-install-clear-item (menu key)
  (let ((action `(lambda () (interactive) 
		   (register-menu-clear-register ,key))))
    (define-key-after menu (make-vector 1 key)
      `(menu-item ,(single-key-description key) ,action))))

(defun register-menu-make-help-string-for-overlay (overlay)
  (let* ((buffer (overlay-buffer overlay))
	 (pos (min (overlay-start overlay) (overlay-end overlay)))
	 line contents whole-line)
    (save-excursion
      (set-buffer buffer)
      (goto-char pos)
      (setq line (count-lines (point-min) (point))
	    contents (buffer-substring (line-beginning-position 0) 
				       (line-end-position 2))
	    whole-line (count-lines (point-min) (point-max)))
      (format 
       "Buffer: %s\nLine: %d(%d%%)\nLines Around the Register: \n%s"
       (buffer-name buffer)
       line 
       (/ (* line 100) whole-line)
       contents))))

(defun register-menu-install-overlay-item (menu key val)
  (let* ((action `(lambda ()(interactive) (jump-to-register ,key)))
	 (help (register-menu-make-help-string-for-overlay val)))
    (define-key-after menu (make-vector 1 key)
      `(menu-item ,(single-key-description key) ,action :help ,help))))

(defun register-menu-install-exchange-item (menu key val)
  (let* ((action `(lambda ()(interactive) 
		    (register-menu-exchange-point-and-register
		     ,key)))
	 (help (register-menu-make-help-string-for-overlay val)))
    (define-key-after menu (make-vector 1 key)
      `(menu-item ,(single-key-description key) ,action :help ,help))))

(defun register-menu-install-string-item (menu key val)
  (let ((action `(lambda ()(interactive) (insert-register ,key)))
	(help (format "Contents: \n%s" val)))
    (define-key-after menu (make-vector 1 key)
      `(menu-item ,(single-key-description key) ,action :help ,help))))

(defun register-menu-install-edit-item (menu key val)
  (let ((action `(lambda ()(interactive) (register-menu-edit-register ,key)))
	(help (format "Contents: \n%s" val)))
    (define-key-after menu (make-vector 1 key)
      `(menu-item ,(single-key-description key) ,action :help ,help))))

(defun register-menu-install-rectangle-item (menu key val)
  (register-menu-install-string-item menu key val))

(defun menu-bar-update-registers (&optional force)
  (let (register val
	(list (copy-sequence register-alist))
	(menu (copy-sequence register-menu-base-menu))
	(overlays-menu (make-sparse-keymap "Jump to"))
	(exchange-menu (make-sparse-keymap "Exchange Point with"))
	(strings-menu (make-sparse-keymap "Insert String"))
	(edit-menu    (make-sparse-keymap "Edit String"))
	(rectangles-menu (make-sparse-keymap "Insert Rectangle"))
	(clear-menu   (make-sparse-keymap "Clear")))
    (setq list (sort list (lambda (a b) (< (car a) (car b)))))
    (dolist (elt list)
      (setq register (car elt)
	    val (get-register register))
      (when val
	(register-menu-install-clear-item clear-menu register)
	(cond
	 ((and (overlayp val) (overlay-buffer val))
	  (when (not (and (eq (current-buffer) (overlay-buffer val))
			(eq (point) (min (overlay-start val)
					 (overlay-end val)))))
	    (register-menu-install-overlay-item
	     overlays-menu register val)
	    (register-menu-install-exchange-item
	     exchange-menu register val)))
	 ((stringp val)
	  (register-menu-install-string-item
	   strings-menu register val)
	  (register-menu-install-edit-item
	   edit-menu register val))
	 ((and (consp val)
	       (not (frame-configuration-p  (car val)))
	       (not (window-configuration-p (car val))))
	  (register-menu-install-rectangle-item
	   rectangles-menu register val))
	 )))
    (define-key menu [sep0] '("--"))
    (define-key menu [rectangles] `(menu-item 
				    "Insert Rectangle"
				    ,rectangles-menu
				    :keys ,(substitute-command-keys "\\[insert-register]")
				    :enable ,(< 2 (length rectangles-menu))))
    (define-key menu [edit] `(menu-item 
			      "Edit String"
			      ,edit-menu
			      :enable ,(< 2 (length edit-menu))))
    (define-key menu [strings] `(menu-item 
				 "Insert String"
				 ,strings-menu
				 :keys ,(substitute-command-keys "\\[insert-register]")
				 :enable ,(< 2 (length strings-menu))))
    (define-key menu [exchange] `(menu-item
				  "Exchange Point with"
				 ,exchange-menu
				 :enable ,(< 2 (length exchange-menu))))
    (define-key menu [overlays] `(menu-item
				 "Jump to"
				 ,overlays-menu
				 :keys ,(substitute-command-keys "\\[jump-to-register]")
				 :enable ,(< 2 (length overlays-menu))))
    (define-key-after menu [sep2] '("--"))
    (define-key-after menu [clear] `(menu-item
				     "Clear"
				     ,clear-menu
				     :enable ,(< 2 (length clear-menu))))
    (cond
     ((eq register-menu-position 'top-level)
      (define-key-after (current-global-map) [menu-bar register]
	(cons "Registers" menu)))
     ((eq register-menu-position 'nested)
      (define-key-after menu-bar-edit-menu [register]
	(cons "Registers" menu) 'bookmark)
      ))))

(add-hook 'menu-bar-update-hook 'menu-bar-update-registers)
(menu-bar-update-registers)

(provide 'regmenu)
;; regmenu.el ends here.

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2004-03-22  5:25 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-03-18 12:10 menu interface for registers Masatake YAMATO
2004-03-20  4:49 ` Richard Stallman
2004-03-21 14:52   ` Masatake YAMATO
2004-03-22  5:25     ` Richard Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).