/[emacs]/emacs/lisp/register.el
ViewVC logotype

Diff of /emacs/lisp/register.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37 by pj, Sun Jul 15 16:15:34 2001 UTC revision 1.38 by rms, Thu Feb 7 17:40:44 2002 UTC
# Line 168  The Lisp value REGISTER is a character." Line 168  The Lisp value REGISTER is a character."
168      (if (null val)      (if (null val)
169          (message "Register %s is empty" (single-key-description register))          (message "Register %s is empty" (single-key-description register))
170        (with-output-to-temp-buffer "*Output*"        (with-output-to-temp-buffer "*Output*"
171          (princ "Register ")          (describe-register-1 register t)))))
         (princ (single-key-description register))  
         (princ " contains ")  
         (cond  
          ((numberp val)  
           (princ val))  
   
          ((markerp val)  
           (let ((buf (marker-buffer val)))  
             (if (null buf)  
                 (princ "a marker in no buffer")  
               (princ "a buffer position:\nbuffer ")  
               (princ (buffer-name buf))  
               (princ ", position ")  
               (princ (marker-position val)))))  
   
          ((and (consp val) (window-configuration-p (car val)))  
           (princ "a window configuration."))  
   
          ((and (consp val) (frame-configuration-p (car val)))  
           (princ "a frame configuration."))  
   
          ((and (consp val) (eq (car val) 'file))  
           (princ "the file ")  
           (prin1 (cdr val))  
           (princ "."))  
   
          ((and (consp val) (eq (car val) 'file-query))  
           (princ "a file-query reference:\nfile ")  
           (prin1 (car (cdr val)))  
           (princ ",\nposition ")  
           (princ (car (cdr (cdr val))))  
           (princ "."))  
172    
173           ((consp val)  (defun list-registers ()
174      "Display a list of nonempty registers saying briefly what they contain."
175      (interactive)
176      (let ((list (copy-sequence register-alist)))
177        (setq list (sort list (lambda (a b) (< (car a) (car b)))))
178        (with-output-to-temp-buffer "*Output*"
179          (dolist (elt list)
180            (when (get-register (car elt))
181              (describe-register-1 (car elt))
182              (terpri))))))
183    
184    (defun describe-register-1 (register &optional verbose)
185      (princ "Register ")
186      (princ (single-key-description register))
187      (princ " contains ")
188      (cond
189       ((numberp val)
190        (princ val))
191    
192       ((markerp val)
193        (let ((buf (marker-buffer val)))
194          (if (null buf)
195              (princ "a marker in no buffer")
196            (princ "a buffer position:\n    buffer ")
197            (princ (buffer-name buf))
198            (princ ", position ")
199            (princ (marker-position val)))))
200    
201       ((and (consp val) (window-configuration-p (car val)))
202        (princ "a window configuration."))
203    
204       ((and (consp val) (frame-configuration-p (car val)))
205        (princ "a frame configuration."))
206    
207       ((and (consp val) (eq (car val) 'file))
208        (princ "the file ")
209        (prin1 (cdr val))
210        (princ "."))
211    
212       ((and (consp val) (eq (car val) 'file-query))
213        (princ "a file-query reference:\n    file ")
214        (prin1 (car (cdr val)))
215        (princ ",\n    position ")
216        (princ (car (cdr (cdr val))))
217        (princ "."))
218    
219       ((consp val)
220        (if verbose
221            (progn
222            (princ "the rectangle:\n")            (princ "the rectangle:\n")
223            (while val            (while val
224                (princ "    ")
225              (princ (car val))              (princ (car val))
226              (terpri)              (terpri)
227              (setq val (cdr val))))              (setq val (cdr val))))
228          (princ "a rectangle starting with ")
229          (princ (car val))))
230    
231           ((stringp val)     ((stringp val)
232        (if verbose
233            (progn
234            (princ "the text:\n")            (princ "the text:\n")
235            (princ val))            (princ val))
236          (princ "text starting with\n    ")
237           (t        (string-match "[^ \t\n].\\{,20\\}" val)
238            (princ "Garbage:\n")        (princ (match-string 0 val))))
239            (prin1 val)))))))     (t
240        (princ "Garbage:\n")
241        (if verbose (prin1 val)))))
242    
243  (defun insert-register (register &optional arg)  (defun insert-register (register &optional arg)
244    "Insert contents of register REGISTER.  (REGISTER is a character.)    "Insert contents of register REGISTER.  (REGISTER is a character.)

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26