Mercurial > hg > xemacs-beta

comparison lisp/register.el @ 284:558f606b08ae r21-0b40

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b40
author cvs
date Mon, 13 Aug 2007 10:34:13 +0200
parents c5d627a313b1
children 3cc9f0ebfbd1
comparison
equal deleted inserted replaced
283:fa3d41851a08 284:558f606b08ae
20 ;; You should have received a copy of the GNU General Public License 20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
23 ;; 02111-1307, USA. 23 ;; 02111-1307, USA.
24 24
25 ;;; Synched up with: FSF 20.1 25 ;;; Synched up with: FSF 20.3
26 26
27 ;;; Commentary: 27 ;;; Commentary:
28 28
29 ;; This file is dumped with XEmacs. 29 ;; This file is dumped with XEmacs.
30 30
35 35
36 ;;; Code: 36 ;;; Code:
37 37
38 (defvar register-alist nil 38 (defvar register-alist nil
39 "Alist of elements (NAME . CONTENTS), one for each Emacs register. 39 "Alist of elements (NAME . CONTENTS), one for each Emacs register.
40 NAME is a character (a number). CONTENTS is a string, number, 40 NAME is a character (a number). CONTENTS is a string, number, marker or list.
41 frame configuration, mark or list.
42 A list of strings represents a rectangle. 41 A list of strings represents a rectangle.
43 A list of the form (file . NAME) represents the file named NAME. 42 A list of the form (file . NAME) represents the file named NAME.
44 A list of the form (file-query NAME POSITION) represents position POSITION 43 A list of the form (file-query NAME POSITION) represents position POSITION
45 in the file named NAME, but query before visiting it.") 44 in the file named NAME, but query before visiting it.
45 A list of the form (WINDOW-CONFIGURATION POSITION)
46 represents a saved window configuration plus a saved value of point.
47 A list of the form (FRAME-CONFIGURATION POSITION)
48 represents a saved frame configuration plus a saved value of point.")
46 49
47 (defun get-register (reg) 50 (defun get-register (reg)
48 "Return contents of Emacs register named REG, or nil if none." 51 "Return contents of Emacs register named REG, or nil if none."
49 (cdr (assq reg register-alist))) 52 (cdr (assq reg register-alist)))
50 53
51 (defun set-register (register value) 54 (defun set-register (register value)
52 "Set contents of Emacs register named REGISTER to VALUE. Return VALUE. 55 "Set contents of Emacs register named REGISTER to VALUE. Returns VALUE.
53 See the documentation of the variable `register-alist' for possible VALUE." 56 See the documentation of the variable `register-alist' for possible VALUE."
54 (let ((aelt (assq register register-alist))) 57 (let ((aelt (assq register register-alist)))
55 (if aelt 58 (if aelt
56 (setcdr aelt value) 59 (setcdr aelt value)
57 (setq aelt (cons register value)) 60 (setq aelt (cons register value))
63 With prefix argument, store current frame configuration. 66 With prefix argument, store current frame configuration.
64 Use \\[jump-to-register] to go to that location or restore that configuration. 67 Use \\[jump-to-register] to go to that location or restore that configuration.
65 Argument is a character, naming the register." 68 Argument is a character, naming the register."
66 (interactive "cPoint to register: \nP") 69 (interactive "cPoint to register: \nP")
67 (set-register register 70 (set-register register
68 (if arg (current-frame-configuration) (point-marker)))) 71 (if arg (list (current-frame-configuration) (point-marker))
72 (point-marker))))
69 73
70 (defun window-configuration-to-register (register &optional arg) 74 (defun window-configuration-to-register (register &optional arg)
71 "Store the window configuration of the selected frame in register REGISTER. 75 "Store the window configuration of the selected frame in register REGISTER.
72 Use \\[jump-to-register] to restore the configuration. 76 Use \\[jump-to-register] to restore the configuration.
73 Argument is a character, naming the register." 77 Argument is a character, naming the register."
74 (interactive "cWindow configuration to register: \nP") 78 (interactive "cWindow configuration to register: \nP")
75 (set-register register (current-window-configuration))) 79 ;; current-window-configuration does not include the value
80 ;; of point in the current buffer, so record that separately.
81 (set-register register (list (current-window-configuration) (point-marker))))
76 82
77 (defun frame-configuration-to-register (register &optional arg) 83 (defun frame-configuration-to-register (register &optional arg)
78 "Store the window configuration of all frames in register REGISTER. 84 "Store the window configuration of all frames in register REGISTER.
79 Use \\[jump-to-register] to restore the configuration. 85 Use \\[jump-to-register] to restore the configuration.
80 Argument is a character, naming the register." 86 Argument is a character, naming the register."
81 (interactive "cFrame configuration to register: \nP") 87 (interactive "cFrame configuration to register: \nP")
82 (set-register register (current-frame-configuration))) 88 ;; current-frame-configuration does not include the value
89 ;; of point in the current buffer, so record that separately.
90 (set-register register (list (current-frame-configuration) (point-marker))))
83 91
84 (defalias 'register-to-point 'jump-to-register) 92 (defalias 'register-to-point 'jump-to-register)
85 (defun jump-to-register (register &optional delete) 93 (defun jump-to-register (register &optional delete)
86 "Move point to location stored in a register. 94 "Move point to location stored in a register.
87 If the register contains a file name, find that file. 95 If the register contains a file name, find that file.
93 delete any existing frames that the frame configuration doesn't mention. 101 delete any existing frames that the frame configuration doesn't mention.
94 \(Otherwise, these frames are iconified.)" 102 \(Otherwise, these frames are iconified.)"
95 (interactive "cJump to register: \nP") 103 (interactive "cJump to register: \nP")
96 (let ((val (get-register register))) 104 (let ((val (get-register register)))
97 (cond 105 (cond
98 ((and (fboundp 'frame-configuration-p) 106 ((and (consp val) (frame-configuration-p (car val)))
99 (frame-configuration-p val)) 107 (set-frame-configuration (car val) (not delete))
100 (set-frame-configuration val (not delete))) 108 (goto-char (cadr val)))
101 ((window-configuration-p val) 109 ((and (consp val) (window-configuration-p (car val)))
102 (set-window-configuration val)) 110 (set-window-configuration (car val))
111 (goto-char (cadr val)))
103 ((markerp val) 112 ((markerp val)
104 (or (marker-buffer val) 113 (or (marker-buffer val)
105 (error "That register's buffer no longer exists")) 114 (error "That register's buffer no longer exists"))
106 (switch-to-buffer (marker-buffer val)) 115 (switch-to-buffer (marker-buffer val))
107 (goto-char val)) 116 (goto-char val))
129 (marker-position (cdr (car tail)))))) 138 (marker-position (cdr (car tail))))))
130 (setq tail (cdr tail)))))) 139 (setq tail (cdr tail))))))
131 140
132 (add-hook 'kill-buffer-hook 'register-swap-out) 141 (add-hook 'kill-buffer-hook 'register-swap-out)
133 142
134 ;(defun number-to-register (arg char) 143 (defun number-to-register (number register)
135 ; "Store a number in a register. 144 "Store a number in a register.
136 ;Two args, NUMBER and REGISTER (a character, naming the register). 145 Two args, NUMBER and REGISTER (a character, naming the register).
137 ;If NUMBER is nil, digits in the buffer following point are read 146 If NUMBER is nil, a decimal number is read from the buffer starting
138 ;to get the number to store. 147 at point, and point moves to the end of that number.
139 ;Interactively, NUMBER is the prefix arg (none means nil)." 148 Interactively, NUMBER is the prefix arg (none means nil)."
140 ; (interactive "P\ncNumber to register: ") 149 (interactive "P\ncNumber to register: ")
141 ; (set-register char 150 (set-register register
142 ; (if arg 151 (if number
143 ; (prefix-numeric-value arg) 152 (prefix-numeric-value number)
144 ; (if (looking-at "[0-9][0-9]*") 153 (if (looking-at "\\s-*-?[0-9]+")
145 ; (save-excursion 154 (progn
146 ; (save-restriction 155 (goto-char (match-end 0))
147 ; (narrow-to-region (point) 156 (string-to-int (match-string 0)))
148 ; (progn (skip-chars-forward "0-9") 157 0))))
149 ; (point))) 158
150 ; (goto-char (point-min)) 159 (defun increment-register (number register)
151 ; (read (current-buffer)))) 160 "Add NUMBER to the contents of register REGISTER.
152 ; 0)))) 161 Interactively, NUMBER is the prefix arg."
153 162 (interactive "p\ncIncrement register: ")
154 ;(defun increment-register (arg char) 163 (or (numberp (get-register register))
155 ; "Add NUMBER to the contents of register REGISTER. 164 (error "Register does not contain a number"))
156 ;Interactively, NUMBER is the prefix arg (none means nil)." 165 (set-register register (+ number (get-register register))))
157 ; (interactive "p\ncNumber to register: ")
158 ; (or (integerp (get-register char))
159 ; (error "Register does not contain a number"))
160 ; (set-register char (+ arg (get-register char))))
161 166
162 (defun view-register (register) 167 (defun view-register (register)
163 "Display what is contained in register named REGISTER. 168 "Display what is contained in register named REGISTER.
164 The Lisp value REGISTER is a character." 169 The Lisp value REGISTER is a character."
165 (interactive "cView register: ") 170 (interactive "cView register: ")
169 (with-output-to-temp-buffer "*Output*" 174 (with-output-to-temp-buffer "*Output*"
170 (princ "Register ") 175 (princ "Register ")
171 (princ (single-key-description register)) 176 (princ (single-key-description register))
172 (princ " contains ") 177 (princ " contains ")
173 (cond 178 (cond
174 ((integerp val) 179 ((numberp val)
175 (princ val)) 180 (princ val))
176 181
177 ((markerp val) 182 ((markerp val)
178 (let ((buf (marker-buffer val))) 183 (let ((buf (marker-buffer val)))
179 (if (null buf) 184 (if (null buf)
181 (princ "a buffer position:\nbuffer ") 186 (princ "a buffer position:\nbuffer ")
182 (princ (buffer-name buf)) 187 (princ (buffer-name buf))
183 (princ ", position ") 188 (princ ", position ")
184 (princ (marker-position val))))) 189 (princ (marker-position val)))))
185 190
186 ((window-configuration-p val) 191 ((and (consp val) (window-configuration-p (car val)))
187 (princ "a window configuration.")) 192 (princ "a window configuration."))
188 193
189 ((frame-configuration-p val) 194 ((and (consp val) (frame-configuration-p (car val)))
190 (princ "a frame configuration.")) 195 (princ "a frame configuration."))
191 196
192 ((and (consp val) (eq (car val) 'file)) 197 ((and (consp val) (eq (car val) 'file))
193 (princ "the file ") 198 (princ "the file ")
194 (prin1 (cdr val)) 199 (prin1 (cdr val))
223 Interactively, second arg is non-nil if prefix arg is supplied." 228 Interactively, second arg is non-nil if prefix arg is supplied."
224 (interactive "*cInsert register: \nP") 229 (interactive "*cInsert register: \nP")
225 (push-mark) 230 (push-mark)
226 (let ((val (get-register register))) 231 (let ((val (get-register register)))
227 (cond 232 (cond
228 ((and (consp val) (fboundp 'insert-rectangle)) 233 ((consp val)
229 (insert-rectangle val)) 234 (insert-rectangle val))
230 ((stringp val) 235 ((stringp val)
231 (insert val)) 236 (insert val))
232 ((integerp val) 237 ((numberp val)
233 (princ val (current-buffer))) 238 (princ val (current-buffer)))
234 ((and (markerp val) (marker-position val)) 239 ((and (markerp val) (marker-position val))
235 (princ (marker-position val) (current-buffer))) 240 (princ (marker-position val) (current-buffer)))
236 (t 241 (t
237 (error "Register does not contain text")))) 242 (error "Register does not contain text"))))
273 "Copy rectangular region into register REGISTER. 278 "Copy rectangular region into register REGISTER.
274 With prefix arg, delete as well. 279 With prefix arg, delete as well.
275 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG. 280 Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
276 START and END are buffer positions giving two corners of rectangle." 281 START and END are buffer positions giving two corners of rectangle."
277 (interactive "cCopy rectangle to register: \nr\nP") 282 (interactive "cCopy rectangle to register: \nr\nP")
278 (unless (fboundp 'extract-rectangle)
279 (error "Rectangles are not available in this XEmacs"))
280 (set-register register 283 (set-register register
281 (if delete-flag 284 (if delete-flag
282 (delete-extract-rectangle start end) 285 (delete-extract-rectangle start end)
283 (extract-rectangle start end)))) 286 (extract-rectangle start end))))
284 287