[bpt/emacs.git] / lisp / autoinsert.el

;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc.

;; Author: Charlie Martin <crm@cs.duke.edu>
;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;;  The following defines an association list for text to be
;;  automatically inserted when a new file is created, and a function
;;  which automatically inserts these files; the idea is to insert
;;  default text much as the mode is automatically set using
;;  auto-mode-alist.
;;
;;  To use: 
;;     (add-hook 'find-file-hooks 'auto-insert)
;;     setq auto-insert-directory to an appropriate slash-terminated value
;;
;;  Author:  Charlie Martin
;;           Department of Computer Science and
;;           National Biomedical Simulation Resource
;;           Box 3709
;;           Duke University Medical Center
;;           Durham, NC 27710
;;	      (crm@cs.duke.edu,mcnc!duke!crm) 

;;; Code:

(defvar auto-insert 'not-modified
  "*Controls automatic insertion into newly found empty files:
	nil	do nothing
	t	insert if possible
	other	insert if possible, but mark as unmodified.
Insertion is possible when something appropriate is found in
`auto-insert-alist'.  When the insertion is marked as unmodified, you can
save it with  \\[write-file] RET.
This variable is used when `auto-insert' is called as a function, e.g.
when you do (add-hook 'find-file-hooks 'auto-insert).
With \\[auto-insert], this is always treated as if it were `t'.")


(defvar auto-insert-query 'function
  "*If non-`nil', ask user before auto-inserting.
When this is `function', only ask when called non-interactively.")


(defvar auto-insert-prompt "Perform %s auto-insertion? "
  "*Prompt to use when querying whether to auto-insert.
If this contains a %s, that will be replaced by the matching rule.")


(defvar auto-insert-alist
  '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
     (upcase (concat (file-name-nondirectory
		      (substring buffer-file-name 0 (match-beginning 0)))
		     "_"
		     (substring buffer-file-name (1+ (match-beginning 0)))))
     "#ifndef " str \n
     "#define " str "\n\n"
     _ "\n\n#endif")

    (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
     nil
     "#include \""
     ;; nop without latest cc-mode
     (and (fboundp 'c-companion-file)
	  ;(file-readable-p (c-companion-file 'name))
	  (file-name-nondirectory (c-companion-file 'name))) & ?\"
     | -10)

    ("[Mm]akefile\\'" . "makefile.inc")

    ("\\.html\\'"
     nil
     "<html>\n"
     "<head>\n"
     "<title>" _ "</title>\n"
     "</head>\n"
     "<body>\n\n"
     "</body>\n"
     "</html>")
    
    (plain-tex-mode . "tex-insert.tex")
    (bibtex-mode . "tex-insert.tex")
    (latex-mode
     ;; should try to offer completing read for these
     "options, RET: "
     "\\documentstyle[" str & ?\] | -1
     ?{ (read-string "class: ") "}\n"
     ("package, %s: "
      "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
     _ "\n\\begin{document}\n" _
     "\n\\end{document}")

    (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
     lambda ()
       (if (eq major-mode default-major-mode)
	 (sh-mode)))
    
    (ada-mode . ada-header)

    (("\\.el\\'" . "Emacs Lisp header")
     "Short description: "
     ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "

;; Copyright (C) " (substring (current-time-string) -4) " by "
 (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "

;; Author: " (user-full-name)
'(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t)
     (replace-match (capitalize (user-login-name)) t t))
'(end-of-line 1) " <" (user-login-name) ?@ (system-name) ">
;; Keywords: "
 '(require 'finder)
 ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
 '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
		   finder-known-keywords)
	v2 (mapconcat (lambda (x) (format "%10.0s:  %s" (car x) (cdr x)))
	   finder-known-keywords
	   "\n"))
 ((let ((minibuffer-help-form v2))
    (completing-read "Keyword, C-h: " v1 nil t))
    str ", ") & -2 "

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; " _ "

;;; Code:


;;; " (file-name-nondirectory (buffer-file-name)) " ends here"))
  "A list specifying text to insert by default into a new file.
Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
CONDITION maybe a regexp that must match the new file's name, or it may be
a symbol that must match the major mode for this element to apply.
Only the first matching element is effective.
Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
file-name or one relative to `auto-insert-directory' or a function to call.
ACTION may also be a vector containing several successive single actions as
described above, e.g. [\"header.insert\" date-and-author-update].")


;; Establish a default value for auto-insert-directory
(defvar auto-insert-directory "~/insert/"
  "*Directory from which auto-inserted files are taken.")


;;;###autoload
(defun auto-insert ()
  "Insert default contents into a new file if `auto-insert' is non-nil.
Matches the visited file name against the elements of `auto-insert-alist'."
  (interactive)
  (and (not buffer-read-only)
       (or (eq this-command 'auto-insert)
	   (and auto-insert
		(bobp) (eobp)))
       (let ((alist auto-insert-alist)
	     case-fold-search cond desc action)
	 (goto-char 1)
	 ;; find first matching alist entry
	 (while alist
	   (if (atom (setq cond (car (car alist))))
	       (setq desc cond)
	     (setq desc (cdr cond)
		   cond (car cond)))
	   (if (if (symbolp cond)
		   (eq cond major-mode)
		 (string-match cond buffer-file-name))
	       (setq action (cdr (car alist))
		     alist nil)
	     (setq alist (cdr alist))))

	 ;; Now, if we found something, do it
	 (and action
	      (if (stringp action)
		  (file-readable-p (concat auto-insert-directory action))
		t)
	      (if auto-insert-query
		  (or (if (eq auto-insert-query 'function)
			  (eq this-command 'auto-insert))
		      (y-or-n-p (format auto-insert-prompt desc)))
		t)
	      (mapcar
	       (lambda (action)
		 (if (stringp action)
		     (if (file-readable-p
			  (setq action (concat auto-insert-directory action)))
			 (insert-file-contents action))
		   (save-window-excursion
		     ;; make buffer visible before skeleton or function
		     ;; which might ask the user for something
		     (switch-to-buffer (current-buffer))
		     (if (and (consp action)
			      (not (eq (car action) 'lambda)))
			 (skeleton-insert action)
		       (funcall action)))))
	       (if (vectorp action)
		   action
		 (vector action))))
	 (and (buffer-modified-p)
	      (not (eq this-command 'auto-insert))
	      (set-buffer-modified-p (eq auto-insert t))))))


;;;###autoload
(defun define-auto-insert (key action &optional after)
  "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
Optional AFTER means to insert action after all existing actions for CONDITION,
or if CONDITION had no actions, after all other CONDITIONs."
  (let ((elt (assoc key auto-insert-alist)))
    (if elt
	(setcdr elt
		(if (vectorp (cdr elt))
		    (vconcat (if after (cdr elt))
			     (if (vectorp action) action (vector action))
			     (if after () (cdr elt)))
		  (if after
		      (vector (cdr elt) action)
		    (vector action (cdr elt)))))
      (if after
	  (nconc auto-insert-alist (list (cons key action)))
	(setq auto-insert-alist (cons (cons key action)
				      auto-insert-alist))))))

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