/[emacs]/emacs/lisp/generic.el
ViewVC logotype

Diff of /emacs/lisp/generic.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31 by monnier, Thu Mar 24 22:11:18 2005 UTC revision 1.32 by lute, Thu Mar 31 14:54:00 2005 UTC
# Line 217  FUNCTION-LIST is a list of functions to Line 217  FUNCTION-LIST is a list of functions to
217  additional setup.  additional setup.
218    
219  See the file generic-x.el for some examples of `define-generic-mode'."  See the file generic-x.el for some examples of `define-generic-mode'."
220    (let* ((name-unquoted (if (eq (car-safe mode) 'quote) ; Backward compatibility.    (declare (debug (sexp def-form def-form def-form form def-form &optional stringp)))
221                              (eval mode)  
222                            mode))    ;; Backward compatibility.
223           (name-string (symbol-name name-unquoted))    (when (eq (car-safe mode) 'quote)
224        (setq mode (eval mode)))
225      (let* ((mode-name (symbol-name mode))
226           (pretty-name (capitalize (replace-regexp-in-string           (pretty-name (capitalize (replace-regexp-in-string
227                                     "-mode\\'" "" name-string))))                                     "-mode\\'" "" mode-name)))
228             (mode-hook (intern (concat mode-name "-hook"))))
229    
230      `(progn      `(progn
231         ;; Add a new entry.         ;; Add a new entry.
232         (add-to-list 'generic-mode-list ,name-string)         (add-to-list 'generic-mode-list ,mode-name)
233    
234         ;; Add it to auto-mode-alist         ;; Add it to auto-mode-alist
235         (dolist (re ,auto-mode-list)         (dolist (re ,auto-mode-list)
236           (add-to-list 'auto-mode-alist (cons re ',name-unquoted)))           (add-to-list 'auto-mode-alist (cons re ',mode)))
237    
238           (defcustom ,mode-hook nil
239             ,(concat "Hook run when entering " pretty-name " mode.")
240             :type 'hook
241             :group (or (custom-current-group)
242                        ',(intern (replace-regexp-in-string
243                                   "-mode\\'" "" mode-name))))
244    
245         (defun ,name-unquoted ()         (defun ,mode ()
246           ,(or docstring           ,(or docstring
247                (concat pretty-name " mode.\n"                (concat pretty-name " mode.\n"
248                        "This a generic mode defined with `define-generic-mode'."))                        "This a generic mode defined with `define-generic-mode'."))
249           (interactive)           (interactive)
250           (generic-mode-internal ',name-unquoted ,comment-list ,keyword-list           (generic-mode-internal ',mode ,comment-list ,keyword-list
251                                  ,font-lock-list ,function-list)))))                                  ,font-lock-list ,function-list)))))
252    
253  ;;;###autoload  ;;;###autoload
254  (defun generic-mode-internal (mode comments keywords font-lock-list funs)  (defun generic-mode-internal (mode comment-list keyword-list
255                                       font-lock-list function-list)
256    "Go into the generic mode MODE."    "Go into the generic mode MODE."
257    (let* ((modename (symbol-name mode))    (let* ((mode-name (symbol-name mode))
          (generic-mode-hooks (intern (concat modename "-hook")))  
258           (pretty-name (capitalize (replace-regexp-in-string           (pretty-name (capitalize (replace-regexp-in-string
259                                     "-mode\\'" "" modename))))                                     "-mode\\'" "" mode-name)))
260             (mode-hook (intern (concat mode-name "-hook"))))
261    
262      (kill-all-local-variables)      (kill-all-local-variables)
263    
264      (setq major-mode mode      (setq major-mode mode
265            mode-name pretty-name)            mode-name pretty-name)
266    
267      (generic-mode-set-comments comments)      (generic-mode-set-comments comment-list)
268    
269      ;; Font-lock functionality.      ;; Font-lock functionality.
270      ;; Font-lock-defaults is always set even if there are no keywords      ;; Font-lock-defaults is always set even if there are no keywords
271      ;; or font-lock expressions, so comments can be highlighted.      ;; or font-lock expressions, so comments can be highlighted.
272      (setq generic-font-lock-keywords      (setq generic-font-lock-keywords
273            (append            (append
274             (when keywords             (when keyword-list
275               (list (generic-make-keywords-list keywords font-lock-keyword-face)))               (list (generic-make-keywords-list keyword-list
276                                                   font-lock-keyword-face)))
277             font-lock-list))             font-lock-list))
278      (setq font-lock-defaults '(generic-font-lock-keywords nil))      (setq font-lock-defaults '(generic-font-lock-keywords nil))
279    
280      ;; Call a list of functions      ;; Call a list of functions
281      (mapcar 'funcall funs)      (mapcar 'funcall function-list)
282    
283      (run-hooks generic-mode-hooks)))      (run-mode-hooks mode-hook)))
284    
285  ;;;###autoload  ;;;###autoload
286  (defun generic-mode (mode)  (defun generic-mode (mode)
# Line 392  This hook will be installed if the varia Line 404  This hook will be installed if the varia
404    
405  (defun generic-mode-ini-file-find-file-hook ()  (defun generic-mode-ini-file-find-file-hook ()
406    "Hook function to enter Default-Generic mode automatically for INI files.    "Hook function to enter Default-Generic mode automatically for INI files.
407  Done if the first few lines of a file in Fundamental mode look like an  Done if the first few lines of a file in Fundamental mode look like an
408  INI file.  This hook is NOT installed by default."  INI file.  This hook is NOT installed by default."
409    (and (eq major-mode 'fundamental-mode)    (and (eq major-mode 'fundamental-mode)
410         (save-excursion         (save-excursion

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.32

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26