X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4fce8dfae60dce6a19bef88ce893bcc019576c66..d914383aad4756cd3ec36589363702ab8d7a0245:/lisp/subr.el diff --git a/lisp/subr.el b/lisp/subr.el index 2b329ef623..ea971b99c7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,7 +1,7 @@ ;;; subr.el --- basic lisp subroutines for Emacs -;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002, 03, 2004 -;; Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003, +;; 2004 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal @@ -566,7 +566,7 @@ The order of bindings in a keymap matters when it is used as a menu." (defmacro kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string constant in the format used for -saving keyboard macros (see `insert-kbd-macro')." +saving keyboard macros (see `edmacro-mode')." (read-kbd-macro keys)) (put 'keyboard-translate-table 'char-table-extra-slots 0) @@ -683,7 +683,7 @@ in the current Emacs session, then this function may return nil." (setq event (car event))) (if (symbolp event) (car (get event 'event-symbol-elements)) - (let ((base (logand event (1- (lsh 1 18))))) + (let ((base (logand event (1- ?\A-\^@)))) (downcase (if (< base 32) (logior base 64) base))))) (defsubst mouse-movement-p (object) @@ -1196,7 +1196,7 @@ Optional args SENTINEL and FILTER specify the sentinel and filter (make-obsolete 'process-kill-without-query "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'." - "21.5") + "21.4") (defun process-kill-without-query (process &optional flag) "Say no query needed if PROCESS is running when Emacs is exited. Optional second argument if non-nil says to require a query. @@ -1949,9 +1949,14 @@ in BODY." (make-variable-buffer-local 'delayed-mode-hooks) (put 'delay-mode-hooks 'permanent-local t) +(defvar after-change-major-mode-hook nil + "Normal hook run at the very end of major mode functions.") + (defun run-mode-hooks (&rest hooks) "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS. Execution is delayed if `delay-mode-hooks' is non-nil. +If `delay-mode-hooks' is nil, run `after-change-major-mode-hook' +after running the mode hooks. Major mode functions should use this." (if delay-mode-hooks ;; Delaying case. @@ -1960,10 +1965,13 @@ Major mode functions should use this." ;; Normal case, just run the hook as before plus any delayed hooks. (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) (setq delayed-mode-hooks nil) - (apply 'run-hooks hooks))) + (apply 'run-hooks hooks) + (run-hooks 'after-change-major-mode-hook))) (defmacro delay-mode-hooks (&rest body) "Execute BODY, but delay any `run-mode-hooks'. +These hooks will be executed by the first following call to +`run-mode-hooks' that occurs outside any `delayed-mode-hooks' form. Only affects hooks run in the current buffer." (declare (debug t)) `(progn @@ -1981,6 +1989,27 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (setq parent (get parent 'derived-mode-parent)))) parent)) +(defun find-tag-default () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (save-excursion + (while (looking-at "\\sw\\|\\s_") + (forward-char 1)) + (if (or (re-search-backward "\\sw\\|\\s_" + (save-excursion (beginning-of-line) (point)) + t) + (re-search-forward "\\(\\sw\\|\\s_\\)+" + (save-excursion (end-of-line) (point)) + t)) + (progn (goto-char (match-end 0)) + (buffer-substring-no-properties + (point) + (progn (forward-sexp -1) + (while (looking-at "\\s'") + (forward-char 1)) + (point)))) + nil))) + (defmacro with-syntax-table (table &rest body) "Evaluate BODY with syntax table of current buffer set to TABLE. The syntax table of the current buffer is saved, BODY is evaluated, and the @@ -2106,7 +2135,7 @@ likely to have undesired semantics.") ;; expression leads to the equivalent implementation that if SEPARATORS ;; is defaulted, OMIT-NULLS is treated as t. (defun split-string (string &optional separators omit-nulls) - "Splits STRING into substrings bounded by matches for SEPARATORS. + "Split STRING into substrings bounded by matches for SEPARATORS. The beginning and end of STRING, and each match for SEPARATORS, are splitting points. The substrings matching SEPARATORS are removed, and @@ -2316,13 +2345,13 @@ which in most cases is shared with all other buffers in the same major mode." (defun global-unset-key (key) "Remove global binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key globally: ") (global-set-key key nil)) (defun local-unset-key (key) "Remove local binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key locally: ") (if (current-local-map) (local-set-key key nil)) @@ -2635,5 +2664,132 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) -;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc +;; Standardized progress reporting + +;; Progress reporter has the following structure: +;; +;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME +;; MIN-VALUE +;; MAX-VALUE +;; MESSAGE +;; MIN-CHANGE +;; MIN-TIME]) +;; +;; This weirdeness is for optimization reasons: we want +;; `progress-reporter-update' to be as fast as possible, so +;; `(car reporter)' is better than `(aref reporter 0)'. +;; +;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple +;; digits of precision, it doesn't really matter here. On the other +;; hand, it greatly simplifies the code. + +(defun make-progress-reporter (message min-value max-value + &optional current-value + min-change min-time) + "Return an object suitable for reporting operation progress with `progress-reporter-update'. + +MESSAGE is shown in the echo area. When at least 1% of operation +is complete, the exact percentage will be appended to the +MESSAGE. When you call `progress-reporter-done', word \"done\" +is printed after the MESSAGE. You can change MESSAGE of an +existing progress reporter with `progress-reporter-force-update'. + +MIN-VALUE and MAX-VALUE designate starting (0% complete) and +final (100% complete) states of operation. The latter should be +larger; if this is not the case, then simply negate all values. +Optional CURRENT-VALUE specifies the progress by the moment you +call this function. You should omit it or set it to nil in most +cases since it defaults to MIN-VALUE. + +Optional MIN-CHANGE determines the minimal change in percents to +report (default is 1%.) Optional MIN-TIME specifies the minimal +time before echo area updates (default is 0.2 seconds.) If +`float-time' function is not present, then time is not tracked +at all. If OS is not capable of measuring fractions of seconds, +then this parameter is effectively rounded up." + + (unless min-time + (setq min-time 0.2)) + (let ((reporter + (cons min-value ;; Force a call to `message' now + (vector (if (and (fboundp 'float-time) + (>= min-time 0.02)) + (float-time) nil) + min-value + max-value + message + (if min-change (max (min min-change 50) 1) 1) + min-time)))) + (progress-reporter-update reporter (or current-value min-value)) + reporter)) + +(defsubst progress-reporter-update (reporter value) + "Report progress of an operation in the echo area. +However, if the change since last echo area update is too small +or not enough time has passed, then do nothing (see +`make-progress-reporter' for details). + +First parameter, REPORTER, should be the result of a call to +`make-progress-reporter'. Second, VALUE, determines the actual +progress of operation; it must be between MIN-VALUE and MAX-VALUE +as passed to `make-progress-reporter'. + +This function is very inexpensive, you may not bother how often +you call it." + (when (>= value (car reporter)) + (progress-reporter-do-update reporter value))) + +(defun progress-reporter-force-update (reporter value &optional new-message) + "Report progress of an operation in the echo area unconditionally. + +First two parameters are the same as for +`progress-reporter-update'. Optional NEW-MESSAGE allows you to +change the displayed message." + (let ((parameters (cdr reporter))) + (when new-message + (aset parameters 3 new-message)) + (when (aref parameters 0) + (aset parameters 0 (float-time))) + (progress-reporter-do-update reporter value))) + +(defun progress-reporter-do-update (reporter value) + (let* ((parameters (cdr reporter)) + (min-value (aref parameters 1)) + (max-value (aref parameters 2)) + (one-percent (/ (- max-value min-value) 100.0)) + (percentage (truncate (/ (- value min-value) one-percent))) + (update-time (aref parameters 0)) + (current-time (float-time)) + (enough-time-passed + ;; See if enough time has passed since the last update. + (or (not update-time) + (when (>= current-time update-time) + ;; Calculate time for the next update + (aset parameters 0 (+ update-time (aref parameters 5))))))) + ;; + ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print + ;; message this time because not enough time has passed, then use + ;; 1 instead of MIN-CHANGE. This makes delays between echo area + ;; updates closer to MIN-TIME. + (setcar reporter + (min (+ min-value (* (+ percentage + (if enough-time-passed + (aref parameters 4) ;; MIN-CHANGE + 1)) + one-percent)) + max-value)) + (when (integerp value) + (setcar reporter (ceiling (car reporter)))) + ;; + ;; Only print message if enough time has passed + (when enough-time-passed + (if (> percentage 0) + (message "%s%d%%" (aref parameters 3) percentage) + (message "%s" (aref parameters 3)))))) + +(defun progress-reporter-done (reporter) + "Print reporter's message followed by word \"done\" in echo area." + (message "%sdone" (aref (cdr reporter) 3))) + +;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc ;;; subr.el ends here