diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 156 |
1 files changed, 110 insertions, 46 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index 2b3231b879b..23e4dcfa7ed 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -193,9 +193,9 @@ except that PLACE is evaluated only once (after NEWELT)." (list 'setq place (list 'cons newelt place)) (require 'macroexp) - (macroexp-let2 macroexp-copyable-p v newelt + (macroexp-let2 macroexp-copyable-p x newelt (gv-letplace (getter setter) place - (funcall setter `(cons ,v ,getter)))))) + (funcall setter `(cons ,x ,getter)))))) (defmacro pop (place) "Return the first element of PLACE's value, and remove it from the list. @@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil. ;; use dolist. ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dolist-tail--)) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other is slightly faster (and has cleaner semantics) - ;; with lexical scoping. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other is + ;; slightly faster (and has cleaner semantics) with lexical scoping. (if lexical-binding `(let ((,temp ,(nth 1 spec))) (while ,temp @@ -280,8 +279,11 @@ Then evaluate RESULT to get return value, default nil. (defmacro dotimes (spec &rest body) "Loop a certain number of times. Evaluate BODY with VAR bound to successive integers running from 0, -inclusive, to COUNT, exclusive. Then evaluate RESULT to get -the return value (nil if RESULT is omitted). Its use is deprecated. +inclusive, to COUNT, exclusive. + +Finally RESULT is evaluated to get the return value (nil if +RESULT is omitted). Using RESULT is deprecated, and may result +in compilation warnings about unused variables. \(fn (VAR COUNT [RESULT]) BODY...)" (declare (indent 1) (debug dolist)) @@ -292,9 +294,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated. (let ((temp '--dotimes-limit--) (start 0) (end (nth 1 spec))) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other has cleaner semantics. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other has + ;; cleaner semantics. (if lexical-binding (let ((counter '--dotimes-counter--)) `(let ((,temp ,end) @@ -767,7 +769,6 @@ If that is non-nil, the element matches; then `assoc-default' If no element matches, the value is nil. If TEST is omitted or nil, `equal' is used." - (declare (side-effect-free t)) (let (found (tail alist) value) (while (and tail (not found)) (let ((elt (car tail))) @@ -884,6 +885,10 @@ side-effects, and the argument LIST is not modified." ;;;; Keymap support. +;; Declare before first use of `save-match-data', +;; where it is used internally. +(defvar save-match-data-internal) + (defun kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string in the format returned by commands such @@ -894,8 +899,9 @@ This is the same format used for saving keyboard macros (see For an approximate inverse of this, see `key-description'." ;; Don't use a defalias, since the `pure' property is true only for ;; the calling convention of `kbd'. - (read-kbd-macro keys)) -(put 'kbd 'pure t) + (declare (pure t)) + ;; A pure function is expected to preserve the match data. + (save-match-data (read-kbd-macro keys))) (defun undefined () "Beep to tell the user this binding is undefined." @@ -1558,7 +1564,6 @@ be a list of the form returned by `event-start' and `event-end'." ;;;; Obsolescent names for functions. -(make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") (make-obsolete 'buffer-has-markers-at nil "24.3") (make-obsolete 'invocation-directory "use the variable of the same name." @@ -1604,8 +1609,6 @@ be a list of the form returned by `event-start' and `event-end'." (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") (make-obsolete 'run-window-configuration-change-hook nil "27.1") -(make-obsolete 'process-filter-multibyte-p nil "23.1") -(make-obsolete 'set-process-filter-multibyte nil "23.1") (make-obsolete-variable 'command-debug-status "expect it to be removed in a future version." "25.2") @@ -1621,6 +1624,9 @@ be a list of the form returned by `event-start' and `event-end'." (defvaralias 'messages-buffer-max-lines 'message-log-max) (define-obsolete-variable-alias 'inhibit-null-byte-detection 'inhibit-nul-byte-detection "27.1") +(make-obsolete-variable 'load-dangerous-libraries + "no longer used." "27.1") + ;;;; Alternate names for functions - these are not being phased out. @@ -1645,7 +1651,8 @@ be a list of the form returned by `event-start' and `event-end'." (defalias 'point-at-eol 'line-end-position) (defalias 'point-at-bol 'line-beginning-position) -(defalias 'user-original-login-name 'user-login-name) +(define-obsolete-function-alias 'user-original-login-name + 'user-login-name "28.1") ;;;; Hook manipulation functions. @@ -1774,6 +1781,21 @@ all symbols are bound before any of the VALUEFORMs are evalled." ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) ,@body)) +(defmacro dlet (binders &rest body) + "Like `let*' but using dynamic scoping." + (declare (indent 1) (debug let)) + ;; (defvar FOO) only affects the current scope, but in order for + ;; this not to affect code after the `let*' we need to create a new scope, + ;; which is what the surrounding `let' is for. + ;; FIXME: (let () ...) currently doesn't actually create a new scope, + ;; which is why we use (let (_) ...). + `(let (_) + ,@(mapcar (lambda (binder) + `(defvar ,(if (consp binder) (car binder) binder))) + binders) + (let* ,binders ,@body))) + + (defmacro with-wrapper-hook (hook args &rest body) "Run BODY, using wrapper functions from HOOK with additional ARGS. HOOK is an abnormal hook. Each hook function in HOOK \"wraps\" @@ -1804,6 +1826,7 @@ FUN is then called once." (defmacro subr--with-wrapper-hook-no-warnings (hook args &rest body) "Like (with-wrapper-hook HOOK ARGS BODY), but without warnings." + (declare (debug (form sexp body))) ;; We need those two gensyms because CL's lexical scoping is not available ;; for function arguments :-( (let ((funs (make-symbol "funs")) @@ -2263,6 +2286,8 @@ Otherwise TYPE is assumed to be a symbol property." (not (eq 'require (car match))))))) (throw 'found file)))))) +(declare-function read-library-name "find-func" nil) + (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. LIBRARY should be a relative file name of the library, a string. @@ -2279,12 +2304,7 @@ is used instead of `load-path'. When called from a program, the file name is normally returned as a string. When run interactively, the argument INTERACTIVE-CALL is t, and the file name is displayed in the echo area." - (interactive (list (completing-read "Locate library: " - (apply-partially - 'locate-file-completion-table - load-path (get-load-suffixes))) - nil nil - t)) + (interactive (list (read-library-name) nil nil t)) (let ((file (locate-file library (or path load-path) (append (unless nosuffix (get-load-suffixes)) @@ -2327,13 +2347,19 @@ use `start-file-process'." (if program (list :command (cons program program-args)))))) -(defun process-lines (program &rest args) +(defun process-lines-handling-status (program status-handler &rest args) "Execute PROGRAM with ARGS, returning its output as a list of lines. -Signal an error if the program returns with a non-zero exit status." +If STATUS-HANDLER is non-NIL, it must be a function with one +argument, which will be called with the exit status of the +program before the output is collected. If STATUS-HANDLER is +NIL, an error is signalled if the program returns with a non-zero +exit status." (with-temp-buffer (let ((status (apply 'call-process program nil (current-buffer) nil args))) - (unless (eq status 0) - (error "%s exited with status %s" program status)) + (if status-handler + (funcall status-handler status) + (unless (eq status 0) + (error "%s exited with status %s" program status))) (goto-char (point-min)) (let (lines) (while (not (eobp)) @@ -2344,6 +2370,18 @@ Signal an error if the program returns with a non-zero exit status." (forward-line 1)) (nreverse lines))))) +(defun process-lines (program &rest args) + "Execute PROGRAM with ARGS, returning its output as a list of lines. +Signal an error if the program returns with a non-zero exit status. +Also see `process-lines-ignore-status'." + (apply #'process-lines-handling-status program nil args)) + +(defun process-lines-ignore-status (program &rest args) + "Execute PROGRAM with ARGS, returning its output as a list of lines. +The exit status of the program is ignored. +Also see `process-lines'." + (apply #'process-lines-handling-status program #'identity args)) + (defun process-live-p (process) "Return non-nil if PROCESS is alive. A process is considered alive if its status is `run', `open', @@ -2521,10 +2559,15 @@ by doing (clear-string STRING)." ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -(defun read-number (prompt &optional default) +(defvar read-number-history nil + "The default history for the `read-number' function.") + +(defun read-number (prompt &optional default hist) "Read a numeric value in the minibuffer, prompting with PROMPT. DEFAULT specifies a default value to return if the user just types RET. The value of DEFAULT is inserted into PROMPT. +HIST specifies a history list variable. See `read-from-minibuffer' +for details of the HIST argument. This function is used by the `interactive' code letter `n'." (let ((n nil) (default1 (if (consp default) (car default) default))) @@ -2538,7 +2581,7 @@ This function is used by the `interactive' code letter `n'." (while (progn (let ((str (read-from-minibuffer - prompt nil nil nil nil + prompt nil nil nil (or hist 'read-number-history) (when default (if (consp default) (mapcar 'number-to-string (delq nil default)) @@ -3049,9 +3092,17 @@ If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." o1)) (defun remove-overlays (&optional beg end name val) - "Clear BEG and END of overlays whose property NAME has value VAL. -Overlays might be moved and/or split. -BEG and END default respectively to the beginning and end of buffer." + "Remove overlays between BEG and END that have property NAME with value VAL. +Overlays might be moved and/or split. If any targeted overlays +start before BEG, the overlays will be altered so that they end +at BEG. Likewise, if the targeted overlays end after END, they +will be altered so that they start at END. Overlays that start +at or after BEG and end before END will be removed completely. + +BEG and END default respectively to the beginning and end of the +buffer. +Values are compared with `eq'. +If either NAME or VAL are specified, both should be specified." ;; This speeds up the loops over overlays. (unless beg (setq beg (point-min))) (unless end (setq end (point-max))) @@ -3200,7 +3251,7 @@ See Info node `(elisp)Security Considerations'." ;; First, quote argument so that CommandLineToArgvW will ;; understand it. See - ;; http://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx + ;; https://msdn.microsoft.com/en-us/library/17w5ykft%28v=vs.85%29.aspx ;; After we perform that level of quoting, escape shell ;; metacharacters so that cmd won't mangle our argument. If the ;; argument contains no double quote characters, we can just @@ -3967,7 +4018,7 @@ the function `undo--wrap-and-run-primitive-undo'." (let (;; (inhibit-modification-hooks t) (before-change-functions ;; Ugly Hack: if the body uses syntax-ppss/syntax-propertize - ;; (e.g. via a regexp-search or sexp-movement trigerring + ;; (e.g. via a regexp-search or sexp-movement triggering ;; on-the-fly syntax-propertize), make sure that this gets ;; properly refreshed after subsequent changes. (if (memq #'syntax-ppss-flush-cache before-change-functions) @@ -4009,7 +4060,7 @@ the function `undo--wrap-and-run-primitive-undo'." (defmacro combine-change-calls (beg end &rest body) "Evaluate BODY, running the change hooks just once. -BODY is a sequence of lisp forms to evaluate. BEG and END bound +BODY is a sequence of Lisp forms to evaluate. BEG and END bound the region the change hooks will be run for. Firstly, `before-change-functions' is invoked for the region @@ -4027,7 +4078,8 @@ change `before-change-functions' or `after-change-functions'. Additionally, the buffer modifications of BODY are recorded on the buffer's undo list as a single \(apply ...) entry containing -the function `undo--wrap-and-run-primitive-undo'. " +the function `undo--wrap-and-run-primitive-undo'." + (declare (debug t) (indent 2)) `(combine-change-calls-1 ,beg ,end (lambda () ,@body))) (defun undo--wrap-and-run-primitive-undo (beg end list) @@ -4080,8 +4132,6 @@ MODES is as for `set-default-file-modes'." ;;; Matching and match data. -(defvar save-match-data-internal) - ;; We use save-match-data-internal as the local variable because ;; that works ok in practice (people should not use that variable elsewhere). ;; We used to use an uninterned symbol; the compiler handles that properly @@ -4382,6 +4432,27 @@ Unless optional argument INPLACE is non-nil, return a new string." (aset newstr i tochar))) newstr)) +(defun string-replace (fromstring tostring instring) + "Replace FROMSTRING with TOSTRING in INSTRING each time it occurs." + (declare (pure t)) + (when (equal fromstring "") + (signal 'wrong-length-argument fromstring)) + (let ((start 0) + (result nil) + pos) + (while (setq pos (string-search fromstring instring start)) + (unless (= start pos) + (push (substring instring start pos) result)) + (push tostring result) + (setq start (+ pos (length fromstring)))) + (if (null result) + ;; No replacements were done, so just return the original string. + instring + ;; Get any remaining bit. + (unless (= start (length instring)) + (push (substring instring start) result)) + (apply #'concat (nreverse result))))) + (defun replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace all matches for REGEXP with REP in STRING. @@ -4649,13 +4720,6 @@ This function is called directly from the C code." ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) -(defun eval-next-after-load (file) - "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))) - (defun display-delayed-warnings () "Display delayed warnings from `delayed-warnings-list'. |