From: Stefan Monnier Date: Tue, 11 Jun 2013 21:26:00 +0000 (-0400) Subject: * lisp/emacs-lisp/generic.el (generic--normalise-comments) X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2016^2~145^2~18 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=31119d6305a37ded482d4d6c6660f4ed7b439ccb;p=emacs.git * 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d08f8ddbcbd..fbc885cefbc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2013-06-11 Stefan Monnier + + * 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 * emacs-lisp/lisp-mode.el (lisp-mode-variables): diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index dd5ff0ec694..cb86a554335 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -93,6 +93,8 @@ ;;; Code: +(eval-when-compile (require 'pcase)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -224,18 +226,11 @@ Some generic modes are defined in `generic-x.el'." (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 @@ Some generic modes are defined in `generic-x.el'." (cond ((characterp end) (setq end (char-to-string end))) ((zerop (length end)) (setq end "\n"))) + (push (cons start end) normalized))) + (nreverse normalized))) - ;; 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 +(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 @@ expression that matches these keywords and concatenates it with 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 "\\_<"