Mercurial > emacs
comparison lisp/generic.el @ 32120:c443d63bec69
* 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
author | Peter Breton <pbreton@attbi.com> |
---|---|
date | Wed, 04 Oct 2000 05:14:25 +0000 |
parents | 218b7edb9baf |
children | ddeab24202fc |
comparison
equal
deleted
inserted
replaced
32119:1155bb8764c8 | 32120:c443d63bec69 |
---|---|
49 ;; * List of keywords to font-lock. Each keyword should be a string. | 49 ;; * List of keywords to font-lock. Each keyword should be a string. |
50 ;; If you have additional keywords which should be highlighted in a face | 50 ;; If you have additional keywords which should be highlighted in a face |
51 ;; different from `font-lock-keyword-face', you can use the convenience | 51 ;; different from `font-lock-keyword-face', you can use the convenience |
52 ;; function `generic-make-keywords-list' (which see), and add the | 52 ;; function `generic-make-keywords-list' (which see), and add the |
53 ;; result to the following list: | 53 ;; result to the following list: |
54 ;; | 54 ;; |
55 ;; * Additional expressions to font-lock. This should be a list of | 55 ;; * Additional expressions to font-lock. This should be a list of |
56 ;; expressions, each of which should be of the same form | 56 ;; expressions, each of which should be of the same form |
57 ;; as those in `font-lock-defaults-alist'. | 57 ;; as those in `font-lock-defaults-alist'. |
58 ;; | 58 ;; |
59 ;; * List of regular expressions to be placed in auto-mode-alist. | 59 ;; * List of regular expressions to be placed in auto-mode-alist. |
60 ;; | 60 ;; |
61 ;; * List of functions to call to do some additional setup | 61 ;; * List of functions to call to do some additional setup |
62 ;; | 62 ;; |
63 ;; This should pretty much cover basic functionality; if you need much | 63 ;; This should pretty much cover basic functionality; if you need much |
71 ;; | 71 ;; |
72 ;; mode: default-generic | 72 ;; mode: default-generic |
73 ;; | 73 ;; |
74 ;; Do NOT use "mode: generic"! | 74 ;; Do NOT use "mode: generic"! |
75 ;; See also "AUTOMATICALLY ENTERING GENERIC MODE" below. | 75 ;; See also "AUTOMATICALLY ENTERING GENERIC MODE" below. |
76 ;; | 76 ;; |
77 ;; DEFINING NEW GENERIC MODES: | 77 ;; DEFINING NEW GENERIC MODES: |
78 ;; | 78 ;; |
79 ;; Use the `define-generic-mode' function to define new modes. | 79 ;; Use the `define-generic-mode' function to define new modes. |
80 ;; For example: | 80 ;; For example: |
81 ;; | 81 ;; |
82 ;; (require 'generic) | 82 ;; (require 'generic) |
83 ;; (define-generic-mode 'foo-generic-mode | 83 ;; (define-generic-mode 'foo-generic-mode |
84 ;; (list ?% ) | 84 ;; (list ?% ) |
85 ;; (list "keyword") | 85 ;; (list "keyword") |
86 ;; nil | 86 ;; nil |
87 ;; (list "\.FOO") | 87 ;; (list "\\.FOO\\'") |
88 ;; (list 'foo-setup-function)) | 88 ;; (list 'foo-setup-function)) |
89 ;; | 89 ;; |
90 ;; defines a new generic-mode `foo-generic-mode', which has '%' as a | 90 ;; defines a new generic-mode `foo-generic-mode', which has '%' as a |
91 ;; comment character, and "keyword" as a keyword. When files which end in | 91 ;; comment character, and "keyword" as a keyword. When files which end in |
92 ;; '.FOO' are loaded, Emacs will go into foo-generic-mode and call | 92 ;; '.FOO' are loaded, Emacs will go into foo-generic-mode and call |
100 ;; fundamental mode start with a hash comment character. To disable | 100 ;; fundamental mode start with a hash comment character. To disable |
101 ;; this functionality, set the variable `generic-use-find-file-hook' | 101 ;; this functionality, set the variable `generic-use-find-file-hook' |
102 ;; to nil BEFORE loading generic-mode. See the variables | 102 ;; to nil BEFORE loading generic-mode. See the variables |
103 ;; `generic-lines-to-scan' and `generic-find-file-regexp' for customization | 103 ;; `generic-lines-to-scan' and `generic-find-file-regexp' for customization |
104 ;; options. | 104 ;; options. |
105 ;; | 105 ;; |
106 ;; GOTCHAS: | 106 ;; GOTCHAS: |
107 ;; | 107 ;; |
108 ;; Be careful that your font-lock definitions are correct. Getting them | 108 ;; Be careful that your font-lock definitions are correct. Getting them |
109 ;; wrong can cause emacs to continually attempt to fontify! This problem | 109 ;; wrong can cause emacs to continually attempt to fontify! This problem |
110 ;; is not specific to generic-mode. | 110 ;; is not specific to generic-mode. |
111 ;; | 111 ;; |
112 | 112 |
113 ;; Credit for suggestions, brainstorming, help with debugging: | 113 ;; Credit for suggestions, brainstorming, help with debugging: |
114 ;; ACorreir@pervasive-sw.com (Alfred Correira) | 114 ;; ACorreir@pervasive-sw.com (Alfred Correira) |
115 | 115 ;; Extensive cleanup by: |
116 ;; Stefan Monnier (monnier+gnu/emacs@flint.cs.yale.edu) | |
117 ;; | |
116 ;;; Code: | 118 ;;; Code: |
119 | |
120 (eval-when-compile | |
121 (require 'cl)) | |
117 | 122 |
118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
119 ;; Internal Variables | 124 ;; Internal Variables |
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
121 | 126 |
122 (defvar generic-font-lock-defaults nil | 127 (defvar generic-font-lock-defaults nil |
123 "Global defaults for font-lock in a generic mode.") | 128 "Global defaults for font-lock in a generic mode.") |
124 (make-variable-buffer-local 'generic-font-lock-defaults) | 129 (make-variable-buffer-local 'generic-font-lock-defaults) |
125 | 130 |
126 (defvar generic-mode-name 'default-generic-mode | 131 (defvar generic-mode-list nil |
127 "The name of the generic mode. | 132 "A list of mode names for `generic-mode'. |
128 This is the car of one of the items in `generic-mode-alist'. | |
129 This variable is buffer-local.") | |
130 (make-variable-buffer-local 'generic-mode-name) | |
131 | |
132 (defvar generic-comment-list nil | |
133 "List of comment characters for a generic mode.") | |
134 (make-variable-buffer-local 'generic-comment-list) | |
135 | |
136 (defvar generic-keywords-list nil | |
137 "List of keywords for a generic mode.") | |
138 (make-variable-buffer-local 'generic-keywords-list) | |
139 | |
140 (defvar generic-font-lock-expressions nil | |
141 "List of font-lock expressions for a generic mode.") | |
142 (make-variable-buffer-local 'generic-font-lock-expressions) | |
143 | |
144 (defvar generic-mode-function-list nil | |
145 "List of customization functions to call for a generic mode.") | |
146 (make-variable-buffer-local 'generic-mode-function-list) | |
147 | |
148 (defvar generic-mode-syntax-table nil | |
149 "Syntax table for use in a generic mode.") | |
150 (make-variable-buffer-local 'generic-mode-syntax-table) | |
151 | |
152 (defvar generic-mode-alist nil | |
153 "An association list for `generic-mode'. | |
154 Each entry in the list looks like this: | |
155 | |
156 NAME COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST. | |
157 | |
158 Do not add entries to this list directly; use `define-generic-mode' | 133 Do not add entries to this list directly; use `define-generic-mode' |
159 instead (which see).") | 134 instead (which see).") |
160 | 135 |
161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
162 ;; Customization Variables | 137 ;; Customization Variables |
181 This variable should be set to a small positive number." | 156 This variable should be set to a small positive number." |
182 :group 'generic | 157 :group 'generic |
183 :type 'integer | 158 :type 'integer |
184 ) | 159 ) |
185 | 160 |
186 (defcustom generic-find-file-regexp "#.*\n\\(.*\n\\)?" | 161 (defcustom generic-find-file-regexp "^#" |
187 "*Regular expression used by `generic-mode-find-file-hook'. | 162 "*Regular expression used by `generic-mode-find-file-hook'. |
188 Used to determine if files in fundamental mode should be put into | 163 Used to determine if files in fundamental mode should be put into |
189 `default-generic-mode' instead." | 164 `default-generic-mode' instead." |
190 :group 'generic | 165 :group 'generic |
191 :type 'regexp | 166 :type 'regexp |
196 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
197 | 172 |
198 (defsubst generic-read-type () | 173 (defsubst generic-read-type () |
199 (completing-read | 174 (completing-read |
200 "Generic Type: " | 175 "Generic Type: " |
201 (mapcar | 176 generic-mode-list |
202 '(lambda (elt) (list (symbol-name (car elt)))) | 177 nil t)) |
203 generic-mode-alist) nil t)) | |
204 | |
205 ;; Basic sanity checks. It does *not* check whether the elements of the lists | |
206 ;; are of the correct type. | |
207 (defsubst generic-mode-sanity-check (name comment-list keyword-list | |
208 font-lock-list auto-mode-list | |
209 function-list &optional description) | |
210 (and (not (symbolp name)) | |
211 (error "%s is not a symbol" (princ name))) | |
212 | |
213 (mapcar '(lambda (elt) | |
214 (if (not (listp elt)) | |
215 (error "%s is not a list" (princ elt)))) | |
216 (list comment-list keyword-list font-lock-list | |
217 auto-mode-list function-list)) | |
218 | |
219 (and (not (or (null description) (stringp description))) | |
220 (error "Description must be a string or nil")) | |
221 ) | |
222 | 178 |
223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
224 ;; Functions | 180 ;; Functions |
225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 181 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
226 | 182 |
238 function. | 194 function. |
239 | 195 |
240 COMMENT-LIST is a list, whose entries are either a single character, | 196 COMMENT-LIST is a list, whose entries are either a single character, |
241 a one or two character string or a cons pair. If the entry is a character | 197 a one or two character string or a cons pair. If the entry is a character |
242 or a one-character string, it is added to the mode's syntax table with | 198 or a one-character string, it is added to the mode's syntax table with |
243 comment-start syntax. If the entry is a cons pair, the elements of the | 199 `comment-start' syntax. If the entry is a cons pair, the elements of the |
244 pair are considered to be comment-start and comment-end respectively. | 200 pair are considered to be `comment-start' and `comment-end' respectively. |
245 Note that Emacs has limitations regarding comment characters. | 201 Note that Emacs has limitations regarding comment characters. |
246 | 202 |
247 KEYWORD-LIST is a list of keywords to highlight with `font-lock-keyword-face'. | 203 KEYWORD-LIST is a list of keywords to highlight with `font-lock-keyword-face'. |
248 Each keyword should be a string. | 204 Each keyword should be a string. |
249 | 205 |
250 FONT-LOCK-LIST is a list of additional expressions to highlight. Each entry | 206 FONT-LOCK-LIST is a list of additional expressions to highlight. Each entry |
251 in the list should have the same form as an entry in `font-lock-defaults-alist' | 207 in the list should have the same form as an entry in `font-lock-defaults-alist' |
252 | 208 |
253 AUTO-MODE-LIST is a list of regular expressions to add to auto-mode-alist. | 209 AUTO-MODE-LIST is a list of regular expressions to add to `auto-mode-alist'. |
254 These regexps are added to auto-mode-alist as soon as `define-generic-mode' | 210 These regexps are added to `auto-mode-alist' as soon as `define-generic-mode' |
255 is called; any old regexps with the same name are removed. | 211 is called; any old regexps with the same name are removed. |
256 | 212 |
257 FUNCTION-LIST is a list of functions to call to do some additional setup. | 213 FUNCTION-LIST is a list of functions to call to do some additional setup. |
258 | 214 |
259 See the file generic-x.el for some examples of `define-generic-mode'." | 215 See the file generic-x.el for some examples of `define-generic-mode'." |
260 | 216 |
261 ;; Basic sanity check | |
262 (generic-mode-sanity-check name | |
263 comment-list keyword-list font-lock-list | |
264 auto-mode-list function-list description) | |
265 | |
266 ;; Remove any old entry | |
267 (setq generic-mode-alist | |
268 (delq (assq name generic-mode-alist) | |
269 generic-mode-alist)) | |
270 | |
271 ;; Add a new entry | 217 ;; Add a new entry |
272 (setq generic-mode-alist | 218 (unless (assq name generic-mode-list) |
273 (append | 219 (push (list name) generic-mode-list)) |
274 (list | |
275 (list | |
276 name comment-list keyword-list font-lock-list | |
277 auto-mode-list function-list | |
278 )) | |
279 generic-mode-alist)) | |
280 | 220 |
281 ;; Add it to auto-mode-alist | 221 ;; Add it to auto-mode-alist |
282 (generic-add-to-auto-mode name auto-mode-list t) | 222 (dolist (re auto-mode-list) |
283 | 223 (add-to-list 'auto-mode-alist (cons re name))) |
284 ;; Define a function for it | 224 |
285 (generic-create-generic-function name description) | 225 ;; Define a function for it using `defalias' (not `fset') to make |
226 ;; the mode appear on load-history. | |
227 (defalias name | |
228 `(lambda nil | |
229 ,(or description (concat "Generic mode for type " (symbol-name name))) | |
230 (interactive) | |
231 (generic-mode-internal ',name ',comment-list ',keyword-list | |
232 ',font-lock-list ',function-list))) | |
286 ) | 233 ) |
287 | 234 |
288 (defun generic-add-to-auto-mode (mode auto-mode-list | 235 (defun generic-mode-internal (mode comments keywords font-lock-list funs) |
289 &optional remove-old prepend) | |
290 "Add the entries for MODE to `auto-mode-alist', supplied as AUTO-MODE-ALIST. | |
291 If remove-old is non-nil, removes old entries first. If prepend is | |
292 non-nil, prepends entries to auto-mode-alist; otherwise, appends them." | |
293 | |
294 (if (not (listp auto-mode-list)) | |
295 (error "%s is not a list" (princ auto-mode-list))) | |
296 | |
297 (let ((new-mode (intern (symbol-name mode)))) | |
298 (and remove-old | |
299 (let ((auto-mode-entry)) | |
300 (while (setq auto-mode-entry (rassq new-mode auto-mode-alist)) | |
301 (setq auto-mode-alist | |
302 (delq auto-mode-entry | |
303 auto-mode-alist))))) | |
304 | |
305 (mapcar '(lambda (entry) | |
306 (generic-add-auto-mode-entry new-mode entry prepend)) | |
307 auto-mode-list))) | |
308 | |
309 (defun generic-add-auto-mode-entry (name entry &optional prepend) | |
310 "Add a new NAME regexp with ENTRY to the end of `auto-mode-alist'. | |
311 If prepend is non-nil, add the entry to the front of the list." | |
312 (let ((new-entry (list (cons entry name)))) | |
313 (setq auto-mode-alist | |
314 (if prepend | |
315 (append new-entry auto-mode-alist) | |
316 (append auto-mode-alist new-entry))))) | |
317 | |
318 (defun generic-create-generic-function (name &optional description) | |
319 "Create a generic mode function with NAME. | |
320 If DESCRIPTION is provided, it is used as the docstring." | |
321 (let ((symname (symbol-name name))) | |
322 ;; Use `defalias', not `fset' to make the mode appear on | |
323 ;; load-history. | |
324 (defalias (intern symname) | |
325 (list 'lambda nil | |
326 (or description | |
327 (concat "Generic mode for type " symname)) | |
328 (list 'interactive) | |
329 (list 'generic-mode-with-type (list 'quote name)))))) | |
330 | |
331 (defun generic-mode-with-type (&optional mode) | |
332 "Go into the generic-mode MODE." | 236 "Go into the generic-mode MODE." |
333 (let* ((type (or mode generic-mode-name)) | 237 (let* ((generic-mode-hooks (intern (concat (symbol-name mode) "-hook"))) |
334 (generic-mode-list (assoc type generic-mode-alist)) | 238 (modename (symbol-name mode)) |
335 (generic-mode-hooks (intern (concat (symbol-name type) "-hooks"))) | 239 (name (if (string-match "-mode\\'" modename) |
240 (substring modename 0 (match-beginning 0)) | |
241 modename)) | |
336 ) | 242 ) |
337 | |
338 (and (not generic-mode-list) | |
339 (error "Can't find generic-mode information for type %s" | |
340 (princ generic-mode-name))) | |
341 | 243 |
342 ;; Put this after the point where we read generic-mode-name! | 244 ;; Put this after the point where we read generic-mode-name! |
343 (kill-all-local-variables) | 245 (kill-all-local-variables) |
344 | 246 |
345 (setq | 247 (setq |
346 generic-mode-name type | 248 major-mode mode |
347 generic-comment-list (nth 1 generic-mode-list) | 249 mode-name (capitalize name) |
348 generic-keywords-list (nth 2 generic-mode-list) | |
349 generic-font-lock-expressions (nth 3 generic-mode-list) | |
350 generic-mode-function-list (nth 5 generic-mode-list) | |
351 major-mode type | |
352 mode-name (symbol-name type) | |
353 ) | 250 ) |
354 | 251 |
355 (generic-mode-set-comments generic-comment-list) | 252 (generic-mode-set-comments comments) |
356 | 253 |
357 ;; Font-lock functionality | 254 ;; Font-lock functionality |
358 ;; Font-lock-defaults are always set even if there are no keywords | 255 ;; Font-lock-defaults are always set even if there are no keywords |
359 ;; or font-lock expressions, so comments can be highlighted. | 256 ;; or font-lock expressions, so comments can be highlighted. |
360 (setq generic-font-lock-defaults nil) | 257 (setq generic-font-lock-defaults nil) |
361 (generic-mode-set-font-lock generic-keywords-list | 258 (generic-mode-set-font-lock keywords font-lock-list) |
362 generic-font-lock-expressions) | |
363 (make-local-variable 'font-lock-defaults) | 259 (make-local-variable 'font-lock-defaults) |
364 (setq font-lock-defaults (list 'generic-font-lock-defaults nil)) | 260 (setq font-lock-defaults (list 'generic-font-lock-defaults nil)) |
365 | 261 |
366 ;; Call a list of functions | 262 ;; Call a list of functions |
367 (and generic-mode-function-list | 263 (mapcar 'funcall funs) |
368 (mapcar 'funcall generic-mode-function-list)) | |
369 | 264 |
370 (run-hooks generic-mode-hooks) | 265 (run-hooks generic-mode-hooks) |
371 ) | 266 ) |
372 ) | 267 ) |
373 | 268 |
374 ;;;###autoload | 269 ;;;###autoload |
375 (defun generic-mode (type) | 270 (defun generic-mode (type) |
376 "Basic comment and font-lock functionality for `generic' files. | 271 "Basic comment and font-lock functionality for `generic' files. |
377 (Files which are too small to warrant their own mode, but have | 272 \(Files which are too small to warrant their own mode, but have |
378 comment characters, keywords, and the like.) | 273 comment characters, keywords, and the like.) |
379 | 274 |
380 To define a generic-mode, use the function `define-generic-mode'. | 275 To define a generic-mode, use the function `define-generic-mode'. |
381 Some generic modes are defined in `generic-x.el'." | 276 Some generic modes are defined in `generic-x.el'." |
382 (interactive | 277 (interactive |
383 (list (generic-read-type))) | 278 (list (generic-read-type))) |
384 (generic-mode-with-type (intern type))) | 279 (funcall (intern type))) |
385 | 280 |
386 ;;; Comment Functionality | 281 ;;; Comment Functionality |
387 (defun generic-mode-set-comments (comment-list) | 282 (defun generic-mode-set-comments (comment-list) |
388 "Set up comment functionality for generic mode." | 283 "Set up comment functionality for generic mode." |
389 (if (null comment-list) | 284 (let ((st (make-syntax-table)) |
390 nil | 285 (chars nil) |
391 (let ((generic-mode-syntax-table (make-syntax-table))) | 286 (comstyles)) |
392 (make-local-variable 'comment-start) | 287 (make-local-variable 'comment-start) |
393 (make-local-variable 'comment-start-skip) | 288 (make-local-variable 'comment-start-skip) |
394 (make-local-variable 'comment-end) | 289 (make-local-variable 'comment-end) |
395 (mapcar 'generic-mode-set-a-comment comment-list) | 290 |
396 (set-syntax-table generic-mode-syntax-table)))) | 291 ;; Go through all the comments |
397 | 292 (dolist (start comment-list) |
398 (defun generic-mode-set-a-comment (comment) | 293 (let ((end ?\n) (comstyle "")) |
399 (and (char-or-string-p comment) | 294 ;; Normalize |
400 (if (stringp comment) | 295 (when (consp start) |
401 (cond | 296 (setq end (or (cdr start) end)) |
402 ((eq (length comment) 1) | 297 (setq start (car start))) |
403 (generic-mode-set-comment-char | 298 (when (char-valid-p start) (setq start (char-to-string start))) |
404 (string-to-char comment))) | 299 (when (char-valid-p end) (setq end (char-to-string end))) |
405 ((eq (length comment) 2) | 300 |
406 (generic-mode-set-comment-string comment)) | 301 ;; Setup the vars for `comment-region' |
407 (t | 302 (if comment-start |
408 (error "Character string %s must be one or two characters long" | 303 ;; We have already setup a comment-style, so use style b |
409 comment)) | 304 (progn |
410 ) | 305 (setq comstyle "b") |
411 (generic-mode-set-comment-char comment))) | 306 (setq comment-start-skip |
412 (and (consp comment) | 307 (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) |
413 (generic-mode-set-comment-pair comment))) | 308 ;; First comment-style |
414 | 309 (setq comment-start start) |
415 (defun generic-mode-set-comment-char (comment-char) | 310 (setq comment-end (unless (string-equal end "\n") end)) |
416 "Set COMMENT-CHAR as a comment character for generic mode." | 311 (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) |
417 (if (not comment-char) | 312 |
418 nil | 313 ;; Reuse comstyles if necessary |
419 (setq | 314 (setq comstyle |
420 comment-end "" | 315 (or (cdr (assoc start comstyles)) |
421 comment-start (char-to-string comment-char) | 316 (cdr (assoc end comstyles)) |
422 comment-start-skip (concat comment-start "+ *") | 317 comstyle)) |
423 ) | 318 (push (cons start comstyle) comstyles) |
424 | 319 (push (cons end comstyle) comstyles) |
425 (modify-syntax-entry comment-char "<" | 320 |
426 generic-mode-syntax-table) | 321 ;; Setup the syntax table |
427 (modify-syntax-entry ?\n ">" | 322 (if (= (length start) 1) |
428 generic-mode-syntax-table))) | 323 (modify-syntax-entry (string-to-char start) |
429 | 324 (concat "< " comstyle) st) |
430 (defun generic-mode-set-comment-string (comment-string) | 325 (let ((c0 (elt start 0)) (c1 (elt start 1))) |
431 "Set COMMENT-STRING as a comment string for generic mode." | 326 ;; Store the relevant info but don't update yet |
432 (if (not comment-string) | 327 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) |
433 nil | 328 (push (cons c1 (concat (cdr (assoc c1 chars)) |
434 (setq | 329 (concat "2" comstyle))) chars))) |
435 comment-end "" | 330 (if (= (length end) 1) |
436 comment-start comment-string | 331 (modify-syntax-entry (string-to-char end) |
437 comment-start-skip (concat comment-start " *") | 332 (concat ">" comstyle) st) |
438 ) | 333 (let ((c0 (elt end 0)) (c1 (elt end 1))) |
439 | 334 ;; Store the relevant info but don't update yet |
440 (let ((first (elt comment-string 0)) | 335 (push (cons c0 (concat (cdr (assoc c0 chars)) |
441 (second (elt comment-string 1))) | 336 (concat "3" comstyle))) chars) |
442 ;; C++ style comments | 337 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) |
443 (if (char-equal first second) | 338 |
444 (progn | 339 ;; Process the chars that were part of a 2-char comment marker |
445 (modify-syntax-entry first "<12b" | 340 (dolist (cs (nreverse chars)) |
446 generic-mode-syntax-table) | 341 (modify-syntax-entry (car cs) |
447 (modify-syntax-entry ?\n ">b" | 342 (concat (char-to-string (char-syntax (car cs))) |
448 generic-mode-syntax-table))) | 343 " " (cdr cs)) |
449 ;; Some other two character string | 344 st)) |
450 (modify-syntax-entry first "<1" | 345 (set-syntax-table st))) |
451 generic-mode-syntax-table) | |
452 (modify-syntax-entry second "<2" | |
453 generic-mode-syntax-table) | |
454 (modify-syntax-entry ?\n ">" | |
455 generic-mode-syntax-table)))) | |
456 | |
457 (defun generic-mode-set-comment-pair (comment-pair) | |
458 "Set COMMENT-PAIR as a comment start and end for generic mode." | |
459 (let ((generic-comment-start (car comment-pair)) | |
460 (generic-comment-end (cdr comment-pair)) | |
461 ) | |
462 (setq | |
463 comment-end generic-comment-end | |
464 comment-start generic-comment-start | |
465 comment-start-skip (concat generic-comment-start " *") | |
466 ) | |
467 | |
468 ;; Sanity checks | |
469 (and (not (and (stringp generic-comment-start) | |
470 (stringp generic-comment-end))) | |
471 (error "Elements of cons pair must be strings")) | |
472 (and (not (and (equal (length generic-comment-start) 2) | |
473 (equal (length generic-comment-end) 2))) | |
474 (error "Start and end must be exactly two characters long")) | |
475 | |
476 (let ((first (elt generic-comment-start 0)) | |
477 (second (elt generic-comment-start 1)) | |
478 (third (elt generic-comment-end 0)) | |
479 (fourth (elt generic-comment-end 1)) | |
480 ) | |
481 | |
482 (modify-syntax-entry first ". 1" generic-mode-syntax-table) | |
483 (modify-syntax-entry second ". 2" generic-mode-syntax-table) | |
484 | |
485 (modify-syntax-entry | |
486 third | |
487 (concat | |
488 "." | |
489 (cond | |
490 ((char-equal first third) " 13") | |
491 ((char-equal second third) " 23") | |
492 (t " 3")) | |
493 ) | |
494 generic-mode-syntax-table) | |
495 | |
496 (modify-syntax-entry | |
497 fourth | |
498 (concat | |
499 "." | |
500 (cond | |
501 ((char-equal first fourth) " 14") | |
502 ((char-equal second fourth) " 24") | |
503 (t " 4")) | |
504 ) | |
505 generic-mode-syntax-table) | |
506 ))) | |
507 | 346 |
508 (defun generic-mode-set-font-lock (keywords font-lock-expressions) | 347 (defun generic-mode-set-font-lock (keywords font-lock-expressions) |
509 "Set up font-lock functionality for generic mode." | 348 "Set up font-lock functionality for generic mode." |
510 (let ((generic-font-lock-expressions)) | 349 (setq generic-font-lock-defaults |
511 ;; Keywords | 350 (append |
512 (and keywords | 351 (when keywords |
513 (setq | 352 (list (generic-make-keywords-list keywords font-lock-keyword-face))) |
514 generic-font-lock-expressions | 353 font-lock-expressions))) |
515 (append | |
516 (list (let ((regexp (regexp-opt keywords))) | |
517 (list (concat "\\<\\(" regexp "\\)\\>") | |
518 1 | |
519 'font-lock-keyword-face))) | |
520 generic-font-lock-expressions))) | |
521 ;; Other font-lock expressions | |
522 (and font-lock-expressions | |
523 (setq generic-font-lock-expressions | |
524 (append | |
525 font-lock-expressions | |
526 generic-font-lock-expressions))) | |
527 (and (or font-lock-expressions keywords) | |
528 (setq generic-font-lock-defaults generic-font-lock-expressions)) | |
529 )) | |
530 | 354 |
531 ;; Support for [KEYWORD] constructs found in INF, INI and Samba files | 355 ;; Support for [KEYWORD] constructs found in INF, INI and Samba files |
532 (defun generic-bracket-support () | 356 (defun generic-bracket-support () |
533 (setq imenu-generic-expression | 357 (setq imenu-generic-expression |
534 '((nil "^\\[\\(.*\\)\\]" 1)) | 358 '((nil "^\\[\\(.*\\)\\]" 1)) |
540 ;; A more general solution would allow us to enter generic-mode for | 364 ;; A more general solution would allow us to enter generic-mode for |
541 ;; *any* comment character, but would require us to synthesize a new | 365 ;; *any* comment character, but would require us to synthesize a new |
542 ;; generic-mode on the fly. I think this gives us most of what we | 366 ;; generic-mode on the fly. I think this gives us most of what we |
543 ;; want. | 367 ;; want. |
544 (defun generic-mode-find-file-hook () | 368 (defun generic-mode-find-file-hook () |
545 "Hook function to enter default-generic-mode automatically. | 369 "Hook function to enter `default-generic-mode' automatically. |
546 Done if the first few lines of a file in `fundamental-mode' start with | 370 Done if the first few lines of a file in `fundamental-mode' start with |
547 a hash comment character. This hook will be installed if the variable | 371 a hash comment character. This hook will be installed if the variable |
548 `generic-use-find-file-hook' is non-nil. The variable | 372 `generic-use-find-file-hook' is non-nil. The variable |
549 `generic-lines-to-scan' determines the number of lines to look at." | 373 `generic-lines-to-scan' determines the number of lines to look at." |
550 (if (not (eq major-mode 'fundamental-mode)) | 374 (when (eq major-mode 'fundamental-mode) |
551 nil | 375 (save-excursion |
552 (and (or (> 1 generic-lines-to-scan) | 376 (goto-char (point-min)) |
553 (< 50 generic-lines-to-scan)) | 377 (when (re-search-forward generic-find-file-regexp |
554 (error "Variable `generic-lines-to-scan' should be set to a small" | 378 (save-excursion |
555 " positive number")) | 379 (forward-line generic-lines-to-scan) |
556 (let ((comment-regexp "") | 380 (point)) t) |
557 (count 0) | |
558 ) | |
559 (while (< count generic-lines-to-scan) | |
560 (setq comment-regexp (concat comment-regexp | |
561 generic-find-file-regexp)) | |
562 (setq count (1+ count))) | |
563 (save-excursion | |
564 (goto-char (point-min)) | 381 (goto-char (point-min)) |
565 (and (looking-at comment-regexp) | 382 (default-generic-mode))))) |
566 (generic-mode-with-type 'default-generic-mode)))))) | |
567 | 383 |
568 (defun generic-mode-ini-file-find-file-hook () | 384 (defun generic-mode-ini-file-find-file-hook () |
569 "Hook function to enter default-generic-mode automatically for INI files. | 385 "Hook function to enter default-generic-mode automatically for INI files. |
570 Done if the first few lines of a file in `fundamental-mode' look like an | 386 Done if the first few lines of a file in `fundamental-mode' look like an |
571 INI file. This hook is NOT installed by default." | 387 INI file. This hook is NOT installed by default." |
572 (and (eq major-mode 'fundamental-mode) | 388 (and (eq major-mode 'fundamental-mode) |
573 (save-excursion | 389 (save-excursion |
574 (goto-char (point-min)) | 390 (goto-char (point-min)) |
575 (and (looking-at "^\\s-*\\[.*\\]") | 391 (and (looking-at "^\\s-*\\[.*\\]") |
576 (generic-mode-with-type 'ini-generic-mode))))) | 392 (ini-generic-mode))))) |
577 | 393 |
578 (and generic-use-find-file-hook | 394 (and generic-use-find-file-hook |
579 (add-hook 'find-file-hooks 'generic-mode-find-file-hook)) | 395 (add-hook 'find-file-hooks 'generic-mode-find-file-hook)) |
580 | 396 |
581 (defun generic-make-keywords-list (keywords-list face &optional prefix suffix) | 397 (defun generic-make-keywords-list (keywords-list face &optional prefix suffix) |
582 "Return a regular expression matching the specified KEYWORDS-LIST. | 398 "Return a regular expression matching the specified KEYWORDS-LIST. |
583 The regexp is highlighted with FACE." | 399 The regexp is highlighted with FACE." |
584 (and (not (listp keywords-list)) | 400 (unless (listp keywords-list) |
585 (error "Keywords argument must be a list of strings")) | 401 (error "Keywords argument must be a list of strings")) |
586 (list (concat (or prefix "") | 402 (list (concat prefix "\\<" |
587 "\\<\\(" | |
588 ;; Use an optimized regexp. | 403 ;; Use an optimized regexp. |
589 (regexp-opt keywords-list t) | 404 (regexp-opt keywords-list t) |
590 "\\)\\>" | 405 "\\>" suffix) |
591 (or suffix "")) | |
592 1 | 406 1 |
593 face)) | 407 face)) |
594 | 408 |
595 (provide 'generic) | 409 (provide 'generic) |
596 | 410 |