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

Diff of /emacs/lisp/skeleton.el

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

revision 1.33 by lektu, Sun May 18 23:58:08 2003 UTC revision 1.34 by monnier, Fri May 23 00:59:12 2003 UTC
# Line 1  Line 1 
1  ;;; skeleton.el --- Lisp language extension for writing statement skeletons  ;;; skeleton.el --- Lisp language extension for writing statement skeletons
2    
3  ;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.  ;; Copyright (C) 1993, 1994, 1995, 1996, 2003 by Free Software Foundation, Inc.
4    
5  ;; Author: Daniel Pfeiffer <occitan@esperanto.org>  ;; Author: Daniel Pfeiffer <occitan@esperanto.org>
6  ;; Maintainer: FSF  ;; Maintainer: FSF
# Line 119  are integer buffer positions in the reve Line 119  are integer buffer positions in the reve
119  ;;;###autoload  ;;;###autoload
120  (defmacro define-skeleton (command documentation &rest skeleton)  (defmacro define-skeleton (command documentation &rest skeleton)
121    "Define a user-configurable COMMAND that enters a statement skeleton.    "Define a user-configurable COMMAND that enters a statement skeleton.
122  DOCUMENTATION is that of the command, while the variable of the same name,  DOCUMENTATION is that of the command.
123  which contains the skeleton, has a documentation to that effect.  SKELETON is as defined under `skeleton-insert'."
 INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."  
124    (if skeleton-debug    (if skeleton-debug
125        (set command skeleton))        (set command skeleton))
126    `(progn    `(progn
127         ;; Tell self-insert-command that this function, if called by an
128         ;; abbrev, should cause the self-insert to be skipped.
129         (put ',command 'no-self-insert t)
130       (defun ,command (&optional str arg)       (defun ,command (&optional str arg)
131         ,(concat documentation         ,(concat documentation
132                  (if (string-match "\n\\>" documentation)                  (if (string-match "\n\\'" documentation)
133                      "" "\n")                      "" "\n")
134                  "\n"                  "\n"
135    "This is a skeleton command (see `skeleton-insert').    "This is a skeleton command (see `skeleton-insert').
# Line 144  This is a way of overriding the use of a Line 146  This is a way of overriding the use of a
146    
147  ;;;###autoload  ;;;###autoload
148  (defun skeleton-proxy-new (skeleton &optional str arg)  (defun skeleton-proxy-new (skeleton &optional str arg)
149    "Insert skeleton defined by variable of same name (see `skeleton-insert').    "Insert SKELETON.
150  Prefix ARG allows wrapping around words or regions (see `skeleton-insert').  Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
151  If no ARG was given, but the region is visible, ARG defaults to -1 depending  If no ARG was given, but the region is visible, ARG defaults to -1 depending
152  on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.  on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
153  This command can also be an abbrev expansion (3rd and 4th columns in  This command can also be an abbrev expansion (3rd and 4th columns in
154  \\[edit-abbrevs]  buffer: \"\"  command-name).  \\[edit-abbrevs]  buffer: \"\"  command-name).
155    
156  When called as a function, optional first argument STR may also be a string  Optional first argument STR may also be a string which will be the value
157  which will be the value of `str' whereas the skeleton's interactor is then  of `str' whereas the skeleton's interactor is then ignored."
158  ignored."    (skeleton-insert (funcall skeleton-filter skeleton)
159    (interactive "*P\nP")                     ;; Pretend  C-x a e  passed its prefix arg to us
160    (setq skeleton (funcall skeleton-filter skeleton))                     (if (or arg current-prefix-arg)
161    (if (not skeleton)                         (prefix-numeric-value (or arg
162        (if (memq this-command '(self-insert-command                                                   current-prefix-arg))
163                                 skeleton-pair-insert-maybe                       (and skeleton-autowrap
164                                 expand-abbrev))                            (or (eq last-command 'mouse-drag-region)
165            (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))                                (and transient-mark-mode mark-active))
166      (skeleton-insert skeleton                            -1))
167                       (if (setq skeleton-abbrev-cleanup                     (if (stringp str)
168                                 (or (eq this-command 'self-insert-command)                         str))
169                                     (eq this-command    ;; Return non-nil to tell expand-abbrev that expansion has happened.
170                                         'skeleton-pair-insert-maybe)))    ;; Otherwise the no-self-insert is ignored.
171                           ()    t)
                        ;; Pretend  C-x a e  passed its prefix arg to us  
                        (if (or arg current-prefix-arg)  
                            (prefix-numeric-value (or arg  
                                                      current-prefix-arg))  
                          (and skeleton-autowrap  
                               (or (eq last-command 'mouse-drag-region)  
                                   (and transient-mark-mode mark-active))  
                               -1)))  
                      (if (stringp str)  
                          str))  
     (and skeleton-abbrev-cleanup  
          (setq skeleton-abbrev-cleanup (point))  
          (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))  
172    
173  ;; This command isn't meant to be called, only its aliases with meaningful  ;; This command isn't meant to be called, only its aliases with meaningful
174  ;; names are.  ;; names are.
# Line 390  automatically, and you are prompted to f Line 379  automatically, and you are prompted to f
379                   opoint (point)                   opoint (point)
380                   skeleton (cdr skeleton))                   skeleton (cdr skeleton))
381        (condition-case quit        (condition-case quit
382            (skeleton-internal-1 (car skeleton))            (skeleton-internal-1 (car skeleton) nil recursive)
383          (quit          (quit
384           (if (eq (cdr quit) 'recursive)           (if (eq (cdr quit) 'recursive)
385               (setq recursive 'quit               (setq recursive 'quit
# Line 410  automatically, and you are prompted to f Line 399  automatically, and you are prompted to f
399        (signal 'quit 'recursive)        (signal 'quit 'recursive)
400      recursive))      recursive))
401    
402  (defun skeleton-internal-1 (element &optional literal)  (defun skeleton-internal-1 (element &optional literal recursive)
403    (cond    (cond
404     ((char-or-string-p element)     ((char-or-string-p element)
405      (if (and (integerp element)         ; -num      (if (and (integerp element)         ; -num
# Line 418  automatically, and you are prompted to f Line 407  automatically, and you are prompted to f
407          (if skeleton-untabify          (if skeleton-untabify
408              (backward-delete-char-untabify (- element))              (backward-delete-char-untabify (- element))
409            (delete-backward-char (- element)))            (delete-backward-char (- element)))
410        (insert (if (and skeleton-transformation        (insert (if (not literal)
                        (not literal))  
411                    (funcall skeleton-transformation element)                    (funcall skeleton-transformation element)
412                  element))))                  element))))
413     ((or (eq element '\n)                        ; actually (eq '\n 'n)     ((or (eq element '\n)                        ; actually (eq '\n 'n)
# Line 457  automatically, and you are prompted to f Line 445  automatically, and you are prompted to f
445            (goto-char (pop skeleton-regions))            (goto-char (pop skeleton-regions))
446            (and (<= (current-column) (current-indentation))            (and (<= (current-column) (current-indentation))
447                 (eq (nth 1 skeleton) '\n)                 (eq (nth 1 skeleton) '\n)
448                      (end-of-line 0)))                 (end-of-line 0)))
449             (or skeleton-point        (or skeleton-point
450                 (setq skeleton-point (point)))))            (setq skeleton-point (point)))))
451          ((eq element '-)     ((eq element '-)
452           (setq skeleton-point (point)))      (setq skeleton-point (point)))
453          ((eq element '&)     ((eq element '&)
454           (when skeleton-modified (pop skeleton)))      (when skeleton-modified (pop skeleton)))
455          ((eq element '|)     ((eq element '|)
456           (unless skeleton-modified (pop skeleton)))      (unless skeleton-modified (pop skeleton)))
457          ((eq element '@)     ((eq element '@)
458           (push (point) skeleton-positions))      (push (point) skeleton-positions))
459          ((eq 'quote (car-safe element))     ((eq 'quote (car-safe element))
460           (eval (nth 1 element)))      (eval (nth 1 element)))
461          ((or (stringp (car-safe element))     ((or (stringp (car-safe element))
462          (consp (car-safe element)))          (consp (car-safe element)))
463      (if (symbolp (car-safe (car element)))      (if (symbolp (car-safe (car element)))
464          (while (skeleton-internal-list element nil t))          (while (skeleton-internal-list element nil t))
# Line 479  automatically, and you are prompted to f Line 467  automatically, and you are prompted to f
467          (skeleton-internal-list element (car literal))          (skeleton-internal-list element (car literal))
468          (setq literal (cdr literal)))))          (setq literal (cdr literal)))))
469     ((null element))     ((null element))
470     (t (skeleton-internal-1 (eval element) t))))     (t (skeleton-internal-1 (eval element) t recursive))))
471    
472  ;; Maybe belongs into simple.el or elsewhere  ;; Maybe belongs into simple.el or elsewhere
473  ;; ;;;###autoload  ;; ;;;###autoload

Legend:
Removed from v.1.33  
changed lines
  Added in v.1.34

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