diff options
| author | Michael Albinus | 2016-10-20 14:58:13 +0200 |
|---|---|---|
| committer | Michael Albinus | 2016-10-20 14:58:13 +0200 |
| commit | ce26926b6223194a6ff0d8a3c17f1d58aaa5d0fe (patch) | |
| tree | 9db5e547a5c7fa2a2380de19fcd1e73d1c45fa29 | |
| parent | 38091c90005932017cbac54f2f5b82b3a003b9fa (diff) | |
| parent | f63a4b82f0e8634a76e4e7794bb7c7c4e734c4ba (diff) | |
| download | emacs-ce26926b6223194a6ff0d8a3c17f1d58aaa5d0fe.tar.gz emacs-ce26926b6223194a6ff0d8a3c17f1d58aaa5d0fe.zip | |
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
| -rw-r--r-- | doc/lispref/files.texi | 3 | ||||
| -rw-r--r-- | etc/NEWS | 12 | ||||
| -rw-r--r-- | lisp/auth-source.el | 24 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 13 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-seq.el | 70 | ||||
| -rw-r--r-- | lisp/eshell/em-hist.el | 19 | ||||
| -rw-r--r-- | lisp/files.el | 46 | ||||
| -rw-r--r-- | lisp/isearch.el | 24 | ||||
| -rw-r--r-- | lisp/net/dig.el | 18 | ||||
| -rw-r--r-- | lisp/net/mailcap.el | 74 | ||||
| -rw-r--r-- | lisp/nxml/nxml-mode.el | 18 | ||||
| -rw-r--r-- | lisp/term/xterm.el | 2 | ||||
| -rw-r--r-- | src/frame.c | 7 | ||||
| -rw-r--r-- | src/window.c | 6 | ||||
| -rw-r--r-- | 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 9af5ce967c2..62e0199f1ff 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 | |||
| 2855 | must use @code{delete-directory} for them. If @var{recursive} is | 2855 | must use @code{delete-directory} for them. If @var{recursive} is |
| 2856 | @code{nil}, and the directory contains any files, | 2856 | @code{nil}, and the directory contains any files, |
| 2857 | @code{delete-directory} signals an error. | 2857 | @code{delete-directory} signals an error. |
| 2858 | If recursive is non-@code{nil}, there is no error merely because the | ||
| 2859 | directory or its files are deleted by some other process before | ||
| 2860 | @code{delete-directory} gets to them. | ||
| 2858 | 2861 | ||
| 2859 | @code{delete-directory} only follows symbolic links at the level of | 2862 | @code{delete-directory} only follows symbolic links at the level of |
| 2860 | parent directories. | 2863 | parent directories. |
| @@ -308,6 +308,13 @@ viewing HTML files and the like. | |||
| 308 | breakpoint (e.g. with "f" and "o") by customizing the new option | 308 | breakpoint (e.g. with "f" and "o") by customizing the new option |
| 309 | 'edebug-sit-on-break'. | 309 | 'edebug-sit-on-break'. |
| 310 | 310 | ||
| 311 | ** Eshell | ||
| 312 | |||
| 313 | *** 'eshell-input-filter's value is now a named function | ||
| 314 | 'eshell-input-filter-default', and has a new custom option | ||
| 315 | 'eshell-input-filter-initial-space' to ignore adding commands prefixed | ||
| 316 | with blank space to eshell history. | ||
| 317 | |||
| 311 | ** eww | 318 | ** eww |
| 312 | 319 | ||
| 313 | +++ | 320 | +++ |
| @@ -619,6 +626,11 @@ collection). | |||
| 619 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' | 626 | ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' |
| 620 | can be used for creation of temporary files of remote or mounted directories. | 627 | can be used for creation of temporary files of remote or mounted directories. |
| 621 | 628 | ||
| 629 | +++ | ||
| 630 | ** The function 'delete-directory' no longer signals an error when | ||
| 631 | operating recursively and when some other process deletes the directory | ||
| 632 | or its files before 'delete-directory' gets to them. | ||
| 633 | |||
| 622 | ** Changes in Frame- and Window- Handling | 634 | ** Changes in Frame- and Window- Handling |
| 623 | 635 | ||
| 624 | +++ | 636 | +++ |
diff --git a/lisp/auth-source.el b/lisp/auth-source.el index 97059fa5bd9..9e1f46877bd 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; auth-source.el --- authentication sources for Gnus and Emacs | 1 | ;;; auth-source.el --- authentication sources for Gnus and Emacs -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2008-2016 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -1002,7 +1002,7 @@ Note that the MAX parameter is used so we can exit the parse early." | |||
| 1002 | (auth-source--aput | 1002 | (auth-source--aput |
| 1003 | auth-source-netrc-cache file | 1003 | auth-source-netrc-cache file |
| 1004 | (list :mtime (nth 5 (file-attributes file)) | 1004 | (list :mtime (nth 5 (file-attributes file)) |
| 1005 | :secret (lexical-let ((v (mapcar #'1+ (buffer-string)))) | 1005 | :secret (let ((v (mapcar #'1+ (buffer-string)))) |
| 1006 | (lambda () (apply #'string (mapcar #'1- v))))))) | 1006 | (lambda () (apply #'string (mapcar #'1- v))))))) |
| 1007 | (goto-char (point-min)) | 1007 | (goto-char (point-min)) |
| 1008 | (let ((entries (auth-source-netrc-parse-entries check max)) | 1008 | (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." | |||
| 1118 | (read-passwd | 1118 | (read-passwd |
| 1119 | (format "Passphrase for %s tokens: " file) | 1119 | (format "Passphrase for %s tokens: " file) |
| 1120 | t)) | 1120 | t)) |
| 1121 | (setcdr entry (lexical-let ((p (copy-sequence passphrase))) | 1121 | (setcdr entry (let ((p (copy-sequence passphrase))) |
| 1122 | (lambda () p))) | 1122 | (lambda () p))) |
| 1123 | passphrase)))) | 1123 | passphrase)))) |
| 1124 | 1124 | ||
| @@ -1174,8 +1174,8 @@ FILE is the file from which we obtained this token." | |||
| 1174 | 1174 | ||
| 1175 | ;; send back the secret in a function (lexical binding) | 1175 | ;; send back the secret in a function (lexical binding) |
| 1176 | (when (equal k "secret") | 1176 | (when (equal k "secret") |
| 1177 | (setq v (lexical-let ((lexv v) | 1177 | (setq v (let ((lexv v) |
| 1178 | (token-decoder nil)) | 1178 | (token-decoder nil)) |
| 1179 | (when (string-match "^gpg:" lexv) | 1179 | (when (string-match "^gpg:" lexv) |
| 1180 | ;; it's a GPG token: create a token decoder | 1180 | ;; it's a GPG token: create a token decoder |
| 1181 | ;; which unsets itself once | 1181 | ;; which unsets itself once |
| @@ -1384,7 +1384,7 @@ See `auth-source-search' for details on SPEC." | |||
| 1384 | (setq artificial (plist-put artificial | 1384 | (setq artificial (plist-put artificial |
| 1385 | (auth-source--symbol-keyword r) | 1385 | (auth-source--symbol-keyword r) |
| 1386 | (if (eq r 'secret) | 1386 | (if (eq r 'secret) |
| 1387 | (lexical-let ((data data)) | 1387 | (let ((data data)) |
| 1388 | (lambda () data)) | 1388 | (lambda () data)) |
| 1389 | data)))) | 1389 | data)))) |
| 1390 | 1390 | ||
| @@ -1414,8 +1414,8 @@ See `auth-source-search' for details on SPEC." | |||
| 1414 | (plist-put | 1414 | (plist-put |
| 1415 | artificial | 1415 | artificial |
| 1416 | :save-function | 1416 | :save-function |
| 1417 | (lexical-let ((file file) | 1417 | (let ((file file) |
| 1418 | (add add)) | 1418 | (add add)) |
| 1419 | (lambda () (auth-source-netrc-saver file add)))) | 1419 | (lambda () (auth-source-netrc-saver file add)))) |
| 1420 | 1420 | ||
| 1421 | (list artificial))) | 1421 | (list artificial))) |
| @@ -1611,7 +1611,7 @@ authentication tokens: | |||
| 1611 | ;; make an entry for the secret (password) element | 1611 | ;; make an entry for the secret (password) element |
| 1612 | (list | 1612 | (list |
| 1613 | :secret | 1613 | :secret |
| 1614 | (lexical-let ((v (secrets-get-secret coll item))) | 1614 | (let ((v (secrets-get-secret coll item))) |
| 1615 | (lambda () v))) | 1615 | (lambda () v))) |
| 1616 | ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist | 1616 | ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist |
| 1617 | (apply #'append | 1617 | (apply #'append |
| @@ -1813,8 +1813,8 @@ entries for git.gnus.org: | |||
| 1813 | ret | 1813 | ret |
| 1814 | keychain-generic | 1814 | keychain-generic |
| 1815 | "secret" | 1815 | "secret" |
| 1816 | (lexical-let ((v (auth-source--decode-octal-string | 1816 | (let ((v (auth-source--decode-octal-string |
| 1817 | (match-string 1)))) | 1817 | (match-string 1)))) |
| 1818 | (lambda () v))))) | 1818 | (lambda () v))))) |
| 1819 | ;; TODO: check if this is really the label | 1819 | ;; TODO: check if this is really the label |
| 1820 | ;; match 0x00000007 <blob>="AppleID" | 1820 | ;; match 0x00000007 <blob>="AppleID" |
| @@ -1896,7 +1896,7 @@ entries for git.gnus.org: | |||
| 1896 | (if secret | 1896 | (if secret |
| 1897 | (setcar | 1897 | (setcar |
| 1898 | (cdr secret) | 1898 | (cdr secret) |
| 1899 | (lexical-let ((v (car (cdr secret)))) | 1899 | (let ((v (car (cdr secret)))) |
| 1900 | (lambda () v)))) | 1900 | (lambda () v)))) |
| 1901 | plist)) | 1901 | plist)) |
| 1902 | items)) | 1902 | items)) |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index f5b7b826431..0096e0aab3e 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'. | |||
| 2590 | [":initial-offset" natnump])])] | 2590 | [":initial-offset" natnump])])] |
| 2591 | [&optional stringp] | 2591 | [&optional stringp] |
| 2592 | ;; All the above is for the following def-form. | 2592 | ;; All the above is for the following def-form. |
| 2593 | &rest &or symbolp (symbolp def-form | 2593 | &rest &or symbolp (symbolp &optional def-form &rest sexp)))) |
| 2594 | &optional ":read-only" sexp)))) | ||
| 2595 | (let* ((name (if (consp struct) (car struct) struct)) | 2594 | (let* ((name (if (consp struct) (car struct) struct)) |
| 2596 | (opts (cdr-safe struct)) | 2595 | (opts (cdr-safe struct)) |
| 2597 | (slots nil) | 2596 | (slots nil) |
| @@ -2655,7 +2654,7 @@ non-nil value, that slot cannot be set via `setf'. | |||
| 2655 | (setq descs (nconc (make-list (car args) '(cl-skip-slot)) | 2654 | (setq descs (nconc (make-list (car args) '(cl-skip-slot)) |
| 2656 | descs))) | 2655 | descs))) |
| 2657 | (t | 2656 | (t |
| 2658 | (error "Slot option %s unrecognized" opt))))) | 2657 | (error "Structure option %s unrecognized" opt))))) |
| 2659 | (unless (or include-name type) | 2658 | (unless (or include-name type) |
| 2660 | (setq include-name cl--struct-default-parent)) | 2659 | (setq include-name cl--struct-default-parent)) |
| 2661 | (when include-name (setq include (cl--struct-get-class include-name))) | 2660 | (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'. | |||
| 2711 | (let ((pos 0) (descp descs)) | 2710 | (let ((pos 0) (descp descs)) |
| 2712 | (while descp | 2711 | (while descp |
| 2713 | (let* ((desc (pop descp)) | 2712 | (let* ((desc (pop descp)) |
| 2714 | (slot (car desc))) | 2713 | (slot (pop desc))) |
| 2715 | (if (memq slot '(cl-tag-slot cl-skip-slot)) | 2714 | (if (memq slot '(cl-tag-slot cl-skip-slot)) |
| 2716 | (progn | 2715 | (progn |
| 2717 | (push nil slots) | 2716 | (push nil slots) |
| @@ -2721,7 +2720,7 @@ non-nil value, that slot cannot be set via `setf'. | |||
| 2721 | (error "Duplicate slots named %s in %s" slot name)) | 2720 | (error "Duplicate slots named %s in %s" slot name)) |
| 2722 | (let ((accessor (intern (format "%s%s" conc-name slot)))) | 2721 | (let ((accessor (intern (format "%s%s" conc-name slot)))) |
| 2723 | (push slot slots) | 2722 | (push slot slots) |
| 2724 | (push (nth 1 desc) defaults) | 2723 | (push (pop desc) defaults) |
| 2725 | ;; The arg "cl-x" is referenced by name in eg pred-form | 2724 | ;; The arg "cl-x" is referenced by name in eg pred-form |
| 2726 | ;; and pred-check, so changing it is not straightforward. | 2725 | ;; and pred-check, so changing it is not straightforward. |
| 2727 | (push `(cl-defsubst ,accessor (cl-x) | 2726 | (push `(cl-defsubst ,accessor (cl-x) |
| @@ -2736,7 +2735,9 @@ non-nil value, that slot cannot be set via `setf'. | |||
| 2736 | (if (= pos 0) '(car cl-x) | 2735 | (if (= pos 0) '(car cl-x) |
| 2737 | `(nth ,pos cl-x)))) | 2736 | `(nth ,pos cl-x)))) |
| 2738 | forms) | 2737 | forms) |
| 2739 | (if (cadr (memq :read-only (cddr desc))) | 2738 | (when (cl-oddp (length desc)) |
| 2739 | (error "Invalid options for slot %s in %s" slot name)) | ||
| 2740 | (if (plist-get desc ':read-only) | ||
| 2740 | (push `(gv-define-expander ,accessor | 2741 | (push `(gv-define-expander ,accessor |
| 2741 | (lambda (_cl-do _cl-x) | 2742 | (lambda (_cl-do _cl-x) |
| 2742 | (error "%s is a read-only slot" ',accessor))) | 2743 | (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 ed27b7c7d05..3f8b1eec66e 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el | |||
| @@ -151,8 +151,8 @@ called. | |||
| 151 | (cl--parsing-keywords ((:start 0) :end) () | 151 | (cl--parsing-keywords ((:start 0) :end) () |
| 152 | (if (listp cl-seq) | 152 | (if (listp cl-seq) |
| 153 | (let ((p (nthcdr cl-start cl-seq)) | 153 | (let ((p (nthcdr cl-start cl-seq)) |
| 154 | (n (if cl-end (- cl-end cl-start) 8000000))) | 154 | (n (and cl-end (- cl-end cl-start)))) |
| 155 | (while (and p (>= (setq n (1- n)) 0)) | 155 | (while (and p (or (null n) (>= (cl-decf n) 0))) |
| 156 | (setcar p cl-item) | 156 | (setcar p cl-item) |
| 157 | (setq p (cdr p)))) | 157 | (setq p (cdr p)))) |
| 158 | (or cl-end (setq cl-end (length cl-seq))) | 158 | (or cl-end (setq cl-end (length cl-seq))) |
| @@ -180,16 +180,20 @@ SEQ1 is destructively modified, then returned. | |||
| 180 | (elt cl-seq2 (+ cl-start2 cl-n)))))) | 180 | (elt cl-seq2 (+ cl-start2 cl-n)))))) |
| 181 | (if (listp cl-seq1) | 181 | (if (listp cl-seq1) |
| 182 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) | 182 | (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) |
| 183 | (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) | 183 | (cl-n1 (and cl-end1 (- cl-end1 cl-start1)))) |
| 184 | (if (listp cl-seq2) | 184 | (if (listp cl-seq2) |
| 185 | (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) | 185 | (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) |
| 186 | (cl-n (min cl-n1 | 186 | (cl-n (cond ((and cl-n1 cl-end2) |
| 187 | (if cl-end2 (- cl-end2 cl-start2) 4000000)))) | 187 | (min cl-n1 (- cl-end2 cl-start2))) |
| 188 | (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) | 188 | ((and cl-n1 (null cl-end2)) cl-n1) |
| 189 | ((and (null cl-n1) cl-end2) (- cl-end2 cl-start2))))) | ||
| 190 | (while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0))) | ||
| 189 | (setcar cl-p1 (car cl-p2)) | 191 | (setcar cl-p1 (car cl-p2)) |
| 190 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) | 192 | (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) |
| 191 | (setq cl-end2 (min (or cl-end2 (length cl-seq2)) | 193 | (setq cl-end2 (if (null cl-n1) |
| 192 | (+ cl-start2 cl-n1))) | 194 | (or cl-end2 (length cl-seq2)) |
| 195 | (min (or cl-end2 (length cl-seq2)) | ||
| 196 | (+ cl-start2 cl-n1)))) | ||
| 193 | (while (and cl-p1 (< cl-start2 cl-end2)) | 197 | (while (and cl-p1 (< cl-start2 cl-end2)) |
| 194 | (setcar cl-p1 (aref cl-seq2 cl-start2)) | 198 | (setcar cl-p1 (aref cl-seq2 cl-start2)) |
| 195 | (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) | 199 | (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) |
| @@ -215,9 +219,10 @@ to avoid corrupting the original SEQ. | |||
| 215 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" | 219 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" |
| 216 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end | 220 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end |
| 217 | (:start 0) :end) () | 221 | (:start 0) :end) () |
| 218 | (if (<= (or cl-count (setq cl-count 8000000)) 0) | 222 | (let ((len (length cl-seq))) |
| 223 | (if (<= (or cl-count (setq cl-count len)) 0) | ||
| 219 | cl-seq | 224 | cl-seq |
| 220 | (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) | 225 | (if (or (nlistp cl-seq) (and cl-from-end (< cl-count (/ len 2)))) |
| 221 | (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end | 226 | (let ((cl-i (cl--position cl-item cl-seq cl-start cl-end |
| 222 | cl-from-end))) | 227 | cl-from-end))) |
| 223 | (if cl-i | 228 | (if cl-i |
| @@ -229,7 +234,7 @@ to avoid corrupting the original SEQ. | |||
| 229 | (if (listp cl-seq) cl-res | 234 | (if (listp cl-seq) cl-res |
| 230 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) | 235 | (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) |
| 231 | cl-seq)) | 236 | cl-seq)) |
| 232 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 237 | (setq cl-end (- (or cl-end len) cl-start)) |
| 233 | (if (= cl-start 0) | 238 | (if (= cl-start 0) |
| 234 | (while (and cl-seq (> cl-end 0) | 239 | (while (and cl-seq (> cl-end 0) |
| 235 | (cl--check-test cl-item (car cl-seq)) | 240 | (cl--check-test cl-item (car cl-seq)) |
| @@ -250,7 +255,7 @@ to avoid corrupting the original SEQ. | |||
| 250 | :start 0 :end (1- cl-end) | 255 | :start 0 :end (1- cl-end) |
| 251 | :count (1- cl-count) cl-keys)))) | 256 | :count (1- cl-count) cl-keys)))) |
| 252 | cl-seq)) | 257 | cl-seq)) |
| 253 | cl-seq))))) | 258 | cl-seq)))))) |
| 254 | 259 | ||
| 255 | ;;;###autoload | 260 | ;;;###autoload |
| 256 | (defun cl-remove-if (cl-pred cl-list &rest cl-keys) | 261 | (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. | |||
| 278 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" | 283 | \n(fn ITEM SEQ [KEYWORD VALUE]...)" |
| 279 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end | 284 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count :from-end |
| 280 | (:start 0) :end) () | 285 | (:start 0) :end) () |
| 281 | (if (<= (or cl-count (setq cl-count 8000000)) 0) | 286 | (let ((len (length cl-seq))) |
| 287 | (if (<= (or cl-count (setq cl-count len)) 0) | ||
| 282 | cl-seq | 288 | cl-seq |
| 283 | (if (listp cl-seq) | 289 | (if (listp cl-seq) |
| 284 | (if (and cl-from-end (< cl-count 4000000)) | 290 | (if (and cl-from-end (< cl-count (/ len 2))) |
| 285 | (let (cl-i) | 291 | (let (cl-i) |
| 286 | (while (and (>= (setq cl-count (1- cl-count)) 0) | 292 | (while (and (>= (setq cl-count (1- cl-count)) 0) |
| 287 | (setq cl-i (cl--position cl-item cl-seq cl-start | 293 | (setq cl-i (cl--position cl-item cl-seq cl-start |
| 288 | cl-end cl-from-end))) | 294 | cl-end cl-from-end))) |
| 289 | (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) | 295 | (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) |
| 290 | (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) | 296 | (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) |
| 291 | (setcdr cl-tail (cdr (cdr cl-tail))))) | 297 | (setcdr cl-tail (cdr (cdr cl-tail))))) |
| 292 | (setq cl-end cl-i)) | 298 | (setq cl-end cl-i)) |
| 293 | cl-seq) | 299 | cl-seq) |
| 294 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 300 | (setq cl-end (- (or cl-end len) cl-start)) |
| 295 | (if (= cl-start 0) | 301 | (if (= cl-start 0) |
| 296 | (progn | 302 | (progn |
| 297 | (while (and cl-seq | 303 | (while (and cl-seq |
| @@ -312,7 +318,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 312 | (setq cl-p (cdr cl-p))) | 318 | (setq cl-p (cdr cl-p))) |
| 313 | (setq cl-end (1- cl-end))))) | 319 | (setq cl-end (1- cl-end))))) |
| 314 | cl-seq) | 320 | cl-seq) |
| 315 | (apply 'cl-remove cl-item cl-seq cl-keys))))) | 321 | (apply 'cl-remove cl-item cl-seq cl-keys)))))) |
| 316 | 322 | ||
| 317 | ;;;###autoload | 323 | ;;;###autoload |
| 318 | (defun cl-delete-if (cl-pred cl-list &rest cl-keys) | 324 | (defun cl-delete-if (cl-pred cl-list &rest cl-keys) |
| @@ -396,15 +402,17 @@ to avoid corrupting the original SEQ. | |||
| 396 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count | 402 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count |
| 397 | (:start 0) :end :from-end) () | 403 | (:start 0) :end :from-end) () |
| 398 | (if (or (eq cl-old cl-new) | 404 | (if (or (eq cl-old cl-new) |
| 399 | (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) | 405 | (<= (or cl-count (setq cl-from-end nil |
| 406 | cl-count (length cl-seq))) 0)) | ||
| 400 | cl-seq | 407 | cl-seq |
| 401 | (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) | 408 | (let ((cl-i (cl--position cl-old cl-seq cl-start cl-end))) |
| 402 | (if (not cl-i) | 409 | (if (not cl-i) |
| 403 | cl-seq | 410 | cl-seq |
| 404 | (setq cl-seq (copy-sequence cl-seq)) | 411 | (setq cl-seq (copy-sequence cl-seq)) |
| 405 | (or cl-from-end | 412 | (unless cl-from-end |
| 406 | (progn (setf (elt cl-seq cl-i) cl-new) | 413 | (setf (elt cl-seq cl-i) cl-new) |
| 407 | (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) | 414 | (cl-incf cl-i) |
| 415 | (cl-decf cl-count)) | ||
| 408 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count | 416 | (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count |
| 409 | :start cl-i cl-keys)))))) | 417 | :start cl-i cl-keys)))))) |
| 410 | 418 | ||
| @@ -434,17 +442,18 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 434 | \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" | 442 | \n(fn NEW OLD SEQ [KEYWORD VALUE]...)" |
| 435 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count | 443 | (cl--parsing-keywords (:test :test-not :key :if :if-not :count |
| 436 | (:start 0) :end :from-end) () | 444 | (:start 0) :end :from-end) () |
| 437 | (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) | 445 | (let ((len (length cl-seq))) |
| 438 | (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) | 446 | (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count len)) 0) |
| 447 | (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count (/ len 2)))) | ||
| 439 | (let ((cl-p (nthcdr cl-start cl-seq))) | 448 | (let ((cl-p (nthcdr cl-start cl-seq))) |
| 440 | (setq cl-end (- (or cl-end 8000000) cl-start)) | 449 | (setq cl-end (- (or cl-end len) cl-start)) |
| 441 | (while (and cl-p (> cl-end 0) (> cl-count 0)) | 450 | (while (and cl-p (> cl-end 0) (> cl-count 0)) |
| 442 | (if (cl--check-test cl-old (car cl-p)) | 451 | (if (cl--check-test cl-old (car cl-p)) |
| 443 | (progn | 452 | (progn |
| 444 | (setcar cl-p cl-new) | 453 | (setcar cl-p cl-new) |
| 445 | (setq cl-count (1- cl-count)))) | 454 | (setq cl-count (1- cl-count)))) |
| 446 | (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) | 455 | (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) |
| 447 | (or cl-end (setq cl-end (length cl-seq))) | 456 | (or cl-end (setq cl-end len)) |
| 448 | (if cl-from-end | 457 | (if cl-from-end |
| 449 | (while (and (< cl-start cl-end) (> cl-count 0)) | 458 | (while (and (< cl-start cl-end) (> cl-count 0)) |
| 450 | (setq cl-end (1- cl-end)) | 459 | (setq cl-end (1- cl-end)) |
| @@ -457,7 +466,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. | |||
| 457 | (progn | 466 | (progn |
| 458 | (aset cl-seq cl-start cl-new) | 467 | (aset cl-seq cl-start cl-new) |
| 459 | (setq cl-count (1- cl-count)))) | 468 | (setq cl-count (1- cl-count)))) |
| 460 | (setq cl-start (1+ cl-start)))))) | 469 | (setq cl-start (1+ cl-start))))))) |
| 461 | cl-seq)) | 470 | cl-seq)) |
| 462 | 471 | ||
| 463 | ;;;###autoload | 472 | ;;;###autoload |
| @@ -513,14 +522,13 @@ Return the index of the matching item, or nil if not found. | |||
| 513 | 522 | ||
| 514 | (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) | 523 | (defun cl--position (cl-item cl-seq cl-start &optional cl-end cl-from-end) |
| 515 | (if (listp cl-seq) | 524 | (if (listp cl-seq) |
| 516 | (let ((cl-p (nthcdr cl-start cl-seq))) | 525 | (let ((cl-p (nthcdr cl-start cl-seq)) |
| 517 | (or cl-end (setq cl-end 8000000)) | 526 | cl-res) |
| 518 | (let ((cl-res nil)) | 527 | (while (and cl-p (or (null cl-end) (< cl-start cl-end)) (or (null cl-res) cl-from-end)) |
| 519 | (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) | ||
| 520 | (if (cl--check-test cl-item (car cl-p)) | 528 | (if (cl--check-test cl-item (car cl-p)) |
| 521 | (setq cl-res cl-start)) | 529 | (setq cl-res cl-start)) |
| 522 | (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) | 530 | (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) |
| 523 | cl-res)) | 531 | cl-res) |
| 524 | (or cl-end (setq cl-end (length cl-seq))) | 532 | (or cl-end (setq cl-end (length cl-seq))) |
| 525 | (if cl-from-end | 533 | (if cl-from-end |
| 526 | (progn | 534 | (progn |
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 198b1d017c4..067c5ea7ff2 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." | |||
| 119 | (const :tag "Always save" t)) | 119 | (const :tag "Always save" t)) |
| 120 | :group 'eshell-hist) | 120 | :group 'eshell-hist) |
| 121 | 121 | ||
| 122 | (defcustom eshell-input-filter | 122 | (defcustom eshell-input-filter 'eshell-input-filter-default |
| 123 | (function | ||
| 124 | (lambda (str) | ||
| 125 | (not (string-match "\\`\\s-*\\'" str)))) | ||
| 126 | "Predicate for filtering additions to input history. | 123 | "Predicate for filtering additions to input history. |
| 127 | Takes one argument, the input. If non-nil, the input may be saved on | 124 | Takes one argument, the input. If non-nil, the input may be saved on |
| 128 | the input history list. Default is to save anything that isn't all | 125 | the input history list. Default is to save anything that isn't all |
| 129 | whitespace." | 126 | whitespace." |
| 130 | :type 'function | 127 | :type '(radio (function-item eshell-input-filter-default) |
| 128 | (function-item eshell-input-filter-initial-space) | ||
| 129 | (function :tag "Other function")) | ||
| 131 | :group 'eshell-hist) | 130 | :group 'eshell-hist) |
| 132 | 131 | ||
| 133 | (put 'eshell-input-filter 'risky-local-variable t) | 132 | (put 'eshell-input-filter 'risky-local-variable t) |
| @@ -206,6 +205,16 @@ element, regardless of any text on the command line. In that case, | |||
| 206 | 205 | ||
| 207 | ;;; Functions: | 206 | ;;; Functions: |
| 208 | 207 | ||
| 208 | (defun eshell-input-filter-default (input) | ||
| 209 | "Do not add blank input to input history. | ||
| 210 | Returns non-nil if INPUT is blank." | ||
| 211 | (not (string-match "\\`\\s-*\\'" input))) | ||
| 212 | |||
| 213 | (defun eshell-input-filter-initial-space (input) | ||
| 214 | "Do not add input beginning with empty space to history. | ||
| 215 | Returns nil if INPUT is prepended by blank space, otherwise non-nil." | ||
| 216 | (not (string-match-p "\\`\\s-+" input))) | ||
| 217 | |||
| 209 | (defun eshell-hist-initialize () | 218 | (defun eshell-hist-initialize () |
| 210 | "Initialize the history management code for one Eshell buffer." | 219 | "Initialize the history management code for one Eshell buffer." |
| 211 | (add-hook 'eshell-expand-input-functions | 220 | (add-hook 'eshell-expand-input-functions |
diff --git a/lisp/files.el b/lisp/files.el index f481b9967c4..12c6c14d534 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -5336,14 +5336,26 @@ raised." | |||
| 5336 | "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" | 5336 | "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" |
| 5337 | "Regexp matching any file name except \".\" and \"..\".") | 5337 | "Regexp matching any file name except \".\" and \"..\".") |
| 5338 | 5338 | ||
| 5339 | (defun files--force (no-such fn &rest args) | ||
| 5340 | "Use NO-SUCH to affect behavior of function FN applied to list ARGS. | ||
| 5341 | This acts like (apply FN ARGS) except it returns NO-SUCH if it is | ||
| 5342 | non-nil and if FN fails due to a missing file or directory." | ||
| 5343 | (condition-case err | ||
| 5344 | (apply fn args) | ||
| 5345 | (file-error | ||
| 5346 | (or (pcase err (`(,_ ,_ "No such file or directory" . ,_) no-such)) | ||
| 5347 | (signal (car err) (cdr err)))))) | ||
| 5348 | |||
| 5339 | (defun delete-directory (directory &optional recursive trash) | 5349 | (defun delete-directory (directory &optional recursive trash) |
| 5340 | "Delete the directory named DIRECTORY. Does not follow symlinks. | 5350 | "Delete the directory named DIRECTORY. Does not follow symlinks. |
| 5341 | If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well. | 5351 | If RECURSIVE is non-nil, delete files in DIRECTORY as well, with |
| 5352 | no error if something else is simultaneously deleting them. | ||
| 5342 | TRASH non-nil means to trash the directory instead, provided | 5353 | TRASH non-nil means to trash the directory instead, provided |
| 5343 | `delete-by-moving-to-trash' is non-nil. | 5354 | `delete-by-moving-to-trash' is non-nil. |
| 5344 | 5355 | ||
| 5345 | When called interactively, TRASH is t if no prefix argument is | 5356 | When called interactively, TRASH is nil if and only if a prefix |
| 5346 | given. With a prefix argument, TRASH is nil." | 5357 | argument is given, and a further prompt asks the user for |
| 5358 | RECURSIVE if DIRECTORY is nonempty." | ||
| 5347 | (interactive | 5359 | (interactive |
| 5348 | (let* ((trashing (and delete-by-moving-to-trash | 5360 | (let* ((trashing (and delete-by-moving-to-trash |
| 5349 | (null current-prefix-arg))) | 5361 | (null current-prefix-arg))) |
| @@ -5381,18 +5393,22 @@ given. With a prefix argument, TRASH is nil." | |||
| 5381 | (move-file-to-trash directory))) | 5393 | (move-file-to-trash directory))) |
| 5382 | ;; Otherwise, call ourselves recursively if needed. | 5394 | ;; Otherwise, call ourselves recursively if needed. |
| 5383 | (t | 5395 | (t |
| 5384 | (if (and recursive (not (file-symlink-p directory))) | 5396 | (when (or (not recursive) (file-symlink-p directory) |
| 5385 | (mapc (lambda (file) | 5397 | (let* ((files |
| 5386 | ;; This test is equivalent to | 5398 | (files--force t #'directory-files directory 'full |
| 5387 | ;; (and (file-directory-p fn) (not (file-symlink-p fn))) | 5399 | directory-files-no-dot-files-regexp)) |
| 5388 | ;; but more efficient | 5400 | (directory-exists (listp files))) |
| 5389 | (if (eq t (car (file-attributes file))) | 5401 | (when directory-exists |
| 5390 | (delete-directory file recursive nil) | 5402 | (mapc (lambda (file) |
| 5391 | (delete-file file nil))) | 5403 | ;; This test is equivalent to but more efficient |
| 5392 | ;; We do not want to delete "." and "..". | 5404 | ;; than (and (file-directory-p fn) |
| 5393 | (directory-files | 5405 | ;; (not (file-symlink-p fn))). |
| 5394 | directory 'full directory-files-no-dot-files-regexp))) | 5406 | (if (eq t (car (file-attributes file))) |
| 5395 | (delete-directory-internal directory))))) | 5407 | (delete-directory file recursive) |
| 5408 | (files--force t #'delete-file file))) | ||
| 5409 | files)) | ||
| 5410 | directory-exists)) | ||
| 5411 | (files--force recursive #'delete-directory-internal directory)))))) | ||
| 5396 | 5412 | ||
| 5397 | (defun file-equal-p (file1 file2) | 5413 | (defun file-equal-p (file1 file2) |
| 5398 | "Return non-nil if files FILE1 and FILE2 name the same file. | 5414 | "Return non-nil if files FILE1 and FILE2 name the same file. |
diff --git a/lisp/isearch.el b/lisp/isearch.el index 0416b08eba2..9418064fc86 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el | |||
| @@ -1145,18 +1145,18 @@ REGEXP if non-nil says use the regexp search ring." | |||
| 1145 | (case-fold-search isearch-case-fold-search) | 1145 | (case-fold-search isearch-case-fold-search) |
| 1146 | (pop-fun (if isearch-push-state-function | 1146 | (pop-fun (if isearch-push-state-function |
| 1147 | (funcall isearch-push-state-function)))))) | 1147 | (funcall isearch-push-state-function)))))) |
| 1148 | (string :read-only t) | 1148 | (string nil :read-only t) |
| 1149 | (message :read-only t) | 1149 | (message nil :read-only t) |
| 1150 | (point :read-only t) | 1150 | (point nil :read-only t) |
| 1151 | (success :read-only t) | 1151 | (success nil :read-only t) |
| 1152 | (forward :read-only t) | 1152 | (forward nil :read-only t) |
| 1153 | (other-end :read-only t) | 1153 | (other-end nil :read-only t) |
| 1154 | (word :read-only t) | 1154 | (word nil :read-only t) |
| 1155 | (error :read-only t) | 1155 | (error nil :read-only t) |
| 1156 | (wrapped :read-only t) | 1156 | (wrapped nil :read-only t) |
| 1157 | (barrier :read-only t) | 1157 | (barrier nil :read-only t) |
| 1158 | (case-fold-search :read-only t) | 1158 | (case-fold-search nil :read-only t) |
| 1159 | (pop-fun :read-only t)) | 1159 | (pop-fun nil :read-only t)) |
| 1160 | 1160 | ||
| 1161 | (defun isearch--set-state (cmd) | 1161 | (defun isearch--set-state (cmd) |
| 1162 | (setq isearch-string (isearch--state-string cmd) | 1162 | (setq isearch-string (isearch--state-string cmd) |
diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 02cb627cfd3..338afca15f1 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el | |||
| @@ -36,8 +36,6 @@ | |||
| 36 | 36 | ||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | (eval-when-compile (require 'cl)) | ||
| 40 | |||
| 41 | (defgroup dig nil | 39 | (defgroup dig nil |
| 42 | "Dig configuration." | 40 | "Dig configuration." |
| 43 | :group 'comm) | 41 | :group 'comm) |
| @@ -126,15 +124,13 @@ Buffer should contain output generated by `dig-invoke'." | |||
| 126 | ;; `font-lock-defaults' buffer-local variable. | 124 | ;; `font-lock-defaults' buffer-local variable. |
| 127 | (put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t)) | 125 | (put 'dig-mode 'font-lock-defaults '(dig-font-lock-keywords t)) |
| 128 | 126 | ||
| 129 | (put 'dig-mode 'mode-class 'special) | ||
| 130 | |||
| 131 | (defvar dig-mode-map | 127 | (defvar dig-mode-map |
| 132 | (let ((map (make-sparse-keymap))) | 128 | (let ((map (make-sparse-keymap))) |
| 133 | (suppress-keymap map) | 129 | (define-key map "g" nil) |
| 134 | (define-key map "q" 'dig-exit) | 130 | (define-key map "q" 'dig-exit) |
| 135 | map)) | 131 | map)) |
| 136 | 132 | ||
| 137 | (define-derived-mode dig-mode nil "Dig" | 133 | (define-derived-mode dig-mode special-mode "Dig" |
| 138 | "Major mode for displaying dig output." | 134 | "Major mode for displaying dig output." |
| 139 | (buffer-disable-undo) | 135 | (buffer-disable-undo) |
| 140 | (unless (featurep 'xemacs) | 136 | (unless (featurep 'xemacs) |
| @@ -148,7 +144,7 @@ Buffer should contain output generated by `dig-invoke'." | |||
| 148 | (defun dig-exit () | 144 | (defun dig-exit () |
| 149 | "Quit dig output buffer." | 145 | "Quit dig output buffer." |
| 150 | (interactive) | 146 | (interactive) |
| 151 | (kill-buffer (current-buffer))) | 147 | (quit-window t)) |
| 152 | 148 | ||
| 153 | ;;;###autoload | 149 | ;;;###autoload |
| 154 | (defun dig (domain &optional | 150 | (defun dig (domain &optional |
| @@ -156,14 +152,12 @@ Buffer should contain output generated by `dig-invoke'." | |||
| 156 | "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. | 152 | "Query addresses of a DOMAIN using dig, by calling `dig-invoke'. |
| 157 | Optional arguments are passed to `dig-invoke'." | 153 | Optional arguments are passed to `dig-invoke'." |
| 158 | (interactive "sHost: ") | 154 | (interactive "sHost: ") |
| 159 | (switch-to-buffer | 155 | (pop-to-buffer-same-window |
| 160 | (dig-invoke domain query-type query-class query-option dig-option server)) | 156 | (dig-invoke domain query-type query-class query-option dig-option server)) |
| 161 | (goto-char (point-min)) | 157 | (goto-char (point-min)) |
| 162 | (and (search-forward ";; ANSWER SECTION:" nil t) | 158 | (and (search-forward ";; ANSWER SECTION:" nil t) |
| 163 | (forward-line)) | 159 | (forward-line)) |
| 164 | (dig-mode) | 160 | (dig-mode)) |
| 165 | (setq buffer-read-only t) | ||
| 166 | (set-buffer-modified-p nil)) | ||
| 167 | 161 | ||
| 168 | ;; named for consistency with query-dns in dns.el | 162 | ;; named for consistency with query-dns in dns.el |
| 169 | (defun query-dig (domain &optional | 163 | (defun query-dig (domain &optional |
| @@ -175,7 +169,7 @@ Returns nil for domain/class/type queries that result in no data." | |||
| 175 | (let ((buffer (dig-invoke domain query-type query-class | 169 | (let ((buffer (dig-invoke domain query-type query-class |
| 176 | query-option dig-option server))) | 170 | query-option dig-option server))) |
| 177 | (when buffer | 171 | (when buffer |
| 178 | (switch-to-buffer buffer) | 172 | (pop-to-buffer-same-window buffer) |
| 179 | (let ((digger (dig-extract-rr domain query-type query-class))) | 173 | (let ((digger (dig-extract-rr domain query-type query-class))) |
| 180 | (kill-buffer buffer) | 174 | (kill-buffer buffer) |
| 181 | digger)))) | 175 | digger)))) |
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f80b300084b..f71d7ba6675 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el | |||
| @@ -29,7 +29,7 @@ | |||
| 29 | 29 | ||
| 30 | ;;; Code: | 30 | ;;; Code: |
| 31 | 31 | ||
| 32 | (eval-when-compile (require 'cl)) | 32 | (eval-when-compile (require 'cl-lib)) |
| 33 | (autoload 'mail-header-parse-content-type "mail-parse") | 33 | (autoload 'mail-header-parse-content-type "mail-parse") |
| 34 | 34 | ||
| 35 | (defgroup mailcap nil | 35 | (defgroup mailcap nil |
| @@ -62,20 +62,20 @@ | |||
| 62 | (let ((val (default-value sym)) | 62 | (let ((val (default-value sym)) |
| 63 | res) | 63 | res) |
| 64 | (dolist (entry val) | 64 | (dolist (entry val) |
| 65 | (setq res (cons (list (cdr (assq 'viewer entry)) | 65 | (push (list (cdr (assq 'viewer entry)) |
| 66 | (cdr (assq 'type entry)) | 66 | (cdr (assq 'type entry)) |
| 67 | (cdr (assq 'test entry))) | 67 | (cdr (assq 'test entry))) |
| 68 | res))) | 68 | res)) |
| 69 | (nreverse res))) | 69 | (nreverse res))) |
| 70 | 70 | ||
| 71 | (defun mailcap--set-user-mime-data (sym val) | 71 | (defun mailcap--set-user-mime-data (sym val) |
| 72 | (let (res) | 72 | (let (res) |
| 73 | (dolist (entry val) | 73 | (dolist (entry val) |
| 74 | (setq res (cons `((viewer . ,(car entry)) | 74 | (push `((viewer . ,(car entry)) |
| 75 | (type . ,(cadr entry)) | 75 | (type . ,(cadr entry)) |
| 76 | ,@(when (caddr entry) | 76 | ,@(when (cl-caddr entry) |
| 77 | `((test . ,(caddr entry))))) | 77 | `((test . ,(cl-caddr entry))))) |
| 78 | res))) | 78 | res)) |
| 79 | (set-default sym (nreverse res)))) | 79 | (set-default sym (nreverse res)))) |
| 80 | 80 | ||
| 81 | (defcustom mailcap-user-mime-data nil | 81 | (defcustom mailcap-user-mime-data nil |
| @@ -430,18 +430,14 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus | |||
| 430 | ;; with /usr before /usr/local. | 430 | ;; with /usr before /usr/local. |
| 431 | '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" | 431 | '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" |
| 432 | "/usr/local/etc/mailcap")))) | 432 | "/usr/local/etc/mailcap")))) |
| 433 | (let ((fnames (reverse | 433 | (dolist (fname (reverse |
| 434 | (if (stringp path) | 434 | (if (stringp path) |
| 435 | (split-string path path-separator t) | 435 | (split-string path path-separator t) |
| 436 | path))) | 436 | path))) |
| 437 | fname) | 437 | (if (and (file-readable-p fname) |
| 438 | (while fnames | 438 | (file-regular-p fname)) |
| 439 | (setq fname (car fnames)) | 439 | (mailcap-parse-mailcap fname))) |
| 440 | (if (and (file-readable-p fname) | 440 | (setq mailcap-parsed-p t))) |
| 441 | (file-regular-p fname)) | ||
| 442 | (mailcap-parse-mailcap fname)) | ||
| 443 | (setq fnames (cdr fnames)))) | ||
| 444 | (setq mailcap-parsed-p t))) | ||
| 445 | 441 | ||
| 446 | (defun mailcap-parse-mailcap (fname) | 442 | (defun mailcap-parse-mailcap (fname) |
| 447 | "Parse out the mailcap file specified by FNAME." | 443 | "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 | |||
| 560 | (setq value (buffer-substring val-pos (point)))) | 556 | (setq value (buffer-substring val-pos (point)))) |
| 561 | ;; `test' as symbol, others like "copiousoutput" and "needsx11" as | 557 | ;; `test' as symbol, others like "copiousoutput" and "needsx11" as |
| 562 | ;; strings | 558 | ;; strings |
| 563 | (setq results (cons (cons (if (string-equal name "test") | 559 | (push (cons (if (string-equal name "test") 'test name) value) results) |
| 564 | 'test | ||
| 565 | name) | ||
| 566 | value) results)) | ||
| 567 | (skip-chars-forward " \";\n\t")) | 560 | (skip-chars-forward " \";\n\t")) |
| 568 | results))) | 561 | results))) |
| 569 | 562 | ||
| @@ -607,9 +600,9 @@ the test clause will be unchanged." | |||
| 607 | (while major | 600 | (while major |
| 608 | (cond | 601 | (cond |
| 609 | ((equal (car (car major)) minor) | 602 | ((equal (car (car major)) minor) |
| 610 | (setq exact (cons (cdr (car major)) exact))) | 603 | (push (cdr (car major)) exact)) |
| 611 | ((and minor (string-match (concat "^" (car (car major)) "$") minor)) | 604 | ((and minor (string-match (concat "^" (car (car major)) "$") minor)) |
| 612 | (setq wildcard (cons (cdr (car major)) wildcard)))) | 605 | (push (cdr (car major)) wildcard))) |
| 613 | (setq major (cdr major))) | 606 | (setq major (cdr major))) |
| 614 | (nconc exact wildcard))) | 607 | (nconc exact wildcard))) |
| 615 | 608 | ||
| @@ -672,7 +665,7 @@ to supply to the test." | |||
| 672 | (otest test) | 665 | (otest test) |
| 673 | (viewer (cdr (assq 'viewer viewer-info))) | 666 | (viewer (cdr (assq 'viewer viewer-info))) |
| 674 | (default-directory (expand-file-name "~/")) | 667 | (default-directory (expand-file-name "~/")) |
| 675 | status parsed-test cache result) | 668 | status cache result) |
| 676 | (cond ((not (or (stringp viewer) (fboundp viewer))) | 669 | (cond ((not (or (stringp viewer) (fboundp viewer))) |
| 677 | nil) ; Non-existent Lisp function | 670 | nil) ; Non-existent Lisp function |
| 678 | ((setq cache (assoc test mailcap-viewer-test-cache)) | 671 | ((setq cache (assoc test mailcap-viewer-test-cache)) |
| @@ -704,9 +697,7 @@ to supply to the test." | |||
| 704 | (defun mailcap-add-mailcap-entry (major minor info) | 697 | (defun mailcap-add-mailcap-entry (major minor info) |
| 705 | (let ((old-major (assoc major mailcap-mime-data))) | 698 | (let ((old-major (assoc major mailcap-mime-data))) |
| 706 | (if (null old-major) ; New major area | 699 | (if (null old-major) ; New major area |
| 707 | (setq mailcap-mime-data | 700 | (push (cons major (list (cons minor info))) mailcap-mime-data) |
| 708 | (cons (cons major (list (cons minor info))) | ||
| 709 | mailcap-mime-data)) | ||
| 710 | (let ((cur-minor (assoc minor old-major))) | 701 | (let ((cur-minor (assoc minor old-major))) |
| 711 | (cond | 702 | (cond |
| 712 | ((or (null cur-minor) ; New minor area, or | 703 | ((or (null cur-minor) ; New minor area, or |
| @@ -786,10 +777,7 @@ If NO-DECODE is non-nil, don't decode STRING." | |||
| 786 | major ; Major encoding (text, etc) | 777 | major ; Major encoding (text, etc) |
| 787 | minor ; Minor encoding (html, etc) | 778 | minor ; Minor encoding (html, etc) |
| 788 | info ; Other info | 779 | info ; Other info |
| 789 | save-pos ; Misc. position during parse | ||
| 790 | major-info ; (assoc major mailcap-mime-data) | 780 | major-info ; (assoc major mailcap-mime-data) |
| 791 | minor-info ; (assoc minor major-info) | ||
| 792 | test ; current test proc. | ||
| 793 | viewers ; Possible viewers | 781 | viewers ; Possible viewers |
| 794 | passed ; Viewers that passed the test | 782 | passed ; Viewers that passed the test |
| 795 | viewer ; The one and only viewer | 783 | viewer ; The one and only viewer |
| @@ -815,7 +803,7 @@ If NO-DECODE is non-nil, don't decode STRING." | |||
| 815 | (cdr ctl))) | 803 | (cdr ctl))) |
| 816 | (while viewers | 804 | (while viewers |
| 817 | (if (mailcap-viewer-passes-test (car viewers) info) | 805 | (if (mailcap-viewer-passes-test (car viewers) info) |
| 818 | (setq passed (cons (car viewers) passed))) | 806 | (push (car viewers) passed)) |
| 819 | (setq viewers (cdr viewers))) | 807 | (setq viewers (cdr viewers))) |
| 820 | (setq passed (sort passed 'mailcap-viewer-lessp)) | 808 | (setq passed (sort passed 'mailcap-viewer-lessp)) |
| 821 | (setq viewer (car passed)))) | 809 | (setq viewer (car passed)))) |
| @@ -980,15 +968,11 @@ If FORCE, re-parse even if already parsed." | |||
| 980 | "/usr/etc/mime-types" | 968 | "/usr/etc/mime-types" |
| 981 | "/usr/local/etc/mime-types" | 969 | "/usr/local/etc/mime-types" |
| 982 | "/usr/local/www/conf/mime-types")))) | 970 | "/usr/local/www/conf/mime-types")))) |
| 983 | (let ((fnames (reverse (if (stringp path) | 971 | (dolist (fname (reverse (if (stringp path) |
| 984 | (split-string path path-separator t) | 972 | (split-string path path-separator t) |
| 985 | path))) | 973 | path))) |
| 986 | fname) | 974 | (if (and (file-readable-p fname)) |
| 987 | (while fnames | 975 | (mailcap-parse-mimetype-file fname))) |
| 988 | (setq fname (car fnames)) | ||
| 989 | (if (and (file-readable-p fname)) | ||
| 990 | (mailcap-parse-mimetype-file fname)) | ||
| 991 | (setq fnames (cdr fnames)))) | ||
| 992 | (setq mailcap-mimetypes-parsed-p t))) | 976 | (setq mailcap-mimetypes-parsed-p t))) |
| 993 | 977 | ||
| 994 | (defun mailcap-parse-mimetype-file (fname) | 978 | (defun mailcap-parse-mimetype-file (fname) |
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index cceb75ead63..0b9975f07fc 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el | |||
| @@ -1521,7 +1521,7 @@ references and character references. A processing instruction | |||
| 1521 | consists of a target and a content string. A comment or a CDATA | 1521 | consists of a target and a content string. A comment or a CDATA |
| 1522 | section contains a single string. An entity reference contains a | 1522 | section contains a single string. An entity reference contains a |
| 1523 | single name. A character reference contains a character number." | 1523 | single name. A character reference contains a character number." |
| 1524 | (interactive "p") | 1524 | (interactive "^p") |
| 1525 | (or arg (setq arg 1)) | 1525 | (or arg (setq arg 1)) |
| 1526 | (cond ((> arg 0) | 1526 | (cond ((> arg 0) |
| 1527 | (while (progn | 1527 | (while (progn |
| @@ -1733,7 +1733,7 @@ single name. A character reference contains a character number." | |||
| 1733 | ret)) | 1733 | ret)) |
| 1734 | 1734 | ||
| 1735 | (defun nxml-up-element (&optional arg) | 1735 | (defun nxml-up-element (&optional arg) |
| 1736 | (interactive "p") | 1736 | (interactive "^p") |
| 1737 | (or arg (setq arg 1)) | 1737 | (or arg (setq arg 1)) |
| 1738 | (if (< arg 0) | 1738 | (if (< arg 0) |
| 1739 | (nxml-backward-up-element (- arg)) | 1739 | (nxml-backward-up-element (- arg)) |
| @@ -1761,7 +1761,7 @@ single name. A character reference contains a character number." | |||
| 1761 | (apply #'error (cddr err)))))) | 1761 | (apply #'error (cddr err)))))) |
| 1762 | 1762 | ||
| 1763 | (defun nxml-backward-up-element (&optional arg) | 1763 | (defun nxml-backward-up-element (&optional arg) |
| 1764 | (interactive "p") | 1764 | (interactive "^p") |
| 1765 | (or arg (setq arg 1)) | 1765 | (or arg (setq arg 1)) |
| 1766 | (if (< arg 0) | 1766 | (if (< arg 0) |
| 1767 | (nxml-up-element (- arg)) | 1767 | (nxml-up-element (- arg)) |
| @@ -1793,7 +1793,7 @@ single name. A character reference contains a character number." | |||
| 1793 | "Move forward down into the content of an element. | 1793 | "Move forward down into the content of an element. |
| 1794 | With ARG, do this that many times. | 1794 | With ARG, do this that many times. |
| 1795 | Negative ARG means move backward but still down." | 1795 | Negative ARG means move backward but still down." |
| 1796 | (interactive "p") | 1796 | (interactive "^p") |
| 1797 | (or arg (setq arg 1)) | 1797 | (or arg (setq arg 1)) |
| 1798 | (if (< arg 0) | 1798 | (if (< arg 0) |
| 1799 | (nxml-backward-down-element (- arg)) | 1799 | (nxml-backward-down-element (- arg)) |
| @@ -1811,7 +1811,7 @@ Negative ARG means move backward but still down." | |||
| 1811 | (setq arg (1- arg))))) | 1811 | (setq arg (1- arg))))) |
| 1812 | 1812 | ||
| 1813 | (defun nxml-backward-down-element (&optional arg) | 1813 | (defun nxml-backward-down-element (&optional arg) |
| 1814 | (interactive "p") | 1814 | (interactive "^p") |
| 1815 | (or arg (setq arg 1)) | 1815 | (or arg (setq arg 1)) |
| 1816 | (if (< arg 0) | 1816 | (if (< arg 0) |
| 1817 | (nxml-down-element (- arg)) | 1817 | (nxml-down-element (- arg)) |
| @@ -1839,7 +1839,7 @@ Negative ARG means move backward but still down." | |||
| 1839 | "Move forward over one element. | 1839 | "Move forward over one element. |
| 1840 | With ARG, do it that many times. | 1840 | With ARG, do it that many times. |
| 1841 | Negative ARG means move backward." | 1841 | Negative ARG means move backward." |
| 1842 | (interactive "p") | 1842 | (interactive "^p") |
| 1843 | (or arg (setq arg 1)) | 1843 | (or arg (setq arg 1)) |
| 1844 | (if (< arg 0) | 1844 | (if (< arg 0) |
| 1845 | (nxml-backward-element (- arg)) | 1845 | (nxml-backward-element (- arg)) |
| @@ -1858,7 +1858,7 @@ Negative ARG means move backward." | |||
| 1858 | "Move backward over one element. | 1858 | "Move backward over one element. |
| 1859 | With ARG, do it that many times. | 1859 | With ARG, do it that many times. |
| 1860 | Negative ARG means move forward." | 1860 | Negative ARG means move forward." |
| 1861 | (interactive "p") | 1861 | (interactive "^p") |
| 1862 | (or arg (setq arg 1)) | 1862 | (or arg (setq arg 1)) |
| 1863 | (if (< arg 0) | 1863 | (if (< arg 0) |
| 1864 | (nxml-forward-element (- arg)) | 1864 | (nxml-forward-element (- arg)) |
| @@ -1893,7 +1893,7 @@ The paragraph marked is the one that contains point or follows point." | |||
| 1893 | (nxml-backward-paragraph)) | 1893 | (nxml-backward-paragraph)) |
| 1894 | 1894 | ||
| 1895 | (defun nxml-forward-paragraph (&optional arg) | 1895 | (defun nxml-forward-paragraph (&optional arg) |
| 1896 | (interactive "p") | 1896 | (interactive "^p") |
| 1897 | (or arg (setq arg 1)) | 1897 | (or arg (setq arg 1)) |
| 1898 | (cond ((< arg 0) | 1898 | (cond ((< arg 0) |
| 1899 | (nxml-backward-paragraph (- arg))) | 1899 | (nxml-backward-paragraph (- arg))) |
| @@ -1903,7 +1903,7 @@ The paragraph marked is the one that contains point or follows point." | |||
| 1903 | (> (setq arg (1- arg)) 0)))))) | 1903 | (> (setq arg (1- arg)) 0)))))) |
| 1904 | 1904 | ||
| 1905 | (defun nxml-backward-paragraph (&optional arg) | 1905 | (defun nxml-backward-paragraph (&optional arg) |
| 1906 | (interactive "p") | 1906 | (interactive "^p") |
| 1907 | (or arg (setq arg 1)) | 1907 | (or arg (setq arg 1)) |
| 1908 | (cond ((< arg 0) | 1908 | (cond ((< arg 0) |
| 1909 | (nxml-forward-paragraph (- arg))) | 1909 | (nxml-forward-paragraph (- arg))) |
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 78646e421c3..ea31ee8a470 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." | |||
| 766 | (make-composed-keymap map (keymap-parent basemap)))) | 766 | (make-composed-keymap map (keymap-parent basemap)))) |
| 767 | 767 | ||
| 768 | (define-minor-mode xterm-inhibit-bracketed-paste-mode | 768 | (define-minor-mode xterm-inhibit-bracketed-paste-mode |
| 769 | "Toggle whether XTerm bracketed paste should be allowed in this bugger. | 769 | "Toggle whether XTerm bracketed paste should be allowed in this buffer. |
| 770 | With a prefix argument ARG, forbid bracketed paste if ARG is | 770 | With a prefix argument ARG, forbid bracketed paste if ARG is |
| 771 | positive, and allow it otherwise. If called from Lisp, forbid | 771 | positive, and allow it otherwise. If called from Lisp, forbid |
| 772 | bracketed paste if ARG is omitted or nil, and toggle the state of | 772 | bracketed paste if ARG is omitted or nil, and toggle the state of |
diff --git a/src/frame.c b/src/frame.c index 45559b0be98..a1c2199d044 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 | |||
| 1160 | if (FRAMEP (xfocus)) | 1160 | if (FRAMEP (xfocus)) |
| 1161 | { | 1161 | { |
| 1162 | focus = FRAME_FOCUS_FRAME (XFRAME (xfocus)); | 1162 | focus = FRAME_FOCUS_FRAME (XFRAME (xfocus)); |
| 1163 | if (FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) | 1163 | if ((FRAMEP (focus) && XFRAME (focus) == SELECTED_FRAME ()) |
| 1164 | /* Redirect frame focus also when FRAME has its minibuffer | ||
| 1165 | window on the selected frame (see Bug#24500). */ | ||
| 1166 | || (NILP (focus) | ||
| 1167 | && EQ (FRAME_MINIBUF_WINDOW (XFRAME (frame)), | ||
| 1168 | sf->selected_window))) | ||
| 1164 | Fredirect_frame_focus (xfocus, frame); | 1169 | Fredirect_frame_focus (xfocus, frame); |
| 1165 | } | 1170 | } |
| 1166 | } | 1171 | } |
diff --git a/src/window.c b/src/window.c index 753ebc16fbf..acbefcdad16 100644 --- a/src/window.c +++ b/src/window.c | |||
| @@ -2377,8 +2377,10 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, | |||
| 2377 | == FRAME_TERMINAL (XFRAME (selected_frame))); | 2377 | == FRAME_TERMINAL (XFRAME (selected_frame))); |
| 2378 | } | 2378 | } |
| 2379 | else if (WINDOWP (all_frames)) | 2379 | else if (WINDOWP (all_frames)) |
| 2380 | candidate_p = (EQ (FRAME_MINIBUF_WINDOW (f), all_frames) | 2380 | /* To qualify as candidate, it's not sufficient for WINDOW's frame |
| 2381 | || EQ (XWINDOW (all_frames)->frame, w->frame) | 2381 | to just share the minibuffer window - it must be active as well |
| 2382 | (see Bug#24500). */ | ||
| 2383 | candidate_p = (EQ (XWINDOW (all_frames)->frame, w->frame) | ||
| 2382 | || EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f))); | 2384 | || EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f))); |
| 2383 | else if (FRAMEP (all_frames)) | 2385 | else if (FRAMEP (all_frames)) |
| 2384 | candidate_p = EQ (all_frames, w->frame); | 2386 | 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 cc393f40583..02d9246db21 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." | |||
| 294 | 294 | ||
| 295 | (ert-deftest cl-seq-test-bug24264 () | 295 | (ert-deftest cl-seq-test-bug24264 () |
| 296 | "Test for http://debbugs.gnu.org/24264 ." | 296 | "Test for http://debbugs.gnu.org/24264 ." |
| 297 | :expected-result :failed | ||
| 298 | (let ((list (append (make-list 8000005 1) '(8))) | 297 | (let ((list (append (make-list 8000005 1) '(8))) |
| 299 | (list2 (make-list 8000005 2))) | 298 | (list2 (make-list 8000005 2))) |
| 300 | (should (cl-position 8 list)) | 299 | (should (cl-position 8 list)) |