bug#8415: 23.3.50; Extensible Emacs Registers

[Stefan Monnier <monnier@iro.umontreal.ca>]

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