X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/71781c31a4860e56434643296eaa303ca43386bb..401857eda39c57bd59a1e3a1dee57fd6420eeab5:/lisp/subr.el diff --git a/lisp/subr.el b/lisp/subr.el index 53dea3e299..0fb4a2ec25 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1,6 +1,6 @@ -;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*- +;;; subr.el --- basic lisp subroutines for Emacs -*- lexical-binding:t -*- -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software +;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2016 Free Software ;; Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -72,7 +72,7 @@ For more information, see Info node `(elisp)Declaring Functions'." If FORM does return, signal an error." (declare (debug t)) `(prog1 ,form - (error "Form marked with ‘noreturn’ did return"))) + (error "Form marked with `noreturn' did return"))) (defmacro 1value (form) "Evaluate FORM, expecting a constant return value. @@ -320,7 +320,7 @@ Defaults to `error'." (mapcar (lambda (parent) (cons parent (or (get parent 'error-conditions) - (error "Unknown signal ‘%s’" parent)))) + (error "Unknown signal `%s'" parent)))) parent)) (cons parent (get parent 'error-conditions))))) (put name 'error-conditions @@ -1503,19 +1503,6 @@ All symbols are bound before the VALUEFORMs are evalled." ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) ,@body)) -(defmacro let-when-compile (bindings &rest body) - "Like `let', but allow for compile time optimization. -Use BINDINGS as in regular `let', but in BODY each usage should -be wrapped in `eval-when-compile'. -This will generate compile-time constants from BINDINGS." - (declare (indent 1) (debug let)) - (cl-progv (mapcar #'car bindings) - (mapcar (lambda (x) (eval (cadr x))) bindings) - (macroexpand-all - (macroexp-progn - body) - macroexpand-all-environment))) - (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\" @@ -1607,7 +1594,7 @@ can do the job." (let* ((sym (cadr list-var)) (append (eval append)) (msg (format-message - "‘add-to-list’ can't use lexical var ‘%s’; use ‘push’ or ‘cl-pushnew’" + "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'" sym)) ;; Big ugly hack so we only output a warning during ;; byte-compilation, and so we can use @@ -2099,6 +2086,10 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (aref keys 1) key))) (cancel-timer timer) + ;; For some reason, `read-key(-sequence)' leaves the prompt in the echo + ;; area, whereas `read-event' seems to empty it just before returning + ;; (bug#22714). So, let's mimic the behavior of `read-event'. + (message nil) (use-global-map old-global-map)))) (defvar read-passwd-map @@ -2208,7 +2199,7 @@ Any input that is not one of CHARS is ignored. If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore keyboard-quit events while waiting for a valid input." (unless (consp chars) - (error "Called ‘read-char-choice’ without valid char choices")) + (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) @@ -2277,7 +2268,18 @@ floating point support." t) ((input-pending-p t) nil) - ((<= seconds 0) + ((or (<= seconds 0) + ;; We are going to call read-event below, which will record + ;; the the next key as part of the macro, even if that key + ;; invokes kmacro-end-macro, so if we are recording a macro, + ;; the macro will recursively call itself. In addition, when + ;; that key is removed from unread-command-events, it will be + ;; recorded the second time, so the macro will have each key + ;; doubled. This used to happen if a macro was defined with + ;; Flyspell mode active (because Flyspell calls sit-for in its + ;; post-command-hook, see bug #21329.) To avoid all that, we + ;; simply disable the wait when we are recording a macro. + defining-kbd-macro) (or nodisp (redisplay))) (t (or nodisp (redisplay)) @@ -2628,29 +2630,7 @@ See also `locate-user-emacs-file'.") "Determine the boundaries of the default tag, based on text at point. Return a cons cell with the beginning and end of the found tag. If there is no plausible default, return nil." - (let (from to bound) - (when (or (progn - ;; Look at text around `point'. - (save-excursion - (skip-syntax-backward "w_") (setq from (point))) - (save-excursion - (skip-syntax-forward "w_") (setq to (point))) - (> to from)) - ;; Look between `line-beginning-position' and `point'. - (save-excursion - (and (setq bound (line-beginning-position)) - (skip-syntax-backward "^w_" bound) - (> (setq to (point)) bound) - (skip-syntax-backward "w_") - (setq from (point)))) - ;; Look between `point' and `line-end-position'. - (save-excursion - (and (setq bound (line-end-position)) - (skip-syntax-forward "^w_" bound) - (< (setq from (point)) bound) - (skip-syntax-forward "w_") - (setq to (point))))) - (cons from to)))) + (bounds-of-thing-at-point 'symbol)) (defun find-tag-default () "Determine default tag to search for, based on text at point. @@ -2713,7 +2693,11 @@ Note: :data and :device are currently not supported on Windows." (declare-function w32-shell-dos-semantics "w32-fns" nil) (defun shell-quote-argument (argument) - "Quote ARGUMENT for passing as argument to an inferior shell." + "Quote ARGUMENT for passing as argument to an inferior shell. + +This function is designed to work with the syntax of your system's +standard shell, and might produce incorrect results with unusual shells. +See Info node `(elisp)Security Considerations'." (cond ((eq system-type 'ms-dos) ;; Quote using double quotes, but escape any existing quotes in @@ -3906,7 +3890,7 @@ If the feature is provided when evaluating code not associated with a file, FORM is evaluated immediately after the provide statement. Usually FILE is just a library name like \"font-lock\" or a feature name -like 'font-lock. +like `font-lock'. This function makes or adds to an entry on `after-load-alist'." (declare (compiler-macro @@ -3961,7 +3945,8 @@ This function makes or adds to an entry on `after-load-alist'." (defmacro with-eval-after-load (file &rest body) "Execute BODY after FILE is loaded. FILE is normally a feature name, but it can also be a file name, -in case that file does not provide any feature." +in case that file does not provide any feature. See `eval-after-load' +for more details about the different forms of FILE and their semantics." (declare (indent 1) (debug t)) `(eval-after-load ,file (lambda () ,@body))) @@ -4122,6 +4107,41 @@ If SYNTAX is nil, return nil." ;; Utility motion commands +(defvar word-move-empty-char-table nil + "Used in `forward-word-strictly' and `backward-word-strictly' +to countermand the effect of `find-word-boundary-function-table'.") + +(defun forward-word-strictly (&optional arg) + "Move point forward ARG words (backward if ARG is negative). +If ARG is omitted or nil, move point forward one word. +Normally returns t. +If an edge of the buffer or a field boundary is reached, point is left there +and the function returns nil. Field boundaries are not noticed if +`inhibit-field-text-motion' is non-nil. + +This function is like `forward-word', but it is not affected +by `find-word-boundary-function-table' (as set up by +e.g. `subword-mode'). It is also not interactive." + (let ((find-word-boundary-function-table + (if (char-table-p word-move-empty-char-table) + word-move-empty-char-table + (setq word-move-empty-char-table (make-char-table nil))))) + (forward-word (or arg 1)))) + +(defun backward-word-strictly (&optional arg) + "Move backward until encountering the beginning of a word. +With argument ARG, do this that many times. +If ARG is omitted or nil, move point backward one word. + +This function is like `forward-word', but it is not affected +by `find-word-boundary-function-table' (as set up by +e.g. `subword-mode'). It is also not interactive." + (let ((find-word-boundary-function-table + (if (char-table-p word-move-empty-char-table) + word-move-empty-char-table + (setq word-move-empty-char-table (make-char-table nil))))) + (forward-word (- (or arg 1))))) + ;; Whitespace (defun forward-whitespace (arg) @@ -4684,14 +4704,14 @@ Usually the separator is \".\", but it can be any other string.") (defconst version-regexp-alist - '(("^[-_+ ]?snapshot$" . -4) + '(("^[-._+ ]?snapshot$" . -4) ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases - ("^[-_+]$" . -4) + ("^[-._+]$" . -4) ;; treat "1.2.3-CVS" as snapshot release - ("^[-_+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4) - ("^[-_+ ]?alpha$" . -3) - ("^[-_+ ]?beta$" . -2) - ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) + ("^[-._+ ]?\\(cvs\\|git\\|bzr\\|svn\\|hg\\|darcs\\)$" . -4) + ("^[-._+ ]?alpha$" . -3) + ("^[-._+ ]?beta$" . -2) + ("^[-._+ ]?\\(pre\\|rc\\)$" . -1)) "Specify association between non-numeric version and its priority. This association is used to handle version string like \"1.0pre2\", @@ -4701,6 +4721,7 @@ non-numeric part of a version string to an integer. For example: String Version Integer List Version \"0.9snapshot\" (0 9 -4) \"1.0-git\" (1 0 -4) + \"1.0.cvs\" (1 0 -4) \"1.0pre2\" (1 0 -1 2) \"1.0PRE2\" (1 0 -1 2) \"22.8beta3\" (22 8 -2 3) @@ -4740,41 +4761,47 @@ in `version-regexp-alist'. Examples of valid version syntax: - 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta + 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta 2.4.snapshot .5 Examples of invalid version syntax: - 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5 + 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 Examples of version conversion: Version String Version as a List of Integers - \"1.0.7.5\" (1 0 7 5) - \"1.0pre2\" (1 0 -1 2) - \"1.0PRE2\" (1 0 -1 2) - \"22.8beta3\" (22 8 -2 3) - \"22.8Beta3\" (22 8 -2 3) - \"0.9alpha1\" (0 9 -3 1) + \".5\" (0 5) + \"0.9 alpha\" (0 9 -3) \"0.9AlphA1\" (0 9 -3 1) - \"0.9alpha\" (0 9 -3) \"0.9snapshot\" (0 9 -4) \"1.0-git\" (1 0 -4) + \"1.0.7.5\" (1 0 7 5) + \"1.0.cvs\" (1 0 -4) + \"1.0PRE2\" (1 0 -1 2) + \"1.0pre2\" (1 0 -1 2) + \"22.8 Beta3\" (22 8 -2 3) + \"22.8beta3\" (22 8 -2 3) See documentation for `version-separator' and `version-regexp-alist'." - (or (and (stringp ver) (> (length ver) 0)) - (error "Invalid version string: ‘%s’" ver)) + (unless (stringp ver) + (error "Version must be a string")) ;; Change .x.y to 0.x.y (if (and (>= (length ver) (length version-separator)) (string-equal (substring ver 0 (length version-separator)) version-separator)) (setq ver (concat "0" ver))) + (unless (string-match-p "^[0-9]" ver) + (error "Invalid version syntax: `%s' (must start with a number)" ver)) + (save-match-data (let ((i 0) (case-fold-search t) ; ignore case in matching lst s al) + ;; Parse the version-string up to a separator until there are none left (while (and (setq s (string-match "[0-9]+" ver i)) (= s i)) - ;; handle numeric part + ;; Add the numeric part to the beginning of the version list; + ;; lst gets reversed at the end (setq lst (cons (string-to-number (substring ver i (match-end 0))) lst) i (match-end 0)) @@ -4790,15 +4817,15 @@ See documentation for `version-separator' and `version-regexp-alist'." (setq al (cdr al))) (cond (al (push (cdar al) lst)) - ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc. - ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s) + ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc., but only if + ;; the letter is the end of the version-string, to avoid + ;; 22.8X3 being valid + ((and (string-match "^[-._+ ]?\\([a-zA-Z]\\)$" s) + (= i (length ver))) (push (- (aref (downcase (match-string 1 s)) 0) ?a -1) lst)) - (t (error "Invalid version syntax: ‘%s’" ver)))))) - (if (null lst) - (error "Invalid version syntax: ‘%s’" ver) - (nreverse lst))))) - + (t (error "Invalid version syntax: `%s'" ver)))))) + (nreverse lst)))) (defun version-list-< (l1 l2) "Return t if L1, a list specification of a version, is lower than L2.