;; Beware: while this file has tag `utf-8', before it's compiled, it gets
;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
-(defvar custom-declare-variable-list nil
- "Record `defcustom' calls made before `custom.el' is loaded to handle them.
-Each element of this list holds the arguments to one call to `defcustom'.")
-
-;; Use this, rather than defcustom, in subr.el and other files loaded
-;; before custom.el.
-(defun custom-declare-variable-early (&rest arguments)
- (setq custom-declare-variable-list
- (cons arguments custom-declare-variable-list)))
-
(defmacro declare-function (_fn _file &optional _arglist _fileonly)
"Tell the byte-compiler that function FN is defined, in FILE.
Optional ARGLIST is the argument list used by the function.
If the value is nil, `pop' returns nil but does not actually
change the list."
(declare (debug (gv-place)))
- (list 'car
- (if (symbolp place)
- ;; So we can use `pop' in the bootstrap before `gv' can be used.
- (list 'prog1 place (list 'setq place (list 'cdr place)))
- (gv-letplace (getter setter) place
- `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
+ ;; We use `car-safe' here instead of `car' because the behavior is the same
+ ;; (if it's not a cons cell, the `cdr' would have signaled an error already),
+ ;; but `car-safe' is total, so the byte-compiler can safely remove it if the
+ ;; result is not used.
+ `(car-safe
+ ,(if (symbolp place)
+ ;; So we can use `pop' in the bootstrap before `gv' can be used.
+ (list 'prog1 place (list 'setq place (list 'cdr place)))
+ (gv-letplace (getter setter) place
+ `(prog1 ,getter ,(funcall setter `(cdr ,getter)))))))
(defmacro when (cond &rest body)
"If COND yields non-nil, do BODY, else return nil.
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
- (while t
- (signal 'error (list (apply 'format args)))))
-(set-advertised-calling-convention 'error '(string &rest args) "23.1")
+ (declare (advertised-calling-convention (string &rest args) "23.1"))
+ (signal 'error (list (apply 'format args))))
(defun user-error (format &rest args)
"Signal a pilot error, making error message by passing all args to `format'.
This is just like `error' except that `user-error's are expected to be the
result of an incorrect manipulation on the part of the user, rather than the
result of an actual problem."
- (while t
- (signal 'user-error (list (apply #'format format args)))))
+ (signal 'user-error (list (apply #'format format args))))
+
+(defun define-error (name message &optional parent)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such an error
+is signaled without being caught by a `condition-case'.
+PARENT is either a signal or a list of signals from which it inherits.
+Defaults to `error'."
+ (unless parent (setq parent 'error))
+ (let ((conditions
+ (if (consp parent)
+ (apply #'nconc
+ (mapcar (lambda (parent)
+ (cons parent
+ (or (get parent 'error-conditions)
+ (error "Unknown signal `%s'" parent))))
+ parent))
+ (cons parent (get parent 'error-conditions)))))
+ (put name 'error-conditions
+ (delete-dups (copy-sequence (cons name conditions))))
+ (when message (put name 'error-message message))))
;; We put this here instead of in frame.el so that it's defined even on
;; systems where frame.el isn't loaded.
(defun undefined ()
"Beep to tell the user this binding is undefined."
(interactive)
- (ding))
+ (ding)
+ (message "%s is undefined" (key-description (this-single-command-keys)))
+ (setq defining-kbd-macro nil)
+ (force-mode-line-update)
+ ;; If this is a down-mouse event, don't reset prefix-arg;
+ ;; pass it to the command run by the up event.
+ (setq prefix-arg
+ (when (memq 'down (event-modifiers last-command-event))
+ current-prefix-arg)))
;; Prevent the \{...} documentation construct
;; from mentioning keys that run this command.
'all-completions '(string collection &optional predicate) "23.1")
(set-advertised-calling-convention 'unintern '(name obarray) "23.3")
(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3")
+(set-advertised-calling-convention 'decode-char '(ch charset) "21.4")
+(set-advertised-calling-convention 'encode-char '(ch charset) "21.4")
\f
;;;; Obsolescence declarations for variables, and aliases.
(setq local t)))
(let ((hook-value (if local (symbol-value hook) (default-value hook))))
;; If the hook value is a single function, turn it into a list.
- (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (when (or (not (listp hook-value)) (functionp hook-value))
(setq hook-value (list hook-value)))
;; Do the actual addition if necessary
(unless (member function hook-value)
;; FIXME: Something like this could be used for `set' as well.
(if (or (not (eq 'quote (car-safe list-var)))
(special-variable-p (cadr list-var))
- (and append compare-fn))
+ (not (macroexp-const-p append)))
exp
(let* ((sym (cadr list-var))
+ (append (eval append))
(msg (format "`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
(when (assq sym byte-compile--lexical-environment)
(byte-compile-log-warning msg t :error))))
(code
- (if append
- (macroexp-let2 macroexp-copyable-p x element
- `(unless (member ,x ,sym)
- (setq ,sym (append ,sym (list ,x)))))
- (require 'cl-lib)
- `(cl-pushnew ,element ,sym
- :test ,(or compare-fn '#'equal)))))
+ (macroexp-let2 macroexp-copyable-p x element
+ `(if ,(if compare-fn
+ (progn
+ (require 'cl-lib)
+ `(cl-member ,x ,sym :test ,compare-fn))
+ ;; For bootstrapping reasons, don't rely on
+ ;; cl--compiler-macro-member for the base case.
+ `(member ,x ,sym))
+ ,sym
+ ,(if append
+ `(setq ,sym (append ,sym (list ,x)))
+ `(push ,x ,sym))))))
(if (not (macroexp--compiling-p))
code
`(progn
\f
;;;; Input and display facilities.
-(defvar read-quoted-char-radix 8
- "Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16.")
-
-(custom-declare-variable-early
- 'read-quoted-char-radix 8
- "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
-Legitimate radix values are 8, 10 and 16."
- :type '(choice (const 8) (const 10) (const 16))
- :group 'editing-basics)
-
(defconst read-key-empty-map (make-sparse-keymap))
(defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully.
(cancel-timer timer)
(use-global-map old-global-map))))
-(defun read-quoted-char (&optional prompt)
- "Like `read-char', but do not allow quitting.
-Also, if the first character read is an octal digit,
-we read any number of octal digits and return the
-specified character code. Any nondigit terminates the sequence.
-If the terminator is RET, it is discarded;
-any other terminator is used itself as input.
-
-The optional argument PROMPT specifies a string to use to prompt the user.
-The variable `read-quoted-char-radix' controls which radix to use
-for numeric input."
- (let ((message-log-max nil) done (first t) (code 0) char translated)
- (while (not done)
- (let ((inhibit-quit first)
- ;; Don't let C-h get the help message--only help function keys.
- (help-char nil)
- (help-form
- "Type the special character you want to use,
-or the octal character code.
-RET terminates the character code and is discarded;
-any other non-digit terminates the character code and is then used as input."))
- (setq translated (read-key (and prompt (format "%s-" prompt))))
- (if inhibit-quit (setq quit-flag nil)))
- (if (integerp translated)
- (setq translated (char-resolve-modifiers translated)))
- (cond ((null translated))
- ((not (integerp translated))
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- ((/= (logand translated ?\M-\^@) 0)
- ;; Turn a meta-character into a character with the 0200 bit set.
- (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
- done t))
- ((and (<= ?0 translated)
- (< translated (+ ?0 (min 10 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (<= ?a (downcase translated))
- (< (downcase translated)
- (+ ?a -10 (min 36 read-quoted-char-radix))))
- (setq code (+ (* code read-quoted-char-radix)
- (+ 10 (- (downcase translated) ?a))))
- (and prompt (setq prompt (message "%s %c" prompt translated))))
- ((and (not first) (eq translated ?\C-m))
- (setq done t))
- ((not first)
- (setq unread-command-events
- (listify-key-sequence (this-single-command-raw-keys))
- done t))
- (t (setq code translated
- done t)))
- (setq first nil))
- code))
-
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
;; minibuffer-local-map along the way!
(setq-local buffer-undo-list t)
(setq-local select-active-regions nil)
(use-local-map read-passwd-map)
+ (setq-local inhibit-modification-hooks nil) ;bug#15501.
(add-hook 'after-change-functions hide-chars-fun nil 'local))
(unwind-protect
(let ((enable-recursive-minibuffers t))
(noninteractive
(sleep-for seconds)
t)
- ((input-pending-p)
+ ((input-pending-p t)
nil)
((<= seconds 0)
(or nodisp (redisplay)))
(push read unread-command-events)
nil))))))
+;; Behind display-popup-menus-p test.
+(declare-function x-popup-dialog "xmenu.c" (position contents &optional header))
+
(defun y-or-n-p (prompt)
"Ask user a \"y or n\" question. Return t if answer is \"y\".
PROMPT is the string to display to ask the question. It should
(define-obsolete-function-alias 'redraw-modeline
'force-mode-line-update "24.3")
-(defun force-mode-line-update (&optional all)
- "Force redisplay of the current buffer's mode line and header line.
-With optional non-nil ALL, force redisplay of all mode lines and
-header lines. This function also forces recomputation of the
-menu bar menus and the frame title."
- (if all (with-current-buffer (other-buffer)))
- (set-buffer-modified-p (buffer-modified-p)))
-
(defun momentary-string-display (string pos &optional exit-char message)
"Momentarily display STRING in the buffer at POS.
Display remains until next event is input.
This hook is normally set up with a function to put the buffer in Help
mode.")
-;; The `assert' macro from the cl package signals
-;; `cl-assertion-failed' at runtime so always define it.
-(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed"))
-
(defconst user-emacs-directory
(if (eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot.
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.
See also `locate-user-emacs-file'.")
-
-(custom-declare-variable-early 'user-emacs-directory-warning t
- "Non-nil means warn if cannot access `user-emacs-directory'.
-Set this to nil at your own risk..."
- :type 'boolean
- :group 'initialization
- :version "24.4")
-
-(defun locate-user-emacs-file (new-name &optional old-name)
- "Return an absolute per-user Emacs-specific file 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)))
- (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.
- (or noninteractive
- purify-flag
- (let (errtype)
- (if (file-directory-p user-emacs-directory)
- (or (file-accessible-directory-p user-emacs-directory)
- (setq errtype "access"))
- (let ((umask (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes ?\700)
- (condition-case nil
- (make-directory user-emacs-directory)
- (error (setq errtype "create"))))
- (set-default-file-modes umask))))
- (when (and errtype
- user-emacs-directory-warning
- (not (get 'user-emacs-directory-warning 'this-session)))
- ;; Only warn once per Emacs session.
- (put 'user-emacs-directory-warning 'this-session t)
- (display-warning 'initialization
- (format "\
-Unable to %s `user-emacs-directory' (%s).
-Any data that would normally be written there may be lost!
-If you never want to see this message again,
-customize the variable `user-emacs-directory-warning'."
- errtype user-emacs-directory)))))
- bestname))))
\f
;;;; Misc. useful functions.
(setq object (indirect-function object t)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
+(defun macrop (object)
+ "Non-nil if and only if OBJECT is a macro."
+ (let ((def (indirect-function object t)))
+ (when (consp def)
+ (or (eq 'macro (car def))
+ (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
+
(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)))
val))
\f
;;;; Support for yanking and text properties.
+;; Why here in subr.el rather than in simple.el? --Stef
(defvar yank-handled-properties)
(defvar yank-excluded-properties)
(define-obsolete-function-alias 'condition-case-no-debug
'condition-case-unless-debug "24.1")
-(defmacro with-demoted-errors (&rest body)
+(defmacro with-demoted-errors (format &rest body)
"Run BODY and demote any errors to simple messages.
If `debug-on-error' is non-nil, run BODY without catching its errors.
This is to be used around code which is not expected to signal an error
-but which should be robust in the unexpected case that an error is signaled."
- (declare (debug t) (indent 0))
- (let ((err (make-symbol "err")))
+but which should be robust in the unexpected case that an error is signaled.
+For backward compatibility, if FORMAT is not a constant string, it
+is assumed to be part of BODY, in which case the message format
+used is \"Error: %S\"."
+ (declare (debug t) (indent 1))
+ (let ((err (make-symbol "err"))
+ (format (if (and (stringp format) body) format
+ (prog1 "Error: %S"
+ (if format (push format body))))))
`(condition-case-unless-debug ,err
- (progn ,@body)
- (error (message "Error: %S" ,err) nil))))
+ ,(macroexp-progn body)
+ (error (message ,format ,err) nil))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
possible, stopping when a single additional previous character
cannot be part of a match for REGEXP. When the match is
extended, its starting position is allowed to occur before
-LIMIT."
+LIMIT.
+
+As a general recommendation, try to avoid using `looking-back'
+wherever possible, since it is slow."
(let ((start (point))
(pos
(save-excursion
;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
;; 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)
+(defun split-string (string &optional separators omit-nulls trim)
"Split STRING into substrings bounded by matches for SEPARATORS.
The beginning and end of STRING, and each match for SEPARATORS, are
are effectively trimmed). If nil, all zero-length substrings are retained,
which correctly parses CSV format, for example.
+If TRIM is non-nil, it should be a regular expression to match
+text to trim from the beginning and end of each substring. If trimming
+makes the substring empty, it is treated as null.
+
+If you want to trim whitespace from the substrings, the reliably correct
+way is using TRIM. Making SEPARATORS match that whitespace gives incorrect
+results when there is whitespace at the start or end of STRING. If you
+see such calls to `split-string', please fix them.
+
Note that the effect of `(split-string STRING)' is the same as
`(split-string STRING split-string-default-separators t)'. In the rare
case that you wish to retain zero-length substrings when splitting on
whitespace, use `(split-string STRING split-string-default-separators)'.
Modifies the match data; use `save-match-data' if necessary."
- (let ((keep-nulls (not (if separators omit-nulls t)))
- (rexp (or separators split-string-default-separators))
- (start 0)
- notfirst
- (list nil))
+ (let* ((keep-nulls (not (if separators omit-nulls t)))
+ (rexp (or separators split-string-default-separators))
+ (start 0)
+ this-start this-end
+ notfirst
+ (list nil)
+ (push-one
+ ;; Push the substring in range THIS-START to THIS-END
+ ;; onto LIST, trimming it and perhaps discarding it.
+ (lambda ()
+ (when trim
+ ;; Discard the trim from start of this substring.
+ (let ((tem (string-match trim string this-start)))
+ (and (eq tem this-start)
+ (setq this-start (match-end 0)))))
+
+ (when (or keep-nulls (< this-start this-end))
+ (let ((this (substring string this-start this-end)))
+
+ ;; Discard the trim from end of this substring.
+ (when trim
+ (let ((tem (string-match (concat trim "\\'") this 0)))
+ (and tem (< tem (length this))
+ (setq this (substring this 0 tem)))))
+
+ ;; Trimming could make it empty; check again.
+ (when (or keep-nulls (> (length this) 0))
+ (push this list)))))))
+
(while (and (string-match rexp string
(if (and notfirst
(= start (match-beginning 0))
(1+ start) start))
(< start (length string)))
(setq notfirst t)
- (if (or keep-nulls (< start (match-beginning 0)))
- (setq list
- (cons (substring string start (match-beginning 0))
- list)))
- (setq start (match-end 0)))
- (if (or keep-nulls (< start (length string)))
- (setq list
- (cons (substring string start)
- list)))
+ (setq this-start start this-end (match-beginning 0)
+ start (match-end 0))
+
+ (funcall push-one))
+
+ ;; Handle the substring at the end of STRING.
+ (setq this-start start this-end (length string))
+ (funcall push-one)
+
(nreverse list)))
(defun combine-and-quote-strings (strings &optional separator)
(when (equal file lfn)
(remove-hook 'after-load-functions fun)
(funcall func))))
- (add-hook 'after-load-functions fun)))))))
+ (add-hook 'after-load-functions fun 'append)))))))
;; Add FORM to the element unless it's already there.
(unless (member delayed-func (cdr elt))
(nconc elt (list delayed-func)))))))
(mapc #'funcall (cdr a-l-element))))
;; Complain when the user uses obsolete files.
(when (string-match-p "/obsolete/[^/]*\\'" abs-file)
- (run-with-timer 0 nil
- (lambda (file)
- (message "Package %s is obsolete!"
- (substring file 0
- (string-match "\\.elc?\\>" file))))
- (file-name-nondirectory abs-file)))
+ ;; Maybe we should just use display-warning? This seems yucky...
+ (let* ((file (file-name-nondirectory abs-file))
+ (msg (format "Package %s is obsolete!"
+ (substring file 0
+ (string-match "\\.elc?\\>" file)))))
+ ;; Cribbed from cl--compiling-file.
+ (if (and (boundp 'byte-compile--outbuffer)
+ (bufferp (symbol-value 'byte-compile--outbuffer))
+ (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+ " *Compiler Output*"))
+ ;; Don't warn about obsolete files using other obsolete files.
+ (unless (and (stringp byte-compile-current-file)
+ (string-match-p "/obsolete/[^/]*\\'"
+ (expand-file-name
+ byte-compile-current-file
+ byte-compile-root-dir)))
+ (byte-compile-log-warning msg))
+ (run-with-timer 0 nil
+ (lambda (msg)
+ (message "%s" msg)) msg))))
+
;; Finally, run any other hook.
(run-hook-with-args 'after-load-functions abs-file))
(declare (obsolete eval-after-load "23.2"))
(eval-after-load file (read)))
+\f
(defun display-delayed-warnings ()
"Display delayed warnings from `delayed-warnings-list'.
Used from `delayed-warnings-hook' (which see)."
warnings listed in `delayed-warnings-list', display them, and set
`delayed-warnings-list' back to nil.")
+(defun delay-warning (type message &optional level buffer-name)
+ "Display a delayed warning.
+Aside from going through `delayed-warnings-list', this is equivalent
+to `display-warning'."
+ (push (list type message level buffer-name) delayed-warnings-list))
+
\f
;;;; invisibility specs
\f
;;;; Text clones
-(defun text-clone-maintain (ol1 after beg end &optional _len)
+(defvar text-clone--maintaining nil)
+
+(defun text-clone--maintain (ol1 after beg end &optional _len)
"Propagate the changes made under the overlay OL1 to the other clones.
This is used on the `modification-hooks' property of text clones."
- (when (and after (not undo-in-progress) (overlay-start ol1))
+ (when (and after (not undo-in-progress)
+ (not text-clone--maintaining)
+ (overlay-start ol1))
(let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
(setq beg (max beg (+ (overlay-start ol1) margin)))
(setq end (min end (- (overlay-end ol1) margin)))
(tail (- (overlay-end ol1) end))
(str (buffer-substring beg end))
(nothing-left t)
- (inhibit-modification-hooks t))
+ (text-clone--maintaining t))
(dolist (ol2 (overlay-get ol1 'text-clones))
(let ((oe (overlay-end ol2)))
(unless (or (eq ol1 ol2) (null oe))
(unless (> mod-beg (point))
(save-excursion (insert str))
(delete-region mod-beg (point)))
- ;;(overlay-put ol2 'modification-hooks '(text-clone-maintain))
+ ;;(overlay-put ol2 'modification-hooks '(text-clone--maintain))
))))
(if nothing-left (delete-overlay ol1))))))))
(>= pt-end (point-max))
(>= start (point-max)))
0 1))
+ ;; FIXME: Reuse overlays at point to extend dups!
(ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
(ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
(dups (list ol1 ol2)))
- (overlay-put ol1 'modification-hooks '(text-clone-maintain))
+ (overlay-put ol1 'modification-hooks '(text-clone--maintain))
(when spreadp (overlay-put ol1 'text-clone-spreadp t))
(when syntax (overlay-put ol1 'text-clone-syntax syntax))
;;(overlay-put ol1 'face 'underline)
(overlay-put ol1 'evaporate t)
(overlay-put ol1 'text-clones dups)
;;
- (overlay-put ol2 'modification-hooks '(text-clone-maintain))
+ (overlay-put ol2 'modification-hooks '(text-clone--maintain))
(when spreadp (overlay-put ol2 'text-clone-spreadp t))
(when syntax (overlay-put ol2 'text-clone-syntax syntax))
;;(overlay-put ol2 'face 'underline)
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)
- (unless (boundp ',sym)
- (let ((i 1))
- (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t)
- (indirect-function 'called-interactively-p)))
- (setq i (1+ i)))
- (setq ,sym 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)))))
+(defconst internal--call-interactively (symbol-function 'call-interactively))
(defun called-interactively-p (&optional kind)
"Return t if the containing function was called by `call-interactively'.
(get-next-frame
(lambda ()
(setq frame nextframe)
- (setq nextframe (internal--called-interactively-p--get-frame i))
+ (setq nextframe (backtrace-frame i 'called-interactively-p))
;; (message "Frame %d = %S" i nextframe)
(setq i (1+ i)))))
(funcall get-next-frame) ;; Get the first frame.
(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)
+ ;; In case #<subr call-interactively> without going through the
+ ;; `call-interactively' symbol (bug#3984).
+ (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
(`(,_ . (t call-interactively . ,_)) t)))))
(defun interactive-p ()
;; suspended during the C-u one so we don't exit isearch just
;; because we hit 1 after C-u and that 1 exits isearch whereas it
;; doesn't exit C-u.
- (unless (cond ((null keep-pred) nil)
- ((eq t keep-pred)
- (eq this-command
- (lookup-key map (this-command-keys-vector))))
- (t (funcall keep-pred)))
- (remove-hook 'pre-command-hook clearfun)
- (internal-pop-keymap map 'overriding-terminal-local-map)
- (when on-exit (funcall on-exit)))))
+ (with-demoted-errors "set-temporary-overlay-map PCH: %S"
+ (unless (cond ((null keep-pred) nil)
+ ((eq t keep-pred)
+ (eq this-command
+ (lookup-key map (this-command-keys-vector))))
+ (t (funcall keep-pred)))
+ (internal-pop-keymap map 'overriding-terminal-local-map)
+ (remove-hook 'pre-command-hook clearfun)
+ (when on-exit (funcall on-exit))))))
(add-hook 'pre-command-hook clearfun)
(internal-push-keymap map 'overriding-terminal-local-map)))
(defconst version-regexp-alist
- '(("^[-_+ ]?alpha$" . -3)
- ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
- ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
- ("^[-_+ ]?beta$" . -2)
- ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
+ '(("^[-_+ ]?snapshot$" . -4)
+ ;; treat "1.2.3-20050920" and "1.2-3" as snapshot releases
+ ("^[-_+]$" . -4)
+ ;; treat "1.2.3-CVS" as snapshot release
+ ("^[-_+ ]?\\(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\",
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.0pre2\" (1 0 -1 2)
\"1.0PRE2\" (1 0 -1 2)
\"22.8beta3\" (22 8 -2 3)
\"0.9alpha1\" (0 9 -3 1)
\"0.9AlphA1\" (0 9 -3 1)
\"0.9alpha\" (0 9 -3)
+ \"0.9snapshot\" (0 9 -4)
+ \"1.0-git\" (1 0 -4)
See documentation for `version-separator' and `version-regexp-alist'."
(or (and (stringp ver) (> (length ver) 0))
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-< (version-to-list v1) (version-to-list v2)))
-
(defun version<= (v1 v2)
"Return t if version V1 is lower (older) than or equal to V2.
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-<= (version-to-list v1) (version-to-list v2)))
(defun version= (v1 v2)
Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
etc. That is, the trailing \".0\"s are insignificant. Also, version
string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\",
-which is higher than \"1alpha\". Also, \"-CVS\" and \"-NNN\" are treated
-as alpha versions."
+which is higher than \"1alpha\", which is higher than \"1snapshot\".
+Also, \"-GIT\", \"-CVS\" and \"-NNN\" are treated as snapshot versions."
(version-list-= (version-to-list v1) (version-to-list v2)))
\f
HCoop / bpt / emacs.git / blobdiff