emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master ce26926 2/2: Merge branch 'master' of git.sv.gnu.or


From: Michael Albinus
Subject: [Emacs-diffs] master ce26926 2/2: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
Date: Thu, 20 Oct 2016 12:58:44 +0000 (UTC)

branch: master
commit ce26926b6223194a6ff0d8a3c17f1d58aaa5d0fe
Merge: 38091c9 f63a4b8
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
 doc/lispref/files.texi               |    3 ++
 etc/NEWS                             |   12 ++++++
 lisp/auth-source.el                  |   24 +++++------
 lisp/emacs-lisp/cl-macs.el           |   13 +++---
 lisp/emacs-lisp/cl-seq.el            |   70 ++++++++++++++++++--------------
 lisp/eshell/em-hist.el               |   19 ++++++---
 lisp/files.el                        |   46 ++++++++++++++-------
 lisp/isearch.el                      |   24 +++++------
 lisp/net/dig.el                      |   18 +++------
 lisp/net/mailcap.el                  |   74 +++++++++++++---------------------
 lisp/nxml/nxml-mode.el               |   18 ++++-----
 lisp/term/xterm.el                   |    2 +-
 src/frame.c                          |    7 +++-
 src/window.c                         |    6 ++-
 test/lisp/emacs-lisp/cl-seq-tests.el |    1 -
 15 files changed, 185 insertions(+), 152 deletions(-)

diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 9af5ce9..62e0199 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -2855,6 +2855,9 @@ This command deletes the directory named @var{dirname}.  
The function
 must use @code{delete-directory} for them.  If @var{recursive} is
 @code{nil}, and the directory contains any files,
 @code{delete-directory} signals an error.
+If recursive is address@hidden, there is no error merely because the
+directory or its files are deleted by some other process before
address@hidden gets to them.
 
 @code{delete-directory} only follows symbolic links at the level of
 parent directories.
diff --git a/etc/NEWS b/etc/NEWS
index 1fd2a00..4f88de9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -308,6 +308,13 @@ viewing HTML files and the like.
 breakpoint (e.g. with "f" and "o") by customizing the new option
 'edebug-sit-on-break'.
 
+** Eshell
+
+*** 'eshell-input-filter's value is now a named function
+'eshell-input-filter-default', and has a new custom option
+'eshell-input-filter-initial-space' to ignore adding commands prefixed
+with blank space to eshell history.
+
 ** eww
 
 +++
@@ -619,6 +626,11 @@ collection).
 ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
 can be used for creation of temporary files of remote or mounted directories.
 
++++
+** The function 'delete-directory' no longer signals an error when
+operating recursively and when some other process deletes the directory
+or its files before 'delete-directory' gets to them.
+
 ** Changes in Frame- and Window- Handling
 
 +++
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 97059fa..9e1f468 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -1,4 +1,4 @@
-;;; auth-source.el --- authentication sources for Gnus and Emacs
+;;; auth-source.el --- authentication sources for Gnus and Emacs -*- 
lexical-binding: t -*-
 
 ;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
 
@@ -1002,7 +1002,7 @@ Note that the MAX parameter is used so we can exit the 
parse early."
             (auth-source--aput
              auth-source-netrc-cache file
              (list :mtime (nth 5 (file-attributes file))
-                   :secret (lexical-let ((v (mapcar #'1+ (buffer-string))))
+                   :secret (let ((v (mapcar #'1+ (buffer-string))))
                              (lambda () (apply #'string (mapcar #'1- v)))))))
           (goto-char (point-min))
           (let ((entries (auth-source-netrc-parse-entries check max))
@@ -1118,7 +1118,7 @@ Note that the MAX parameter is used so we can exit the 
parse early."
                (read-passwd
                 (format "Passphrase for %s tokens: " file)
                 t))
-         (setcdr entry (lexical-let ((p (copy-sequence passphrase)))
+         (setcdr entry (let ((p (copy-sequence passphrase)))
                          (lambda () p)))
          passphrase))))
 
@@ -1174,8 +1174,8 @@ FILE is the file from which we obtained this token."
 
                   ;; send back the secret in a function (lexical binding)
                   (when (equal k "secret")
-                    (setq v (lexical-let ((lexv v)
-                                          (token-decoder nil))
+                    (setq v (let ((lexv v)
+                                  (token-decoder nil))
                               (when (string-match "^gpg:" lexv)
                                 ;; it's a GPG token: create a token decoder
                                 ;; which unsets itself once
@@ -1384,7 +1384,7 @@ See `auth-source-search' for details on SPEC."
           (setq artificial (plist-put artificial
                                       (auth-source--symbol-keyword r)
                                       (if (eq r 'secret)
-                                          (lexical-let ((data data))
+                                          (let ((data data))
                                             (lambda () data))
                                         data))))
 
@@ -1414,8 +1414,8 @@ See `auth-source-search' for details on SPEC."
     (plist-put
      artificial
      :save-function
-     (lexical-let ((file file)
-                   (add add))
+     (let ((file file)
+           (add add))
        (lambda () (auth-source-netrc-saver file add))))
 
     (list artificial)))
@@ -1611,7 +1611,7 @@ authentication tokens:
                            ;; make an entry for the secret (password) element
                            (list
                             :secret
-                            (lexical-let ((v (secrets-get-secret coll item)))
+                            (let ((v (secrets-get-secret coll item)))
                               (lambda () v)))
                            ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
                            (apply #'append
@@ -1813,8 +1813,8 @@ entries for git.gnus.org:
                        ret
                        keychain-generic
                        "secret"
-                       (lexical-let ((v (auth-source--decode-octal-string
-                                         (match-string 1))))
+                       (let ((v (auth-source--decode-octal-string
+                                 (match-string 1))))
                          (lambda () v)))))
            ;; TODO: check if this is really the label
            ;; match 0x00000007 <blob>="AppleID"
@@ -1896,7 +1896,7 @@ entries for git.gnus.org:
                             (if secret
                                 (setcar
                                  (cdr secret)
-                                 (lexical-let ((v (car (cdr secret))))
+                                 (let ((v (car (cdr secret))))
                                    (lambda () v))))
                             plist))
                         items))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index f5b7b82..0096e0a 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2590,8 +2590,7 @@ non-nil value, that slot cannot be set via `setf'.
                              [":initial-offset" natnump])])]
              [&optional stringp]
              ;; All the above is for the following def-form.
-             &rest &or symbolp (symbolp def-form
-                                        &optional ":read-only" sexp))))
+             &rest &or symbolp (symbolp &optional def-form &rest sexp))))
   (let* ((name (if (consp struct) (car struct) struct))
         (opts (cdr-safe struct))
         (slots nil)
@@ -2655,7 +2654,7 @@ non-nil value, that slot cannot be set via `setf'.
               (setq descs (nconc (make-list (car args) '(cl-skip-slot))
                                  descs)))
              (t
-              (error "Slot option %s unrecognized" opt)))))
+              (error "Structure option %s unrecognized" opt)))))
     (unless (or include-name type)
       (setq include-name cl--struct-default-parent))
     (when include-name (setq include (cl--struct-get-class include-name)))
@@ -2711,7 +2710,7 @@ non-nil value, that slot cannot be set via `setf'.
     (let ((pos 0) (descp descs))
       (while descp
        (let* ((desc (pop descp))
-              (slot (car desc)))
+              (slot (pop desc)))
          (if (memq slot '(cl-tag-slot cl-skip-slot))
              (progn
                (push nil slots)
@@ -2721,7 +2720,7 @@ non-nil value, that slot cannot be set via `setf'.
                (error "Duplicate slots named %s in %s" slot name))
            (let ((accessor (intern (format "%s%s" conc-name slot))))
              (push slot slots)
-             (push (nth 1 desc) defaults)
+             (push (pop desc) defaults)
              ;; The arg "cl-x" is referenced by name in eg pred-form
              ;; and pred-check, so changing it is not straightforward.
              (push `(cl-defsubst ,accessor (cl-x)
@@ -2736,7 +2735,9 @@ non-nil value, that slot cannot be set via `setf'.
                           (if (= pos 0) '(car cl-x)
                             `(nth ,pos cl-x))))
                     forms)
-              (if (cadr (memq :read-only (cddr desc)))
+              (when (cl-oddp (length desc))
+                (error "Invalid options for slot %s in %s" slot name))
+              (if (plist-get desc ':read-only)
                   (push `(gv-define-expander ,accessor
                            (lambda (_cl-do _cl-x)
                              (error "%s is a read-only slot" ',accessor)))
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index ed27b7c..3f8b1ee 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -151,8 +151,8 @@ called.
   (cl--parsing-keywords ((:start 0) :end) ()
     (if (listp cl-seq)
        (let ((p (nthcdr cl-start cl-seq))
-             (n (if cl-end (- cl-end cl-start) 8000000)))
-         (while (and p (>= (setq n (1- n)) 0))
+             (n (and cl-end (- cl-end cl-start))))
+         (while (and p (or (null n) (>= (cl-decf n) 0)))
            (setcar p cl-item)
            (setq p (cdr p))))
       (or cl-end (setq cl-end (length cl-seq)))
@@ -180,16 +180,20 @@ SEQ1 is destructively modified, then returned.
                            (elt cl-seq2 (+ cl-start2 cl-n))))))
       (if (listp cl-seq1)
          (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-               (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
+               (cl-n1 (and cl-end1 (- cl-end1 cl-start1))))
            (if (listp cl-seq2)
                (let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-                     (cl-n (min cl-n1
-                                (if cl-end2 (- cl-end2 cl-start2) 4000000))))
-                 (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
+                     (cl-n (cond ((and cl-n1 cl-end2)
+                                  (min cl-n1 (- cl-end2 cl-start2)))
+                                 ((and cl-n1 (null cl-end2)) cl-n1)
+                                 ((and (null cl-n1) cl-end2) (- cl-end2 
cl-start2)))))
+                 (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 
0)))
                    (setcar cl-p1 (car cl-p2))
                    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
-             (setq cl-end2 (min (or cl-end2 (length cl-seq2))
-                                (+ cl-start2 cl-n1)))
+             (setq cl-end2 (if (null cl-n1)
+                               (or cl-end2 (length cl-seq2))
+                             (min (or cl-end2 (length cl-seq2))
+                                  (+ cl-start2 cl-n1))))
              (while (and cl-p1 (< cl-start2 cl-end2))
                (setcar cl-p1 (aref cl-seq2 cl-start2))
                (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
@@ -215,9 +219,10 @@ to avoid corrupting the original SEQ.
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
                        (:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
+    (let ((len (length cl-seq)))
+      (if (<= (or cl-count (setq cl-count len)) 0)
        cl-seq
-      (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
+        (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2))))
          (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end
                                     cl-from-end)))
            (if cl-i
@@ -229,7 +234,7 @@ to avoid corrupting the original SEQ.
                  (if (listp cl-seq) cl-res
                    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
              cl-seq))
-       (setq cl-end (- (or cl-end 8000000) cl-start))
+         (setq cl-end (- (or cl-end len) cl-start))
        (if (= cl-start 0)
            (while (and cl-seq (> cl-end 0)
                        (cl--check-test cl-item (car cl-seq))
@@ -250,7 +255,7 @@ to avoid corrupting the original SEQ.
                                       :start 0 :end (1- cl-end)
                                       :count (1- cl-count) cl-keys))))
                cl-seq))
-         cl-seq)))))
+         cl-seq))))))
 
 ;;;###autoload
 (defun cl-remove-if (cl-pred cl-list &rest cl-keys)
@@ -278,20 +283,21 @@ This is a destructive function; it reuses the storage of 
SEQ whenever possible.
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end
                        (:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
+    (let ((len (length cl-seq)))
+      (if (<= (or cl-count (setq cl-count len)) 0)
        cl-seq
       (if (listp cl-seq)
-         (if (and cl-from-end (< cl-count 4000000))
+         (if (and cl-from-end (< cl-count (/ len 2)))
              (let (cl-i)
                (while (and (>= (setq cl-count (1- cl-count)) 0)
                            (setq cl-i (cl--position cl-item cl-seq cl-start
-                                                     cl-end cl-from-end)))
+                                                    cl-end cl-from-end)))
                  (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
                    (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
                      (setcdr cl-tail (cdr (cdr cl-tail)))))
                  (setq cl-end cl-i))
                cl-seq)
-           (setq cl-end (- (or cl-end 8000000) cl-start))
+           (setq cl-end (- (or cl-end len) cl-start))
            (if (= cl-start 0)
                (progn
                  (while (and cl-seq
@@ -312,7 +318,7 @@ This is a destructive function; it reuses the storage of 
SEQ whenever possible.
                      (setq cl-p (cdr cl-p)))
                    (setq cl-end (1- cl-end)))))
            cl-seq)
-       (apply 'cl-remove cl-item cl-seq cl-keys)))))
+       (apply 'cl-remove cl-item cl-seq cl-keys))))))
 
 ;;;###autoload
 (defun cl-delete-if (cl-pred cl-list &rest cl-keys)
@@ -396,15 +402,17 @@ to avoid corrupting the original SEQ.
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
                        (:start 0) :end :from-end) ()
     (if (or (eq cl-old cl-new)
-           (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
+           (<= (or cl-count (setq cl-from-end nil
+                                  cl-count (length cl-seq))) 0))
        cl-seq
       (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end)))
        (if (not cl-i)
            cl-seq
          (setq cl-seq (copy-sequence cl-seq))
-         (or cl-from-end
-             (progn (setf (elt cl-seq cl-i) cl-new)
-                    (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
+         (unless cl-from-end
+           (setf (elt cl-seq cl-i) cl-new)
+           (cl-incf cl-i)
+           (cl-decf cl-count))
          (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
                 :start cl-i cl-keys))))))
 
@@ -434,17 +442,18 @@ This is a destructive function; it reuses the storage of 
SEQ whenever possible.
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
   (cl--parsing-keywords (:test :test-not :key :if :if-not :count
                        (:start 0) :end :from-end) ()
-    (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
-       (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
+    (let ((len (length cl-seq)))
+      (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0)
+         (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2))))
            (let ((cl-p (nthcdr cl-start cl-seq)))
-             (setq cl-end (- (or cl-end 8000000) cl-start))
+             (setq cl-end (- (or cl-end len) cl-start))
              (while (and cl-p (> cl-end 0) (> cl-count 0))
                (if (cl--check-test cl-old (car cl-p))
                    (progn
                      (setcar cl-p cl-new)
                      (setq cl-count (1- cl-count))))
                (setq cl-p (cdr cl-p) cl-end (1- cl-end))))
-         (or cl-end (setq cl-end (length cl-seq)))
+           (or cl-end (setq cl-end len))
          (if cl-from-end
              (while (and (< cl-start cl-end) (> cl-count 0))
                (setq cl-end (1- cl-end))
@@ -457,7 +466,7 @@ This is a destructive function; it reuses the storage of 
SEQ whenever possible.
                  (progn
                    (aset cl-seq cl-start cl-new)
                    (setq cl-count (1- cl-count))))
-             (setq cl-start (1+ cl-start))))))
+             (setq cl-start (1+ cl-start)))))))
     cl-seq))
 
 ;;;###autoload
@@ -513,14 +522,13 @@ Return the index of the matching item, or nil if not 
found.
 
 (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
   (if (listp cl-seq)
-      (let ((cl-p (nthcdr cl-start cl-seq)))
-       (or cl-end (setq cl-end 8000000))
-       (let ((cl-res nil))
-         (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
+      (let ((cl-p (nthcdr cl-start cl-seq))
+           cl-res)
+       (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null 
cl-res) cl-from-end))
            (if (cl--check-test cl-item (car cl-p))
                (setq cl-res cl-start))
            (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
-         cl-res))
+       cl-res)
     (or cl-end (setq cl-end (length cl-seq)))
     (if cl-from-end
        (progn
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 198b1d0..067c5ea 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -119,15 +119,14 @@ If set to t, history will always be saved, silently."
                 (const :tag "Always save" t))
   :group 'eshell-hist)
 
-(defcustom eshell-input-filter
-  (function
-   (lambda (str)
-     (not (string-match "\\`\\s-*\\'" str))))
+(defcustom eshell-input-filter 'eshell-input-filter-default
   "Predicate for filtering additions to input history.
 Takes one argument, the input.  If non-nil, the input may be saved on
 the input history list.  Default is to save anything that isn't all
 whitespace."
-  :type 'function
+  :type '(radio (function-item eshell-input-filter-default)
+                (function-item eshell-input-filter-initial-space)
+                (function :tag "Other function"))
   :group 'eshell-hist)
 
 (put 'eshell-input-filter 'risky-local-variable t)
@@ -206,6 +205,16 @@ element, regardless of any text on the command line.  In 
that case,
 
 ;;; Functions:
 
+(defun eshell-input-filter-default (input)
+  "Do not add blank input to input history.
+Returns non-nil if INPUT is blank."
+  (not (string-match "\\`\\s-*\\'" input)))
+
+(defun eshell-input-filter-initial-space (input)
+  "Do not add input beginning with empty space to history.
+Returns nil if INPUT is prepended by blank space, otherwise non-nil."
+  (not (string-match-p "\\`\\s-+" input)))
+
 (defun eshell-hist-initialize ()
   "Initialize the history management code for one Eshell buffer."
   (add-hook 'eshell-expand-input-functions
diff --git a/lisp/files.el b/lisp/files.el
index f481b99..12c6c14 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5336,14 +5336,26 @@ raised."
   "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
   "Regexp matching any file name except \".\" and \"..\".")
 
+(defun files--force (no-such fn &rest args)
+  "Use NO-SUCH to affect behavior of function FN applied to list ARGS.
+This acts like (apply FN ARGS) except it returns NO-SUCH if it is
+non-nil and if FN fails due to a missing file or directory."
+  (condition-case err
+      (apply fn args)
+    (file-error
+     (or (pcase err (`(,_ ,_ "No such file or directory" . ,_) no-such))
+        (signal (car err) (cdr err))))))
+
 (defun delete-directory (directory &optional recursive trash)
   "Delete the directory named DIRECTORY.  Does not follow symlinks.
-If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well.
+If RECURSIVE is non-nil, delete files in DIRECTORY as well, with
+no error if something else is simultaneously deleting them.
 TRASH non-nil means to trash the directory instead, provided
 `delete-by-moving-to-trash' is non-nil.
 
-When called interactively, TRASH is t if no prefix argument is
-given.  With a prefix argument, TRASH is nil."
+When called interactively, TRASH is nil if and only if a prefix
+argument is given, and a further prompt asks the user for
+RECURSIVE if DIRECTORY is nonempty."
   (interactive
    (let* ((trashing (and delete-by-moving-to-trash
                         (null current-prefix-arg)))
@@ -5381,18 +5393,22 @@ given.  With a prefix argument, TRASH is nil."
        (move-file-to-trash directory)))
      ;; Otherwise, call ourselves recursively if needed.
      (t
-      (if (and recursive (not (file-symlink-p directory)))
-         (mapc (lambda (file)
-                 ;; This test is equivalent to
-                 ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
-                 ;; but more efficient
-                 (if (eq t (car (file-attributes file)))
-                     (delete-directory file recursive nil)
-                   (delete-file file nil)))
-               ;; We do not want to delete "." and "..".
-               (directory-files
-                directory 'full directory-files-no-dot-files-regexp)))
-      (delete-directory-internal directory)))))
+      (when (or (not recursive) (file-symlink-p directory)
+               (let* ((files
+                       (files--force t #'directory-files directory 'full
+                                     directory-files-no-dot-files-regexp))
+                      (directory-exists (listp files)))
+                 (when directory-exists
+                   (mapc (lambda (file)
+                           ;; This test is equivalent to but more efficient
+                           ;; than (and (file-directory-p fn)
+                           ;;           (not (file-symlink-p fn))).
+                           (if (eq t (car (file-attributes file)))
+                               (delete-directory file recursive)
+                             (files--force t #'delete-file file)))
+                         files))
+                 directory-exists))
+       (files--force recursive #'delete-directory-internal directory))))))
 
 (defun file-equal-p (file1 file2)
   "Return non-nil if files FILE1 and FILE2 name the same file.
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 0416b08..9418064 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1145,18 +1145,18 @@ REGEXP if non-nil says use the regexp search ring."
                  (case-fold-search isearch-case-fold-search)
                  (pop-fun (if isearch-push-state-function
                               (funcall isearch-push-state-function))))))
-  (string :read-only t)
-  (message :read-only t)
-  (point :read-only t)
-  (success :read-only t)
-  (forward :read-only t)
-  (other-end :read-only t)
-  (word :read-only t)
-  (error :read-only t)
-  (wrapped :read-only t)
-  (barrier :read-only t)
-  (case-fold-search :read-only t)
-  (pop-fun :read-only t))
+  (string nil :read-only t)
+  (message nil :read-only t)
+  (point nil :read-only t)
+  (success nil :read-only t)
+  (forward nil :read-only t)
+  (other-end nil :read-only t)
+  (word nil :read-only t)
+  (error nil :read-only t)
+  (wrapped nil :read-only t)
+  (barrier nil :read-only t)
+  (case-fold-search nil :read-only t)
+  (pop-fun nil :read-only t))
 
 (defun isearch--set-state (cmd)
   (setq isearch-string (isearch--state-string cmd)
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 02cb627..338afca 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -36,8 +36,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 (defgroup dig nil
   "Dig configuration."
   :group 'comm)
@@ -126,15 +124,13 @@ Buffer should contain output generated by `dig-invoke'."
 ;; `font-lock-defaults' buffer-local variable.
 (put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t))
 
-(put 'dig-mode 'mode-class 'special)
-
 (defvar dig-mode-map
   (let ((map (make-sparse-keymap)))
-    (suppress-keymap map)
+    (define-key map "g" nil)
     (define-key map "q" 'dig-exit)
     map))
 
-(define-derived-mode dig-mode nil "Dig"
+(define-derived-mode dig-mode special-mode "Dig"
   "Major mode for displaying dig output."
   (buffer-disable-undo)
   (unless (featurep 'xemacs)
@@ -148,7 +144,7 @@ Buffer should contain output generated by `dig-invoke'."
 (defun dig-exit ()
   "Quit dig output buffer."
   (interactive)
-  (kill-buffer (current-buffer)))
+  (quit-window t))
 
 ;;;###autoload
 (defun dig (domain &optional
@@ -156,14 +152,12 @@ Buffer should contain output generated by `dig-invoke'."
   "Query addresses of a DOMAIN using dig, by calling `dig-invoke'.
 Optional arguments are passed to `dig-invoke'."
   (interactive "sHost: ")
-  (switch-to-buffer
+  (pop-to-buffer-same-window
    (dig-invoke domain query-type query-class query-option dig-option server))
   (goto-char (point-min))
   (and (search-forward ";; ANSWER SECTION:" nil t)
        (forward-line))
-  (dig-mode)
-  (setq buffer-read-only t)
-  (set-buffer-modified-p nil))
+  (dig-mode))
 
 ;; named for consistency with query-dns in dns.el
 (defun query-dig (domain &optional
@@ -175,7 +169,7 @@ Returns nil for domain/class/type queries that result in no 
data."
 (let ((buffer (dig-invoke domain query-type query-class
                          query-option dig-option server)))
   (when buffer
-    (switch-to-buffer buffer)
+    (pop-to-buffer-same-window buffer)
     (let ((digger (dig-extract-rr domain query-type query-class)))
       (kill-buffer buffer)
       digger))))
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index f80b300..f71d7ba 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -29,7 +29,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (autoload 'mail-header-parse-content-type "mail-parse")
 
 (defgroup mailcap nil
@@ -62,20 +62,20 @@
   (let ((val (default-value sym))
        res)
     (dolist (entry val)
-      (setq res (cons (list (cdr (assq 'viewer entry))
-                           (cdr (assq 'type entry))
-                           (cdr (assq 'test entry)))
-                     res)))
+      (push (list (cdr (assq 'viewer entry))
+                  (cdr (assq 'type entry))
+                  (cdr (assq 'test entry)))
+            res))
     (nreverse res)))
 
 (defun mailcap--set-user-mime-data (sym val)
   (let (res)
     (dolist (entry val)
-      (setq res (cons `((viewer . ,(car entry))
-                       (type . ,(cadr entry))
-                       ,@(when (caddr entry)
-                           `((test . ,(caddr entry)))))
-                     res)))
+      (push `((viewer . ,(car entry))
+              (type . ,(cadr entry))
+              ,@(when (cl-caddr entry)
+                  `((test . ,(cl-caddr entry)))))
+            res))
     (set-default sym (nreverse res))))
 
 (defcustom mailcap-user-mime-data nil
@@ -430,18 +430,14 @@ MAILCAPS if set; otherwise (on Unix) use the path from 
RFC 1524, plus
              ;; with /usr before /usr/local.
              '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
                "/usr/local/etc/mailcap"))))
-    (let ((fnames (reverse
-                  (if (stringp path)
-                      (split-string path path-separator t)
-                    path)))
-         fname)
-      (while fnames
-       (setq fname (car fnames))
-       (if (and (file-readable-p fname)
-                (file-regular-p fname))
-           (mailcap-parse-mailcap fname))
-       (setq fnames (cdr fnames))))
-      (setq mailcap-parsed-p t)))
+    (dolist (fname (reverse
+                    (if (stringp path)
+                        (split-string path path-separator t)
+                      path)))
+      (if (and (file-readable-p fname)
+               (file-regular-p fname))
+          (mailcap-parse-mailcap fname)))
+    (setq mailcap-parsed-p t)))
 
 (defun mailcap-parse-mailcap (fname)
   "Parse out the mailcap file specified by FNAME."
@@ -560,10 +556,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 
1524, plus
          (setq value (buffer-substring val-pos (point))))
        ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
        ;; strings
-       (setq results (cons (cons (if (string-equal name "test")
-                                      'test
-                                    name)
-                                  value) results))
+       (push (cons (if (string-equal name "test") 'test name) value) results)
        (skip-chars-forward " \";\n\t"))
       results)))
 
@@ -607,9 +600,9 @@ the test clause will be unchanged."
     (while major
       (cond
        ((equal (car (car major)) minor)
-       (setq exact (cons (cdr (car major)) exact)))
+       (push (cdr (car major)) exact))
        ((and minor (string-match (concat "^" (car (car major)) "$") minor))
-       (setq wildcard (cons (cdr (car major)) wildcard))))
+       (push (cdr (car major)) wildcard)))
       (setq major (cdr major)))
     (nconc exact wildcard)))
 
@@ -672,7 +665,7 @@ to supply to the test."
         (otest test)
         (viewer (cdr (assq 'viewer viewer-info)))
         (default-directory (expand-file-name "~/"))
-        status parsed-test cache result)
+        status cache result)
     (cond ((not (or (stringp viewer) (fboundp viewer)))
           nil)                         ; Non-existent Lisp function
          ((setq cache (assoc test mailcap-viewer-test-cache))
@@ -704,9 +697,7 @@ to supply to the test."
 (defun mailcap-add-mailcap-entry (major minor info)
   (let ((old-major (assoc major mailcap-mime-data)))
     (if (null old-major)               ; New major area
-       (setq mailcap-mime-data
-             (cons (cons major (list (cons minor info)))
-                   mailcap-mime-data))
+       (push (cons major (list (cons minor info))) mailcap-mime-data)
       (let ((cur-minor (assoc minor old-major)))
        (cond
         ((or (null cur-minor)          ; New minor area, or
@@ -786,10 +777,7 @@ If NO-DECODE is non-nil, don't decode STRING."
        major                           ; Major encoding (text, etc)
        minor                           ; Minor encoding (html, etc)
        info                            ; Other info
-       save-pos                        ; Misc. position during parse
        major-info                      ; (assoc major mailcap-mime-data)
-       minor-info                      ; (assoc minor major-info)
-       test                            ; current test proc.
        viewers                         ; Possible viewers
        passed                          ; Viewers that passed the test
        viewer                          ; The one and only viewer
@@ -815,7 +803,7 @@ If NO-DECODE is non-nil, don't decode STRING."
                                (cdr ctl)))
             (while viewers
               (if (mailcap-viewer-passes-test (car viewers) info)
-                  (setq passed (cons (car viewers) passed)))
+                  (push (car viewers) passed))
               (setq viewers (cdr viewers)))
             (setq passed (sort passed 'mailcap-viewer-lessp))
             (setq viewer (car passed))))
@@ -980,15 +968,11 @@ If FORCE, re-parse even if already parsed."
                "/usr/etc/mime-types"
                "/usr/local/etc/mime-types"
                "/usr/local/www/conf/mime-types"))))
-    (let ((fnames (reverse (if (stringp path)
-                              (split-string path path-separator t)
-                            path)))
-         fname)
-      (while fnames
-       (setq fname (car fnames))
-       (if (and (file-readable-p fname))
-           (mailcap-parse-mimetype-file fname))
-       (setq fnames (cdr fnames))))
+    (dolist (fname (reverse (if (stringp path)
+                                (split-string path path-separator t)
+                              path)))
+      (if (and (file-readable-p fname))
+          (mailcap-parse-mimetype-file fname)))
     (setq mailcap-mimetypes-parsed-p t)))
 
 (defun mailcap-parse-mimetype-file (fname)
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index cceb75e..0b9975f 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -1521,7 +1521,7 @@ references and character references.  A processing 
instruction
 consists of a target and a content string.  A comment or a CDATA
 section contains a single string.  An entity reference contains a
 single name.  A character reference contains a character number."
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (cond ((> arg 0)
         (while (progn
@@ -1733,7 +1733,7 @@ single name.  A character reference contains a character 
number."
     ret))
 
 (defun nxml-up-element (&optional arg)
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-backward-up-element (- arg))
@@ -1761,7 +1761,7 @@ single name.  A character reference contains a character 
number."
        (apply #'error (cddr err))))))
 
 (defun nxml-backward-up-element (&optional arg)
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-up-element (- arg))
@@ -1793,7 +1793,7 @@ single name.  A character reference contains a character 
number."
   "Move forward down into the content of an element.
 With ARG, do this that many times.
 Negative ARG means move backward but still down."
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-backward-down-element (- arg))
@@ -1811,7 +1811,7 @@ Negative ARG means move backward but still down."
       (setq arg (1- arg)))))
 
 (defun nxml-backward-down-element (&optional arg)
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-down-element (- arg))
@@ -1839,7 +1839,7 @@ Negative ARG means move backward but still down."
   "Move forward over one element.
 With ARG, do it that many times.
 Negative ARG means move backward."
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-backward-element (- arg))
@@ -1858,7 +1858,7 @@ Negative ARG means move backward."
   "Move backward over one element.
 With ARG, do it that many times.
 Negative ARG means move forward."
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (if (< arg 0)
       (nxml-forward-element (- arg))
@@ -1893,7 +1893,7 @@ The paragraph marked is the one that contains point or 
follows point."
   (nxml-backward-paragraph))
 
 (defun nxml-forward-paragraph (&optional arg)
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (cond ((< arg 0)
         (nxml-backward-paragraph (- arg)))
@@ -1903,7 +1903,7 @@ The paragraph marked is the one that contains point or 
follows point."
                     (> (setq arg (1- arg)) 0))))))
 
 (defun nxml-backward-paragraph (&optional arg)
-  (interactive "p")
+  (interactive "^p")
   (or arg (setq arg 1))
   (cond ((< arg 0)
         (nxml-forward-paragraph (- arg)))
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 78646e4..ea31ee8 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -766,7 +766,7 @@ We run the first FUNCTION whose STRING matches the input 
events."
    (make-composed-keymap map (keymap-parent basemap))))
 
 (define-minor-mode xterm-inhibit-bracketed-paste-mode
-  "Toggle whether XTerm bracketed paste should be allowed in this bugger.
+  "Toggle whether XTerm bracketed paste should be allowed in this buffer.
 With a prefix argument ARG, forbid bracketed paste if ARG is
 positive, and allow it otherwise.  If called from Lisp, forbid
 bracketed paste if ARG is omitted or nil, and toggle the state of
diff --git a/src/frame.c b/src/frame.c
index 45559b0..a1c2199 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1160,7 +1160,12 @@ do_switch_frame (Lisp_Object frame, int track, int 
for_deletion, Lisp_Object nor
       if (FRAMEP (xfocus))
        {
          focus = FRAME_FOCUS_FRAME (XFRAME (xfocus));
-         if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
+         if ((FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ())
+             /* Redirect frame focus also when FRAME has its minibuffer
+                window on the selected frame (see Bug#24500).  */
+             || (NILP (focus)
+                 && EQ (FRAME_MINIBUF_WINDOW (XFRAME (frame)),
+                        sf->selected_window)))
            Fredirect_frame_focus (xfocus, frame);
        }
     }
diff --git a/src/window.c b/src/window.c
index 753ebc1..acbefcd 100644
--- a/src/window.c
+++ b/src/window.c
@@ -2377,8 +2377,10 @@ candidate_window_p (Lisp_Object window, Lisp_Object 
owindow,
            == FRAME_TERMINAL (XFRAME (selected_frame)));
     }
   else if (WINDOWP (all_frames))
-    candidate_p = (EQ (FRAME_MINIBUF_WINDOW (f), all_frames)
-                  || EQ (XWINDOW (all_frames)->frame, w->frame)
+    /*         To qualify as candidate, it's not sufficient for WINDOW's frame
+       to just share the minibuffer window - it must be active as well
+       (see Bug#24500).  */
+    candidate_p = (EQ (XWINDOW (all_frames)->frame, w->frame)
                   || EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f)));
   else if (FRAMEP (all_frames))
     candidate_p = EQ (all_frames, w->frame);
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el 
b/test/lisp/emacs-lisp/cl-seq-tests.el
index cc393f4..02d9246 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -294,7 +294,6 @@ Body are forms defining the test."
 
 (ert-deftest cl-seq-test-bug24264 ()
   "Test for http://debbugs.gnu.org/24264 ."
-  :expected-result :failed
   (let ((list  (append (make-list 8000005 1) '(8)))
         (list2 (make-list 8000005 2)))
     (should (cl-position 8 list))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]