Copyright up-date.
[emacs.git] / lisp / generic.el
blob2d8cf4c937b639b2a589fc1045248edba7fd090b
1 ;;; generic.el --- Defining simple major modes with comment and font-lock.
2 ;;
3 ;; Copyright (C) 1997, 1999 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Peter Breton <pbreton@cs.umb.edu>
6 ;; Created: Fri Sep 27 1996
7 ;; Keywords: generic, comment, font-lock
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;; Purpose:
28 ;; Meta-mode to create simple major modes
29 ;; with basic comment and font-lock support
31 ;;; Commentary:
33 ;; INTRODUCTION:
35 ;; Generic-mode is a meta-mode which can be used to define small modes
36 ;; which provide basic comment and font-lock support. These modes are
37 ;; intended for the many configuration files and such which are too small
38 ;; for a "real" mode, but still have a regular syntax, comment characters
39 ;; and the like.
41 ;; Each generic mode can define the following:
43 ;; * List of comment-characters. The entries in this list should be
44 ;; either a character, a one or two character string or a cons pair.
45 ;; If the entry is a character or a one-character string
46 ;; LIMITATIONS: Emacs does not support comment strings of more than
47 ;; two characters in length.
49 ;; * List of keywords to font-lock. Each keyword should be a string.
50 ;; If you have additional keywords which should be highlighted in a face
51 ;; different from `font-lock-keyword-face', you can use the convenience
52 ;; function `generic-make-keywords-list' (which see), and add the
53 ;; result to the following list:
54 ;;
55 ;; * Additional expressions to font-lock. This should be a list of
56 ;; expressions, each of which should be of the same form
57 ;; as those in `font-lock-defaults-alist'.
58 ;;
59 ;; * List of regular expressions to be placed in auto-mode-alist.
61 ;; * List of functions to call to do some additional setup
63 ;; This should pretty much cover basic functionality; if you need much
64 ;; more than this, or you find yourself writing extensive customizations,
65 ;; perhaps you should be writing a major mode instead!
67 ;; LOCAL VARIABLES:
69 ;; To put a file into generic mode using local variables, use a line
70 ;; like this in a Local Variables block:
72 ;; mode: default-generic
74 ;; Do NOT use "mode: generic"!
75 ;; See also "AUTOMATICALLY ENTERING GENERIC MODE" below.
76 ;;
77 ;; DEFINING NEW GENERIC MODES:
79 ;; Use the `define-generic-mode' function to define new modes.
80 ;; For example:
82 ;; (require 'generic)
83 ;; (define-generic-mode 'foo-generic-mode
84 ;; (list ?% )
85 ;; (list "keyword")
86 ;; nil
87 ;; (list "\.FOO")
88 ;; (list 'foo-setup-function))
90 ;; defines a new generic-mode `foo-generic-mode', which has '%' as a
91 ;; comment character, and "keyword" as a keyword. When files which end in
92 ;; '.FOO' are loaded, Emacs will go into foo-generic-mode and call
93 ;; foo-setup-function. You can also use the function `foo-generic-mode'
94 ;; (which is interactive) to put a buffer into foo-generic-mode.
96 ;; AUTOMATICALLY ENTERING GENERIC MODE:
98 ;; Generic-mode provides a hook which automatically puts a
99 ;; file into default-generic-mode if the first few lines of a file in
100 ;; fundamental mode start with a hash comment character. To disable
101 ;; this functionality, set the variable `generic-use-find-file-hook'
102 ;; to nil BEFORE loading generic-mode. See the variables
103 ;; `generic-lines-to-scan' and `generic-find-file-regexp' for customization
104 ;; options.
106 ;; GOTCHAS:
108 ;; Be careful that your font-lock definitions are correct. Getting them
109 ;; wrong can cause emacs to continually attempt to fontify! This problem
110 ;; is not specific to generic-mode.
113 ;; Credit for suggestions, brainstorming, help with debugging:
114 ;; ACorreir@pervasive-sw.com (Alfred Correira)
116 ;;; Code:
118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
119 ;; Internal Variables
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
122 (defvar generic-font-lock-defaults nil
123 "Global defaults for font-lock in a generic mode.")
124 (make-variable-buffer-local 'generic-font-lock-defaults)
126 (defvar generic-mode-name 'default-generic-mode
127 "The name of the generic mode.
128 This is the car of one of the items in `generic-mode-alist'.
129 This variable is buffer-local.")
130 (make-variable-buffer-local 'generic-mode-name)
132 (defvar generic-comment-list nil
133 "List of comment characters for a generic mode.")
134 (make-variable-buffer-local 'generic-comment-list)
136 (defvar generic-keywords-list nil
137 "List of keywords for a generic mode.")
138 (make-variable-buffer-local 'generic-keywords-list)
140 (defvar generic-font-lock-expressions nil
141 "List of font-lock expressions for a generic mode.")
142 (make-variable-buffer-local 'generic-font-lock-expressions)
144 (defvar generic-mode-function-list nil
145 "List of customization functions to call for a generic mode.")
146 (make-variable-buffer-local 'generic-mode-function-list)
148 (defvar generic-mode-syntax-table nil
149 "Syntax table for use in a generic mode.")
150 (make-variable-buffer-local 'generic-mode-syntax-table)
152 (defvar generic-mode-alist nil
153 "An association list for `generic-mode'.
154 Each entry in the list looks like this:
156 NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST.
158 Do not add entries to this list directly; use `define-generic-mode'
159 instead (which see).")
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
162 ;; Customization Variables
163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165 (defgroup generic nil
166 "Define simple major modes with comment and font-lock support."
167 :prefix "generic-"
168 :group 'extensions)
170 (defcustom generic-use-find-file-hook t
171 "*If non-nil, add a hook to enter default-generic-mode automatically.
172 This is done if the first few lines of a file in fundamental mode start
173 with a hash comment character."
174 :group 'generic
175 :type 'boolean
178 (defcustom generic-lines-to-scan 3
179 "*Number of lines that `generic-mode-find-file-hook' looks at.
180 Relevant when deciding whether to enter `generic-mode' automatically.
181 This variable should be set to a small positive number."
182 :group 'generic
183 :type 'integer
186 (defcustom generic-find-file-regexp "#.*\n\\(.*\n\\)?"
187 "*Regular expression used by `generic-mode-find-file-hook'.
188 Used to determine if files in fundamental mode should be put into
189 `default-generic-mode' instead."
190 :group 'generic
191 :type 'regexp
194 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
195 ;; Inline functions
196 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
198 (defsubst generic-read-type ()
199 (completing-read
200 "Generic Type: "
201 (mapcar
202 '(lambda (elt) (list (symbol-name (car elt))))
203 generic-mode-alist) nil t))
205 ;; Basic sanity checks. It does *not* check whether the elements of the lists
206 ;; are of the correct type.
207 (defsubst generic-mode-sanity-check (name comment-list keyword-list
208 font-lock-list auto-mode-list
209 function-list &optional description)
210 (and (not (symbolp name))
211 (error "%s is not a symbol" (princ name)))
213 (mapcar '(lambda (elt)
214 (if (not (listp elt))
215 (error "%s is not a list" (princ elt))))
216 (list comment-list keyword-list font-lock-list
217 auto-mode-list function-list))
219 (and (not (or (null description) (stringp description)))
220 (error "Description must be a string or nil"))
223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
224 ;; Functions
225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
227 ;;;###autoload
228 (defun define-generic-mode (name comment-list keyword-list font-lock-list
229 auto-mode-list function-list
230 &optional description)
231 "Create a new generic mode with NAME.
233 Args: (NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST
234 FUNCTION-LIST &optional DESCRIPTION)
236 NAME should be a symbol; its string representation is used as the function
237 name. If DESCRIPTION is provided, it is used as the docstring for the new
238 function.
240 COMMENT-LIST is a list, whose entries are either a single character,
241 a one or two character string or a cons pair. If the entry is a character
242 or a one-character string, it is added to the mode's syntax table with
243 comment-start syntax. If the entry is a cons pair, the elements of the
244 pair are considered to be comment-start and comment-end respectively.
245 Note that Emacs has limitations regarding comment characters.
247 KEYWORD-LIST is a list of keywords to highlight with `font-lock-keyword-face'.
248 Each keyword should be a string.
250 FONT-LOCK-LIST is a list of additional expressions to highlight. Each entry
251 in the list should have the same form as an entry in `font-lock-defaults-alist'
253 AUTO-MODE-LIST is a list of regular expressions to add to auto-mode-alist.
254 These regexps are added to auto-mode-alist as soon as `define-generic-mode'
255 is called; any old regexps with the same name are removed.
257 FUNCTION-LIST is a list of functions to call to do some additional setup.
259 See the file generic-x.el for some examples of `define-generic-mode'."
261 ;; Basic sanity check
262 (generic-mode-sanity-check name
263 comment-list keyword-list font-lock-list
264 auto-mode-list function-list description)
266 ;; Remove any old entry
267 (setq generic-mode-alist
268 (delq (assq name generic-mode-alist)
269 generic-mode-alist))
271 ;; Add a new entry
272 (setq generic-mode-alist
273 (append
274 (list
275 (list
276 name comment-list keyword-list font-lock-list
277 auto-mode-list function-list
279 generic-mode-alist))
281 ;; Add it to auto-mode-alist
282 (generic-add-to-auto-mode name auto-mode-list t)
284 ;; Define a function for it
285 (generic-create-generic-function name description)
288 (defun generic-add-to-auto-mode (mode auto-mode-list
289 &optional remove-old prepend)
290 "Add the entries for MODE to `auto-mode-alist', supplied as AUTO-MODE-ALIST.
291 If remove-old is non-nil, removes old entries first. If prepend is
292 non-nil, prepends entries to auto-mode-alist; otherwise, appends them."
294 (if (not (listp auto-mode-list))
295 (error "%s is not a list" (princ auto-mode-list)))
297 (let ((new-mode (intern (symbol-name mode))))
298 (and remove-old
299 (let ((auto-mode-entry))
300 (while (setq auto-mode-entry (rassq new-mode auto-mode-alist))
301 (setq auto-mode-alist
302 (delq auto-mode-entry
303 auto-mode-alist)))))
305 (mapcar '(lambda (entry)
306 (generic-add-auto-mode-entry new-mode entry prepend))
307 auto-mode-list)))
309 (defun generic-add-auto-mode-entry (name entry &optional prepend)
310 "Add a new NAME regexp with ENTRY to the end of `auto-mode-alist'.
311 If prepend is non-nil, add the entry to the front of the list."
312 (let ((new-entry (list (cons entry name))))
313 (setq auto-mode-alist
314 (if prepend
315 (append new-entry auto-mode-alist)
316 (append auto-mode-alist new-entry)))))
318 (defun generic-create-generic-function (name &optional description)
319 "Create a generic mode function with NAME.
320 If DESCRIPTION is provided, it is used as the docstring."
321 (let ((symname (symbol-name name)))
322 ;; Use `defalias', not `fset' to make the mode appear on
323 ;; load-history.
324 (defalias (intern symname)
325 (list 'lambda nil
326 (or description
327 (concat "Generic mode for type " symname))
328 (list 'interactive)
329 (list 'generic-mode-with-type (list 'quote name))))))
331 (defun generic-mode-with-type (&optional mode)
332 "Go into the generic-mode MODE."
333 (let* ((type (or mode generic-mode-name))
334 (generic-mode-list (assoc type generic-mode-alist))
335 (generic-mode-hooks (intern (concat (symbol-name type) "-hooks")))
338 (and (not generic-mode-list)
339 (error "Can't find generic-mode information for type %s"
340 (princ generic-mode-name)))
342 ;; Put this after the point where we read generic-mode-name!
343 (kill-all-local-variables)
345 (setq
346 generic-mode-name type
347 generic-comment-list (nth 1 generic-mode-list)
348 generic-keywords-list (nth 2 generic-mode-list)
349 generic-font-lock-expressions (nth 3 generic-mode-list)
350 generic-mode-function-list (nth 5 generic-mode-list)
351 major-mode type
352 mode-name (symbol-name type)
355 (generic-mode-set-comments generic-comment-list)
357 ;; Font-lock functionality
358 ;; Font-lock-defaults are always set even if there are no keywords
359 ;; or font-lock expressions, so comments can be highlighted.
360 (setq generic-font-lock-defaults nil)
361 (generic-mode-set-font-lock generic-keywords-list
362 generic-font-lock-expressions)
363 (make-local-variable 'font-lock-defaults)
364 (setq font-lock-defaults (list 'generic-font-lock-defaults nil))
366 ;; Call a list of functions
367 (and generic-mode-function-list
368 (mapcar 'funcall generic-mode-function-list))
370 (run-hooks generic-mode-hooks)
374 ;;;###autoload
375 (defun generic-mode (type)
376 "Basic comment and font-lock functionality for `generic' files.
377 (Files which are too small to warrant their own mode, but have
378 comment characters, keywords, and the like.)
380 To define a generic-mode, use the function `define-generic-mode'.
381 Some generic modes are defined in `generic-x.el'."
382 (interactive
383 (list (generic-read-type)))
384 (generic-mode-with-type (intern type)))
386 ;;; Comment Functionality
387 (defun generic-mode-set-comments (comment-list)
388 "Set up comment functionality for generic mode."
389 (if (null comment-list)
391 (let ((generic-mode-syntax-table (make-syntax-table)))
392 (make-local-variable 'comment-start)
393 (make-local-variable 'comment-start-skip)
394 (make-local-variable 'comment-end)
395 (mapcar 'generic-mode-set-a-comment comment-list)
396 (set-syntax-table generic-mode-syntax-table))))
398 (defun generic-mode-set-a-comment (comment)
399 (and (char-or-string-p comment)
400 (if (stringp comment)
401 (cond
402 ((eq (length comment) 1)
403 (generic-mode-set-comment-char
404 (string-to-char comment)))
405 ((eq (length comment) 2)
406 (generic-mode-set-comment-string comment))
408 (error "Character string %s must be one or two characters long"
409 comment))
411 (generic-mode-set-comment-char comment)))
412 (and (consp comment)
413 (generic-mode-set-comment-pair comment)))
415 (defun generic-mode-set-comment-char (comment-char)
416 "Set COMMENT-CHAR as a comment character for generic mode."
417 (if (not comment-char)
419 (setq
420 comment-end ""
421 comment-start (char-to-string comment-char)
422 comment-start-skip (concat comment-start "+ *")
425 (modify-syntax-entry comment-char "<"
426 generic-mode-syntax-table)
427 (modify-syntax-entry ?\n ">"
428 generic-mode-syntax-table)))
430 (defun generic-mode-set-comment-string (comment-string)
431 "Set COMMENT-STRING as a comment string for generic mode."
432 (if (not comment-string)
434 (setq
435 comment-end ""
436 comment-start comment-string
437 comment-start-skip (concat comment-start " *")
440 (let ((first (elt comment-string 0))
441 (second (elt comment-string 1)))
442 ;; C++ style comments
443 (if (char-equal first second)
444 (progn
445 (modify-syntax-entry first "<12b"
446 generic-mode-syntax-table)
447 (modify-syntax-entry ?\n ">b"
448 generic-mode-syntax-table)))
449 ;; Some other two character string
450 (modify-syntax-entry first "<1"
451 generic-mode-syntax-table)
452 (modify-syntax-entry second "<2"
453 generic-mode-syntax-table)
454 (modify-syntax-entry ?\n ">"
455 generic-mode-syntax-table))))
457 (defun generic-mode-set-comment-pair (comment-pair)
458 "Set COMMENT-PAIR as a comment start and end for generic mode."
459 (let ((generic-comment-start (car comment-pair))
460 (generic-comment-end (cdr comment-pair))
462 (setq
463 comment-end generic-comment-end
464 comment-start generic-comment-start
465 comment-start-skip (concat generic-comment-start " *")
468 ;; Sanity checks
469 (and (not (and (stringp generic-comment-start)
470 (stringp generic-comment-end)))
471 (error "Elements of cons pair must be strings"))
472 (and (not (and (equal (length generic-comment-start) 2)
473 (equal (length generic-comment-end) 2)))
474 (error "Start and end must be exactly two characters long"))
476 (let ((first (elt generic-comment-start 0))
477 (second (elt generic-comment-start 1))
478 (third (elt generic-comment-end 0))
479 (fourth (elt generic-comment-end 1))
482 (modify-syntax-entry first ". 1" generic-mode-syntax-table)
483 (modify-syntax-entry second ". 2" generic-mode-syntax-table)
485 (modify-syntax-entry
486 third
487 (concat
489 (cond
490 ((char-equal first third) " 13")
491 ((char-equal second third) " 23")
492 (t " 3"))
494 generic-mode-syntax-table)
496 (modify-syntax-entry
497 fourth
498 (concat
500 (cond
501 ((char-equal first fourth) " 14")
502 ((char-equal second fourth) " 24")
503 (t " 4"))
505 generic-mode-syntax-table)
508 (defun generic-mode-set-font-lock (keywords font-lock-expressions)
509 "Set up font-lock functionality for generic mode."
510 (let ((generic-font-lock-expressions))
511 ;; Keywords
512 (and keywords
513 (setq
514 generic-font-lock-expressions
515 (append
516 (list (let ((regexp (regexp-opt keywords)))
517 (list (concat "\\<\\(" regexp "\\)\\>")
519 'font-lock-keyword-face)))
520 generic-font-lock-expressions)))
521 ;; Other font-lock expressions
522 (and font-lock-expressions
523 (setq generic-font-lock-expressions
524 (append
525 font-lock-expressions
526 generic-font-lock-expressions)))
527 (and (or font-lock-expressions keywords)
528 (setq generic-font-lock-defaults generic-font-lock-expressions))
531 ;; Support for [KEYWORD] constructs found in INF, INI and Samba files
532 (defun generic-bracket-support ()
533 (setq imenu-generic-expression
534 '((nil "^\\[\\(.*\\)\\]" 1))
535 imenu-case-fold-search t))
537 ;; This generic mode is always defined
538 (define-generic-mode 'default-generic-mode (list ?#) nil nil nil nil)
540 ;; A more general solution would allow us to enter generic-mode for
541 ;; *any* comment character, but would require us to synthesize a new
542 ;; generic-mode on the fly. I think this gives us most of what we
543 ;; want.
544 (defun generic-mode-find-file-hook ()
545 "Hook function to enter default-generic-mode automatically.
546 Done if the first few lines of a file in `fundamental-mode' start with
547 a hash comment character. This hook will be installed if the variable
548 `generic-use-find-file-hook' is non-nil. The variable
549 `generic-lines-to-scan' determines the number of lines to look at."
550 (if (not (eq major-mode 'fundamental-mode))
552 (and (or (> 1 generic-lines-to-scan)
553 (< 50 generic-lines-to-scan))
554 (error "Variable `generic-lines-to-scan' should be set to a small"
555 " positive number"))
556 (let ((comment-regexp "")
557 (count 0)
559 (while (< count generic-lines-to-scan)
560 (setq comment-regexp (concat comment-regexp
561 generic-find-file-regexp))
562 (setq count (1+ count)))
563 (save-excursion
564 (goto-char (point-min))
565 (and (looking-at comment-regexp)
566 (generic-mode-with-type 'default-generic-mode))))))
568 (defun generic-mode-ini-file-find-file-hook ()
569 "Hook function to enter default-generic-mode automatically for INI files.
570 Done if the first few lines of a file in `fundamental-mode' look like an
571 INI file. This hook is NOT installed by default."
572 (and (eq major-mode 'fundamental-mode)
573 (save-excursion
574 (goto-char (point-min))
575 (and (looking-at "^\\s-*\\[.*\\]")
576 (generic-mode-with-type 'ini-generic-mode)))))
578 (and generic-use-find-file-hook
579 (add-hook 'find-file-hooks 'generic-mode-find-file-hook))
581 (defun generic-make-keywords-list (keywords-list face &optional prefix suffix)
582 "Return a regular expression matching the specified KEYWORDS-LIST.
583 The regexp is highlighted with FACE."
584 (and (not (listp keywords-list))
585 (error "Keywords argument must be a list of strings"))
586 (list (concat (or prefix "")
587 "\\<\\("
588 ;; Use an optimized regexp.
589 (regexp-opt keywords-list t)
590 "\\)\\>"
591 (or suffix ""))
593 face))
595 (provide 'generic)
597 ;;; generic.el ends here