overload-docstring-extension for mode-local functions.
* cedet/mode-local.el:
* cedet/semantic/mru-bookmark.el:
* cedet/pulse.el: Remove advice.
* cedet/semantic.el: Add autoloads for semantic/idle functions.
2009-09-21 Chong Yidong <cyd@stupidchicken.com>
+ * help-fns.el (describe-function-1): Call
+ overload-docstring-extension for mode-local functions.
+
+ * cedet/mode-local.el:
+ * cedet/semantic/mru-bookmark.el:
+ * cedet/pulse.el: Remove advice.
+
* cedet/semantic.el: Add autoloads for semantic/idle functions.
* cedet/semantic/util.el (semantic--completion-cache): New var.
;;; Code:
(eval-when-compile (require 'cl))
-;;; Compatibility
-;;
-(defun mode-local-define-derived-mode-needed-p ()
- "Return non-nil if mode local has to fix `define-derived-mode'.
-That is, if `define-derived-mode' does not set `derived-mode-parent'."
- (let ((body (cdr (macroexpand '(define-derived-mode c p ""))))
- (bad t))
- (while (and body bad)
- (if (equal (car body) '(put 'c 'derived-mode-parent 'p))
- (setq bad nil)
- (setq body (cdr body))))
- bad))
-
-(when (mode-local-define-derived-mode-needed-p)
- ;; Workaround a bug in some (XEmacs) versions of
- ;; `define-derived-mode' that don't set the `derived-mode-parent'
- ;; property, and break mode-local.
- (defadvice define-derived-mode
- (after mode-local-define-derived-mode activate)
- "Fix missing `derived-mode-parent' property on child."
- (unless (eq 'fundamental-mode (ad-get-arg 1))
- (let ((form (cdr ad-return-value)))
- (setq ad-return-value nil)
- (while form
- (and (eq 'defun (car-safe (car form)))
- (eq (ad-get-arg 0) (car (cdr-safe (car form))))
- (push `(or (get ',(ad-get-arg 0) 'derived-mode-parent)
- (put ',(ad-get-arg 0) 'derived-mode-parent
- ',(ad-get-arg 1)))
- ad-return-value))
- (push (car form) ad-return-value)
- (setq form (cdr form)))
- (setq ad-return-value `(progn ,@(nreverse ad-return-value)))
- )))
- )
-
;;; Misc utilities
;;
(defun mode-local-map-file-buffers (function &optional predicate buffers)
(defun overload-docstring-extension (overload)
"Return the doc string that augments the description of OVERLOAD."
(let ((doc "\n\This function can be overloaded\
- (see `define-mode-local-override' for details).")
+ with `define-mode-local-override'.")
(sym (overload-obsoleted-by overload)))
(when sym
(setq doc (format "%s\nIt makes the overload `%s' obsolete."
)
(toggle-read-only 1))))
-;; Help for Overload functions. Need to advise help.
-(defadvice describe-function (around mode-local-help activate)
- "Display the full documentation of FUNCTION (a symbol).
-Returns the documentation as a string, also."
- (prog1
- ad-do-it
- (if (function-overload-p (ad-get-arg 0))
- (mode-local-augment-function-help (ad-get-arg 0)))))
-
;; Help for mode-local bindings.
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."
(pulse-momentary-highlight-overlay o face)))
;;; Random integration with other tools
-;;
-(defvar pulse-command-advice-flag nil
- "Non-nil means pulse advice is active.
-To active pulse advice, use `pulse-enable-integration-advice'.")
-
-(defun pulse-toggle-integration-advice (arg)
- "Toggle activation of advised functions that will now pulse.
-Wint no ARG, toggle the pulse advice.
-With a negative ARG, disable pulse advice.
-With a positive ARG, enable pulse advice.
-Currently advised functions include:
- `goto-line'
- `exchange-point-and-mark'
- `find-tag'
- `tags-search'
- `tags-loop-continue'
- `pop-tag-mark'
- `imenu-default-goto-function'
-Pulsing via `pulse-line-hook-function' has also been added to
-the following hook:
- `next-error-hook'"
- (interactive "P")
- (if (null arg)
- (setq pulse-command-advice-flag (not pulse-command-advice-flag))
- (if (< (prefix-numeric-value arg) 0)
- (setq pulse-command-advice-flag nil)
- (setq pulse-command-advice-flag t)
- )
- )
- (if pulse-command-advice-flag
- (message "Pulse advice enabled")
- (message "Pulse advice disabled"))
- )
-
-(defadvice goto-line (after pulse-advice activate)
- "Cause the line that is `goto'd to pulse when the cursor gets there."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-(defadvice exchange-point-and-mark (after pulse-advice activate)
- "Cause the line that is `goto'd to pulse when the cursor gets there."
- (when (and pulse-command-advice-flag (interactive-p)
- (> (abs (- (point) (mark))) 400))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice find-tag (after pulse-advice activate)
- "After going to a tag, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice tags-search (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice tags-loop-continue (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice pop-tag-mark (after pulse-advice activate)
- "After going to a hit, pulse the line the cursor lands on."
- (when (and pulse-command-advice-flag (interactive-p))
- (pulse-momentary-highlight-one-line (point))))
-
-(defadvice imenu-default-goto-function (after pulse-advice activate)
- "After going to a tag, pulse the line the cursor lands on."
- (when pulse-command-advice-flag
- (pulse-momentary-highlight-one-line (point))))
+(defvar pulse-command-advice-flag nil)
(defun pulse-line-hook-function ()
"Function used in hooks to pulse the current line.
(when pulse-command-advice-flag
(pulse-momentary-highlight-one-line (point))))
-(add-hook 'next-error-hook 'pulse-line-hook-function)
-
(provide 'pulse)
;;; pulse.el ends here
(semantic-mrub-visit tagmark)
)
-;;; ADVICE
-;;
-;; Advise some commands to help set tag marks.
-;; (defadvice push-mark (around semantic-mru-bookmark activate)
-;; "Push a mark at LOCATION with NOMSG and ACTIVATE passed to `push-mark'.
-;; If `semantic-mru-bookmark-mode' is active, also push a tag onto
-;; the mru bookmark stack."
-;; (semantic-mrub-push semantic-mru-bookmark-ring
-;; (point)
-;; 'mark)
-;; ad-do-it)
-
-;(defadvice set-mark-command (around semantic-mru-bookmark activate)
-; "Set this buffer's mark to POS.
-;If `semantic-mru-bookmark-mode' is active, also push a tag onto
-;the mru bookmark stack."
-; (when (and semantic-mru-bookmark-mode (interactive-p))
-; (semantic-mrub-push semantic-mru-bookmark-ring
-; (point)
-; 'mark))
-; ad-do-it)
-
-
;;; Debugging
;;
(defun semantic-adebug-mrub ()
(and src-file (file-readable-p src-file) src-file))))))
(declare-function ad-get-advice-info "advice" (function))
+(declare-function function-overload-p "mode-local")
+(declare-function overload-docstring-extension function "mode-local")
;;;###autoload
(defun describe-function-1 (function)
(insert (car high) "\n")
(fill-region fill-begin (point)))
(setq doc (cdr high))))
+
+ ;; Note if function is obsolete.
(let* ((obsolete (and
;; function might be a lambda construct.
(symbolp function)
(insert (cond ((stringp use) (concat ";\n" use))
(use (format ";\nuse `%s' instead." use))
(t "."))
- "\n"))
- (insert "\n"
- (or doc "Not documented."))))))))
+ "\n")))
+
+ ;; Note if function is overloadable (see the `mode-local'
+ ;; package in CEDET).
+ (when (and (featurep 'mode-local)
+ (symbolp function)
+ (function-overload-p function))
+ (insert (overload-docstring-extension function) "\n"))
+
+ (insert "\n" (or doc "Not documented.")))))))
\f
;; Variables
HCoop / bpt / emacs.git / commitdiff