diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 411 |
1 files changed, 342 insertions, 69 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 95783205ca2..5182dfdadd1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -80,6 +80,7 @@ For more information, see Info node `(elisp)Declaring Functions'." (defmacro noreturn (form) "Evaluate FORM, expecting it not to return. If FORM does return, signal an error." + (declare (debug t)) `(prog1 ,form (error "Form marked with `noreturn' did return"))) @@ -87,6 +88,7 @@ If FORM does return, signal an error." "Evaluate FORM, expecting a constant return value. This is the global do-nothing version. There is also `testcover-1value' that complains if FORM ever does return differing values." + (declare (debug t)) form) (defmacro def-edebug-spec (symbol spec) @@ -193,11 +195,6 @@ value of last one, or nil if there are none. (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) -(if (null (featurep 'cl)) - (progn - ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'. - (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each car from LIST, in turn. @@ -220,9 +217,7 @@ Then evaluate RESULT to get return value, default nil. (let ((,(car spec) (car ,temp))) ,@body (setq ,temp (cdr ,temp)))) - ,@(if (cdr (cdr spec)) - ;; FIXME: This let often leads to "unused var" warnings. - `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) + ,@(cdr (cdr spec))) `(let ((,temp ,(nth 1 spec)) ,(car spec)) (while ,temp @@ -269,16 +264,22 @@ the return value (nil if RESULT is omitted). ,@(cdr (cdr spec)))))) (defmacro declare (&rest _specs) - "Do not evaluate any arguments and return nil. -Treated as a declaration when used at the right place in a -`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" + "Do not evaluate any arguments, and return nil. +If a `declare' form appears as the first form in the body of a +`defun' or `defmacro' form, SPECS specifies various additional +information about the function or macro; these go into effect +during the evaluation of the `defun' or `defmacro' form. + +The possible values of SPECS are specified by +`defun-declarations-alist' and `macro-declarations-alist'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) -)) (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. -Otherwise, return result of last form in BODY." +Otherwise, return result of last form in BODY. +See also `with-demoted-errors' that does something similar +without silencing all errors." (declare (debug t) (indent 0)) `(condition-case nil (progn ,@body) (error nil))) @@ -457,18 +458,18 @@ If TEST is omitted or nil, `equal' is used." (setq tail (cdr tail))) value)) -(make-obsolete 'assoc-ignore-case 'assoc-string "22.1") (defun assoc-ignore-case (key alist) "Like `assoc', but ignores differences in case and text representation. KEY must be a string. Upper-case and lower-case letters are treated as equal. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist t)) -(make-obsolete 'assoc-ignore-representation 'assoc-string "22.1") (defun assoc-ignore-representation (key alist) "Like `assoc', but ignores differences in text representation. KEY must be a string. Unibyte strings are converted to multibyte for comparison." + (declare (obsolete assoc-string "22.1")) (assoc-string key alist nil)) (defun member-ignore-case (elt list) @@ -1175,12 +1176,13 @@ be a list of the form returned by `event-start' and `event-end'." "Mocklisp-compatibility insert function. Like the function `insert' except that any argument that is a number is converted into a string by expressing it in decimal." + (declare (obsolete insert "22.1")) (dolist (el args) (insert (if (integerp el) (number-to-string el) el)))) -(make-obsolete 'insert-string 'insert "22.1") -(defun makehash (&optional test) (make-hash-table :test (or test 'eql))) -(make-obsolete 'makehash 'make-hash-table "22.1") +(defun makehash (&optional test) + (declare (obsolete make-hash-table "22.1")) + (make-hash-table :test (or test 'eql))) ;; These are used by VM and some old programs (defalias 'focus-frame 'ignore "") @@ -1189,8 +1191,6 @@ is converted into a string by expressing it in decimal." (make-obsolete 'unfocus-frame "it does nothing." "22.1") (make-obsolete 'make-variable-frame-local "explicitly check for a frame-parameter instead." "22.2") -(make-obsolete 'interactive-p 'called-interactively-p "23.2") -(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1") (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") @@ -1246,26 +1246,14 @@ is converted into a string by expressing it in decimal." (make-obsolete 'process-filter-multibyte-p nil "23.1") (make-obsolete 'set-process-filter-multibyte nil "23.1") -(make-obsolete-variable - 'mode-line-inverse-video - "use the appropriate faces instead." - "21.1") -(make-obsolete-variable - 'unread-command-char - "use `unread-command-events' instead. That variable is a list of events -to reread, so it now uses nil to mean `no event', instead of -1." - "before 19.15") - ;; Lisp manual only updated in 22.1. (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro "before 19.34") -(defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions) -(make-obsolete-variable 'x-lost-selection-hooks - 'x-lost-selection-functions "22.1") -(defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions) -(make-obsolete-variable 'x-sent-selection-hooks - 'x-sent-selection-functions "22.1") +(define-obsolete-variable-alias 'x-lost-selection-hooks + 'x-lost-selection-functions "22.1") +(define-obsolete-variable-alias 'x-sent-selection-hooks + 'x-sent-selection-functions "22.1") ;; This was introduced in 21.4 for pre-unicode unification. That ;; usage was rendered obsolete in 23.1 which uses Unicode internally. @@ -1548,7 +1536,7 @@ if it is empty or a duplicate." (or keep-all (not (equal (car history) newelt)))) (if history-delete-duplicates - (delete newelt history)) + (setq history (delete newelt history))) (setq history (cons newelt history)) (when (integerp maxelt) (if (= 0 maxelt) @@ -1912,8 +1900,8 @@ This function is called directly from the C code." "Read the following input sexp, and run it whenever FILE is loaded. This makes or adds to an entry on `after-load-alist'. FILE should be the name of a library, with no directory name." + (declare (obsolete eval-after-load "23.2")) (eval-after-load file (read))) -(make-obsolete 'eval-next-after-load `eval-after-load "23.2") (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. @@ -2143,6 +2131,15 @@ any other non-digit terminates the character code and is then used as input.")) (setq first nil)) code)) +(defvar read-passwd-map + ;; BEWARE: `defconst' would purecopy it, breaking the sharing with + ;; minibuffer-local-map along the way! + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570 + map) + "Keymap used while reading passwords.") + (defun read-passwd (prompt &optional confirm default) "Read a password, prompting with PROMPT, and return it. If optional CONFIRM is non-nil, read the password twice to make sure. @@ -2179,7 +2176,10 @@ by doing (clear-string STRING)." (lambda () (setq minibuf (current-buffer)) ;; Turn off electricity. - (set (make-local-variable 'post-self-insert-hook) nil) + (setq-local post-self-insert-hook nil) + (setq-local buffer-undo-list t) + (setq-local select-active-regions nil) + (use-local-map read-passwd-map) (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect (let ((enable-recursive-minibuffers t)) @@ -2237,7 +2237,8 @@ keyboard-quit events while waiting for a valid input." (error "Called `read-char-choice' without valid char choices")) (let (char done show-help (helpbuf " *Char Help*")) (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro)) + (executing-kbd-macro executing-kbd-macro) + (esc-flag nil)) (save-window-excursion ; in case we call help-form-show (while (not done) (unless (get-text-property 0 'face prompt) @@ -2261,8 +2262,12 @@ keyboard-quit events while waiting for a valid input." ;; there are no more events in the macro. Attempt to ;; get an event interactively. (setq executing-kbd-macro nil)) - ((and (not inhibit-keyboard-quit) (eq char ?\C-g)) - (keyboard-quit)))))) + ((not inhibit-keyboard-quit) + (cond + ((and (null esc-flag) (eq char ?\e)) + (setq esc-flag t)) + ((memq char '(?\C-g ?\e)) + (keyboard-quit)))))))) ;; Display the question with the answer. But without cursor-in-echo-area. (message "%s%s" prompt (char-to-string char)) char)) @@ -2314,11 +2319,19 @@ floating point support." PROMPT is the string to display to ask the question. It should end in a space; `y-or-n-p' adds \"(y or n) \" to it. -No confirmation of the answer is requested; a single character is enough. -Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses -the bindings in `query-replace-map'; see the documentation of that variable -for more information. In this case, the useful bindings are `act', `skip', -`recenter', and `quit'.\) +No confirmation of the answer is requested; a single character is +enough. SPC also means yes, and DEL means no. + +To be precise, this function translates user input into responses +by consulting the bindings in `query-replace-map'; see the +documentation of that variable for more information. In this +case, the useful bindings are `act', `skip', `recenter', +`scroll-up', `scroll-down', and `quit'. +An `act' response means yes, and a `skip' response means no. +A `quit' response means to invoke `keyboard-quit'. +If the user enters `recenter', `scroll-up', or `scroll-down' +responses, perform the requested window recentering or scrolling +and ask again. Under a windowing system a dialog box will be used if `last-nonmenu-event' is nil and `use-dialog-box' is non-nil." @@ -2350,21 +2363,33 @@ is nil and `use-dialog-box' is non-nil." "" " ") "(y or n) ")) (while - (let* ((key + (let* ((scroll-actions '(recenter scroll-up scroll-down + scroll-other-window scroll-other-window-down)) + (key (let ((cursor-in-echo-area t)) (when minibuffer-auto-raise (raise-frame (window-frame (minibuffer-window)))) - (read-key (propertize (if (eq answer 'recenter) + (read-key (propertize (if (memq answer scroll-actions) prompt (concat "Please answer y or n. " prompt)) 'face 'minibuffer-prompt))))) (setq answer (lookup-key query-replace-map (vector key) t)) (cond - ((memq answer '(skip act)) nil) - ((eq answer 'recenter) (recenter) t) - ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) - (t t))) + ((memq answer '(skip act)) nil) + ((eq answer 'recenter) + (recenter) t) + ((eq answer 'scroll-up) + (ignore-errors (scroll-up-command)) t) + ((eq answer 'scroll-down) + (ignore-errors (scroll-down-command)) t) + ((eq answer 'scroll-other-window) + (ignore-errors (scroll-other-window)) t) + ((eq answer 'scroll-other-window-down) + (ignore-errors (scroll-other-window-down)) t) + ((or (memq answer '(exit-prefix quit)) (eq key ?\e)) + (signal 'quit nil) t) + (t t))) (ding) (discard-input)))) (let ((ret (eq answer 'act))) @@ -2597,13 +2622,14 @@ When the hook runs, the temporary buffer is current. This hook is normally set up with a function to put the buffer in Help mode.") -;; Avoid compiler warnings about this variable, -;; which has a special meaning on certain system types. -(defvar buffer-file-type nil +(defvar-local buffer-file-type nil "Non-nil if the visited file is a binary file. -This variable is meaningful on MS-DOG and Windows NT. +This variable is meaningful on MS-DOG and MS-Windows. On those systems, it is automatically local in every buffer. -On other systems, this variable is normally always nil.") +On other systems, this variable is normally always nil. + +WARNING: This variable is obsolete and will disappear Real Soon Now. +Don't use it!") ;; The `assert' macro from the cl package signals ;; `cl-assertion-failed' at runtime so always define it. @@ -2622,13 +2648,17 @@ See also `locate-user-emacs-file'.") (defun locate-user-emacs-file (new-name &optional old-name) "Return an absolute per-user Emacs-specific file name. -If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. +If NEW-NAME exists in `user-emacs-directory', return it. +Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. Else return NEW-NAME in `user-emacs-directory', creating the directory if it does not exist." (convert-standard-filename (let* ((home (concat "~" (or init-file-user ""))) - (at-home (and old-name (expand-file-name old-name home)))) - (if (and at-home (file-readable-p at-home)) + (at-home (and old-name (expand-file-name old-name home))) + (bestname (abbreviate-file-name + (expand-file-name new-name user-emacs-directory)))) + (if (and at-home (not (file-readable-p bestname)) + (file-readable-p at-home)) at-home ;; Make sure `user-emacs-directory' exists, ;; unless we're in batch mode or dumping Emacs @@ -2642,11 +2672,14 @@ directory if it does not exist." (set-default-file-modes ?\700) (make-directory user-emacs-directory)) (set-default-file-modes umask)))) - (abbreviate-file-name - (expand-file-name new-name user-emacs-directory)))))) + bestname)))) ;;;; Misc. useful functions. +(defsubst buffer-narrowed-p () + "Return non-nil if the current buffer is narrowed." + (/= (- (point-max) (point-min)) (buffer-size))) + (defun find-tag-default () "Determine default tag to search for, based on text at point. If there is no plausible default, return nil." @@ -2769,6 +2802,12 @@ Otherwise, return nil." Otherwise, return nil." (and (memq object '(nil t)) t)) +(defun special-form-p (object) + "Non-nil if and only if OBJECT is a special form." + (if (and (symbolp object) (fboundp object)) + (setq object (indirect-function object))) + (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) + (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." (let ((raw-field (get-char-property (field-beginning pos) 'field))) @@ -2910,8 +2949,8 @@ They default to the values of (point-min) and (point-max) in BUFFER." BUFFER may be a buffer or a buffer name. Arguments START and END are character positions specifying the substring. They default to the values of (point-min) and (point-max) in BUFFER. -Strip text properties from the inserted text according to -`yank-excluded-properties'." +Before insertion, process text properties according to +`yank-handled-properties' and `yank-excluded-properties'." ;; Since the buffer text should not normally have yank-handler properties, ;; there is no need to handle them here. (let ((opoint (point))) @@ -3110,6 +3149,46 @@ in which case `save-window-excursion' cannot help." (unwind-protect (progn ,@body) (set-window-configuration ,c))))) +(defun internal-temp-output-buffer-show (buffer) + "Internal function for `with-output-to-temp-buffer'." + (with-current-buffer buffer + (set-buffer-modified-p nil) + (goto-char (point-min))) + + (if temp-buffer-show-function + (funcall temp-buffer-show-function buffer) + (with-current-buffer buffer + (let* ((window + (let ((window-combination-limit + ;; When `window-combination-limit' equals + ;; `temp-buffer' or `temp-buffer-resize' and + ;; `temp-buffer-resize-mode' is enabled in this + ;; buffer bind it to t so resizing steals space + ;; preferably from the window that was split. + (if (or (eq window-combination-limit 'temp-buffer) + (and (eq window-combination-limit + 'temp-buffer-resize) + temp-buffer-resize-mode)) + t + window-combination-limit))) + (display-buffer buffer))) + (frame (and window (window-frame window)))) + (when window + (unless (eq frame (selected-frame)) + (make-frame-visible frame)) + (setq minibuffer-scroll-window window) + (set-window-hscroll window 0) + ;; Don't try this with NOFORCE non-nil! + (set-window-start window (point-min) t) + ;; This should not be necessary. + (set-window-point window (point-min)) + ;; Run `temp-buffer-show-hook', with the chosen window selected. + (with-selected-window window + (run-hooks 'temp-buffer-show-hook)))))) + ;; Return nil. + nil) + +;; Doc is very similar to with-temp-buffer-window. (defmacro with-output-to-temp-buffer (bufname &rest body) "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. @@ -3135,7 +3214,9 @@ with the buffer BUFNAME temporarily current. It runs the hook `temp-buffer-show-hook' after displaying buffer BUFNAME, with that buffer temporarily current, and the window that was used to display it temporarily selected. But it doesn't run `temp-buffer-show-hook' -if it uses `temp-buffer-show-function'." +if it uses `temp-buffer-show-function'. + +See the related form `with-temp-buffer-window'." (declare (debug t)) (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) @@ -3728,7 +3809,7 @@ from `standard-syntax-table' otherwise." table)) (defun syntax-after (pos) - "Return the raw syntax of the char after POS. + "Return the raw syntax descriptor for the char after POS. If POS is outside the buffer's accessible portion, return nil." (unless (or (< pos (point-min)) (>= pos (point-max))) (let ((st (if parse-sexp-lookup-properties @@ -3737,7 +3818,12 @@ If POS is outside the buffer's accessible portion, return nil." (aref (or st (syntax-table)) (char-after pos)))))) (defun syntax-class (syntax) - "Return the syntax class part of the syntax descriptor SYNTAX. + "Return the code for the syntax class described by SYNTAX. + +SYNTAX should be a raw syntax descriptor; the return value is a +integer which encodes the corresponding syntax class. See Info +node `(elisp)Syntax Table Internals' for a list of codes. + If SYNTAX is nil, return nil." (and syntax (logand (car syntax) 65535))) @@ -3761,7 +3847,7 @@ This is used on the `modification-hooks' property of text clones." (if (not (re-search-forward (overlay-get ol1 'text-clone-syntax) cend t)) ;; Mark the overlay for deletion. - (overlay-put ol1 'text-clones nil) + (setq end cbeg) (when (< (match-end 0) cend) ;; Shrink the clone at its end. (setq end (min end (match-end 0))) @@ -3876,7 +3962,163 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) +(defvar called-interactively-p-functions nil + "Special hook called to skip special frames in `called-interactively-p'. +The functions are called with 3 arguments: (I FRAME1 FRAME2), +where FRAME1 is a \"current frame\", FRAME2 is the next frame, +I is the index of the frame after FRAME2. It should return nil +if those frames don't seem special and otherwise, it should return +the number of frames to skip (minus 1).") + +(defmacro internal--called-interactively-p--get-frame (n) + ;; `sym' will hold a global variable, which will be used kind of like C's + ;; "static" variables. + (let ((sym (make-symbol "base-index"))) + `(progn + (defvar ,sym + (let ((i 1)) + (while (not (eq (nth 1 (backtrace-frame i)) + 'called-interactively-p)) + (setq i (1+ i))) + i)) + ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) + ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) + (backtrace-frame (+ ,sym ,n))))) + +(defun called-interactively-p (&optional kind) + "Return t if the containing function was called by `call-interactively'. +If KIND is `interactive', then only return t if the call was made +interactively by the user, i.e. not in `noninteractive' mode nor +when `executing-kbd-macro'. +If KIND is `any', on the other hand, it will return t for any kind of +interactive call, including being called as the binding of a key or +from a keyboard macro, even in `noninteractive' mode. + +This function is very brittle, it may fail to return the intended result when +the code is debugged, advised, or instrumented in some form. Some macros and +special forms (such as `condition-case') may also sometimes wrap their bodies +in a `lambda', so any call to `called-interactively-p' from those bodies will +indicate whether that lambda (rather than the surrounding function) was called +interactively. + +Instead of using this function, it is cleaner and more reliable to give your +function an extra optional argument whose `interactive' spec specifies +non-nil unconditionally (\"p\" is a good way to do this), or via +\(not (or executing-kbd-macro noninteractive)). + +The only known proper use of `interactive' for KIND is in deciding +whether to display a helpful message, or how to display it. If you're +thinking of using it for any other purpose, it is quite likely that +you're making a mistake. Think: what do you want to do when the +command is called from a keyboard macro?" + (declare (advertised-calling-convention (kind) "23.1")) + (when (not (and (eq kind 'interactive) + (or executing-kbd-macro noninteractive))) + (let* ((i 1) ;; 0 is the called-interactively-p frame. + frame nextframe + (get-next-frame + (lambda () + (setq frame nextframe) + (setq nextframe (internal--called-interactively-p--get-frame i)) + ;; (message "Frame %d = %S" i nextframe) + (setq i (1+ i))))) + (funcall get-next-frame) ;; Get the first frame. + (while + ;; FIXME: The edebug and advice handling should be made modular and + ;; provided directly by edebug.el and nadvice.el. + (progn + ;; frame =(backtrace-frame i-2) + ;; nextframe=(backtrace-frame i-1) + (funcall get-next-frame) + ;; `pcase' would be a fairly good fit here, but it sometimes moves + ;; branches within local functions, which then messes up the + ;; `backtrace-frame' data we get, + (or + ;; Skip special forms (from non-compiled code). + (and frame (null (car frame))) + ;; Skip also `interactive-p' (because we don't want to know if + ;; interactive-p was called interactively but if it's caller was) + ;; and `byte-code' (idem; this appears in subexpressions of things + ;; like condition-case, which are wrapped in a separate bytecode + ;; chunk). + ;; FIXME: For lexical-binding code, this is much worse, + ;; because the frames look like "byte-code -> funcall -> #[...]", + ;; which is not a reliable signature. + (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; Skip package-specific stack-frames. + (let ((skip (run-hook-with-args-until-success + 'called-interactively-p-functions + i frame nextframe))) + (pcase skip + (`nil nil) + (`0 t) + (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) + ;; Now `frame' should be "the function from which we were called". + (pcase (cons frame nextframe) + ;; No subr calls `interactive-p', so we can rule that out. + (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) + ;; Somehow, I sometimes got `command-execute' rather than + ;; `call-interactively' on my stacktrace !? + ;;(`(,_ . (t command-execute . ,_)) t) + (`(,_ . (t call-interactively . ,_)) t))))) + +(defun interactive-p () + "Return t if the containing function was run directly by user input. +This means that the function was called with `call-interactively' +\(which includes being called as the binding of a key) +and input is currently coming from the keyboard (not a keyboard macro), +and Emacs is not running in batch mode (`noninteractive' is nil). + +The only known proper use of `interactive-p' is in deciding whether to +display a helpful message, or how to display it. If you're thinking +of using it for any other purpose, it is quite likely that you're +making a mistake. Think: what do you want to do when the command is +called from a keyboard macro or in batch mode? + +To test whether your function was called with `call-interactively', +either (i) add an extra optional argument and give it an `interactive' +spec that specifies non-nil unconditionally (such as \"p\"); or (ii) +use `called-interactively-p'." + (declare (obsolete called-interactively-p "23.2")) + (called-interactively-p 'interactive)) + +(defun function-arity (f &optional num) + "Return the (MIN . MAX) arity of F. +If the maximum arity is infinite, MAX is `many'. +F can be a function or a macro. +If NUM is non-nil, return non-nil iff F can be called with NUM args." + (if (symbolp f) (setq f (indirect-function f))) + (if (eq (car-safe f) 'macro) (setq f (cdr f))) + (let ((res + (if (subrp f) + (let ((x (subr-arity f))) + (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) + (let* ((args (if (consp f) (cadr f) (aref f 0))) + (max (length args)) + (opt (memq '&optional args)) + (rest (memq '&rest args)) + (min (- max (length opt)))) + (if opt + (cons min (if rest 'many (1- max))) + (if rest + (cons (- max (length rest)) 'many) + (cons min max))))))) + (if (not num) + res + (and (>= num (car res)) + (or (eq 'many (cdr res)) (<= num (cdr res))))))) + (defun set-temporary-overlay-map (map &optional keep-pred) + "Set MAP as a temporary keymap taking precedence over most other keymaps. +Note that this does NOT take precedence over the \"overriding\" maps +`overriding-terminal-local-map' and `overriding-local-map' (or the +`keymap' text property). Unlike those maps, if no match for a key is +found in MAP, the normal key lookup sequence then continues. + +Normally, MAP is used only once. If the optional argument +KEEP-PRED is t, MAP stays active if a key from MAP is used. +KEEP-PRED can also be a function of no arguments: if it returns +non-nil then MAP stays active." (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) (overlaysym (make-symbol "t")) (alist (list (cons overlaysym map))) @@ -3889,6 +4131,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (lookup-key ',map (this-command-keys-vector)))) (t `(funcall ',keep-pred))) + (set ',overlaysym nil) ;Just in case. (remove-hook 'pre-command-hook ',clearfunsym) (setq emulation-mode-map-alists (delq ',alist emulation-mode-map-alists)))))) @@ -4080,6 +4323,36 @@ convenience wrapper around `make-progress-reporter' and friends. nil ,@(cdr (cdr spec))))) +;;;; Support for watching filesystem events. + +(defun inotify-event-p (event) + "Check if EVENT is an inotify event." + (and (listp event) + (>= (length event) 3) + (eq (car event) 'file-inotify))) + +;;;###autoload +(defun inotify-handle-event (event) + "Handle inotify file system monitoring event. +If EVENT is an inotify filewatch event, call its callback. +Otherwise, signal a `filewatch-error'." + (interactive "e") + (unless (inotify-event-p event) + (signal 'filewatch-error (cons "Not a valid inotify event" event))) + (funcall (nth 2 event) (nth 1 event))) + +(defun w32notify-handle-event (event) + "Handle MS-Windows file system monitoring event. +If EVENT is an MS-Windows filewatch event, call its callback. +Otherwise, signal a `filewatch-error'." + (interactive "e") + (if (and (eq (car event) 'file-w32notify) + (= (length event) 3)) + (funcall (nth 2 event) (nth 1 event)) + (signal 'filewatch-error + (cons "Not a valid MS-Windows file-notify event" event)))) + + ;;;; Comparing version strings. (defconst version-separator "." |