53 |
(let ((aelt (assq register register-alist))) |
(let ((aelt (assq register register-alist))) |
54 |
(if aelt |
(if aelt |
55 |
(setcdr aelt value) |
(setcdr aelt value) |
56 |
(setq aelt (cons register value)) |
(push (cons register value) register-alist)) |
|
(setq register-alist (cons aelt register-alist))) |
|
57 |
value)) |
value)) |
58 |
|
|
59 |
(defun point-to-register (register &optional arg) |
(defun point-to-register (register &optional arg) |
62 |
Use \\[jump-to-register] to go to that location or restore that configuration. |
Use \\[jump-to-register] to go to that location or restore that configuration. |
63 |
Argument is a character, naming the register." |
Argument is a character, naming the register." |
64 |
(interactive "cPoint to register: \nP") |
(interactive "cPoint to register: \nP") |
65 |
|
;; Turn the marker into a file-ref if the buffer is killed. |
66 |
|
(add-hook 'kill-buffer-hook 'register-swap-out nil t) |
67 |
(set-register register |
(set-register register |
68 |
(if arg (list (current-frame-configuration) (point-marker)) |
(if arg (list (current-frame-configuration) (point-marker)) |
69 |
(point-marker)))) |
(point-marker)))) |
122 |
(t |
(t |
123 |
(error "Register doesn't contain a buffer position or configuration"))))) |
(error "Register doesn't contain a buffer position or configuration"))))) |
124 |
|
|
|
;; Turn markers into file-query references when a buffer is killed. |
|
125 |
(defun register-swap-out () |
(defun register-swap-out () |
126 |
|
"Turn markers into file-query references when a buffer is killed." |
127 |
(and buffer-file-name |
(and buffer-file-name |
128 |
(let ((tail register-alist)) |
(dolist (elem register-alist) |
129 |
(while tail |
(and (markerp (cdr elem)) |
130 |
(and (markerp (cdr (car tail))) |
(eq (marker-buffer (cdr elem)) (current-buffer)) |
131 |
(eq (marker-buffer (cdr (car tail))) (current-buffer)) |
(setcdr elem |
132 |
(setcdr (car tail) |
(list 'file-query |
133 |
(list 'file-query |
buffer-file-name |
134 |
buffer-file-name |
(marker-position (cdr elem)))))))) |
|
(marker-position (cdr (car tail)))))) |
|
|
(setq tail (cdr tail)))))) |
|
|
|
|
|
(add-hook 'kill-buffer-hook 'register-swap-out) |
|
135 |
|
|
136 |
(defun number-to-register (number register) |
(defun number-to-register (number register) |
137 |
"Store a number in a register. |
"Store a number in a register. |
140 |
at point, and point moves to the end of that number. |
at point, and point moves to the end of that number. |
141 |
Interactively, NUMBER is the prefix arg (none means nil)." |
Interactively, NUMBER is the prefix arg (none means nil)." |
142 |
(interactive "P\ncNumber to register: ") |
(interactive "P\ncNumber to register: ") |
143 |
(set-register register |
(set-register register |
144 |
(if number |
(if number |
145 |
(prefix-numeric-value number) |
(prefix-numeric-value number) |
146 |
(if (looking-at "\\s-*-?[0-9]+") |
(if (looking-at "\\s-*-?[0-9]+") |
227 |
(princ (car val)))) |
(princ (car val)))) |
228 |
|
|
229 |
((stringp val) |
((stringp val) |
230 |
(setq val |
(remove-list-of-text-properties 0 (length val) |
231 |
(remove-list-of-text-properties 0 (length val) |
yank-excluded-properties val) |
|
yank-excluded-properties val)) |
|
232 |
(if verbose |
(if verbose |
233 |
(progn |
(progn |
234 |
(princ "the text:\n") |
(princ "the text:\n") |
235 |
(princ val)) |
(princ val)) |
236 |
(princ "text starting with\n ") |
(cond |
237 |
(string-match "[^ \t\n].\\{,20\\}" val) |
;; Extract first N characters starting with first non-whitespace. |
238 |
(princ (match-string 0 val)))) |
((string-match (format "[^ \t\n].\\{,%d\\}" |
239 |
|
;; Deduct 6 for the spaces inserted below. |
240 |
|
(min 20 (max 0 (- (window-width) 6)))) |
241 |
|
val) |
242 |
|
(princ "text starting with\n ") |
243 |
|
(princ (match-string 0 val))) |
244 |
|
((string-match "^[ \t\n]+$" val) |
245 |
|
(princ "whitespace")) |
246 |
|
(t |
247 |
|
(princ "the empty string"))))) |
248 |
(t |
(t |
249 |
(princ "Garbage:\n") |
(princ "Garbage:\n") |
250 |
(if verbose (prin1 val)))))) |
(if verbose (prin1 val)))))) |