bug#8415: 23.3.50; Extensible Emacs Registers

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

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

I would like to propose the following patch that makes the register
system easier to hook into. With this change, for example, if one wants
to make a command to save a keyboard macro to a register. There is no
need to change register.el. 3rd party libraries such as undo-tree.el can
add registers of undo state that one can jump to with C-x r j.

With this change, register is now a compound data structure. I have also
removed one inconsistent use of the argument REGISTER. In the new code
it always refers to the register object and never the name.

There is only one small incompatible change, set-register now returns
the register object but the return value of register-set is rarely used.
Other than that it should be 100% backward compatible. Let me know if
not.

Leo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: register.diff --]
[-- Type: text/x-diff, Size: 15759 bytes --]

=== modified file 'lisp/register.el'
--- lisp/register.el	2011-01-25 04:08:28 +0000
+++ lisp/register.el	2011-04-03 12:00:44 +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,27 @@
 
 ;;; 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.
+;;; in-memeory persistency
+(defvar register-hash-table (make-hash-table))
+
+;;; immutable register object
+(defstruct
+  (register (:constructor nil)
+	    (:constructor register--make (name &optional value print-func
+					       jump-func insert-func extra))
+	    (:copier nil)
+	    (:type list)
+	    :named)
+  (name	       nil :read-only t)
+  (value       nil :read-only t)
+  (print-func  nil :read-only t)
+  (jump-func   nil :read-only t)
+  (insert-func nil :read-only t)
+  (extra       nil :read-only t))
+
+(defun* register-make (name value &key print-func jump-func insert-func extra)
+  "Return a newly created register with NAME and VALUE.
+VALUE may 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,53 +81,78 @@
 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.
 
-(defun get-register (register)
-  "Return contents of Emacs register named REGISTER, or nil if none."
-  (cdr (assq register register-alist)))
-
-(defun set-register (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)))
-    (if aelt
-	(setcdr aelt value)
-      (push (cons register value) register-alist))
-    value))
+VALUE may also be any customized data.
 
-(defun point-to-register (register &optional arg)
-  "Store current location of point in register REGISTER.
+PRINT-FUNC if provided controls how `list-registers' and
+`view-register' print the register.  It should be a function
+recieving one argument VALUE and print text that completes
+this sentence:
+  Register `X' contains [TEXT PRINTED BY PRINT-FUNC]
+
+JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register.
+INSERT-FUNC if set, controls how `insert-register' insert the register.
+They both receive the VALUE of the register as argument."
+  (let ((register (register--make name value print-func
+				  jump-func insert-func extra)))
+    (puthash name register register-hash-table)
+    register))
+
+(defsubst register-find (name &optional if-does-not-exist)
+  "Find the register named NAME and return it.
+If IF-DOES-NOT-EXIST is :error, signal an error; otherwise return nil."
+  (let ((register (gethash name register-hash-table)))
+    (or register (case if-does-not-exist
+		   (:error (error "Register named `%s' does not exist"
+				  (single-key-description name)))
+		   (otherwise nil)))))
+
+(defsubst register-map (function)
+  "Apply FUNCTION to each register for side effects only.
+FUNCTION should accept one argument - the register."
+  (maphash (lambda (name register)
+	     (funcall function register)) register-hash-table))
+
+(define-obsolete-function-alias 'set-register 'register-make "24.1")
+(make-obsolete 'get-register "use `register-find' and `register-value'." "24.1")
+
+(defun get-register (name)
+  "Return the value of register named NAME or nil if none."
+  (ignore-errors (register-value (register-find name :error))))
+
+(defun point-to-register (name &optional arg)
+  "Store current location of point in a register.
 With prefix argument, store current frame configuration.
 Use \\[jump-to-register] to go to that location or restore that configuration.
 Argument is a character, naming the register."
   (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
-		(if arg (list (current-frame-configuration) (point-marker))
-		  (point-marker))))
+  (register-make name
+		 (if arg (list (current-frame-configuration) (point-marker))
+		   (point-marker))))
 
-(defun window-configuration-to-register (register &optional arg)
-  "Store the window configuration of the selected frame in register REGISTER.
+(defun window-configuration-to-register (name &optional arg)
+  "Store the window configuration of the selected frame in a register.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (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-make name (list (current-window-configuration) (point-marker))))
 
-(defun frame-configuration-to-register (register &optional arg)
-  "Store the window configuration of all frames in register REGISTER.
+(defun frame-configuration-to-register (name &optional arg)
+  "Store the window configuration of all frames in a register.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (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-make name (list (current-frame-configuration) (point-marker))))
 
 (defalias 'register-to-point 'jump-to-register)
-(defun jump-to-register (register &optional delete)
+(defun jump-to-register (name &optional delete)
   "Move point to location stored in a register.
 If the register contains a file name, find that file.
 \(To put a file name in a register, you must use `set-register'.)
@@ -118,8 +163,11 @@
 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* ((register (register-find name :error))
+	 (val (register-value register))
+	 (jump-func (register-jump-func register)))
     (cond
+     (jump-func (funcall jump-func val))
      ((and (consp val) (frame-configuration-p (car val)))
       (set-frame-configuration (car val) (not delete))
       (goto-char (cadr val)))
@@ -150,65 +198,71 @@
 (defun register-swap-out ()
   "Turn markers into file-query references when a buffer is killed."
   (and buffer-file-name
-       (dolist (elem register-alist)
-	 (and (markerp (cdr elem))
-	      (eq (marker-buffer (cdr elem)) (current-buffer))
-	      (setcdr elem
-		      (list 'file-query
-			    buffer-file-name
-			    (marker-position (cdr elem))))))))
+       (register-map
+	(lambda (register)
+	  (let ((val (register-value register)))
+	    (and (markerp val)
+		 (eq (marker-buffer val) (current-buffer))
+		 (register-make (register-name register)
+				(list 'file-query
+				      buffer-file-name
+				      (marker-position val)))))))))
 
-(defun number-to-register (number register)
+(defun number-to-register (number name)
   "Store a number in a register.
-Two args, NUMBER and REGISTER (a character, naming the register).
+Two args, NUMBER and NAME (a character, naming the register).
 If NUMBER is nil, a decimal number is read from the buffer starting
 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
-		(if number
-		    (prefix-numeric-value number)
-		  (if (looking-at "\\s-*-?[0-9]+")
-		      (progn
-			(goto-char (match-end 0))
-			(string-to-number (match-string 0)))
-		    0))))
+  (register-make name
+		 (if number
+		     (prefix-numeric-value number)
+		   (if (looking-at "\\s-*-?[0-9]+")
+		       (progn
+			 (goto-char (match-end 0))
+			 (string-to-number (match-string 0)))
+		     0))))
 
-(defun increment-register (number register)
-  "Add NUMBER to the contents of register REGISTER.
+(defun increment-register (number name)
+  "Add NUMBER to the value of the register named NAME.
 Interactively, NUMBER is the prefix arg."
   (interactive "p\ncIncrement register: ")
-  (or (numberp (get-register register))
-      (error "Register does not contain a number"))
-  (set-register register (+ number (get-register register))))
-
-(defun view-register (register)
-  "Display what is contained in register named REGISTER.
-The Lisp value REGISTER is a character."
+  (let ((register (register-find name :error)))
+    (or (numberp (register-value register))
+	(error "Register does not contain a number"))
+    (register-make name (+ number (register-value register)))))
+
+(defun view-register (name)
+  "Display what is contained in register named NAME."
   (interactive "cView register: ")
-  (let ((val (get-register register)))
-    (if (null val)
-	(message "Register %s is empty" (single-key-description register))
-      (with-output-to-temp-buffer "*Output*"
-	(describe-register-1 register t)))))
+  (let* ((register (register-find name :error))
+	 (val (register-value register)))
+    (with-output-to-temp-buffer "*Output*"
+      (describe-register-1 register t))))
 
 (defun list-registers ()
   "Display a list of nonempty registers saying briefly what they contain."
   (interactive)
-  (let ((list (copy-sequence register-alist)))
-    (setq list (sort list (lambda (a b) (< (car a) (car b)))))
+  (let (names register)
+    (register-map (lambda (r) (push (register-name r) names)))
+    (setq names (sort names '<))
     (with-output-to-temp-buffer "*Output*"
-      (dolist (elt list)
-	(when (get-register (car elt))
-	  (describe-register-1 (car elt))
+      (dolist (name names)
+	(setq register (register-find name))
+	(when (and register (register-value register))
+	  (describe-register-1 register)
 	  (terpri))))))
 
 (defun describe-register-1 (register &optional verbose)
   (princ "Register ")
-  (princ (single-key-description register))
+  (princ (single-key-description (register-name register)))
   (princ " contains ")
-  (let ((val (get-register register)))
+  (let ((val (register-value register))
+	(print-func (register-print-func register)))
     (cond
+     (print-func (funcall print-func val))
+
      ((numberp val)
       (princ val))
 
@@ -276,17 +330,18 @@
       (princ "Garbage:\n")
       (if verbose (prin1 val))))))
 
-(defun insert-register (register &optional arg)
-  "Insert contents of register REGISTER.  (REGISTER is a character.)
+(defun insert-register (name &optional arg)
+  "Insert the value of the register named NAME.
 Normally puts point before and mark after the inserted text.
 If optional second arg is non-nil, puts mark before and point after.
 Interactively, second arg is non-nil if prefix arg is supplied."
   (interactive "*cInsert register: \nP")
-  (push-mark)
-  (let ((val (get-register register)))
+  (let* ((register (register-find name :error))
+	 (val (register-value register))
+	 (insert-func (register-insert-func register)))
+    (push-mark)
     (cond
-     ((consp val)
-      (insert-rectangle val))
+     (insert-func (funcall insert-func val))
      ((stringp val)
       (insert-for-yank val))
      ((numberp val)
@@ -301,55 +356,54 @@
       (error "Register does not contain text"))))
   (if (not arg) (exchange-point-and-mark)))
 
-(defun copy-to-register (register start end &optional delete-flag)
-  "Copy region into register REGISTER.
+(defun copy-to-register (name start end &optional delete-flag)
+  "Copy region into register named NAME.
 With prefix arg, delete as well.
 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-make name (filter-buffer-substring start end))
   (if delete-flag (delete-region start end)))
 
-(defun append-to-register (register start end &optional delete-flag)
-  "Append region to text in register REGISTER.
+(defun append-to-register (name start end &optional delete-flag)
+  "Append region to text in register named NAME.
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to append."
   (interactive "cAppend to register: \nr\nP")
-  (let ((reg (get-register register))
-        (text (filter-buffer-substring start end)))
-    (set-register
-     register (cond ((not reg) text)
-                    ((stringp reg) (concat reg text))
-                    (t (error "Register does not contain text")))))
+  (let* ((register (register-find name))
+	 (val (and register (register-value register)))
+	 (text (filter-buffer-substring start end)))
+    (assert (string-or-null-p val) nil "Register does not contain text")
+    (register-make name (concat val text)))
   (if delete-flag (delete-region start end)))
 
-(defun prepend-to-register (register start end &optional delete-flag)
-  "Prepend region to text in register REGISTER.
+(defun prepend-to-register (name start end &optional delete-flag)
+  "Prepend region to text in register named NAME.
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to prepend."
   (interactive "cPrepend to register: \nr\nP")
-  (let ((reg (get-register register))
-        (text (filter-buffer-substring start end)))
-    (set-register
-     register (cond ((not reg) text)
-                    ((stringp reg) (concat text reg))
-                    (t (error "Register does not contain text")))))
+  (let* ((register (register-find name))
+	 (val (and register (register-value register)))
+	 (text (filter-buffer-substring start end)))
+    (assert (string-or-null-p val) nil "Register does not contain text")
+    (register-make name (concat text val)))
   (if delete-flag (delete-region start end)))
 
-(defun copy-rectangle-to-register (register start end &optional delete-flag)
-  "Copy rectangular region into register REGISTER.
+(defun copy-rectangle-to-register (name start end &optional delete-flag)
+  "Copy rectangular region into register named NAME.
 With prefix arg, delete as well.
 To insert this register in the buffer, use \\[insert-register].
 
 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
-		(if delete-flag
-		    (delete-extract-rectangle start end)
-		  (extract-rectangle start end))))
+  (register-make name
+		 (if delete-flag
+		     (delete-extract-rectangle start end)
+		   (extract-rectangle start end))
+		 :insert-func #'insert-rectangle))
 
 (provide 'register)
 ;;; register.el ends here

bug#8415: 23.3.50; Extensible Emacs Registers

[Daniel Colascione]

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

Hi Leo,

On 4/3/11 5:29 AM, Leo wrote:
> I would like to propose the following patch that makes the register
> system easier to hook into. With this change, for example, if one wants
> to make a command to save a keyboard macro to a register. There is no
> need to change register.el. 3rd party libraries such as undo-tree.el can
> add registers of undo state that one can jump to with C-x r j.
> 
> With this change, register is now a compound data structure. I have also
> removed one inconsistent use of the argument REGISTER. In the new code
> it always refers to the register object and never the name.


Thanks for doing this work.  Why is window configuration special-cased
instead of going through the function hooking mechanism?  "Any
customized data" might be parsed as referring to the customize
mechanism; "any value" would suffice.  increment and append don't have
extension points.  It'd be reasonable for a non-text register type to
support these operations in some sense.

Other than that, it good okay to me.

Thanks,
Daniel Colascione


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

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

On 2011-04-04 01:21 +0800, Daniel Colascione wrote:
> Thanks for doing this work. Why is window configuration special-cased
> instead of going through the function hooking mechanism?

I plan (in a subsequent patch to this) to break down jump-to-register,
describe-register-1 etc and move the pieces to where they belong using
the new implementation including moving semantic tag support back to
cedet.

> "Any customized data" might be parsed as referring to the customize
> mechanism; "any value" would suffice.

Thanks. I have changed this as suggested.

> increment and append don't have extension points. It'd be reasonable
> for a non-text register type to support these operations in some
> sense.

Agreed. On the other hand, we could add these support very quickly
should someone ask for them. I don't know what to do here. Should we add
them now?

An updated patch can be found here: http://paste.pocoo.org/show/365119
(only small tweaks).

Leo

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

> I would like to propose the following patch that makes the register
> system easier to hook into. With this change, for example, if one wants
> to make a command to save a keyboard macro to a register. There is no
> need to change register.el. 3rd party libraries such as undo-tree.el can
> add registers of undo state that one can jump to with C-x r j.

Sounds good.

> -(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.
> +;;; in-memeory persistency

Please capitalize your comments and add a closing ".".
Why "memeory"?  ;-)

> +(defvar register-hash-table (make-hash-table))

Why change it to a hash-table?

> +;;; immutable register object
> +(defstruct
> +  (register (:constructor nil)
> +	    (:constructor register--make (name &optional value print-func
> +					       jump-func insert-func extra))
> +	    (:copier nil)
> +	    (:type list)
> +	    :named)
> +  (name	       nil :read-only t)
> +  (value       nil :read-only t)
> +  (print-func  nil :read-only t)
> +  (jump-func   nil :read-only t)
> +  (insert-func nil :read-only t)
> +  (extra       nil :read-only t))

Remove `extra': it's unused, undocumented, and doesn't seem to be any
use (there's already `value').

> +VALUE may be a string, number, marker or list.

IIUC this is not true any more, it can be any value.

> +(define-obsolete-function-alias 'set-register 'register-make "24.1")
> +(make-obsolete 'get-register "use `register-find' and `register-value'." "24.1")

A more backward-compatible change would be to not use register-structs
for pre-existing cases (i.e. markers, strings, lists of string, and
win-confs).  I.e. only add register structs as a new accepted kind
of value (and move `name' out of the struct).

The patch would most likely be a lot smaller.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

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

On 2011-04-04 22:29 +0800, Stefan Monnier wrote:
> Please capitalize your comments and add a closing ".".
> Why "memeory"?  ;-)

Fixed.

>> +(defvar register-hash-table (make-hash-table))
>
> Why change it to a hash-table?

It is simpler to work with. No need to check if a register named ?a is
defined or not, just override it whenever making a new register.

> Remove `extra': it's unused, undocumented, and doesn't seem to be any
> use (there's already `value').

Done.

>> +VALUE may be a string, number, marker or list.
>
> IIUC this is not true any more, it can be any value.

It can be any value but all the user commands may not be able to deal
with it. This patch removes this limit (for the major user commands).

>> +(define-obsolete-function-alias 'set-register 'register-make "24.1")
>> +(make-obsolete 'get-register "use `register-find' and `register-value'." "24.1")
>
> A more backward-compatible change would be to not use register-structs
> for pre-existing cases (i.e. markers, strings, lists of string, and
> win-confs).  I.e. only add register structs as a new accepted kind
> of value (and move `name' out of the struct).
>
> The patch would most likely be a lot smaller.

The original register.el is very inflexible and does its work mostly by
guess because it misses the best moment to decide how to
jump/insert/print a register i.e. at the time of creating it. So we will
have to make almost all values a struct anyway to fix bugs like this:
the original insert-register checks a value is a cons cell and called
insert-rectangle on it, which fails for file-query registers and
possible other values too.

As I said in another post, subsequent to this patch I will break down
jump-to-register, describe-register-1, insert-register to take advantage
of this new implementation.

>         Stefan


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: register2.diff --]
[-- Type: text/x-diff, Size: 15706 bytes --]

=== modified file 'lisp/register.el'
--- lisp/register.el	2011-01-25 04:08:28 +0000
+++ lisp/register.el	2011-04-04 17:31:27 +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,26 @@
 
 ;;; 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.
+;;; In-memory persistency.
+(defvar register-hash-table (make-hash-table))
+
+;;; Immutable register object.
+(defstruct
+  (register (:constructor nil)
+	    (:constructor register--make (name &optional value print-func
+					       jump-func insert-func))
+	    (:copier nil)
+	    (:type list)
+	    :named)
+  (name	       nil :read-only t)
+  (value       nil :read-only t)
+  (print-func  nil :read-only t)
+  (jump-func   nil :read-only t)
+  (insert-func nil :read-only t))
+
+(defun* register-make (name value &key print-func jump-func insert-func)
+  "Return a newly created register with NAME and VALUE.
+VALUE may 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,53 +80,79 @@
 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.
 
-(defun get-register (register)
-  "Return contents of Emacs register named REGISTER, or nil if none."
-  (cdr (assq register register-alist)))
-
-(defun set-register (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)))
-    (if aelt
-	(setcdr aelt value)
-      (push (cons register value) register-alist))
-    value))
+VALUE may also be any value.
 
-(defun point-to-register (register &optional arg)
-  "Store current location of point in register REGISTER.
+PRINT-FUNC if provided controls how `list-registers' and
+`view-register' print the register.  It should be a function
+recieving one argument VALUE and print text that completes
+this sentence:
+  Register X contains [TEXT PRINTED BY PRINT-FUNC]
+
+JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register.
+INSERT-FUNC if provided, controls how `insert-register' insert the register.
+They both receive the VALUE of the register as argument."
+  (let ((register (register--make name value print-func
+				  jump-func insert-func)))
+    (puthash name register register-hash-table)
+    register))
+
+(defun register-find (name &optional if-does-not-exist)
+  "Find the register named NAME and return it.
+If IF-DOES-NOT-EXIST is :error, signal an error; otherwise return nil."
+  (let ((register (gethash name register-hash-table)))
+    (or register (case if-does-not-exist
+		   (:error (error "Register named `%s' does not exist"
+				  (single-key-description name)))
+		   (otherwise nil)))))
+
+(defun register-map (function)
+  "Apply FUNCTION to each register for side effects only.
+FUNCTION should accept one argument - the register."
+  (maphash (lambda (name register)
+	     (funcall function register)) register-hash-table))
+
+(define-obsolete-function-alias 'set-register 'register-make "24.1")
+(make-obsolete 'get-register "\
+use `register-find' and `register-value' instead." "24.1")
+
+(defun get-register (name)
+  "Return the value of register named NAME or nil if none."
+  (ignore-errors (register-value (register-find name :error))))
+
+(defun point-to-register (name &optional arg)
+  "Store current location of point in a register.
 With prefix argument, store current frame configuration.
 Use \\[jump-to-register] to go to that location or restore that configuration.
 Argument is a character, naming the register."
   (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
-		(if arg (list (current-frame-configuration) (point-marker))
-		  (point-marker))))
+  (register-make name
+		 (if arg (list (current-frame-configuration) (point-marker))
+		   (point-marker))))
 
-(defun window-configuration-to-register (register &optional arg)
-  "Store the window configuration of the selected frame in register REGISTER.
+(defun window-configuration-to-register (name &optional arg)
+  "Store the window configuration of the selected frame in a register.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (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-make name (list (current-window-configuration) (point-marker))))
 
-(defun frame-configuration-to-register (register &optional arg)
-  "Store the window configuration of all frames in register REGISTER.
+(defun frame-configuration-to-register (name &optional arg)
+  "Store the window configuration of all frames in a register.
 Use \\[jump-to-register] to restore the configuration.
 Argument is a character, naming the register."
   (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-make name (list (current-frame-configuration) (point-marker))))
 
 (defalias 'register-to-point 'jump-to-register)
-(defun jump-to-register (register &optional delete)
+(defun jump-to-register (name &optional delete)
   "Move point to location stored in a register.
 If the register contains a file name, find that file.
 \(To put a file name in a register, you must use `set-register'.)
@@ -118,8 +163,11 @@
 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* ((register (register-find name :error))
+	 (val (register-value register))
+	 (jump-func (register-jump-func register)))
     (cond
+     (jump-func (funcall jump-func val))
      ((and (consp val) (frame-configuration-p (car val)))
       (set-frame-configuration (car val) (not delete))
       (goto-char (cadr val)))
@@ -150,65 +198,71 @@
 (defun register-swap-out ()
   "Turn markers into file-query references when a buffer is killed."
   (and buffer-file-name
-       (dolist (elem register-alist)
-	 (and (markerp (cdr elem))
-	      (eq (marker-buffer (cdr elem)) (current-buffer))
-	      (setcdr elem
-		      (list 'file-query
-			    buffer-file-name
-			    (marker-position (cdr elem))))))))
+       (register-map
+	(lambda (register)
+	  (let ((val (register-value register)))
+	    (and (markerp val)
+		 (eq (marker-buffer val) (current-buffer))
+		 (register-make (register-name register)
+				(list 'file-query
+				      buffer-file-name
+				      (marker-position val)))))))))
 
-(defun number-to-register (number register)
+(defun number-to-register (number name)
   "Store a number in a register.
-Two args, NUMBER and REGISTER (a character, naming the register).
+Two args, NUMBER and NAME (a character, naming the register).
 If NUMBER is nil, a decimal number is read from the buffer starting
 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
-		(if number
-		    (prefix-numeric-value number)
-		  (if (looking-at "\\s-*-?[0-9]+")
-		      (progn
-			(goto-char (match-end 0))
-			(string-to-number (match-string 0)))
-		    0))))
+  (register-make name
+		 (if number
+		     (prefix-numeric-value number)
+		   (if (looking-at "\\s-*-?[0-9]+")
+		       (progn
+			 (goto-char (match-end 0))
+			 (string-to-number (match-string 0)))
+		     0))))
 
-(defun increment-register (number register)
-  "Add NUMBER to the contents of register REGISTER.
+(defun increment-register (number name)
+  "Add NUMBER to the value of the register named NAME.
 Interactively, NUMBER is the prefix arg."
   (interactive "p\ncIncrement register: ")
-  (or (numberp (get-register register))
-      (error "Register does not contain a number"))
-  (set-register register (+ number (get-register register))))
-
-(defun view-register (register)
-  "Display what is contained in register named REGISTER.
-The Lisp value REGISTER is a character."
+  (let ((register (register-find name :error)))
+    (or (numberp (register-value register))
+	(error "Register does not contain a number"))
+    (register-make name (+ number (register-value register)))))
+
+(defun view-register (name)
+  "Display what is contained in register named NAME."
   (interactive "cView register: ")
-  (let ((val (get-register register)))
-    (if (null val)
-	(message "Register %s is empty" (single-key-description register))
-      (with-output-to-temp-buffer "*Output*"
-	(describe-register-1 register t)))))
+  (let* ((register (register-find name :error))
+	 (val (register-value register)))
+    (with-output-to-temp-buffer "*Output*"
+      (describe-register-1 register t))))
 
 (defun list-registers ()
   "Display a list of nonempty registers saying briefly what they contain."
   (interactive)
-  (let ((list (copy-sequence register-alist)))
-    (setq list (sort list (lambda (a b) (< (car a) (car b)))))
+  (let (names register)
+    (register-map (lambda (r) (push (register-name r) names)))
+    (setq names (sort names '<))
     (with-output-to-temp-buffer "*Output*"
-      (dolist (elt list)
-	(when (get-register (car elt))
-	  (describe-register-1 (car elt))
+      (dolist (name names)
+	(setq register (register-find name))
+	(when (and register (register-value register))
+	  (describe-register-1 register)
 	  (terpri))))))
 
 (defun describe-register-1 (register &optional verbose)
   (princ "Register ")
-  (princ (single-key-description register))
+  (princ (single-key-description (register-name register)))
   (princ " contains ")
-  (let ((val (get-register register)))
+  (let ((val (register-value register))
+	(print-func (register-print-func register)))
     (cond
+     (print-func (funcall print-func val))
+
      ((numberp val)
       (princ val))
 
@@ -276,17 +330,18 @@
       (princ "Garbage:\n")
       (if verbose (prin1 val))))))
 
-(defun insert-register (register &optional arg)
-  "Insert contents of register REGISTER.  (REGISTER is a character.)
+(defun insert-register (name &optional arg)
+  "Insert the value of the register named NAME.
 Normally puts point before and mark after the inserted text.
 If optional second arg is non-nil, puts mark before and point after.
 Interactively, second arg is non-nil if prefix arg is supplied."
   (interactive "*cInsert register: \nP")
-  (push-mark)
-  (let ((val (get-register register)))
+  (let* ((register (register-find name :error))
+	 (val (register-value register))
+	 (insert-func (register-insert-func register)))
+    (push-mark)
     (cond
-     ((consp val)
-      (insert-rectangle val))
+     (insert-func (funcall insert-func val))
      ((stringp val)
       (insert-for-yank val))
      ((numberp val)
@@ -301,55 +356,54 @@
       (error "Register does not contain text"))))
   (if (not arg) (exchange-point-and-mark)))
 
-(defun copy-to-register (register start end &optional delete-flag)
-  "Copy region into register REGISTER.
+(defun copy-to-register (name start end &optional delete-flag)
+  "Copy region into register named NAME.
 With prefix arg, delete as well.
 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-make name (filter-buffer-substring start end))
   (if delete-flag (delete-region start end)))
 
-(defun append-to-register (register start end &optional delete-flag)
-  "Append region to text in register REGISTER.
+(defun append-to-register (name start end &optional delete-flag)
+  "Append region to text in register named NAME.
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to append."
   (interactive "cAppend to register: \nr\nP")
-  (let ((reg (get-register register))
-        (text (filter-buffer-substring start end)))
-    (set-register
-     register (cond ((not reg) text)
-                    ((stringp reg) (concat reg text))
-                    (t (error "Register does not contain text")))))
+  (let* ((register (register-find name))
+	 (val (and register (register-value register)))
+	 (text (filter-buffer-substring start end)))
+    (assert (string-or-null-p val) nil "Register does not contain text")
+    (register-make name (concat val text)))
   (if delete-flag (delete-region start end)))
 
-(defun prepend-to-register (register start end &optional delete-flag)
-  "Prepend region to text in register REGISTER.
+(defun prepend-to-register (name start end &optional delete-flag)
+  "Prepend region to text in register named NAME.
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to prepend."
   (interactive "cPrepend to register: \nr\nP")
-  (let ((reg (get-register register))
-        (text (filter-buffer-substring start end)))
-    (set-register
-     register (cond ((not reg) text)
-                    ((stringp reg) (concat text reg))
-                    (t (error "Register does not contain text")))))
+  (let* ((register (register-find name))
+	 (val (and register (register-value register)))
+	 (text (filter-buffer-substring start end)))
+    (assert (string-or-null-p val) nil "Register does not contain text")
+    (register-make name (concat text val)))
   (if delete-flag (delete-region start end)))
 
-(defun copy-rectangle-to-register (register start end &optional delete-flag)
-  "Copy rectangular region into register REGISTER.
+(defun copy-rectangle-to-register (name start end &optional delete-flag)
+  "Copy rectangular region into register named NAME.
 With prefix arg, delete as well.
 To insert this register in the buffer, use \\[insert-register].
 
 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
-		(if delete-flag
-		    (delete-extract-rectangle start end)
-		  (extract-rectangle start end))))
+  (register-make name
+		 (if delete-flag
+		     (delete-extract-rectangle start end)
+		   (extract-rectangle start end))
+		 :insert-func #'insert-rectangle))
 
 (provide 'register)
 ;;; register.el ends here

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>> A more backward-compatible change would be to not use register-structs
>> for pre-existing cases (i.e. markers, strings, lists of string, and
>> win-confs).  I.e. only add register structs as a new accepted kind
>> of value (and move `name' out of the struct).
>> The patch would most likely be a lot smaller.

> The original register.el is very inflexible and does its work mostly by
> guess because it misses the best moment to decide how to
> jump/insert/print a register i.e. at the time of creating it.

AFAICT, the code currently doesn't guess: the different kinds of values
are mutually exclusive.  So the moment at which they decide which
code to use doesn't matter because it'll give the same answer (tho
as you point out there are errors in this code currently because it's
dispersed).

> So we will have to make almost all values a struct anyway to fix bugs
> like this.

Yes, all new types will use register structs.  That's not a problem.
And you can even later-on de-support old types and have them go through
register structs as well.

> As I said in another post, subsequent to this patch I will break down
> jump-to-register, describe-register-1, insert-register to take advantage
> of this new implementation.

That's good.  But I'd rather you break backward compatibility at *that*
point rather than right from the start.
I.e. start with a patch like the one below.  Of course, instead of
register structs, you can use functions (like we do for completion
tables) as in:

   === modified file 'lisp/register.el'
   --- lisp/register.el	2011-01-25 04:08:28 +0000
   +++ lisp/register.el	2011-04-04 22:16:56 +0000
   @@ -52,7 +52,10 @@
    
    (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.
   +NAME is a character (a number).  CONTENTS can take various forms:
   +A function that takes one argument (the action to perform).
   +  The action can be `print', `insert', or `jump'.  Any action it does not
   +  understand should result in signalling an error.
    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
   @@ -120,6 +123,7 @@
      (interactive "cJump to register: \nP")
      (let ((val (get-register register)))
        (cond
   +     ((functionp val) (funcall val 'jump))
         ((and (consp val) (frame-configuration-p (car val)))
          (set-frame-configuration (car val) (not delete))
          (goto-char (cadr val)))
   @@ -209,6 +213,7 @@
      (princ " contains ")
      (let ((val (get-register register)))
        (cond
   +     ((functionp val) (funcall val 'print))
         ((numberp val)
          (princ val))
    
   @@ -285,6 +290,7 @@
      (push-mark)
      (let ((val (get-register register)))
        (cond
   +     ((functionp val) (funcall val 'insert))
         ((consp val)
          (insert-rectangle val))
         ((stringp val)
   
   
-- Stefan


=== modified file 'lisp/register.el'
--- lisp/register.el	2011-01-25 04:08:28 +0000
+++ lisp/register.el	2011-04-04 22:10:11 +0000
@@ -52,7 +52,8 @@
 
 (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.
+NAME is a character (a number).  CONTENTS can take various forms:
+A `register' structure, made with `register-make'.
 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
@@ -63,6 +64,18 @@
 A list of the form (FRAME-CONFIGURATION POSITION)
  represents a saved frame configuration plus a saved value of point.")
 
+(eval-when-compile (require 'cl))
+
+(defstruct
+  (register (:constructor nil)
+	    (:constructor register-make (value &key print-func
+                                               jump-func insert-func))
+	    (:copier nil))
+  (value       nil :read-only t)
+  (print-func  nil :read-only t)
+  (jump-func   nil :read-only t)
+  (insert-func nil :read-only t))
+
 (defun get-register (register)
   "Return contents of Emacs register named REGISTER, or nil if none."
   (cdr (assq register register-alist)))
@@ -120,6 +133,7 @@
   (interactive "cJump to register: \nP")
   (let ((val (get-register register)))
     (cond
+     ((register-p val) (funcall (register-jump-func val) val))
      ((and (consp val) (frame-configuration-p (car val)))
       (set-frame-configuration (car val) (not delete))
       (goto-char (cadr val)))
@@ -149,6 +163,7 @@
 
 (defun register-swap-out ()
   "Turn markers into file-query references when a buffer is killed."
+  ;; FIXME: Let register structures hook here as well.
   (and buffer-file-name
        (dolist (elem register-alist)
 	 (and (markerp (cdr elem))
@@ -177,6 +192,7 @@
 (defun increment-register (number register)
   "Add NUMBER to the contents of register REGISTER.
 Interactively, NUMBER is the prefix arg."
+  ;; FIXME: Let register structures hook here as well.
   (interactive "p\ncIncrement register: ")
   (or (numberp (get-register register))
       (error "Register does not contain a number"))
@@ -209,6 +225,7 @@
   (princ " contains ")
   (let ((val (get-register register)))
     (cond
+     ((register-p val) (funcall (register-print-func val) val))
      ((numberp val)
       (princ val))
 
@@ -285,6 +302,7 @@
   (push-mark)
   (let ((val (get-register register)))
     (cond
+     ((register-p val) (funcall (register-insert-func val) val))
      ((consp val)
       (insert-rectangle val))
      ((stringp val)
@@ -315,6 +333,7 @@
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to append."
+  ;; FIXME: Let register structures hook here as well?
   (interactive "cAppend to register: \nr\nP")
   (let ((reg (get-register register))
         (text (filter-buffer-substring start end)))
@@ -329,6 +348,7 @@
 With prefix arg, delete as well.
 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
 START and END are buffer positions indicating what to prepend."
+  ;; FIXME: Let register structures hook here as well?
   (interactive "cPrepend to register: \nr\nP")
   (let ((reg (get-register register))
         (text (filter-buffer-substring start end)))

bug#8415: 23.3.50; Extensible Emacs Registers

[Daniel Colascione]

On 4/4/2011 3:19 PM, Stefan Monnier wrote:
>>> A more backward-compatible change would be to not use register-structs
>>> for pre-existing cases (i.e. markers, strings, lists of string, and
>>> win-confs).  I.e. only add register structs as a new accepted kind
>>> of value (and move `name' out of the struct).
>>> The patch would most likely be a lot smaller.
>
>> The original register.el is very inflexible and does its work mostly by
>> guess because it misses the best moment to decide how to
>> jump/insert/print a register i.e. at the time of creating it.
>
> AFAICT, the code currently doesn't guess: the different kinds of values
> are mutually exclusive.  So the moment at which they decide which
> code to use doesn't matter because it'll give the same answer (tho
> as you point out there are errors in this code currently because it's
> dispersed).

Polymorphism-via-typecase is delicate at best no matter what language 
we're working in.

>> So we will have to make almost all values a struct anyway to fix bugs
>> like this.
>
> Yes, all new types will use register structs.  That's not a problem.
> And you can even later-on de-support old types and have them go through
> register structs as well.

What's wrong with getting it over with now?

>> As I said in another post, subsequent to this patch I will break down
>> jump-to-register, describe-register-1, insert-register to take advantage
>> of this new implementation.
>
> That's good.  But I'd rather you break backward compatibility at *that*
> point rather than right from the start.
> I.e. start with a patch like the one below.  Of course, instead of
> register structs, you can use functions (like we do for completion
> tables) as in:

I'd still prefer Leo's approach here.  Accessing register values 
directly wasn't common anyway, so the change shouldn't affect user code. 
  If we're going to change the code, then IMHO it's better to start with 
a clean, orthogonal design where both existing cases and extensions use 
the same polymorphic system.  All other things being equal, it's better 
to have one code path than two.

I'd also slightly prefer Leo's structure approach to the 
dispatcher-function one below.  Using separate struct fields leads to 
register-value-creating code more explicitly showing which operations 
are supported, and it also allows the register operation code to do 
something consistent when a particular register doesn't support some 
particular operation.  Under the dispatcher function approach, the 
common register code has no idea whether a register value is going to do 
something intelligent with the given operation.


>
>     === modified file 'lisp/register.el'
>     --- lisp/register.el	2011-01-25 04:08:28 +0000
>     +++ lisp/register.el	2011-04-04 22:16:56 +0000
>     @@ -52,7 +52,10 @@
>
>      (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.
>     +NAME is a character (a number).  CONTENTS can take various forms:
>     +A function that takes one argument (the action to perform).
>     +  The action can be `print', `insert', or `jump'.  Any action it does not
>     +  understand should result in signalling an error.
>      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
>     @@ -120,6 +123,7 @@
>        (interactive "cJump to register: \nP")
>        (let ((val (get-register register)))
>          (cond
>     +     ((functionp val) (funcall val 'jump))
>           ((and (consp val) (frame-configuration-p (car val)))
>            (set-frame-configuration (car val) (not delete))
>            (goto-char (cadr val)))
>     @@ -209,6 +213,7 @@
>        (princ " contains ")
>        (let ((val (get-register register)))
>          (cond
>     +     ((functionp val) (funcall val 'print))
>           ((numberp val)
>            (princ val))
>
>     @@ -285,6 +290,7 @@
>        (push-mark)
>        (let ((val (get-register register)))
>          (cond
>     +     ((functionp val) (funcall val 'insert))
>           ((consp val)
>            (insert-rectangle val))
>           ((stringp val)
>
>
> -- Stefan
>
>
> === modified file 'lisp/register.el'
> --- lisp/register.el	2011-01-25 04:08:28 +0000
> +++ lisp/register.el	2011-04-04 22:10:11 +0000
> @@ -52,7 +52,8 @@
>
>   (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.
> +NAME is a character (a number).  CONTENTS can take various forms:
> +A `register' structure, made with `register-make'.
>   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
> @@ -63,6 +64,18 @@
>   A list of the form (FRAME-CONFIGURATION POSITION)
>    represents a saved frame configuration plus a saved value of point.")
>
> +(eval-when-compile (require 'cl))
> +
> +(defstruct
> +  (register (:constructor nil)
> +	    (:constructor register-make (value&key print-func
> +                                               jump-func insert-func))
> +	    (:copier nil))
> +  (value       nil :read-only t)
> +  (print-func  nil :read-only t)
> +  (jump-func   nil :read-only t)
> +  (insert-func nil :read-only t))
> +
>   (defun get-register (register)
>     "Return contents of Emacs register named REGISTER, or nil if none."
>     (cdr (assq register register-alist)))
> @@ -120,6 +133,7 @@
>     (interactive "cJump to register: \nP")
>     (let ((val (get-register register)))
>       (cond
> +     ((register-p val) (funcall (register-jump-func val) val))
>        ((and (consp val) (frame-configuration-p (car val)))
>         (set-frame-configuration (car val) (not delete))
>         (goto-char (cadr val)))
> @@ -149,6 +163,7 @@
>
>   (defun register-swap-out ()
>     "Turn markers into file-query references when a buffer is killed."
> +  ;; FIXME: Let register structures hook here as well.
>     (and buffer-file-name
>          (dolist (elem register-alist)
>   	 (and (markerp (cdr elem))
> @@ -177,6 +192,7 @@
>   (defun increment-register (number register)
>     "Add NUMBER to the contents of register REGISTER.
>   Interactively, NUMBER is the prefix arg."
> +  ;; FIXME: Let register structures hook here as well.
>     (interactive "p\ncIncrement register: ")
>     (or (numberp (get-register register))
>         (error "Register does not contain a number"))
> @@ -209,6 +225,7 @@
>     (princ " contains ")
>     (let ((val (get-register register)))
>       (cond
> +     ((register-p val) (funcall (register-print-func val) val))
>        ((numberp val)
>         (princ val))
>
> @@ -285,6 +302,7 @@
>     (push-mark)
>     (let ((val (get-register register)))
>       (cond
> +     ((register-p val) (funcall (register-insert-func val) val))
>        ((consp val)
>         (insert-rectangle val))
>        ((stringp val)
> @@ -315,6 +333,7 @@
>   With prefix arg, delete as well.
>   Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
>   START and END are buffer positions indicating what to append."
> +  ;; FIXME: Let register structures hook here as well?
>     (interactive "cAppend to register: \nr\nP")
>     (let ((reg (get-register register))
>           (text (filter-buffer-substring start end)))
> @@ -329,6 +348,7 @@
>   With prefix arg, delete as well.
>   Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
>   START and END are buffer positions indicating what to prepend."
> +  ;; FIXME: Let register structures hook here as well?
>     (interactive "cPrepend to register: \nr\nP")
>     (let ((reg (get-register register))
>           (text (filter-buffer-substring start end)))
>

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>> AFAICT, the code currently doesn't guess: the different kinds of values
>> are mutually exclusive.  So the moment at which they decide which
>> code to use doesn't matter because it'll give the same answer (tho
>> as you point out there are errors in this code currently because it's
>> dispersed).
> Polymorphism-via-typecase is delicate at best no matter what language we're
> working in.

[ Irrelevant side-comment: Completely depends on the problem at hand: it
  makes adding "methods" much easier. ]

>>> So we will have to make almost all values a struct anyway to fix bugs
>>> like this.
>> Yes, all new types will use register structs.  That's not a problem.
>> And you can even later-on de-support old types and have them go through
>> register structs as well.
> What's wrong with getting it over with now?

It's the difference between "one simple obviously correct change" and
"one big change that might be correct".

> I'd also slightly prefer Leo's structure approach to the
> dispatcher-function one below.

I tend to agree, tho both kind of suck: we'd want real objects with
dynamic dispatch instead.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Daniel Colascione]

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

On 4/4/11 6:41 PM, Stefan Monnier wrote:
>> Polymorphism-via-typecase is delicate at best no matter what language we're
>> working in.
> 
> [ Irrelevant side-comment: Completely depends on the problem at hand: it
>   makes adding "methods" much easier. ]

IMHO, those situations are the exceptions.

>>>> So we will have to make almost all values a struct anyway to fix bugs
>>>> like this.
>>> Yes, all new types will use register structs.  That's not a problem.
>>> And you can even later-on de-support old types and have them go through
>>> register structs as well.
>> What's wrong with getting it over with now?
> 
> It's the difference between "one simple obviously correct change" and
> "one big change that might be correct".

I see your point, though both approaches would be pretty small changes
in the scheme of things.  If you want to split the change into smaller
steps, that's fine so long as we eventually aim to get rid of the
typecase polymorphism.

>> I'd also slightly prefer Leo's structure approach to the
>> dispatcher-function one below.
> 
> I tend to agree, tho both kind of suck: we'd want real objects with
> dynamic dispatch instead.

Well, there's EIEIO.  It gives you the ability to easily add methods
while not baking the dispatch into each one.  On the other hand, it's a
quite a bit of code to pull into the core at runtime.


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

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>> It's the difference between "one simple obviously correct change" and
>> "one big change that might be correct".

> I see your point, though both approaches would be pretty small changes
> in the scheme of things.  If you want to split the change into smaller
> steps, that's fine so long as we eventually aim to get rid of the
> typecase polymorphism.

The end point is pretty much the same, but all the intermediate steps
are safe and easy to check.

> Well, there's EIEIO.  It gives you the ability to easily add methods
> while not baking the dispatch into each one.  On the other hand, it's a
> quite a bit of code to pull into the core at runtime.

Indeed.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

On 2011-04-05 11:07 +0800, Stefan Monnier wrote:
> The end point is pretty much the same, but all the intermediate steps
> are safe and easy to check.

I think a structure still is a better approach. It offers uniformity and
allows access to the value stored in each slot so one can easily build a
new register reusing values from an old one which, in some use cases
(defadvice), can be convenient.

>> Well, there's EIEIO.  It gives you the ability to easily add methods
>> while not baking the dispatch into each one.  On the other hand, it's a
>> quite a bit of code to pull into the core at runtime.
>
> Indeed.

I have thought about using EIEIO in the beginning and ruled it out since
it is required at run time.

Leo

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>> The end point is pretty much the same, but all the intermediate steps
>> are safe and easy to check.
> I think a structure still is a better approach.

I already agreed in the previous message.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

On 2011-04-05 21:50 +0800, Stefan Monnier wrote:
>>> The end point is pretty much the same, but all the intermediate steps
>>> are safe and easy to check.
>> I think a structure still is a better approach.
>
> I already agreed in the previous message.
>
>
>         Stefan

Sorry if I have missed that.

The alternative you propose, i.e. making the value a structure is
actually the first approach I attempted in
http://article.gmane.org/gmane.emacs.devel/137781.

1. all existing register-creating commands need to use the new
   implementation, so the patch won't be any smaller.

2. needs explicitly creating a register-value struct i.e.
  (register-set ?a (register-value-make ....)). If change
  register-set to implicitly convert to a struct then it has
  the same incompatible change as I proposed in this bug report.

So the alternative doesn't offer anything better.

If you are agreeable to the patch in
http://debbugs.gnu.org/cgi/bugreport.cgi?bug=8415#19, I am ready to
watch closely for any incoming bugs that related to register.el and fix
them as quickly as I can.

Leo

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>>>>> "Leo" == Leo  <sdl.web@gmail.com> writes:

> On 2011-04-05 21:50 +0800, Stefan Monnier wrote:
>>>> The end point is pretty much the same, but all the intermediate steps
>>>> are safe and easy to check.
>>> I think a structure still is a better approach.
>> 
>> I already agreed in the previous message.
>> 
>> 
>> Stefan

> Sorry if I have missed that.

> The alternative you propose, i.e. making the value a structure is
> actually the first approach I attempted in
> http://article.gmane.org/gmane.emacs.devel/137781.

I think that's a better approach, yes (tho I'd pass the register object
to the functions, so instead of:

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

you just have

   (let* ((object (register-get register))
 	 (jump (and (register-p object)
 		    (register-jump-func object))))
     (cond
      (jump (funcall jump object))

or
      
   (let* ((object (register-get register)))
     (cond
      ((register-p object) (funcall (or (register-jump-func object)
                                        (error "Don't know how to jump"))
                                    object))

> 1. all existing register-creating commands need to use the new
>    implementation, so the patch won't be any smaller.

That's for subsequent patches.

> 2. needs explicitly creating a register-value struct i.e.
>   (register-set ?a (register-value-make ....)).

I see that as a feature.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

On 2011-04-06 23:38 +0800, Stefan Monnier wrote:
> I think that's a better approach, yes (tho I'd pass the register object
> to the functions, so instead of:
>
>    (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))
>
> you just have
>
>    (let* ((object (register-get register))
>  	 (jump (and (register-p object)
>  		    (register-jump-func object))))
>      (cond
>       (jump (funcall jump object))
>
> or
>       
>    (let* ((object (register-get register)))
>      (cond
>       ((register-p object) (funcall (or (register-jump-func object)
>                                         (error "Don't know how to jump"))
>                                     object))

I am lost here. VAL is needed in the rest of the function, the old code.
So you can't just omit it.

>> 1. all existing register-creating commands need to use the new
>>    implementation, so the patch won't be any smaller.
>
> That's for subsequent patches.

The intention is to have a clean uniform extensible internal
representation of registers so subsequent patches are completely trivial
which I opted to omit for now so that people can focus on more important
changes. Somehow that didn't work out well.

>> 2. needs explicitly creating a register-value struct i.e.
>>   (register-set ?a (register-value-make ....)).
>
> I see that as a feature.

If register-value-make is not used, 'typecase polymorphism' has to be
used. If we were to eliminate 'typecase polymorphism',
register-value-make is required.

For me, (register-make ...) is just simpler. One of the reasons that the
first patch I posted to emacs-devel evolved to the one I submitted in
this bug report.

It just has selectors and three public function register-make,
register-find, register-map. The rest of code can just build on top of
them.

Leo

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

>> I think that's a better approach, yes (tho I'd pass the register object
>> to the functions, so instead of:
>> 
>> (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))
>> 
>> you just have
>> 
>> (let* ((object (register-get register))
>> (jump (and (register-p object)
>> (register-jump-func object))))
>> (cond
>> (jump (funcall jump object))
>> 
>> or
>> 
>> (let* ((object (register-get register)))
>> (cond
>> ((register-p object) (funcall (or (register-jump-func object)
>> (error "Don't know how to jump"))
>> object))

> I am lost here. VAL is needed in the rest of the function, the old code.
> So you can't just omit it.

In the rest of the function register-p is false, so `val' = `object'.

>>> 1. all existing register-creating commands need to use the new
>>> implementation, so the patch won't be any smaller.
>> That's for subsequent patches.
> The intention is to have a clean uniform extensible internal
> representation of registers so subsequent patches are completely trivial
> which I opted to omit for now so that people can focus on more important
> changes. Somehow that didn't work out well.

The patches will be just as clean with the other approach.  Try it.

>>> 2. needs explicitly creating a register-value struct i.e.
>>> (register-set ?a (register-value-make ....)).
>> I see that as a feature.
> If register-value-make is not used, 'typecase polymorphism' has to be
> used. If we were to eliminate 'typecase polymorphism',
> register-value-make is required.

`typecase polymorphism' is what we have, and after the addition
I suggest we can remove it little by little.

> It just has selectors and three public function register-make,
> register-find, register-map. The rest of code can just build on top of
> them.

With the alist representation, register-find and register-map aren't
even needed.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

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

Hello Stefan,

Is this patch OK?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: reg.diff --]
[-- Type: text/x-diff, Size: 3844 bytes --]

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2011-06-23 03:35:05 +0000
+++ lisp/ChangeLog	2011-06-23 07:46:05 +0000
@@ -1,3 +1,11 @@
+2011-06-23  Leo Liu  <sdl.web@gmail.com>
+
+	* register.el (registerv): New struct.
+	(registerv-make): New function.
+	(jump-to-register, describe-register-1, insert-register): Support
+	the jump-func, print-func and insert-func slot of a registerv
+	struct.
+
 2011-06-22  Leo Liu  <sdl.web@gmail.com>
 
 	* minibuffer.el (completing-read-function)

=== modified file 'lisp/register.el'
--- lisp/register.el	2011-04-19 13:44:55 +0000
+++ lisp/register.el	2011-06-23 05:07:49 +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,36 @@
 
 ;;; Code:
 
+(defstruct
+  (registerv (:constructor nil)
+	     (:constructor registerv--make (&optional data print-func
+						      jump-func insert-func))
+	     (:copier nil)
+	     (:type list)
+	     :named)
+  (data        nil :read-only t)
+  (print-func  nil :read-only t)
+  (jump-func   nil :read-only t)
+  (insert-func nil :read-only t))
+
+(defun* registerv-make (data &key print-func jump-func insert-func)
+  "Create a register value object.
+
+DATA can be any value.
+PRINT-FUNC if provided controls how `list-registers' and
+`view-register' print the register.  It should be a function
+recieving one argument DATA and print text that completes
+this sentence:
+  Register X contains [TEXT PRINTED BY PRINT-FUNC]
+JUMP-FUNC if provided, controls how `jump-to-register' jumps to the register.
+INSERT-FUNC if provided, controls how `insert-register' insert the register.
+They both receive DATA as argument."
+  (registerv--make data print-func jump-func insert-func))
+
 (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.
+NAME is a character (a number).  CONTENTS is a string, number, marker, list
+or a struct returned by `registerv-make'.
 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
@@ -118,8 +147,10 @@
 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* ((val (get-register register))
+	 (jump-func (and (registerv-p val) (registerv-jump-func val))))
     (cond
+     (jump-func (funcall jump-func (registerv-data val)))
      ((and (consp val) (frame-configuration-p (car val)))
       (set-frame-configuration (car val) (not delete))
       (goto-char (cadr val)))
@@ -207,8 +238,11 @@
   (princ "Register ")
   (princ (single-key-description register))
   (princ " contains ")
-  (let ((val (get-register register)))
+  (let* ((val (get-register register))
+	 (print-func (and (registerv-p val) (registerv-print-func val))))
     (cond
+     (print-func (funcall print-func (registerv-data val)))
+
      ((numberp val)
       (princ val))
 
@@ -283,8 +317,10 @@
 Interactively, second arg is non-nil if prefix arg is supplied."
   (interactive "*cInsert register: \nP")
   (push-mark)
-  (let ((val (get-register register)))
+  (let* ((val (get-register register))
+	 (insert-func (and (registerv-p val) (registerv-insert-func val))))
     (cond
+     (insert-func (funcall insert-func (registerv-data val)))
      ((consp val)
       (insert-rectangle val))
      ((stringp val)


[-- Attachment #3: Type: text/plain, Size: 5 bytes --]


Leo

bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier]

> Is this patch OK?

Looks OK, yes.

> +     (jump-func (funcall jump-func (registerv-data val)))

But I'd pass `val' directly, so the function can use extra fields in
values that inherit from registerv.  You could drop the `data' field as
well, at that point.

This just makes it more OO, and maybe experience would show that it
actually makes things worse (just adds unused extra flexibility), so
I'll let you judge.  Either way is OK with me.


        Stefan

bug#8415: 23.3.50; Extensible Emacs Registers

[Leo]

On 2011-06-25 21:19 +0800, Stefan Monnier wrote:
> But I'd pass `val' directly, so the function can use extra fields in
> values that inherit from registerv.  You could drop the `data' field as
> well, at that point.
>
> This just makes it more OO, and maybe experience would show that it
> actually makes things worse (just adds unused extra flexibility), so
> I'll let you judge.  Either way is OK with me.

Thanks for the comments. From my use cases, it seems most of the time
only DATA is needed and in other times closure can be used. I have made
the commit for wider testing.

Leo