lisp/autoinsert.el

   1 ;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1994, 1995, 1998, 2000, 2001, 2002,
   4 ;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Charlie Martin <crm@cs.duke.edu>
   7 ;; Adapted-By: Daniel Pfeiffer <occitan@esperanto.org>
   8 ;; Keywords: convenience
   9 ;; Maintainer: FSF
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, USA.
  27
  28 ;;; Commentary:
  29
  30 ;;  The following defines an association list for text to be
  31 ;;  automatically inserted when a new file is created, and a function
  32 ;;  which automatically inserts these files; the idea is to insert
  33 ;;  default text much as the mode is automatically set using
  34 ;;  auto-mode-alist.
  35 ;;
  36 ;;  To use:
  37 ;;     (add-hook 'find-file-hook 'auto-insert)
  38 ;;     setq auto-insert-directory to an appropriate slash-terminated value
  39 ;;
  40 ;;  You can also customize the variable `auto-insert-mode' to load the
  41 ;;  package.  Alternatively, add the following to your .emacs file:
  42 ;;  (auto-insert-mode 1)
  43 ;;
  44 ;;  Author:  Charlie Martin
  45 ;;           Department of Computer Science and
  46 ;;           National Biomedical Simulation Resource
  47 ;;           Box 3709
  48 ;;           Duke University Medical Center
  49 ;;           Durham, NC 27710
  50 ;;            (crm@cs.duke.edu,mcnc!duke!crm)
  51
  52 ;;; Code:
  53
  54 (defgroup auto-insert nil
  55   "Automatic mode-dependent insertion of text into new files."
  56   :prefix "auto-insert-"
  57   :group 'files
  58   :group 'convenience)
  59
  60
  61 (defcustom auto-insert 'not-modified
  62   "*Controls automatic insertion into newly found empty files.
  63 Possible values:
  64         nil     do nothing
  65         t       insert if possible
  66         other   insert if possible, but mark as unmodified.
  67 Insertion is possible when something appropriate is found in
  68 `auto-insert-alist'.  When the insertion is marked as unmodified, you can
  69 save it with  \\[write-file] RET.
  70 This variable is used when the function `auto-insert' is called, e.g.
  71 when you do (add-hook 'find-file-hook 'auto-insert).
  72 With \\[auto-insert], this is always treated as if it were t."
  73   :type '(choice (const :tag "Insert if possible" t)
  74                  (const :tag "Do nothing" nil)
  75                  (other :tag "insert if possible, mark as unmodified."
  76                         not-modified))
  77   :group 'auto-insert)
  78
  79 (defcustom auto-insert-query 'function
  80   "*Non-nil means ask user before auto-inserting.
  81 When this is `function', only ask when called non-interactively."
  82   :type '(choice (const :tag "Don't ask" nil)
  83                  (const :tag "Ask if called non-interactively" function)
  84                  (other :tag "Ask" t))
  85   :group 'auto-insert)
  86
  87 (defcustom auto-insert-prompt "Perform %s auto-insertion? "
  88   "*Prompt to use when querying whether to auto-insert.
  89 If this contains a %s, that will be replaced by the matching rule."
  90   :type 'string
  91   :group 'auto-insert)
  92
  93
  94 (defcustom auto-insert-alist
  95   '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
  96      (upcase (concat (file-name-nondirectory
  97                       (substring buffer-file-name 0 (match-beginning 0)))
  98                      "_"
  99                      (substring buffer-file-name (1+ (match-beginning 0)))))
 100      "#ifndef " str \n
 101      "#define " str "\n\n"
 102      _ "\n\n#endif")
 103
 104     (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
 105      nil
 106      "#include \""
 107      (let ((stem (file-name-sans-extension buffer-file-name)))
 108        (cond ((file-exists-p (concat stem ".h"))
 109               (file-name-nondirectory (concat stem ".h")))
 110              ((file-exists-p (concat stem ".hh"))
 111               (file-name-nondirectory (concat stem ".hh")))))
 112      & ?\" | -10)
 113
 114     (("[Mm]akefile\\'" . "Makefile") . "makefile.inc")
 115
 116     (html-mode . (lambda () (sgml-tag "html")))
 117
 118     (plain-tex-mode . "tex-insert.tex")
 119     (bibtex-mode . "tex-insert.tex")
 120     (latex-mode
 121      ;; should try to offer completing read for these
 122      "options, RET: "
 123      "\\documentclass[" str & ?\] | -1
 124      ?{ (read-string "class: ") "}\n"
 125      ("package, %s: "
 126       "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
 127      _ "\n\\begin{document}\n" _
 128      "\n\\end{document}")
 129
 130     (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
 131      lambda ()
 132        (if (eq major-mode default-major-mode)
 133          (sh-mode)))
 134
 135     (ada-mode . ada-header)
 136
 137     (("\\.[1-9]\\'" . "Man page skeleton")
 138      "Short description: "
 139      ".\\\" Copyright (C), " (substring (current-time-string) -4) "  "
 140      (getenv "ORGANIZATION") | (progn user-full-name)
 141      "
 142 .\\\" You may distribute this file under the terms of the GNU Free
 143 .\\\" Documentation License.
 144 .TH " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
 145      " " (file-name-extension (buffer-file-name))
 146      " " (format-time-string "%Y-%m-%d ")
 147      "\n.SH NAME\n"
 148      (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
 149      " \\- " str
 150      "\n.SH SYNOPSIS
 151 .B " (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
 152      "\n"
 153      _
 154      "
 155 .SH DESCRIPTION
 156 .SH OPTIONS
 157 .SH FILES
 158 .SH \"SEE ALSO\"
 159 .SH BUGS
 160 .SH AUTHOR
 161 " (user-full-name)
 162      '(if (search-backward "&" (line-beginning-position) t)
 163           (replace-match (capitalize (user-login-name)) t t))
 164      '(end-of-line 1) " <" (progn user-mail-address) ">\n")
 165
 166     (("\\.el\\'" . "Emacs Lisp header")
 167      "Short description: "
 168      ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
 169
 170 ;; Copyright (C) " (substring (current-time-string) -4) "  "
 171  (getenv "ORGANIZATION") | (progn user-full-name) "
 172
 173 ;; Author: " (user-full-name)
 174 '(if (search-backward "&" (line-beginning-position) t)
 175      (replace-match (capitalize (user-login-name)) t t))
 176 '(end-of-line 1) " <" (progn user-mail-address) ">
 177 ;; Keywords: "
 178  '(require 'finder)
 179  ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
 180  '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
 181                    finder-known-keywords)
 182         v2 (mapconcat (lambda (x) (format "%12s:  %s" (car x) (cdr x)))
 183            finder-known-keywords
 184            "\n"))
 185  ((let ((minibuffer-help-form v2))
 186     (completing-read "Keyword, C-h: " v1 nil t))
 187     str ", ") & -2 "
 188
 189 \;; This program is free software; you can redistribute it and/or modify
 190 \;; it under the terms of the GNU General Public License as published by
 191 \;; the Free Software Foundation, either version 3 of the License, or
 192 \;; (at your option) any later version.
 193
 194 \;; This program is distributed in the hope that it will be useful,
 195 \;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 196 \;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 197 \;; GNU General Public License for more details.
 198
 199 \;; You should have received a copy of the GNU General Public License
 200 \;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 201
 202 \;;; Commentary:
 203
 204 \;; " _ "
 205
 206 \;;; Code:
 207
 208
 209
 210 \(provide '"
 211        (file-name-sans-extension (file-name-nondirectory (buffer-file-name)))
 212        ")
 213 \;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
 214     (("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton")
 215      "Title: "
 216      "\\input texinfo   @c -*-texinfo-*-
 217 @c %**start of header
 218 @setfilename "
 219      (file-name-sans-extension
 220       (file-name-nondirectory (buffer-file-name))) ".info\n"
 221       "@settitle " str "
 222 @c %**end of header
 223 @copying\n"
 224       (setq short-description (read-string "Short description: "))
 225       ".\n\n"
 226       "Copyright @copyright{} " (substring (current-time-string) -4) "  "
 227       (getenv "ORGANIZATION") | (progn user-full-name) "
 228
 229 @quotation
 230 Permission is granted to copy, distribute and/or modify this document
 231 under the terms of the GNU Free Documentation License, Version 1.2
 232 or any later version published by the Free Software Foundation;
 233 with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
 234 Texts.  A copy of the license is included in the section entitled ``GNU
 235 Free Documentation License''.
 236
 237 A copy of the license is also available from the Free Software
 238 Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}.
 239
 240 @end quotation
 241
 242 The document was typeset with
 243 @uref{http://www.texinfo.org/, GNU Texinfo}.
 244
 245 @end copying
 246
 247 @titlepage
 248 @title " str "
 249 @subtitle " short-description "
 250 @author " (getenv "ORGANIZATION") | (progn user-full-name)
 251      " <" (progn user-mail-address) ">
 252 @page
 253 @vskip 0pt plus 1filll
 254 @insertcopying
 255 @end titlepage
 256
 257 @c Output the table of the contents at the beginning.
 258 @contents
 259
 260 @ifnottex
 261 @node Top
 262 @top " str "
 263
 264 @insertcopying
 265 @end ifnottex
 266
 267 @c Generate the nodes for this menu with `C-c C-u C-m'.
 268 @menu
 269 @end menu
 270
 271 @c Update all node entries with `C-c C-u C-n'.
 272 @c Insert new nodes with `C-c C-c n'.
 273 @node Chapter One
 274 @chapter Chapter One
 275
 276 " _ "
 277
 278 @node Copying This Manual
 279 @appendix Copying This Manual
 280
 281 @menu
 282 * GNU Free Documentation License::  License for copying this manual.
 283 @end menu
 284
 285 @c Get fdl.texi from http://www.gnu.org/licenses/fdl.html
 286 @include fdl.texi
 287
 288 @node Index
 289 @unnumbered Index
 290
 291 @printindex cp
 292
 293 @bye
 294
 295 @c " (file-name-nondirectory (buffer-file-name)) " ends here\n"))
 296   "A list specifying text to insert by default into a new file.
 297 Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
 298 CONDITION may be a regexp that must match the new file's name, or it may be
 299 a symbol that must match the major mode for this element to apply.
 300 Only the first matching element is effective.
 301 Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
 302 ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
 303 file-name or one relative to `auto-insert-directory' or a function to call.
 304 ACTION may also be a vector containing several successive single actions as
 305 described above, e.g. [\"header.insert\" date-and-author-update]."
 306   :type 'sexp
 307   :group 'auto-insert)
 308
 309
 310 ;; Establish a default value for auto-insert-directory
 311 (defcustom auto-insert-directory "~/insert/"
 312   "*Directory from which auto-inserted files are taken.
 313 The value must be an absolute directory name;
 314 thus, on a GNU or Unix system, it must end in a slash."
 315   :type 'directory
 316   :group 'auto-insert)
 317
 318
 319 ;;;###autoload
 320 (defun auto-insert ()
 321   "Insert default contents into new files if variable `auto-insert' is non-nil.
 322 Matches the visited file name against the elements of `auto-insert-alist'."
 323   (interactive)
 324   (and (not buffer-read-only)
 325        (or (eq this-command 'auto-insert)
 326            (and auto-insert
 327                 (bobp) (eobp)))
 328        (let ((alist auto-insert-alist)
 329              case-fold-search cond desc action)
 330          (goto-char 1)
 331          ;; find first matching alist entry
 332          (while alist
 333            (if (atom (setq cond (car (car alist))))
 334                (setq desc cond)
 335              (setq desc (cdr cond)
 336                    cond (car cond)))
 337            (if (if (symbolp cond)
 338                    (eq cond major-mode)
 339                  (and buffer-file-name
 340                       (string-match cond buffer-file-name)))
 341                (setq action (cdr (car alist))
 342                      alist nil)
 343              (setq alist (cdr alist))))
 344
 345          ;; Now, if we found something, do it
 346          (and action
 347               (if (stringp action)
 348                   (file-readable-p (concat auto-insert-directory action))
 349                 t)
 350               (if auto-insert-query
 351                   (or (if (eq auto-insert-query 'function)
 352                           (eq this-command 'auto-insert))
 353                       (y-or-n-p (format auto-insert-prompt desc)))
 354                 t)
 355               (mapc
 356                (lambda (action)
 357                  (if (stringp action)
 358                      (if (file-readable-p
 359                           (setq action (concat auto-insert-directory action)))
 360                          (insert-file-contents action))
 361                    (save-window-excursion
 362                      ;; make buffer visible before skeleton or function
 363                      ;; which might ask the user for something
 364                      (switch-to-buffer (current-buffer))
 365                      (if (and (consp action)
 366                               (not (eq (car action) 'lambda)))
 367                          (skeleton-insert action)
 368                        (funcall action)))))
 369                (if (vectorp action)
 370                    action
 371                  (vector action))))
 372          (and (buffer-modified-p)
 373               (not (eq this-command 'auto-insert))
 374               (set-buffer-modified-p (eq auto-insert t)))))
 375   ;; Return nil so that it could be used in
 376   ;; `find-file-not-found-hooks', though that's probably inadvisable.
 377   nil)
 378
 379
 380 ;;;###autoload
 381 (defun define-auto-insert (condition action &optional after)
 382   "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
 383 Optional AFTER means to insert action after all existing actions for CONDITION,
 384 or if CONDITION had no actions, after all other CONDITIONs."
 385   (let ((elt (assoc condition auto-insert-alist)))
 386     (if elt
 387         (setcdr elt
 388                 (if (vectorp (cdr elt))
 389                     (vconcat (if after (cdr elt))
 390                              (if (vectorp action) action (vector action))
 391                              (if after () (cdr elt)))
 392                   (if after
 393                       (vector (cdr elt) action)
 394                     (vector action (cdr elt)))))
 395       (if after
 396           (nconc auto-insert-alist (list (cons condition action)))
 397         (setq auto-insert-alist (cons (cons condition action)
 398                                       auto-insert-alist))))))
 399
 400 ;;;###autoload
 401 (define-minor-mode auto-insert-mode
 402   "Toggle Auto-insert mode.
 403 With prefix ARG, turn Auto-insert mode on if and only if ARG is positive.
 404 Returns the new status of Auto-insert mode (non-nil means on).
 405
 406 When Auto-insert mode is enabled, when new files are created you can
 407 insert a template for the file depending on the mode of the buffer."
 408   :global t :group 'auto-insert
 409   (if auto-insert-mode
 410       (add-hook 'find-file-hook 'auto-insert)
 411     (remove-hook 'find-file-hook 'auto-insert)))
 412
 413 (provide 'autoinsert)
 414
 415 ;; arch-tag: 5b6630ac-c735-43cf-b097-b78c622af909
 416 ;;; autoinsert.el ends here