;;; mode-local.el --- Support for mode local facilities
;;
-;; Copyright (C) 2004, 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2005, 2007-2011
+;; Free Software Foundation, Inc.
;;
;; Author: David Ponce <david@dponce.com>
;; Maintainer: David Ponce <david@dponce.com>
;; that nature, and also provides reasonable defaults.
;;
;; There are buffer local variables, and frame local variables.
-;; This library give the illusion of mode specific variables.
+;; This library gives the illusion of mode specific variables.
;;
;; You should use a mode-local variable or override to allow extension
;; only if you expect a mode author to provide that extension. If a
;; To Do:
;; Allow customization of a variable for a specific mode?
;;
-;; Add mecro for defining the '-default' functionality.
-
-;;; History:
-;;
+;; Add macro for defining the '-default' functionality.
;;; Code:
+
(eval-when-compile (require 'cl))
;;; Misc utilities
(or (get mode 'mode-local-parent)
(get mode 'derived-mode-parent)))
+;; FIXME doc (and function name) seems wrong.
+;; Return a list of MODE and all its parent modes, if any.
+;; Lists parent modes first.
(defun mode-local-equivalent-mode-p (mode)
"Is the major-mode in the current buffer equivalent to a mode in MODES."
(let ((modes nil))
(eq mode-local--init-mode major-mode))
(defun mode-local-post-major-mode-change ()
- "`post-command-hook' run when there is a `major-mode' change.
-This makes sure mode local init type stuff can occur."
+ "Initialize mode-local facilities.
+This is run from `find-file-hook', and from `post-command-hook'
+after changing the major mode."
(remove-hook 'post-command-hook 'mode-local-post-major-mode-change nil)
(let ((buffers mode-local-changed-mode-buffers))
(setq mode-local-changed-mode-buffers nil)
(mode-local-map-file-buffers
- #'(lambda ()
- ;; Make sure variables are set up for this mode.
- (activate-mode-local-bindings)
- (run-hooks 'mode-local-init-hook))
- #'(lambda ()
- (not (mode-local-initialized-p)))
+ (lambda ()
+ ;; Make sure variables are set up for this mode.
+ (activate-mode-local-bindings)
+ (run-hooks 'mode-local-init-hook))
+ (lambda ()
+ (not (mode-local-initialized-p)))
buffers)))
(defun mode-local-on-major-mode-change ()
"Function called in `change-major-mode-hook'."
(add-to-list 'mode-local-changed-mode-buffers (current-buffer))
(add-hook 'post-command-hook 'mode-local-post-major-mode-change t nil))
-
-(add-hook 'find-file-hooks 'mode-local-post-major-mode-change)
-(add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change)
\f
;;; Mode lineage
;;
The current mode bindings are saved, BODY is evaluated, and the saved
bindings are restored, even in case of an abnormal exit.
Value is what BODY returns.
-This lis like `with-mode-local-symbol', except that MODE is quoted
-and is note evaluated."
+This is like `with-mode-local-symbol', except that MODE is quoted
+and is not evaluated."
`(with-mode-local-symbol ',mode ,@body))
(put 'with-mode-local 'lisp-indent-function 1)
\f
;;; Function overloading
;;
-(defun make-obsolete-overload (old new)
- "Mark OLD overload as obsoleted by NEW overload."
+(defun make-obsolete-overload (old new when)
+ "Mark OLD overload as obsoleted by NEW overload.
+WHEN is a string describing the first release where it was made obsolete."
(put old 'overload-obsoleted-by new)
+ (put old 'overload-obsoleted-since when)
(put old 'mode-local-overload t)
(put new 'overload-obsolete old))
with `define-mode-local-override'.")
(sym (overload-obsoleted-by overload)))
(when sym
- (setq doc (format "%s\nIt makes the overload `%s' obsolete."
- doc sym)))
+ (setq doc (format "%s\nIt has made the overload `%s' obsolete since %s."
+ doc sym (get sym 'overload-obsoleted-since))))
(setq sym (overload-that-obsolete overload))
(when sym
- (setq doc (format "%s\nThis overload is obsoletes;\nUse `%s' instead."
- doc sym)))
+ (setq doc (format "%s\nThis overload is obsolete since %s;\nUse `%s' instead."
+ doc (get overload 'overload-obsoleted-since) sym)))
doc))
(defun mode-local-augment-function-help (symbol)
SYMBOL is a function that can be overridden."
(with-current-buffer "*Help*"
(pop-to-buffer (current-buffer))
- (unwind-protect
- (progn
- (toggle-read-only -1)
- (goto-char (point-min))
- (unless (re-search-forward "^$" nil t)
- (goto-char (point-max))
- (beginning-of-line)
- (forward-line -1))
- (insert (overload-docstring-extension symbol) "\n")
- ;; NOTE TO SELF:
- ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
- )
- (toggle-read-only 1))))
+ (goto-char (point-min))
+ (unless (re-search-forward "^$" nil t)
+ (goto-char (point-max))
+ (beginning-of-line)
+ (forward-line -1))
+ (let ((inhibit-read-only t))
+ (insert (overload-docstring-extension symbol) "\n")
+ ;; NOTE TO SELF:
+ ;; LIST ALL LOADED OVERRIDES FOR SYMBOL HERE
+ )))
;; Help for mode-local bindings.
(defun mode-local-print-binding (symbol)
"Display mode local bindings active in BUFFER."
(interactive "b")
(when (setq buffer (get-buffer buffer))
- (mode-local-describe-bindings-1 buffer (interactive-p))))
+ (mode-local-describe-bindings-1 buffer (called-interactively-p 'any))))
(defun describe-mode-local-bindings-in-mode (mode)
"Display mode local bindings active in MODE hierarchy."
#'(lambda (s) (get s 'mode-local-symbol-table))
t (symbol-name major-mode))))
(when (setq mode (intern-soft mode))
- (mode-local-describe-bindings-1 mode (interactive-p))))
+ (mode-local-describe-bindings-1 mode (called-interactively-p 'any))))
\f
-;;; Font-lock support
-;;
-(defconst mode-local-font-lock-keywords
- (eval-when-compile
- (let* (
- ;; Variable declarations
- (kv (regexp-opt
- '(
- "defconst-mode-local"
- "defvar-mode-local"
- ) t))
- ;; Function declarations
- (kf (regexp-opt
- '(
- "define-mode-local-override"
- "define-child-mode"
- "define-overload"
- "define-overloadable-function"
- ;;"make-obsolete-overload"
- "with-mode-local"
- ) t))
- ;; Regexp depths
- (kv-depth (regexp-opt-depth kv))
- (kf-depth (regexp-opt-depth kf))
- )
- `((,(concat
- ;; Declarative things
- "(\\(" kv "\\|" kf "\\)"
- ;; Whitespaces & names
- "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?"
- )
- (1 font-lock-keyword-face)
- (,(+ 1 kv-depth kf-depth 1)
- (cond ((match-beginning 2)
- font-lock-type-face)
- ((match-beginning ,(+ 1 kv-depth 1))
- font-lock-function-name-face)
- )
- nil t)
- (,(+ 1 kv-depth kf-depth 1 1)
- (cond ((match-beginning 2)
- font-lock-variable-name-face)
- )
- nil t)))
- ))
- "Highlighted keywords.")
-
-\f
-;;; find-func support (Emacs 21.4, or perhaps 22.1)
-;;
-(condition-case nil
- ;; Try to get find-func so we can modify it.
- (require 'find-func)
- (error nil))
-
-(when (boundp 'find-function-regexp)
- (unless (string-match "ine-overload" find-function-regexp)
- (if (string-match "(def\\\\(" find-function-regexp)
- (let ((end (match-end 0))
- )
- (setq find-function-regexp
- (concat (substring find-function-regexp 0 end)
- "ine-overload\\|ine-mode-local-override\\|"
- "ine-child-mode\\|"
- (substring find-function-regexp end)))))
- )
- ;; The regexp for variables is a little more kind.
- )
-
-;; TODO: Add XEmacs support
-;; (when (fboundp 'font-lock-add-keywords)
-;; (font-lock-add-keywords 'emacs-lisp-mode
-;; mode-local-font-lock-keywords))
+;; ;;; find-func support (Emacs 21.4, or perhaps 22.1)
+;; ;;
+;; (condition-case nil
+;; ;; Try to get find-func so we can modify it.
+;; (require 'find-func)
+;; (error nil))
+
+;; (when (boundp 'find-function-regexp)
+;; (unless (string-match "ine-overload" find-function-regexp)
+;; (if (string-match "(def\\\\(" find-function-regexp)
+;; (let ((end (match-end 0))
+;; )
+;; (setq find-function-regexp
+;; (concat (substring find-function-regexp 0 end)
+;; "ine-overload\\|ine-mode-local-override\\|"
+;; "ine-child-mode\\|"
+;; (substring find-function-regexp end)))))))
\f
;;; edebug support
;;
(defun mode-local-setup-edebug-specs ()
"Define edebug specification for mode local macros."
(def-edebug-spec setq-mode-local
- (symbolp &rest symbolp form)
- )
+ (symbolp &rest symbolp form))
(def-edebug-spec defvar-mode-local
- (&define symbolp name def-form [ &optional stringp ] )
- )
+ (&define symbolp name def-form [ &optional stringp ] ))
(def-edebug-spec defconst-mode-local
- defvar-mode-local
- )
+ defvar-mode-local)
(def-edebug-spec define-overload
- (&define name lambda-list stringp def-body)
- )
+ (&define name lambda-list stringp def-body))
(def-edebug-spec define-overloadable-function
- (&define name lambda-list stringp def-body)
- )
+ (&define name lambda-list stringp def-body))
(def-edebug-spec define-mode-local-override
- (&define name symbolp lambda-list stringp def-body)
- )
- )
+ (&define name symbolp lambda-list stringp def-body)))
(add-hook 'edebug-setup-hook 'mode-local-setup-edebug-specs)
+(add-hook 'find-file-hook 'mode-local-post-major-mode-change)
+(add-hook 'change-major-mode-hook 'mode-local-on-major-mode-change)
+
(provide 'mode-local)
;;; mode-local.el ends here
HCoop / bpt / emacs.git / blobdiff