2 files changed, 147 insertions, 314 deletions

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  <pbreton@ne.mediaone.net>
 
+        * 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))