From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Leo Newsgroups: gmane.emacs.devel Subject: Make register easier to hook Date: Mon, 28 Mar 2011 23:35:27 +0800 Message-ID: NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: dough.gmane.org 1301326567 12413 80.91.229.12 (28 Mar 2011 15:36:07 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Mon, 28 Mar 2011 15:36:07 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Mar 28 17:36:03 2011 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Q4EU5-0003Lr-G2 for ged-emacs-devel@m.gmane.org; Mon, 28 Mar 2011 17:36:02 +0200 Original-Received: from localhost ([127.0.0.1]:45134 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q4EU4-0002hu-M8 for ged-emacs-devel@m.gmane.org; Mon, 28 Mar 2011 11:36:00 -0400 Original-Received: from [140.186.70.92] (port=52244 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Q4ETz-0002hc-Tj for emacs-devel@gnu.org; Mon, 28 Mar 2011 11:35:57 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Q4ETx-0002Ej-U3 for emacs-devel@gnu.org; Mon, 28 Mar 2011 11:35:55 -0400 Original-Received: from lo.gmane.org ([80.91.229.12]:41291) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Q4ETx-0002EW-EZ for emacs-devel@gnu.org; Mon, 28 Mar 2011 11:35:53 -0400 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1Q4ETu-0003H8-F4 for emacs-devel@gnu.org; Mon, 28 Mar 2011 17:35:50 +0200 Original-Received: from th041112.ip.tsinghua.edu.cn ([59.66.41.112]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 28 Mar 2011 17:35:50 +0200 Original-Received: from sdl.web by th041112.ip.tsinghua.edu.cn with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Mon, 28 Mar 2011 17:35:50 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 241 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: th041112.ip.tsinghua.edu.cn Face: iVBORw0KGgoAAAANSUhEUgAAACgAAAAoBAMAAAB+0KVeAAAAGFBMVEUzRVhbQj4eZqO6SjnT eWpxnMetm5b6/PmidmqrAAAAAWJLR0QAiAUdSAAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1F B9cBBwMLBfKABCMAAAFoSURBVCjPtZI9a8MwEIaFoc7aYDdelQMna0Em3tsSr0XUeE2Q6a22a+v+ fk8fSSBkbDUI6dHpfe9OEvRgiD+ApqKPJgJeB6iUUXWESjUe/ig38AJrhqqvaU2nTIXbNvOQ40fe qdry4kyGoVWsfCQalXpHnJGM01wjWdYbMlXNFdsZDO69m9aqNqxEJqTEgbM5OF7wlEfIoll1Ked4 LbM5X2EdILLokEdmI8z7g5cKED0cuTC930TYhy7ZDekkXVGw/L60TguJePPxcJF48lpsSUWEA/Ju jGFNgJOXc4Hz7TmAdBeu5Ve4AEjOi2/2jfd3cAJZ+IbNrvdjgBZY01b+HTuG3cLws6BJZqVOj/pp T0OqVwx3rFq+QmJwx3loK5JSLEhDIt62+mtC2C+SrAUxEbV6C6v2BRbd6pILBKFpepKZJHgGgrKF sptSUUoczpwg2pQ7ZH1tgs0ou/917mzz6Cs2//C978cv5l07L02orIEAAAAASUVORK5CYII= User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/23.3.50 (Mac OS X 10.6.7) Cancel-Lock: sha1:rEH+C/GNUdMu7R+bH2VwnIwKvIs= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 80.91.229.12 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:137781 Archived-At: Hello all, I would like to extend register.el so that 3rd party packages can add new register and have C-x r j, C-x r i and M-x list-registers work with it without needing to modify register.el. With the attached draft patch, one can now do: (defun WHATEVER-to-register (register) (interactive) (register-set register (register-make :info WHATEVER :jump-func function-to-handle-WHATEVER))) And C-x r j will call function-to-handle-WHATEVER for jumping. Any comments will be highly appreciated. Thanks. Leo === modified file 'lisp/register.el' --- lisp/register.el 2011-01-25 04:08:28 +0000 +++ lisp/register.el 2011-03-28 15:23:23 +0000 @@ -28,6 +28,8 @@ ;; pieces of buffer state to named variables. The entry points are ;; documented in the Emacs user's manual. +(eval-when-compile (require 'cl)) + (declare-function semantic-insert-foreign-tag "semantic/tag" (foreign-tag)) (declare-function semantic-tag-buffer "semantic/tag" (tag)) (declare-function semantic-tag-start "semantic/tag" (tag)) @@ -50,9 +52,16 @@ ;;; Code: -(defvar register-alist nil - "Alist of elements (NAME . CONTENTS), one for each Emacs register. -NAME is a character (a number). CONTENTS is a string, number, marker or list. +(defstruct (register (:constructor register-make) + (:copier nil) + (:type list) + :named) + info print-func jump-func insert-func) + +;; Add documentation string for the constructor +(setf (documentation-property 'register-make 'function-documentation) + "Constructor for register objects. +INFO holds the contents of the register. It can be a string, number, marker or list. A list of strings represents a rectangle. A list of the form (file . FILE-NAME) represents the file named FILE-NAME. A list of the form (file-query FILE-NAME POSITION) represents @@ -61,13 +70,27 @@ A list of the form (WINDOW-CONFIGURATION POSITION) represents a saved window configuration plus a saved value of point. A list of the form (FRAME-CONFIGURATION POSITION) - represents a saved frame configuration plus a saved value of point.") + represents a saved frame configuration plus a saved value of point. + +PRINT-FUNC if set controls how `list-registers' and +`view-register' print a register. It should be a function +recieving one argument INFO. + +If JUMP-FUNC is set, `jump-to-register' calls it to do the work. + +If INSERT-FUNC is set, `insert-register' calls it to do the work. -(defun get-register (register) +\(fn &key INFO PRINT-FUNC JUMP-FUNC INSERT-FUNC)") + +(defvar register-alist nil + "Alist of elements (NAME . OBJECT), one for each Emacs register. +NAME is a character (a number). OBJECT is created by `register-make'.") + +(defun register-get (register) "Return contents of Emacs register named REGISTER, or nil if none." (cdr (assq register register-alist))) -(defun set-register (register value) +(defun register-set (register value) "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE. See the documentation of the variable `register-alist' for possible VALUEs." (let ((aelt (assq register register-alist))) @@ -76,6 +99,9 @@ (push (cons register value) register-alist)) value)) +(define-obsolete-function-alias 'get-register 'register-get "24.1") +(define-obsolete-function-alias 'set-register 'register-set "24.1") + (defun point-to-register (register &optional arg) "Store current location of point in register REGISTER. With prefix argument, store current frame configuration. @@ -84,7 +110,7 @@ (interactive "cPoint to register: \nP") ;; Turn the marker into a file-ref if the buffer is killed. (add-hook 'kill-buffer-hook 'register-swap-out nil t) - (set-register register + (register-set register (if arg (list (current-frame-configuration) (point-marker)) (point-marker)))) @@ -95,7 +121,7 @@ (interactive "cWindow configuration to register: \nP") ;; current-window-configuration does not include the value ;; of point in the current buffer, so record that separately. - (set-register register (list (current-window-configuration) (point-marker)))) + (register-set register (list (current-window-configuration) (point-marker)))) (defun frame-configuration-to-register (register &optional arg) "Store the window configuration of all frames in register REGISTER. @@ -104,7 +130,7 @@ (interactive "cFrame configuration to register: \nP") ;; current-frame-configuration does not include the value ;; of point in the current buffer, so record that separately. - (set-register register (list (current-frame-configuration) (point-marker)))) + (register-set register (list (current-frame-configuration) (point-marker)))) (defalias 'register-to-point 'jump-to-register) (defun jump-to-register (register &optional delete) @@ -118,8 +144,14 @@ delete any existing frames that the frame configuration doesn't mention. \(Otherwise, these frames are iconified.)" (interactive "cJump to register: \nP") - (let ((val (get-register register))) + (let* ((object (register-get register)) + (val (if (register-p object) + (register-info object) + object)) + (jump (and (register-p object) + (register-jump-func object)))) (cond + (jump (funcall jump val)) ((and (consp val) (frame-configuration-p (car val))) (set-frame-configuration (car val) (not delete)) (goto-char (cadr val))) @@ -165,7 +197,7 @@ at point, and point moves to the end of that number. Interactively, NUMBER is the prefix arg (none means nil)." (interactive "P\ncNumber to register: ") - (set-register register + (register-set register (if number (prefix-numeric-value number) (if (looking-at "\\s-*-?[0-9]+") @@ -180,13 +212,13 @@ (interactive "p\ncIncrement register: ") (or (numberp (get-register register)) (error "Register does not contain a number")) - (set-register register (+ number (get-register register)))) + (register-set register (+ number (get-register register)))) (defun view-register (register) "Display what is contained in register named REGISTER. The Lisp value REGISTER is a character." (interactive "cView register: ") - (let ((val (get-register register))) + (let ((val (register-get register))) (if (null val) (message "Register %s is empty" (single-key-description register)) (with-output-to-temp-buffer "*Output*" @@ -199,7 +231,7 @@ (setq list (sort list (lambda (a b) (< (car a) (car b))))) (with-output-to-temp-buffer "*Output*" (dolist (elt list) - (when (get-register (car elt)) + (when (register-get (car elt)) (describe-register-1 (car elt)) (terpri)))))) @@ -207,8 +239,15 @@ (princ "Register ") (princ (single-key-description register)) (princ " contains ") - (let ((val (get-register register))) + (let* ((object (register-get register)) + (val (if (register-p object) + (register-info object) + object)) + (printfunc (and (register-p object) + (register-print-func object)))) (cond + (printfunc (funcall printfunc val)) + ((numberp val) (princ val)) @@ -283,8 +322,14 @@ Interactively, second arg is non-nil if prefix arg is supplied." (interactive "*cInsert register: \nP") (push-mark) - (let ((val (get-register register))) + (let* ((object (register-get register)) + (val (if (register-p object) + (register-info object) + object)) + (insert-func (and (register-p object) + (register-insert-func object)))) (cond + (insert-func (funcall insert-func val)) ((consp val) (insert-rectangle val)) ((stringp val) @@ -307,7 +352,7 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions indicating what to copy." (interactive "cCopy to register: \nr\nP") - (set-register register (filter-buffer-substring start end)) + (register-set register (filter-buffer-substring start end)) (if delete-flag (delete-region start end))) (defun append-to-register (register start end &optional delete-flag) @@ -318,7 +363,7 @@ (interactive "cAppend to register: \nr\nP") (let ((reg (get-register register)) (text (filter-buffer-substring start end))) - (set-register + (register-set register (cond ((not reg) text) ((stringp reg) (concat reg text)) (t (error "Register does not contain text"))))) @@ -332,7 +377,7 @@ (interactive "cPrepend to register: \nr\nP") (let ((reg (get-register register)) (text (filter-buffer-substring start end))) - (set-register + (register-set register (cond ((not reg) text) ((stringp reg) (concat text reg)) (t (error "Register does not contain text"))))) @@ -346,7 +391,7 @@ Called from a program, takes four args: REGISTER, START, END and DELETE-FLAG. START and END are buffer positions giving two corners of rectangle." (interactive "cCopy rectangle to register: \nr\nP") - (set-register register + (register-set register (if delete-flag (delete-extract-rectangle start end) (extract-rectangle start end))))