Mercurial > hg > xemacs-beta

comparison lisp/packages/autoinsert.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
2 ;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
3
4 ;; Author: Charlie Martin <crm@cs.duke.edu>
5 ;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
6
7 ;; This file is part of XEmacs.
8
9 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
22
23 ;;; Synched up with: FSF 19.30.
24
25 ;;; Commentary:
26
27 ;; The following defines an association list for text to be
28 ;; automatically inserted when a new file is created, and a function
29 ;; which automatically inserts these files; the idea is to insert
30 ;; default text much as the mode is automatically set using
31 ;; auto-mode-alist.
32 ;;
33 ;; To use:
34 ;; (add-hook 'find-file-hooks 'auto-insert)
35 ;; setq auto-insert-directory to an appropriate slash-terminated value
36 ;;
37 ;; Author: Charlie Martin
38 ;; Department of Computer Science and
39 ;; National Biomedical Simulation Resource
40 ;; Box 3709
41 ;; Duke University Medical Center
42 ;; Durham, NC 27710
43 ;; (crm@cs.duke.edu,mcnc!duke!crm)
44
45 ;;; Code:
46
47 (defvar auto-insert 'not-modified
48 "*Controls automatic insertion into newly found empty files:
49 nil do nothing
50 t insert if possible
51 other insert if possible, but mark as unmodified.
52 Insertion is possible when something appropriate is found in
53 `auto-insert-alist'. When the insertion is marked as unmodified, you can
54 save it with \\[write-file] RET.
55 This variable is used when `auto-insert' is called as a function, e.g.
56 when you do (add-hook 'find-file-hooks 'auto-insert).
57 With \\[auto-insert], this is always treated as if it were `t'.")
58
59
60 (defvar auto-insert-query 'function
61 "*If non-`nil', ask user before auto-inserting.
62 When this is `function', only ask when called non-interactively.")
63
64
65 (defvar auto-insert-prompt "Perform %s auto-insertion? "
66 "*Prompt to use when querying whether to auto-insert.
67 If this contains a %s, that will be replaced by the matching rule.")
68
69
70 (defvar auto-insert-alist
71 '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
72 (upcase (concat (file-name-nondirectory
73 (substring buffer-file-name 0 (match-beginning 0)))
74 "_"
75 (substring buffer-file-name (1+ (match-beginning 0)))))
76 "#ifndef " str \n
77 "#define " str "\n\n"
78 _ "\n\n#endif")
79
80 (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
81 nil
82 "#include \""
83 ;; nop without latest cc-mode
84 (and (fboundp 'c-companion-file)
85 ;(file-readable-p (c-companion-file 'name))
86 (file-name-nondirectory (c-companion-file 'name))) & ?\"
87 | -10)
88
89 ("[Mm]akefile\\'" . "makefile.inc")
90
91 ("\\.html\\'"
92 nil
93 "<html>\n"
94 "<head>\n"
95 "<title>" _ "</title>\n"
96 "</head>\n"
97 "<body>\n\n"
98 "</body>\n"
99 "</html>")
100
101 (plain-tex-mode . "tex-insert.tex")
102 (bibtex-mode . "tex-insert.tex")
103 (latex-mode
104 ;; should try to offer completing read for these
105 "options, RET: "
106 "\\documentstyle[" str & ?\] | -1
107 ?{ (read-string "class: ") "}\n"
108 ("package, %s: "
109 "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
110 _ "\n\\begin{document}\n" _
111 "\n\\end{document}")
112
113 (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
114 lambda ()
115 (if (eq major-mode default-major-mode)
116 (sh-mode)))
117
118 (ada-mode . ada-header)
119
120 (("\\.el\\'" . "Emacs Lisp header")
121 "Short description: "
122 ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
123
124 ;; Copyright (C) " (substring (current-time-string) -4) " by "
125 (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "
126
127 ;; Author: " (user-full-name)
128 '(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t)
129 (replace-match (capitalize (user-login-name)) t t))
130 '(end-of-line 1) " <" (user-login-name) ?@ (system-name) ">
131 ;; Keywords: "
132 '(require 'finder)
133 ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
134 '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
135 finder-known-keywords)
136 v2 (mapconcat (lambda (x) (format "%10.0s: %s" (car x) (cdr x)))
137 finder-known-keywords
138 "\n"))
139 ((let ((minibuffer-help-form v2))
140 (completing-read "Keyword, C-h: " v1 nil t))
141 str ", ") & -2 "
142
143 ;; This file is part of GNU Emacs.
144
145 ;; GNU Emacs is free software; you can redistribute it and/or modify
146 ;; it under the terms of the GNU General Public License as published by
147 ;; the Free Software Foundation; either version 2, or (at your option)
148 ;; any later version.
149
150 ;; GNU Emacs is distributed in the hope that it will be useful,
151 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
152 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
153 ;; GNU General Public License for more details.
154
155 ;; You should have received a copy of the GNU General Public License
156 ;; along with GNU Emacs; see the file COPYING. If not, write to
157 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
158
159 ;;; Commentary:
160
161 ;; " _ "
162
163 ;;; Code:
164
165
166
167 ;;; " (file-name-nondirectory (buffer-file-name)) " ends here"))
168 "A list specifying text to insert by default into a new file.
169 Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
170 CONDITION maybe a regexp that must match the new file's name, or it may be
171 a symbol that must match the major mode for this element to apply.
172 Only the first matching element is effective.
173 Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
174 ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
175 file-name or one relative to `auto-insert-directory' or a function to call.
176 ACTION may also be a vector containing several successive single actions as
177 described above, e.g. [\"header.insert\" date-and-author-update].")
178
179
180 ;; Establish a default value for auto-insert-directory
181 (defvar auto-insert-directory "~/insert/"
182 "*Directory from which auto-inserted files are taken.")
183
184
185 ;;;###autoload
186 (defun auto-insert ()
187 "Insert default contents into a new file if `auto-insert' is non-nil.
188 Matches the visited file name against the elements of `auto-insert-alist'."
189 (interactive)
190 (and (not buffer-read-only)
191 (or (eq this-command 'auto-insert)
192 (and auto-insert
193 (bobp) (eobp)))
194 (let ((alist auto-insert-alist)
195 case-fold-search cond desc action)
196 (goto-char 1)
197 ;; find first matching alist entry
198 (while alist
199 (if (atom (setq cond (car (car alist))))
200 (setq desc cond)
201 (setq desc (cdr cond)
202 cond (car cond)))
203 (if (if (symbolp cond)
204 (eq cond major-mode)
205 (string-match cond buffer-file-name))
206 (setq action (cdr (car alist))
207 alist nil)
208 (setq alist (cdr alist))))
209
210 ;; Now, if we found something, do it
211 (and action
212 (if (stringp action)
213 (file-readable-p (concat auto-insert-directory action))
214 t)
215 (if auto-insert-query
216 (or (if (eq auto-insert-query 'function)
217 (eq this-command 'auto-insert))
218 (y-or-n-p (format auto-insert-prompt desc)))
219 t)
220 (mapcar
221 (lambda (action)
222 (if (stringp action)
223 (if (file-readable-p
224 (setq action (concat auto-insert-directory action)))
225 (insert-file-contents action))
226 (save-window-excursion
227 ;; make buffer visible before skeleton or function
228 ;; which might ask the user for something
229 (switch-to-buffer (current-buffer))
230 (if (and (consp action)
231 (not (eq (car action) 'lambda)))
232 (skeleton-insert action)
233 (funcall action)))))
234 (if (vectorp action)
235 action
236 (vector action))))
237 (and (buffer-modified-p)
238 (not (eq this-command 'auto-insert))
239 (set-buffer-modified-p (eq auto-insert t))))))
240
241
242 ;;;###autoload
243 (defun define-auto-insert (key action &optional after)
244 "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
245 Optional AFTER means to insert action after all existing actions for CONDITION,
246 or if CONDITION had no actions, after all other CONDITIONs."
247 (let ((elt (assoc key auto-insert-alist)))
248 (if elt
249 (setcdr elt
250 (if (vectorp (cdr elt))
251 (vconcat (if after (cdr elt))
252 (if (vectorp action) action (vector action))
253 (if after () (cdr elt)))
254 (if after
255 (vector (cdr elt) action)
256 (vector action (cdr elt)))))
257 (if after
258 (nconc auto-insert-alist (list (cons key action)))
259 (setq auto-insert-alist (cons (cons key action)
260 auto-insert-alist))))))
261
262 ;;; autoinsert.el ends here