patch: {append,prepend}-to-register on empty register

patch: {append,prepend}-to-register on empty register

[Sean O'Rourke]

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

The following patch makes {append,prepend}-to-register act like
copy-to-register when the register is empty, rather than just
throwing an error.  Both still throw an error when the register
contains non-text.

/s

2007-11-02  Sean O'Rourke  <seano@cs.ucla.edu>

	* register.el (append-to-register): copy text to empty
	registers.
	(prepend-to-register): same.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 2032 bytes --]

Index: register.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/register.el,v
retrieving revision 1.56
diff -p -u -w -r1.56 register.el
--- register.el	26 Jul 2007 05:26:32 -0000	1.56
+++ register.el	2 Nov 2007 19:00:03 -0000
@@ -287,10 +287,14 @@ 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")
-  (or (stringp (get-register register))
-      (error "Register does not contain text"))
-  (set-register register (concat (get-register register)
-			    (filter-buffer-substring start end)))
+  (let ((reg (get-register register)))
+    (cond
+     ((not reg) (set-register register (filter-buffer-substring start end)))
+     ((stringp reg)
+      (set-register register
+                    (concat reg (filter-buffer-substring start end))))
+     (t
+      (error "Register does not contain text"))))
   (if delete-flag (delete-region start end)))
 
 (defun prepend-to-register (register start end &optional delete-flag)
@@ -299,10 +303,14 @@ 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")
-  (or (stringp (get-register register))
-      (error "Register does not contain text"))
-  (set-register register (concat (filter-buffer-substring start end)
-			    (get-register register)))
+  (let ((reg (get-register register)))
+    (cond
+     ((not reg) (set-register register (filter-buffer-substring start end)))
+     ((stringp reg)
+      (set-register register
+                    (concat (filter-buffer-substring start end) reg)))
+     (t
+      (error "Register does not contain text"))))
   (if delete-flag (delete-region start end)))
 
 (defun copy-rectangle-to-register (register start end &optional delete-flag)

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

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

Re: patch: {append,prepend}-to-register on empty register

[Thien-Thi Nguyen]

() "Sean O'Rourke" <seano@cs.ucla.edu>
() Fri, 02 Nov 2007 12:18:55 -0700

   +  (let ((reg (get-register register)))
   +    (cond
   +     ((not reg) (set-register register (filter-buffer-substring start end)))
   +     ((stringp reg)
   +      (set-register register
   +                    (concat reg (filter-buffer-substring start end))))
   +     (t
   +      (error "Register does not contain text"))))

i would prefer `(set-register register (cond ...))'.
likewise for other hunk.

thi

Re: patch: {append,prepend}-to-register on empty register

[Richard Stallman]

It seems like a good idea.  Would someone please install that, then
ack?

Re: patch: {append,prepend}-to-register on empty register

[Thien-Thi Nguyen]

() Richard Stallman <rms@gnu.org>
() Sat, 03 Nov 2007 16:48:13 -0400

   install that

ack.

Re: patch: {append,prepend}-to-register on empty register

[Miles Bader]

Thien-Thi Nguyen <ttn@gnuvola.org> writes:
> i would prefer `(set-register register (cond ...))'.
> likewise for other hunk.

(let ((reg (get-register register))
      (text (filter-buffer-substring start end)))
  (cond ((stringp reg)
	 (setq text (concat reg text)))
	(reg
	 (error "Register does not contain text")))
  (set-register register text))

-miles
-- 
((lambda (x) (list x x)) (lambda (x) (list x x)))

Re: patch: {append,prepend}-to-register on empty register

[Thien-Thi Nguyen]

() Miles Bader <miles.bader@necel.com>
() Mon, 05 Nov 2007 15:54:52 +0900

   Thien-Thi Nguyen <ttn@gnuvola.org> writes:
   > i would prefer `(set-register register (cond ...))'.
   > likewise for other hunk.

   (let ((reg (get-register register))
         (text (filter-buffer-substring start end)))
     (cond ((stringp reg)
            (setq text (concat reg text)))
           (reg
            (error "Register does not contain text")))
     (set-register register text))

i like this better than the original, but not as
much as the (more) functional, approach, due to setq.

fwiw, following is a *scratch* snapshot.  i read it as
"you win some, you lose some, ..."  :-/

thi


______________________________________________________________
(defun ttn-a (register start end)
  (let ((reg (get-register register))
        (text (filter-buffer-substring start end)))
    (cond ((stringp reg)
           (setq text (concat reg text)))
          (reg
           (error "Register does not contain text")))
    (set-register register text)))

(defun ttn-b (register start end)
  (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"))))))

(byte-compile 'ttn-a)
(byte-compile 'ttn-b)

(disassemble 'ttn-a) ; write output to file A
(disassemble 'ttn-b) ; write output to file B

(shell-command "echo ; diff -y A B -W 78" t)
783
byte code for ttn-a:		      |	byte code for ttn-b:
  args: (register start end)		  args: (register start end)
0	constant  get-register		0	constant  get-register
1	varref	  register		1	varref	  register
2	call	  1			2	call	  1
3	constant  filter-buffer-subst	3	constant  filter-buffer-subst
4	varref	  start			4	varref	  start
5	varref	  end			5	varref	  end
6	call	  2			6	call	  2
7	varbind	  text			7	varbind	  text
8	dup	  		      |	8	varbind	  reg
9	varbind	  reg		      |	9	constant  set-register
10	stringp	  		      |	10	varref	  register
11	goto-if-nil 1		      |	11	varref	  reg
14	varref	  reg		      |	12	goto-if-not-nil 1
15	varref	  text			15	varref	  text
16	concat2	  		      |	16	goto	  3
17	varset	  text		      |	19:1	varref	  reg
18	goto	  2		      |	20	stringp	  
21:1	varref	  reg		      |	21	goto-if-nil 2
22	goto-if-nil 2		      |	24	varref	  reg
25	constant  error		      |	25	varref	  text
26	constant  "Register does..."  |	26	concat2	  
27	call	  1		      |	27	goto	  3
28	discard	  		      |	30:2	constant  error
29:2	constant  set-register	      |	31	constant  "Register does..."
30	varref	  register	      |	32	call	  1
31	varref	  text		      |	33:3	call	  2
32	call	  2		      |	34	unbind	  2
33	unbind	  2		      |	35	return	  
34	return	  		      <