unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* Make register easier to hook
@ 2011-03-28 15:35 Leo
  2011-03-28 17:37 ` Daniel Colascione
  2011-03-28 17:39 ` Davis Herring
  0 siblings, 2 replies; 6+ messages in thread
From: Leo @ 2011-03-28 15:35 UTC (permalink / raw)
  To: emacs-devel

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))))





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

end of thread, other threads:[~2011-03-31 10:37 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-03-28 15:35 Make register easier to hook Leo
2011-03-28 17:37 ` Daniel Colascione
2011-03-29  0:52   ` Leo
2011-03-29  2:14     ` Daniel Colascione
2011-03-28 17:39 ` Davis Herring
2011-03-31 10:37   ` Leo

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).