Make register easier to hook

Make register easier to hook

[Leo]

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

Re: Make register easier to hook

[Daniel Colascione]

[-- Attachment #1: Type: text/plain, Size: 1168 bytes --]

Hi Leo,

On 3/28/11 8:35 AM, Leo wrote:
> 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.

Thanks for doing this work.  An extensible register system is also on my
wishlist.  Why did you decide to use the list for the register structure
instead of the default vector representation?

Also, have you considered eliminating the `info' slot?  Users can
construct closures over any necessary variables and assign these
closures to the register structure's remaining function slots.  After
all, we're getting lexbind, and this feature will make constructing
closures both easy and safe.

Thanks,
Daniel Colascione


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 195 bytes --]

Re: Make register easier to hook

[Leo]

On 2011-03-29 01:37 +0800, Daniel Colascione wrote:
> Thanks for doing this work.  An extensible register system is also on my
> wishlist.  Why did you decide to use the list for the register structure
> instead of the default vector representation?

Probably because it looks nicer inside register-alist and there is
little performance to lose.

> Also, have you considered eliminating the `info' slot? Users can
> construct closures over any necessary variables and assign these
> closures to the register structure's remaining function slots. After
> all, we're getting lexbind, and this feature will make constructing
> closures both easy and safe.

Now I do. But I fail to see how that makes things more convenient. The
closures must be created inside the command/function that creates the
register, right? So one won't be able to define functions with defun for
the slots. Did I miss something?

Leo

Re: Make register easier to hook

[Daniel Colascione]

On 3/28/2011 5:52 PM, Leo wrote:
 > On 2011-03-29 01:37 +0800, Daniel Colascione wrote:
 >> Thanks for doing this work.  An extensible register system is also on my
 >> wishlist.  Why did you decide to use the list for the register structure
 >> instead of the default vector representation?
 >
 > Probably because it looks nicer inside register-alist and there is
 > little performance to lose.
 >
 >> Also, have you considered eliminating the `info' slot? Users can
 >> construct closures over any necessary variables and assign these
 >> closures to the register structure's remaining function slots. After
 >> all, we're getting lexbind, and this feature will make constructing
 >> closures both easy and safe.
 >
 > Now I do. But I fail to see how that makes things more convenient. The
 > closures must be created inside the command/function that creates the
 > register, right? So one won't be able to define functions with defun for
 > the slots. Did I miss something?

Well, when we get lexbind, we'll be able to write something like this
safely, cleanly, and efficiency:

(defun foo-register-jump (some-datum)
   "Implement the jump operation for registers with foo values."
   ...
)

(defun foo-register-assign (register some-datum)
   "Assign a foo register value to some register"

   (register-set register
     (register-make
       :jump-func (lambda () (foo-register-jump some-datum))))


Today, we'd have to write this instead for the same effect:

(defun foo-register-assign (register some-datum)
   "Assign a foo register value to some register"
   (lexical-let ((some-datum some-datum)) ; <----- HACK -------<
     (register-set register
       (register-make
         :jump-func (lambda () (foo-register-jump some-datum)))))

I still think the version with lexical-let is cleaner than using a 
separate data value, especially because you can easily close over 
multiple variables without having to build some aggregate data structure 
to hold them.

By the way: I'd also suggest calling the structure register-value or 
somesuch. It's confusing to have the same word refer to the *identifier* 
for the register (a, b, c, ...) and for the thing *inside* a register (a 
window configuration, a marker, a string, etc.)

Re: Make register easier to hook

[Davis Herring]

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

There are also the (rarer) verbs increment, prepend, and append that could
be useful interfaces to expose for some types.

Davis

-- 
This product is sold by volume, not by mass.  If it appears too dense or
too sparse, it is because mass-energy conversion has occurred during
shipping.

Re: Make register easier to hook

[Leo]

On 2011-03-29 01:39 +0800, Davis Herring wrote:
>> 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.
>
> There are also the (rarer) verbs increment, prepend, and append that could
> be useful interfaces to expose for some types.

Thanks for suggesting. I think we can add support for these when
requested.

Leo