X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bbbabffe06d4c763534d5be92844c48a3f8746e2..6e5a5743ddab1142018f20000081184f0bd9dc94:/lisp/subr.el diff --git a/lisp/subr.el b/lisp/subr.el index 6cfece1045..09a085288a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -334,6 +334,7 @@ Any list whose car is `frame-configuration' is assumed to be a frame configuration." (and (consp object) (eq (car object) 'frame-configuration))) + ;;;; List functions. @@ -382,6 +383,13 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. @@ -1119,7 +1127,7 @@ pixels. POSITION should be a list of the form returned by "Return the nominal column and row in POSITION, measured in characters. The column and row values are approximations calculated from the x and y coordinates in POSITION and the frame's default character width -and height. +and default line height, including spacing. For a scroll-bar event, the result column is 0, and the row corresponds to the vertical position of the click in the scroll bar. POSITION should be a list of the form returned by the `event-start' @@ -2153,6 +2161,10 @@ where the optional arg MILLISECONDS specifies an additional wait period, in milliseconds; this was useful when Emacs was built without floating point support." (declare (advertised-calling-convention (seconds &optional nodisp) "22.1")) + ;; This used to be implemented in C until the following discussion: + ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html + ;; Then it was moved to C using an implementation based on an idle timer, + ;; which was then replaced by the use of read-event. (if (numberp nodisp) (setq seconds (+ seconds (* 1e-3 nodisp)) nodisp obsolete) @@ -2170,15 +2182,24 @@ floating point support." ;; FIXME: we should not read-event here at all, because it's much too ;; difficult to reliably "undo" a read-event by pushing it onto ;; unread-command-events. - (let ((read (read-event nil t seconds))) + ;; For bug#14782, we need read-event to do the keyboard-coding-system + ;; decoding (hence non-nil as second arg under POSIX ttys). + ;; For bug#15614, we need read-event not to inherit-input-method. + ;; So we temporarily suspend input-method-function. + (let ((read (let ((input-method-function nil)) + (read-event nil t seconds)))) (or (null read) (progn - ;; If last command was a prefix arg, e.g. C-u, push this event onto - ;; unread-command-events as (t . EVENT) so it will be added to - ;; this-command-keys by read-key-sequence. - (if (eq overriding-terminal-local-map universal-argument-map) - (setq read (cons t read))) - (push read unread-command-events) + ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html + ;; We want `read' appear in the next command's this-command-event + ;; but not in the current one. + ;; By pushing (cons t read), we indicate that `read' has not + ;; yet been recorded in this-command-keys, so it will be recorded + ;; next time it's read. + ;; And indeed the `seconds' argument to read-event correctly + ;; prevented recording this event in the current command's + ;; this-command-keys. + (push (cons t read) unread-command-events) nil)))))) ;; Behind display-popup-menus-p test. @@ -3292,6 +3313,19 @@ The value returned is the value of the last form in BODY." ,@body) (with-current-buffer ,old-buffer (set-case-table ,old-case-table)))))) + +(defmacro with-file-modes (modes &rest body) + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))) + ;;; Matching and match data. @@ -3643,12 +3677,14 @@ and replace a sub-expression, e.g. (setq matches (cons (substring string start l) matches)) ; leftover (apply #'concat (nreverse matches))))) -(defun string-prefix-p (str1 str2 &optional ignore-case) - "Return non-nil if STR1 is a prefix of STR2. +(defun string-prefix-p (prefix string &optional ignore-case) + "Return non-nil if PREFIX is a prefix of STRING. If IGNORE-CASE is non-nil, the comparison is done without paying attention to case differences." - (eq t (compare-strings str1 nil nil - str2 0 (length str1) ignore-case))) + (let ((prefix-length (length prefix))) + (if (> prefix-length (length string)) nil + (eq t (compare-strings prefix 0 prefix-length string + 0 prefix-length ignore-case))))) (defun string-suffix-p (suffix string &optional ignore-case) "Return non-nil if SUFFIX is a suffix of STRING. @@ -3832,7 +3868,8 @@ This function is called directly from the C code." (byte-compile-log-warning msg)) (run-with-timer 0 nil (lambda (msg) - (message "%s" msg)) msg)))) + (message "%s" msg)) + msg)))) ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) @@ -4149,7 +4186,8 @@ 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).") -(defconst internal--call-interactively (symbol-function 'call-interactively)) +(defconst internal--funcall-interactively + (symbol-function 'funcall-interactively)) (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. @@ -4223,10 +4261,13 @@ command is called from a keyboard macro?" (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) - ;; In case # without going through the - ;; `call-interactively' symbol (bug#3984). - (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) - (`(,_ . (t call-interactively . ,_)) t))))) + ;; In case # without going through the + ;; `funcall-interactively' symbol (bug#3984). + (`(,_ . (t ,(pred (lambda (f) + (eq internal--funcall-interactively + (indirect-function f)))) + . ,_)) + t))))) (defun interactive-p () "Return t if the containing function was run directly by user input. @@ -4288,28 +4329,28 @@ lookup sequence then continues." ;; in a cycle. (fset clearfun (suspicious-object - (lambda () - (with-demoted-errors "set-transient-map PCH: %S" - (unless (cond - ((not (eq map (cadr overriding-terminal-local-map))) - ;; There's presumably some other transient-map in - ;; effect. Wait for that one to terminate before we - ;; remove ourselves. - ;; For example, if isearch and C-u both use transient - ;; maps, then the lifetime of the C-u should be nested - ;; within isearch's, so the pre-command-hook of - ;; isearch should be 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. - t) - ((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) + (lambda () + (with-demoted-errors "set-transient-map PCH: %S" + (unless (cond + ((null keep-pred) nil) + ((not (eq map (cadr overriding-terminal-local-map))) + ;; There's presumably some other transient-map in + ;; effect. Wait for that one to terminate before we + ;; remove ourselves. + ;; For example, if isearch and C-u both use transient + ;; maps, then the lifetime of the C-u should be nested + ;; within isearch's, so the pre-command-hook of + ;; isearch should be 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. + t) + ((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)) ;; Comment out the fset if you want to debug the GC bug. ;;; (fset clearfun nil)