From: Peter Breton Date: Wed, 4 Oct 2000 05:17:12 +0000 (+0000) Subject: * generic.el: X-Git-Tag: emacs-pretest-21.0.90~1179 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9a7f629dd758ad3206a2ee82833df97591ef65fe;p=emacs.git * generic.el: Incorporates extensive cleanup and docfixes by Stefan Monnier (monnier+gnu/emacs@flint.cs.yale.edu). Uses cl compile-time macros. (generic-mode-name, generic-comment-list, generic-keywords-list, generic-font-lock-expressions, generic-mode-function-list, generic-mode-syntax-table): Removed variables. (generic-mode-alist): Renamed to generic-mode-list. (generic-find-file-regexp): Default changed to "^#". (generic-read-type): Uses completing read on generic-mode-list. (generic-mode-sanity-check): removed this function. (generic-add-to-auto-mode): Removed this function (generic-mode-internal): Binds mode-specific definitions into function instead of putting them in alist. (generic-mode-set-comments): Reworked extensively. (generic-mode-find-file-hook): Simplified regexp searching (generic-make-keywords-list): Omit extra pair of parens --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bec5f449b6b..b259abd71e4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,24 @@ 2000-10-04 Peter Breton + * generic.el: + Incorporates extensive cleanup and docfixes by + Stefan Monnier (monnier+gnu/emacs@flint.cs.yale.edu). + Uses cl compile-time macros. + (generic-mode-name, generic-comment-list, + generic-keywords-list, generic-font-lock-expressions, + generic-mode-function-list, generic-mode-syntax-table): + Removed variables. + (generic-mode-alist): Renamed to generic-mode-list. + (generic-find-file-regexp): Default changed to "^#". + (generic-read-type): Uses completing read on generic-mode-list. + (generic-mode-sanity-check): removed this function. + (generic-add-to-auto-mode): Removed this function + (generic-mode-internal): Binds mode-specific definitions + into function instead of putting them in alist. + (generic-mode-set-comments): Reworked extensively. + (generic-mode-find-file-hook): Simplified regexp searching + (generic-make-keywords-list): Omit extra pair of parens + * find-lisp.el (find-lisp-find-files-internal): Make sure directory name ends with "/". diff --git a/lisp/generic.el b/lisp/generic.el index 2d8cf4c937b..e08b4ad371c 100644 --- a/lisp/generic.el +++ b/lisp/generic.el @@ -51,11 +51,11 @@ ;; different from `font-lock-keyword-face', you can use the convenience ;; function `generic-make-keywords-list' (which see), and add the ;; result to the following list: -;; +;; ;; * Additional expressions to font-lock. This should be a list of ;; expressions, each of which should be of the same form ;; as those in `font-lock-defaults-alist'. -;; +;; ;; * List of regular expressions to be placed in auto-mode-alist. ;; ;; * List of functions to call to do some additional setup @@ -73,7 +73,7 @@ ;; ;; Do NOT use "mode: generic"! ;; See also "AUTOMATICALLY ENTERING GENERIC MODE" below. -;; +;; ;; DEFINING NEW GENERIC MODES: ;; ;; Use the `define-generic-mode' function to define new modes. @@ -84,7 +84,7 @@ ;; (list ?% ) ;; (list "keyword") ;; nil -;; (list "\.FOO") +;; (list "\\.FOO\\'") ;; (list 'foo-setup-function)) ;; ;; defines a new generic-mode `foo-generic-mode', which has '%' as a @@ -102,19 +102,24 @@ ;; to nil BEFORE loading generic-mode. See the variables ;; `generic-lines-to-scan' and `generic-find-file-regexp' for customization ;; options. -;; +;; ;; GOTCHAS: ;; ;; Be careful that your font-lock definitions are correct. Getting them ;; wrong can cause emacs to continually attempt to fontify! This problem ;; is not specific to generic-mode. -;; +;; ;; Credit for suggestions, brainstorming, help with debugging: ;; ACorreir@pervasive-sw.com (Alfred Correira) - +;; Extensive cleanup by: +;; Stefan Monnier (monnier+gnu/emacs@flint.cs.yale.edu) +;; ;;; Code: +(eval-when-compile + (require 'cl)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -123,38 +128,8 @@ "Global defaults for font-lock in a generic mode.") (make-variable-buffer-local 'generic-font-lock-defaults) -(defvar generic-mode-name 'default-generic-mode - "The name of the generic mode. -This is the car of one of the items in `generic-mode-alist'. -This variable is buffer-local.") -(make-variable-buffer-local 'generic-mode-name) - -(defvar generic-comment-list nil - "List of comment characters for a generic mode.") -(make-variable-buffer-local 'generic-comment-list) - -(defvar generic-keywords-list nil - "List of keywords for a generic mode.") -(make-variable-buffer-local 'generic-keywords-list) - -(defvar generic-font-lock-expressions nil - "List of font-lock expressions for a generic mode.") -(make-variable-buffer-local 'generic-font-lock-expressions) - -(defvar generic-mode-function-list nil - "List of customization functions to call for a generic mode.") -(make-variable-buffer-local 'generic-mode-function-list) - -(defvar generic-mode-syntax-table nil - "Syntax table for use in a generic mode.") -(make-variable-buffer-local 'generic-mode-syntax-table) - -(defvar generic-mode-alist nil - "An association list for `generic-mode'. -Each entry in the list looks like this: - - NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST. - +(defvar generic-mode-list nil + "A list of mode names for `generic-mode'. Do not add entries to this list directly; use `define-generic-mode' instead (which see).") @@ -183,7 +158,7 @@ This variable should be set to a small positive number." :type 'integer ) -(defcustom generic-find-file-regexp "#.*\n\\(.*\n\\)?" +(defcustom generic-find-file-regexp "^#" "*Regular expression used by `generic-mode-find-file-hook'. Used to determine if files in fundamental mode should be put into `default-generic-mode' instead." @@ -198,27 +173,8 @@ Used to determine if files in fundamental mode should be put into (defsubst generic-read-type () (completing-read "Generic Type: " - (mapcar - '(lambda (elt) (list (symbol-name (car elt)))) - generic-mode-alist) nil t)) - -;; Basic sanity checks. It does *not* check whether the elements of the lists -;; are of the correct type. -(defsubst generic-mode-sanity-check (name comment-list keyword-list - font-lock-list auto-mode-list - function-list &optional description) - (and (not (symbolp name)) - (error "%s is not a symbol" (princ name))) - - (mapcar '(lambda (elt) - (if (not (listp elt)) - (error "%s is not a list" (princ elt)))) - (list comment-list keyword-list font-lock-list - auto-mode-list function-list)) - - (and (not (or (null description) (stringp description))) - (error "Description must be a string or nil")) -) + generic-mode-list + nil t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions @@ -240,8 +196,8 @@ function. COMMENT-LIST is a list, whose entries are either a single character, a one or two character string or a cons pair. If the entry is a character or a one-character string, it is added to the mode's syntax table with -comment-start syntax. If the entry is a cons pair, the elements of the -pair are considered to be comment-start and comment-end respectively. +`comment-start' syntax. If the entry is a cons pair, the elements of the +pair are considered to be `comment-start' and `comment-end' respectively. Note that Emacs has limitations regarding comment characters. KEYWORD-LIST is a list of keywords to highlight with `font-lock-keyword-face'. @@ -250,122 +206,61 @@ Each keyword should be a string. FONT-LOCK-LIST is a list of additional expressions to highlight. Each entry in the list should have the same form as an entry in `font-lock-defaults-alist' -AUTO-MODE-LIST is a list of regular expressions to add to auto-mode-alist. -These regexps are added to auto-mode-alist as soon as `define-generic-mode' +AUTO-MODE-LIST is a list of regular expressions to add to `auto-mode-alist'. +These regexps are added to `auto-mode-alist' as soon as `define-generic-mode' is called; any old regexps with the same name are removed. FUNCTION-LIST is a list of functions to call to do some additional setup. See the file generic-x.el for some examples of `define-generic-mode'." - ;; Basic sanity check - (generic-mode-sanity-check name - comment-list keyword-list font-lock-list - auto-mode-list function-list description) - - ;; Remove any old entry - (setq generic-mode-alist - (delq (assq name generic-mode-alist) - generic-mode-alist)) - ;; Add a new entry - (setq generic-mode-alist - (append - (list - (list - name comment-list keyword-list font-lock-list - auto-mode-list function-list - )) - generic-mode-alist)) + (unless (assq name generic-mode-list) + (push (list name) generic-mode-list)) ;; Add it to auto-mode-alist - (generic-add-to-auto-mode name auto-mode-list t) - - ;; Define a function for it - (generic-create-generic-function name description) + (dolist (re auto-mode-list) + (add-to-list 'auto-mode-alist (cons re name))) + + ;; Define a function for it using `defalias' (not `fset') to make + ;; the mode appear on load-history. + (defalias name + `(lambda nil + ,(or description (concat "Generic mode for type " (symbol-name name))) + (interactive) + (generic-mode-internal ',name ',comment-list ',keyword-list + ',font-lock-list ',function-list))) ) -(defun generic-add-to-auto-mode (mode auto-mode-list - &optional remove-old prepend) - "Add the entries for MODE to `auto-mode-alist', supplied as AUTO-MODE-ALIST. -If remove-old is non-nil, removes old entries first. If prepend is -non-nil, prepends entries to auto-mode-alist; otherwise, appends them." - - (if (not (listp auto-mode-list)) - (error "%s is not a list" (princ auto-mode-list))) - - (let ((new-mode (intern (symbol-name mode)))) - (and remove-old - (let ((auto-mode-entry)) - (while (setq auto-mode-entry (rassq new-mode auto-mode-alist)) - (setq auto-mode-alist - (delq auto-mode-entry - auto-mode-alist))))) - - (mapcar '(lambda (entry) - (generic-add-auto-mode-entry new-mode entry prepend)) - auto-mode-list))) - -(defun generic-add-auto-mode-entry (name entry &optional prepend) - "Add a new NAME regexp with ENTRY to the end of `auto-mode-alist'. -If prepend is non-nil, add the entry to the front of the list." - (let ((new-entry (list (cons entry name)))) - (setq auto-mode-alist - (if prepend - (append new-entry auto-mode-alist) - (append auto-mode-alist new-entry))))) - -(defun generic-create-generic-function (name &optional description) - "Create a generic mode function with NAME. -If DESCRIPTION is provided, it is used as the docstring." - (let ((symname (symbol-name name))) - ;; Use `defalias', not `fset' to make the mode appear on - ;; load-history. - (defalias (intern symname) - (list 'lambda nil - (or description - (concat "Generic mode for type " symname)) - (list 'interactive) - (list 'generic-mode-with-type (list 'quote name)))))) - -(defun generic-mode-with-type (&optional mode) +(defun generic-mode-internal (mode comments keywords font-lock-list funs) "Go into the generic-mode MODE." - (let* ((type (or mode generic-mode-name)) - (generic-mode-list (assoc type generic-mode-alist)) - (generic-mode-hooks (intern (concat (symbol-name type) "-hooks"))) + (let* ((generic-mode-hooks (intern (concat (symbol-name mode) "-hook"))) + (modename (symbol-name mode)) + (name (if (string-match "-mode\\'" modename) + (substring modename 0 (match-beginning 0)) + modename)) ) - (and (not generic-mode-list) - (error "Can't find generic-mode information for type %s" - (princ generic-mode-name))) - ;; Put this after the point where we read generic-mode-name! (kill-all-local-variables) (setq - generic-mode-name type - generic-comment-list (nth 1 generic-mode-list) - generic-keywords-list (nth 2 generic-mode-list) - generic-font-lock-expressions (nth 3 generic-mode-list) - generic-mode-function-list (nth 5 generic-mode-list) - major-mode type - mode-name (symbol-name type) + major-mode mode + mode-name (capitalize name) ) - (generic-mode-set-comments generic-comment-list) + (generic-mode-set-comments comments) ;; Font-lock functionality ;; Font-lock-defaults are always set even if there are no keywords ;; or font-lock expressions, so comments can be highlighted. (setq generic-font-lock-defaults nil) - (generic-mode-set-font-lock generic-keywords-list - generic-font-lock-expressions) + (generic-mode-set-font-lock keywords font-lock-list) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults (list 'generic-font-lock-defaults nil)) ;; Call a list of functions - (and generic-mode-function-list - (mapcar 'funcall generic-mode-function-list)) + (mapcar 'funcall funs) (run-hooks generic-mode-hooks) ) @@ -374,159 +269,88 @@ If DESCRIPTION is provided, it is used as the docstring." ;;;###autoload (defun generic-mode (type) "Basic comment and font-lock functionality for `generic' files. -(Files which are too small to warrant their own mode, but have +\(Files which are too small to warrant their own mode, but have comment characters, keywords, and the like.) To define a generic-mode, use the function `define-generic-mode'. Some generic modes are defined in `generic-x.el'." (interactive (list (generic-read-type))) - (generic-mode-with-type (intern type))) + (funcall (intern type))) ;;; Comment Functionality (defun generic-mode-set-comments (comment-list) "Set up comment functionality for generic mode." - (if (null comment-list) - nil - (let ((generic-mode-syntax-table (make-syntax-table))) - (make-local-variable 'comment-start) - (make-local-variable 'comment-start-skip) - (make-local-variable 'comment-end) - (mapcar 'generic-mode-set-a-comment comment-list) - (set-syntax-table generic-mode-syntax-table)))) - -(defun generic-mode-set-a-comment (comment) - (and (char-or-string-p comment) - (if (stringp comment) - (cond - ((eq (length comment) 1) - (generic-mode-set-comment-char - (string-to-char comment))) - ((eq (length comment) 2) - (generic-mode-set-comment-string comment)) - (t - (error "Character string %s must be one or two characters long" - comment)) - ) - (generic-mode-set-comment-char comment))) - (and (consp comment) - (generic-mode-set-comment-pair comment))) - -(defun generic-mode-set-comment-char (comment-char) - "Set COMMENT-CHAR as a comment character for generic mode." - (if (not comment-char) - nil - (setq - comment-end "" - comment-start (char-to-string comment-char) - comment-start-skip (concat comment-start "+ *") - ) - - (modify-syntax-entry comment-char "<" - generic-mode-syntax-table) - (modify-syntax-entry ?\n ">" - generic-mode-syntax-table))) - -(defun generic-mode-set-comment-string (comment-string) - "Set COMMENT-STRING as a comment string for generic mode." - (if (not comment-string) - nil - (setq - comment-end "" - comment-start comment-string - comment-start-skip (concat comment-start " *") - ) - - (let ((first (elt comment-string 0)) - (second (elt comment-string 1))) - ;; C++ style comments - (if (char-equal first second) - (progn - (modify-syntax-entry first "<12b" - generic-mode-syntax-table) - (modify-syntax-entry ?\n ">b" - generic-mode-syntax-table))) - ;; Some other two character string - (modify-syntax-entry first "<1" - generic-mode-syntax-table) - (modify-syntax-entry second "<2" - generic-mode-syntax-table) - (modify-syntax-entry ?\n ">" - generic-mode-syntax-table)))) - -(defun generic-mode-set-comment-pair (comment-pair) - "Set COMMENT-PAIR as a comment start and end for generic mode." - (let ((generic-comment-start (car comment-pair)) - (generic-comment-end (cdr comment-pair)) - ) - (setq - comment-end generic-comment-end - comment-start generic-comment-start - comment-start-skip (concat generic-comment-start " *") - ) - - ;; Sanity checks - (and (not (and (stringp generic-comment-start) - (stringp generic-comment-end))) - (error "Elements of cons pair must be strings")) - (and (not (and (equal (length generic-comment-start) 2) - (equal (length generic-comment-end) 2))) - (error "Start and end must be exactly two characters long")) - - (let ((first (elt generic-comment-start 0)) - (second (elt generic-comment-start 1)) - (third (elt generic-comment-end 0)) - (fourth (elt generic-comment-end 1)) - ) - - (modify-syntax-entry first ". 1" generic-mode-syntax-table) - (modify-syntax-entry second ". 2" generic-mode-syntax-table) - - (modify-syntax-entry - third - (concat - "." - (cond - ((char-equal first third) " 13") - ((char-equal second third) " 23") - (t " 3")) - ) - generic-mode-syntax-table) - - (modify-syntax-entry - fourth - (concat - "." - (cond - ((char-equal first fourth) " 14") - ((char-equal second fourth) " 24") - (t " 4")) - ) - generic-mode-syntax-table) - ))) + (let ((st (make-syntax-table)) + (chars nil) + (comstyles)) + (make-local-variable 'comment-start) + (make-local-variable 'comment-start-skip) + (make-local-variable 'comment-end) + + ;; Go through all the comments + (dolist (start comment-list) + (let ((end ?\n) (comstyle "")) + ;; Normalize + (when (consp start) + (setq end (or (cdr start) end)) + (setq start (car start))) + (when (char-valid-p start) (setq start (char-to-string start))) + (when (char-valid-p end) (setq end (char-to-string end))) + + ;; Setup the vars for `comment-region' + (if comment-start + ;; We have already setup a comment-style, so use style b + (progn + (setq comstyle "b") + (setq comment-start-skip + (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) + ;; First comment-style + (setq comment-start start) + (setq comment-end (unless (string-equal end "\n") end)) + (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) + + ;; Reuse comstyles if necessary + (setq comstyle + (or (cdr (assoc start comstyles)) + (cdr (assoc end comstyles)) + comstyle)) + (push (cons start comstyle) comstyles) + (push (cons end comstyle) comstyles) + + ;; Setup the syntax table + (if (= (length start) 1) + (modify-syntax-entry (string-to-char start) + (concat "< " comstyle) st) + (let ((c0 (elt start 0)) (c1 (elt start 1))) + ;; Store the relevant info but don't update yet + (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) + (concat "2" comstyle))) chars))) + (if (= (length end) 1) + (modify-syntax-entry (string-to-char end) + (concat ">" comstyle) st) + (let ((c0 (elt end 0)) (c1 (elt end 1))) + ;; Store the relevant info but don't update yet + (push (cons c0 (concat (cdr (assoc c0 chars)) + (concat "3" comstyle))) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) + + ;; Process the chars that were part of a 2-char comment marker + (dolist (cs (nreverse chars)) + (modify-syntax-entry (car cs) + (concat (char-to-string (char-syntax (car cs))) + " " (cdr cs)) + st)) + (set-syntax-table st))) (defun generic-mode-set-font-lock (keywords font-lock-expressions) "Set up font-lock functionality for generic mode." - (let ((generic-font-lock-expressions)) - ;; Keywords - (and keywords - (setq - generic-font-lock-expressions - (append - (list (let ((regexp (regexp-opt keywords))) - (list (concat "\\<\\(" regexp "\\)\\>") - 1 - 'font-lock-keyword-face))) - generic-font-lock-expressions))) - ;; Other font-lock expressions - (and font-lock-expressions - (setq generic-font-lock-expressions - (append - font-lock-expressions - generic-font-lock-expressions))) - (and (or font-lock-expressions keywords) - (setq generic-font-lock-defaults generic-font-lock-expressions)) - )) + (setq generic-font-lock-defaults + (append + (when keywords + (list (generic-make-keywords-list keywords font-lock-keyword-face))) + font-lock-expressions))) ;; Support for [KEYWORD] constructs found in INF, INI and Samba files (defun generic-bracket-support () @@ -542,28 +366,20 @@ Some generic modes are defined in `generic-x.el'." ;; generic-mode on the fly. I think this gives us most of what we ;; want. (defun generic-mode-find-file-hook () - "Hook function to enter default-generic-mode automatically. + "Hook function to enter `default-generic-mode' automatically. Done if the first few lines of a file in `fundamental-mode' start with a hash comment character. This hook will be installed if the variable `generic-use-find-file-hook' is non-nil. The variable `generic-lines-to-scan' determines the number of lines to look at." - (if (not (eq major-mode 'fundamental-mode)) - nil - (and (or (> 1 generic-lines-to-scan) - (< 50 generic-lines-to-scan)) - (error "Variable `generic-lines-to-scan' should be set to a small" - " positive number")) - (let ((comment-regexp "") - (count 0) - ) - (while (< count generic-lines-to-scan) - (setq comment-regexp (concat comment-regexp - generic-find-file-regexp)) - (setq count (1+ count))) - (save-excursion + (when (eq major-mode 'fundamental-mode) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward generic-find-file-regexp + (save-excursion + (forward-line generic-lines-to-scan) + (point)) t) (goto-char (point-min)) - (and (looking-at comment-regexp) - (generic-mode-with-type 'default-generic-mode)))))) + (default-generic-mode))))) (defun generic-mode-ini-file-find-file-hook () "Hook function to enter default-generic-mode automatically for INI files. @@ -573,7 +389,7 @@ INI file. This hook is NOT installed by default." (save-excursion (goto-char (point-min)) (and (looking-at "^\\s-*\\[.*\\]") - (generic-mode-with-type 'ini-generic-mode))))) + (ini-generic-mode))))) (and generic-use-find-file-hook (add-hook 'find-file-hooks 'generic-mode-find-file-hook)) @@ -581,14 +397,12 @@ INI file. This hook is NOT installed by default." (defun generic-make-keywords-list (keywords-list face &optional prefix suffix) "Return a regular expression matching the specified KEYWORDS-LIST. The regexp is highlighted with FACE." - (and (not (listp keywords-list)) - (error "Keywords argument must be a list of strings")) - (list (concat (or prefix "") - "\\<\\(" + (unless (listp keywords-list) + (error "Keywords argument must be a list of strings")) + (list (concat prefix "\\<" ;; Use an optimized regexp. (regexp-opt keywords-list t) - "\\)\\>" - (or suffix "")) + "\\>" suffix) 1 face))