procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs

Browse source
This commit is contained in:
Michael Albinus 2016-10-20 14:58:13 +02:00
commit ce26926b62
15 changed files with 185 additions and 152 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
doc/lispref/files.texi
View file

@ -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 non-@code{nil}, there is no error merely because the
directory or its files are deleted by some other process before
@code{delete-directory} gets to them.
@code{delete-directory} only follows symbolic links at the level of
parent directories.

12
etc/NEWS
View file

@ -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
+++

24
lisp/auth-source.el
View file

@ -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))

13
lisp/emacs-lisp/cl-macs.el
View file

@ -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)))

70
lisp/emacs-lisp/cl-seq.el
View file

@ -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

19
lisp/eshell/em-hist.el
View file

@ -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

46
lisp/files.el
View file

@ -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.

24
lisp/isearch.el
View file

@ -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)

18
lisp/net/dig.el
View file

@ -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))))

74
lisp/net/mailcap.el
View file

@ -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)

18
lisp/nxml/nxml-mode.el
View file

@ -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)))

2
lisp/term/xterm.el
View file

@ -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

7
src/frame.c
View file

@ -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);
}
}

6
src/window.c
View file

@ -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);

1
test/lisp/emacs-lisp/cl-seq-tests.el
View file

@ -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))