Lisp completion functions

[bpt/emacs.git] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index 6cfece1..5280c77 100644 (file)
--- 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)))
 configuration."
   (and (consp object)
        (eq (car object) 'frame-configuration)))

+

 \f
 ;;;; List functions.
 
 \f
 ;;;; 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))))
 
           (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.
 (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
   "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'
 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'


@@ -1242,8 +1250,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 'unfocus-frame "it does nothing." "22.1")
 (make-obsolete 'make-variable-frame-local
               "explicitly check for a frame-parameter instead." "22.2")

-(set-advertised-calling-convention
- '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 '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")


@@ -2008,6 +2014,7 @@ If optional CONFIRM is non-nil, read the password twice to make sure.
 Optional DEFAULT is a default password to use instead of empty input.
 
 This function echoes `.' for each character that the user types.
 Optional DEFAULT is a default password to use instead of empty input.
 
 This function echoes `.' for each character that the user types.

+Note that in batch mode, the input is not hidden!

 
 Once the caller uses the password, it can erase the password
 by doing (clear-string STRING)."
 
 Once the caller uses the password, it can erase the password
 by doing (clear-string STRING)."


@@ -2047,7 +2054,11 @@ by doing (clear-string STRING)."
             (add-hook 'after-change-functions hide-chars-fun nil 'local))
         (unwind-protect
             (let ((enable-recursive-minibuffers t))
             (add-hook 'after-change-functions hide-chars-fun nil 'local))
         (unwind-protect
             (let ((enable-recursive-minibuffers t))

-              (read-string prompt nil t default)) ; t = "no history"
+              (read-string
+               (if noninteractive
+                   (format "%s[INPUT WILL NOT BE HIDDEN!] " prompt) ; bug#17839
+                 prompt)
+               nil t default)) ; t = "no history"

           (when (buffer-live-p minibuf)
             (with-current-buffer minibuf
               ;; Not sure why but it seems that there might be cases where the
           (when (buffer-live-p minibuf)
             (with-current-buffer minibuf
               ;; Not sure why but it seems that there might be cases where the


@@ -2153,6 +2164,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"))
 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)
   (if (numberp nodisp)
       (setq seconds (+ seconds (* 1e-3 nodisp))
             nodisp obsolete)


@@ -2170,15 +2185,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.
     ;; 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
       (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.
            nil))))))
 
 ;; Behind display-popup-menus-p test.


@@ -3292,6 +3316,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))))))
                  ,@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)))))
+

 \f
 ;;; Matching and match data.
 
 \f
 ;;; Matching and match data.
 


@@ -3643,12 +3680,14 @@ and replace a sub-expression, e.g.
       (setq matches (cons (substring string start l) matches)) ; leftover
       (apply #'concat (nreverse matches)))))
 \f
       (setq matches (cons (substring string start l) matches)) ; leftover
       (apply #'concat (nreverse matches)))))
 \f

-(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."
 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.
 
 (defun string-suffix-p (suffix string  &optional ignore-case)
   "Return non-nil if SUFFIX is a suffix of STRING.


@@ -3832,7 +3871,8 @@ This function is called directly from the C code."
            (byte-compile-log-warning msg))
        (run-with-timer 0 nil
                        (lambda (msg)
            (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))
 
   ;; Finally, run any other hook.
   (run-hook-with-args 'after-load-functions abs-file))


@@ -4149,7 +4189,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).")
 
 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'.
 
 (defun called-interactively-p (&optional kind)
   "Return t if the containing function was called by `call-interactively'.


@@ -4223,10 +4264,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)
       (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 #<subr call-interactively> without going through the
-        ;; `call-interactively' symbol (bug#3984).
-        (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t)
-        (`(,_ . (t call-interactively . ,_)) t)))))
+        ;; In case #<subr funcall-interactively> 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.
 
 (defun interactive-p ()
   "Return t if the containing function was run directly by user input.


@@ -4287,34 +4331,33 @@ lookup sequence then continues."
     ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
     ;; in a cycle.
     (fset clearfun
     ;; Don't use letrec, because equal (in add/remove-hook) would get trapped
     ;; 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)
 ;;;             (set clearfun nil)
                  (when on-exit (funcall on-exit))
                  ;; Comment out the fset if you want to debug the GC bug.
 ;;;            (fset clearfun nil)
 ;;;             (set clearfun nil)

-                 )))))
+                 ))))

     (add-hook 'pre-command-hook clearfun)
     (internal-push-keymap map 'overriding-terminal-local-map)))
 
     (add-hook 'pre-command-hook clearfun)
     (internal-push-keymap map 'overriding-terminal-local-map)))