aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2013-06-11 17:26:00 -0400
committerStefan Monnier2013-06-11 17:26:00 -0400
commit31119d6305a37ded482d4d6c6660f4ed7b439ccb (patch)
treef47e0668ddf892729e129a417296766c79558ef3
parentf7394b12358ae453a0c8b85fc307afc1b740010d (diff)
downloademacs-31119d6305a37ded482d4d6c6660f4ed7b439ccb.tar.gz
emacs-31119d6305a37ded482d4d6c6660f4ed7b439ccb.zip
* 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.
-rw-r--r--lisp/ChangeLog8
-rw-r--r--lisp/emacs-lisp/generic.el89
2 files changed, 61 insertions, 36 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d08f8ddbcbd..fbc885cefbc 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
12013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/generic.el (generic--normalise-comments)
4 (generic-set-comment-syntax, generic-set-comment-vars): New functions.
5 (generic-mode-set-comments): Use them.
6 (generic-bracket-support): Use setq-local.
7 (generic-make-keywords-list): Declare obsolete.
8
12013-06-11 Glenn Morris <rgm@gnu.org> 92013-06-11 Glenn Morris <rgm@gnu.org>
2 10
3 * emacs-lisp/lisp-mode.el (lisp-mode-variables): 11 * 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 @@
93 93
94;;; Code: 94;;; Code:
95 95
96(eval-when-compile (require 'pcase))
97
96;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 98;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97;; Internal Variables 99;; Internal Variables
98;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -224,18 +226,11 @@ Some generic modes are defined in `generic-x.el'."
224 (funcall (intern mode))) 226 (funcall (intern mode)))
225 227
226;;; Comment Functionality 228;;; Comment Functionality
227(defun generic-mode-set-comments (comment-list)
228 "Set up comment functionality for generic mode."
229 (let ((st (make-syntax-table))
230 (chars nil)
231 (comstyles))
232 (make-local-variable 'comment-start)
233 (make-local-variable 'comment-start-skip)
234 (make-local-variable 'comment-end)
235 229
236 ;; Go through all the comments 230(defun generic--normalise-comments (comment-list)
231 (let ((normalized '()))
237 (dolist (start comment-list) 232 (dolist (start comment-list)
238 (let (end (comstyle "")) 233 (let (end)
239 ;; Normalize 234 ;; Normalize
240 (when (consp start) 235 (when (consp start)
241 (setq end (cdr start)) 236 (setq end (cdr start))
@@ -244,58 +239,79 @@ Some generic modes are defined in `generic-x.el'."
244 (cond 239 (cond
245 ((characterp end) (setq end (char-to-string end))) 240 ((characterp end) (setq end (char-to-string end)))
246 ((zerop (length end)) (setq end "\n"))) 241 ((zerop (length end)) (setq end "\n")))
242 (push (cons start end) normalized)))
243 (nreverse normalized)))
247 244
248 ;; Setup the vars for `comment-region' 245(defun generic-set-comment-syntax (st comment-list)
249 (if comment-start 246 "Set up comment functionality for generic mode."
250 ;; We have already setup a comment-style, so use style b 247 (let ((chars nil)
251 (progn 248 (comstyles)
252 (setq comstyle "b") 249 (comstyle "")
253 (setq comment-start-skip 250 (comment-start nil))
254 (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) 251
255 ;; First comment-style 252 ;; Go through all the comments.
256 (setq comment-start start) 253 (pcase-dolist (`(,start . ,end) comment-list)
257 (setq comment-end (if (string-equal end "\n") "" end)) 254 (let ((comstyle
258 (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) 255 ;; Reuse comstyles if necessary.
259
260 ;; Reuse comstyles if necessary
261 (setq comstyle
262 (or (cdr (assoc start comstyles)) 256 (or (cdr (assoc start comstyles))
263 (cdr (assoc end comstyles)) 257 (cdr (assoc end comstyles))
264 comstyle)) 258 ;; Otherwise, use a style not yet in use.
259 (if (not (rassoc "" comstyles)) "")
260 (if (not (rassoc "b" comstyles)) "b")
261 "c")))
265 (push (cons start comstyle) comstyles) 262 (push (cons start comstyle) comstyles)
266 (push (cons end comstyle) comstyles) 263 (push (cons end comstyle) comstyles)
267 264
268 ;; Setup the syntax table 265 ;; Setup the syntax table.
269 (if (= (length start) 1) 266 (if (= (length start) 1)
270 (modify-syntax-entry (string-to-char start) 267 (modify-syntax-entry (aref start 0)
271 (concat "< " comstyle) st) 268 (concat "< " comstyle) st)
272 (let ((c0 (elt start 0)) (c1 (elt start 1))) 269 (let ((c0 (aref start 0)) (c1 (aref start 1)))
273 ;; Store the relevant info but don't update yet 270 ;; Store the relevant info but don't update yet.
274 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) 271 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
275 (push (cons c1 (concat (cdr (assoc c1 chars)) 272 (push (cons c1 (concat (cdr (assoc c1 chars))
276 (concat "2" comstyle))) chars))) 273 (concat "2" comstyle))) chars)))
277 (if (= (length end) 1) 274 (if (= (length end) 1)
278 (modify-syntax-entry (string-to-char end) 275 (modify-syntax-entry (aref end 0)
279 (concat ">" comstyle) st) 276 (concat ">" comstyle) st)
280 (let ((c0 (elt end 0)) (c1 (elt end 1))) 277 (let ((c0 (aref end 0)) (c1 (aref end 1)))
281 ;; Store the relevant info but don't update yet 278 ;; Store the relevant info but don't update yet.
282 (push (cons c0 (concat (cdr (assoc c0 chars)) 279 (push (cons c0 (concat (cdr (assoc c0 chars))
283 (concat "3" comstyle))) chars) 280 (concat "3" comstyle))) chars)
284 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) 281 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
285 282
286 ;; Process the chars that were part of a 2-char comment marker 283 ;; Process the chars that were part of a 2-char comment marker
284 (with-syntax-table st ;For `char-syntax'.
287 (dolist (cs (nreverse chars)) 285 (dolist (cs (nreverse chars))
288 (modify-syntax-entry (car cs) 286 (modify-syntax-entry (car cs)
289 (concat (char-to-string (char-syntax (car cs))) 287 (concat (char-to-string (char-syntax (car cs)))
290 " " (cdr cs)) 288 " " (cdr cs))
291 st)) 289 st)))))
290
291(defun generic-set-comment-vars (comment-list)
292 (when comment-list
293 (setq-local comment-start (caar comment-list))
294 (setq-local comment-end
295 (let ((end (cdar comment-list)))
296 (if (string-equal end "\n") "" end)))
297 (setq-local comment-start-skip
298 (concat (regexp-opt (mapcar #'car comment-list))
299 "+[ \t]*"))
300 (setq-local comment-end-skip
301 (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list))))))
302
303(defun generic-mode-set-comments (comment-list)
304 "Set up comment functionality for generic mode."
305 (let ((st (make-syntax-table))
306 (comment-list (generic--normalise-comments comment-list)))
307 (generic-set-comment-syntax st comment-list)
308 (generic-set-comment-vars comment-list)
292 (set-syntax-table st))) 309 (set-syntax-table st)))
293 310
294(defun generic-bracket-support () 311(defun generic-bracket-support ()
295 "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." 312 "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files."
296 (setq imenu-generic-expression 313 (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1)))
297 '((nil "^\\[\\(.*\\)\\]" 1)) 314 (setq-local imenu-case-fold-search t))
298 imenu-case-fold-search t))
299 315
300;;;###autoload 316;;;###autoload
301(defun generic-make-keywords-list (keyword-list face &optional prefix suffix) 317(defun generic-make-keywords-list (keyword-list face &optional prefix suffix)
@@ -306,6 +322,7 @@ expression that matches these keywords and concatenates it with
306PREFIX and SUFFIX. Then it returns a construct based on this 322PREFIX and SUFFIX. Then it returns a construct based on this
307regular expression that can be used as an element of 323regular expression that can be used as an element of
308`font-lock-keywords'." 324`font-lock-keywords'."
325 (declare (obsolete regexp-opt "24.4"))
309 (unless (listp keyword-list) 326 (unless (listp keyword-list)
310 (error "Keywords argument must be a list of strings")) 327 (error "Keywords argument must be a list of strings"))
311 (list (concat prefix "\\_<" 328 (list (concat prefix "\\_<"