diff options
| author | Stefan Monnier | 2013-06-11 17:26:00 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-06-11 17:26:00 -0400 |
| commit | 31119d6305a37ded482d4d6c6660f4ed7b439ccb (patch) | |
| tree | f47e0668ddf892729e129a417296766c79558ef3 | |
| parent | f7394b12358ae453a0c8b85fc307afc1b740010d (diff) | |
| download | emacs-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/ChangeLog | 8 | ||||
| -rw-r--r-- | lisp/emacs-lisp/generic.el | 89 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-06-11 Glenn Morris <rgm@gnu.org> | 9 | 2013-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 | |||
| 306 | PREFIX and SUFFIX. Then it returns a construct based on this | 322 | PREFIX and SUFFIX. Then it returns a construct based on this |
| 307 | regular expression that can be used as an element of | 323 | regular 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 "\\_<" |