[Emacs-diffs] trunk r112930: * lisp/emacs-lisp/generic.el (generic--normalise-comments)

[Stefan Monnier]

------------------------------------------------------------
revno: 112930
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Tue 2013-06-11 17:26:00 -0400
message:
  * lisp/emacs-lisp/generic.el (generic--normalise-comments)
  (generic-set-comment-syntax, generic-set-comment-vars): New functions.
  (generic-mode-set-comments): Use them.
  (generic-bracket-support): Use setq-local.
  (generic-make-keywords-list): Declare obsolete.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/generic.el     generic.el-20091113204419-o5vbwnq5f7feedwu-3402

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-06-11 18:00:27 +0000
+++ b/lisp/ChangeLog    2013-06-11 21:26:00 +0000
@@ -1,3 +1,11 @@
+2013-06-11  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/generic.el (generic--normalise-comments)
+       (generic-set-comment-syntax, generic-set-comment-vars): New functions.
+       (generic-mode-set-comments): Use them.
+       (generic-bracket-support): Use setq-local.
+       (generic-make-keywords-list): Declare obsolete.
+
 2013-06-11  Glenn Morris  <address@hidden>
 
        * emacs-lisp/lisp-mode.el (lisp-mode-variables):

=== modified file 'lisp/emacs-lisp/generic.el'
--- a/lisp/emacs-lisp/generic.el        2013-01-01 09:11:05 +0000
+++ b/lisp/emacs-lisp/generic.el        2013-06-11 21:26:00 +0000
@@ -93,6 +93,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'pcase))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal Variables
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -224,18 +226,11 @@
   (funcall (intern mode)))
 
 ;;; Comment Functionality
-(defun generic-mode-set-comments (comment-list)
-  "Set up comment functionality for generic mode."
-  (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
+(defun generic--normalise-comments (comment-list)
+  (let ((normalized '()))
     (dolist (start comment-list)
-      (let (end (comstyle ""))
+      (let (end)
        ;; Normalize
        (when (consp start)
          (setq end (cdr start))
@@ -244,58 +239,79 @@
        (cond
         ((characterp end)   (setq end (char-to-string end)))
         ((zerop (length end)) (setq end "\n")))
-
-       ;; 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 (if (string-equal end "\n") "" end))
-         (setq comment-start-skip (concat (regexp-quote start) "+\\s-*")))
-
-       ;; Reuse comstyles if necessary
-       (setq comstyle
+        (push (cons start end) normalized)))
+    (nreverse normalized)))
+
+(defun generic-set-comment-syntax (st comment-list)
+  "Set up comment functionality for generic mode."
+  (let ((chars nil)
+       (comstyles)
+        (comstyle "")
+        (comment-start nil))
+
+    ;; Go through all the comments.
+    (pcase-dolist (`(,start . ,end) comment-list)
+      (let ((comstyle
+             ;; Reuse comstyles if necessary.
              (or (cdr (assoc start comstyles))
                  (cdr (assoc end comstyles))
-                 comstyle))
+                 ;; Otherwise, use a style not yet in use.
+                 (if (not (rassoc "" comstyles)) "")
+                 (if (not (rassoc "b" comstyles)) "b")
+                 "c")))
        (push (cons start comstyle) comstyles)
        (push (cons end comstyle) comstyles)
 
-       ;; Setup the syntax table
+       ;; Setup the syntax table.
        (if (= (length start) 1)
-           (modify-syntax-entry (string-to-char start)
+           (modify-syntax-entry (aref start 0)
                                 (concat "< " comstyle) st)
-         (let ((c0 (elt start 0)) (c1 (elt start 1)))
-           ;; Store the relevant info but don't update yet
+         (let ((c0 (aref start 0)) (c1 (aref 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)
+           (modify-syntax-entry (aref end 0)
                                 (concat ">" comstyle) st)
-         (let ((c0 (elt end 0)) (c1 (elt end 1)))
-           ;; Store the relevant info but don't update yet
+         (let ((c0 (aref end 0)) (c1 (aref 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
+    (with-syntax-table st               ;For `char-syntax'.
     (dolist (cs (nreverse chars))
       (modify-syntax-entry (car cs)
                           (concat (char-to-string (char-syntax (car cs)))
                                   " " (cdr cs))
-                          st))
+                             st)))))
+
+(defun generic-set-comment-vars (comment-list)
+  (when comment-list
+    (setq-local comment-start (caar comment-list))
+    (setq-local comment-end
+                (let ((end (cdar comment-list)))
+                  (if (string-equal end "\n") "" end)))
+    (setq-local comment-start-skip
+                (concat (regexp-opt (mapcar #'car comment-list))
+                        "+[ \t]*"))
+    (setq-local comment-end-skip
+                (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list))))))
+
+(defun generic-mode-set-comments (comment-list)
+  "Set up comment functionality for generic mode."
+  (let ((st (make-syntax-table))
+        (comment-list (generic--normalise-comments comment-list)))
+    (generic-set-comment-syntax st comment-list)
+    (generic-set-comment-vars comment-list)
     (set-syntax-table st)))
 
 (defun generic-bracket-support ()
   "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files."
-  (setq imenu-generic-expression
-       '((nil "^\\[\\(.*\\)\\]" 1))
-        imenu-case-fold-search t))
+  (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1)))
+  (setq-local imenu-case-fold-search t))
 
 ;;;###autoload
 (defun generic-make-keywords-list (keyword-list face &optional prefix suffix)
@@ -306,6 +322,7 @@
 PREFIX and SUFFIX.  Then it returns a construct based on this
 regular expression that can be used as an element of
 `font-lock-keywords'."
+  (declare (obsolete regexp-opt "24.4"))
   (unless (listp keyword-list)
     (error "Keywords argument must be a list of strings"))
   (list (concat prefix "\\_<"