diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 25 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 31 | ||||
| -rw-r--r-- | lisp/gnus/gnus-group.el | 8 | ||||
| -rw-r--r-- | lisp/gnus/gnus-sum.el | 3 | ||||
| -rw-r--r-- | lisp/gnus/message.el | 2 | ||||
| -rw-r--r-- | lisp/gnus/mml1991.el | 53 | ||||
| -rw-r--r-- | lisp/gnus/nnimap.el | 4 | ||||
| -rw-r--r-- | lisp/gnus/nnvirtual.el | 9 | ||||
| -rw-r--r-- | lisp/gnus/pop3.el | 3 | ||||
| -rw-r--r-- | lisp/icomplete.el | 5 | ||||
| -rw-r--r-- | lisp/mail/smtpmail.el | 9 | ||||
| -rw-r--r-- | lisp/minibuffer.el | 173 | ||||
| -rw-r--r-- | lisp/simple.el | 1 |
14 files changed, 238 insertions, 90 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0064bb79544..07f700f6987 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,28 @@ +2011-05-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el: Add metadata method to completion tables. + (completion-category-overrides): New defcustom. + (completion-metadata, completion--field-metadata) + (completion-metadata-get, completion--styles) + (completion--cycle-threshold): New functions. + (completion-try-completion, completion-all-completions): + Add `metadata' argument to choose completion-styles. + (completion--do-completion): Use metadata to choose cycling. + (completion-all-sorted-completions): Use metadata for sorting. + Remove :completion-cycle-penalty which is not needed any more. + (completion--try-word-completion): Add `metadata' argument. + (minibuffer-completion-help): Check metadata for annotation function + and sorting. + (completion-file-name-table): Return `category' metadata. + (minibuffer-completing-file-name): Make obsolete. + * simple.el (minibuffer-completing-symbol): Make obsolete. + * icomplete.el (icomplete-completions): Pass new `metadata' param to + completion-try-completion. + +2011-05-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/smtpmail.el (smtpmail-send-data): Add progress reporter. + 2011-05-30 Leo Liu <sdl.web@gmail.com> * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f0f59123aa9..0dae6748c24 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4155,6 +4155,8 @@ binding slots have been popped." (if (eq fun 'defconst) ;; `defconst' sets `var' unconditionally. (let ((tmp (make-symbol "defconst-tmp-var"))) + ;; Quote with `quote' to prevent byte-compiling the body, + ;; which would lead to an inf-loop. `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) ,value)) ;; `defvar' sets `var' only when unbound. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 4aba3a27900..dcbc647950f 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,34 @@ +2011-05-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-group-mark-article-read): It's possible that we + want to have `gnus-newsgroup-unselected' kept sorted. If this isn't + done, then unselected articles may be marked as read. + + * pop3.el (pop3-open-server): Erase the buffer after the greeting, + since not doing this seems to lead to a race condition in pop3-logon. + + * nnvirtual.el (nnvirtual-request-article): Bind `gnus-command-method' + so that the call chain it correct when we call "upwards". + + * gnus-sum.el (gnus-select-newsgroup): Auto-expiry doesn't make sense + in read-only groups. + + * gnus-group.el (gnus-group-mark-article-read): Ditto. + + * message.el (message-cite-reply-position): Doc string fix. + + * nnimap.el (nnimap-transform-headers): Simplify regexp to hopefully + avoid regexp overflow. + (nnimap-transform-split-mail): Ditto. + + * pop3.el (pop3-retr): Error out if the server closes the connection. + +2011-05-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed + mm-with-unibyte-current-buffer. The buffer should not contain any + multibyte chars anyway at this stage. + 2011-05-29 Lars Magne Ingebrigtsen <larsi@gnus.org> * shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 65192bf173e..4c474b0aa23 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3567,7 +3567,8 @@ or nil if no action could be taken." (gnus-add-marked-articles group 'tick nil nil 'force) (gnus-add-marked-articles group 'dormant nil nil 'force)) ;; Do auto-expirable marks if that's required. - (when (gnus-group-auto-expirable-p group) + (when (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group))) (gnus-range-map (lambda (article) (gnus-add-marked-articles group 'expire (list article)) @@ -4630,10 +4631,11 @@ This command may read the active file." (push n gnus-newsgroup-unselected)) (setq n (1+ n))) (setq gnus-newsgroup-unselected - (nreverse gnus-newsgroup-unselected))))) + (sort gnus-newsgroup-unselected '<))))) (gnus-activate-group group) (gnus-group-make-articles-read group (list article)) - (when (gnus-group-auto-expirable-p group) + (when (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group))) (gnus-add-marked-articles group 'expire (list article)))))) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 3ec443743df..2d75c35158a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -5715,7 +5715,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-summary-remove-list-identifiers) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) + (and (gnus-group-auto-expirable-p group) + (not (gnus-group-read-only-p group)))) ;; Set up the article buffer now, if necessary. (unless (and gnus-single-article-buffer (equal gnus-article-buffer "*Article*")) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4d08baa674c..58740c32e9c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1091,7 +1091,7 @@ Note: Many newsgroups frown upon nontraditional reply styles. You probably want to set this variable only for specific groups, e.g. using `gnus-posting-styles': - (eval (set (make-local-variable 'message-cite-reply-above) 'above))" + (eval (set (make-local-variable 'message-cite-reply-position) 'above))" :type '(choice (const :tag "Reply inline" 'traditional) (const :tag "Reply above" 'above) (const :tag "Reply below" 'below)) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 0ce74b1d765..a5d778845c1 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -137,33 +137,32 @@ Whether the passphrase is cached at all is controlled by (while (looking-at "^Content[^ ]+:") (forward-line)) (unless (bobp) (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (inline (mm-disable-multibyte)) - (setq cipher (current-buffer)) - (insert-buffer-substring text) - (unless (mc-encrypt-generic - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - nil - (point-min) (point-max) - (message-options-get 'message-sender) - 'sign) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) + (with-temp-buffer + (inline (mm-disable-multibyte)) + (setq cipher (current-buffer)) + (insert-buffer-substring text) + (unless (mc-encrypt-generic + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + nil + (point-min) (point-max) + (message-options-get 'message-sender) + 'sign) + (unless (> (point-max) (point-min)) + (pop-to-buffer result-buffer) + (error "Encrypt error"))) + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" t t)) + (set-buffer text) + (delete-region (point-min) (point-max)) + ;;(insert "Content-Type: application/pgp-encrypted\n\n") + ;;(insert "Version: 1\n\n") + (insert "\n") + (insert-buffer-substring cipher) + (goto-char (point-max))))) ;; pgg wrapper diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 6882ed63135..dc8b38b8f9a 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -190,7 +190,7 @@ textual parts.") (let (article bytes lines size string) (block nil (while (not (eobp)) - (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) + (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) @@ -1904,7 +1904,7 @@ textual parts.") (let (article bytes) (block nil (while (not (eobp)) - (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) + (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 0cc53ad2332..ea64c247d99 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -194,10 +194,11 @@ component group will show up when you enter the virtual group.") (when buffer (set-buffer buffer)) (let* ((gnus-override-method nil) - (method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) - (funcall (gnus-get-function method 'request-article) - article nil (nth 1 method) buffer))))) + (gnus-command-method + (gnus-find-method-for-group + nnvirtual-last-accessed-component-group))) + (funcall (gnus-get-function gnus-command-method 'request-article) + article nil (nth 1 gnus-command-method) buffer))))) ;; This is a fetch by number. (let* ((amap (nnvirtual-map-article article)) (cgroup (car amap))) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 6f12d3d63e1..90e11b3ca8f 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -319,6 +319,7 @@ Returns the process associated with the connection." (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) (pop3-set-process-query-on-exit-flag (car result) nil) + (erase-buffer) (car result))))) ;; Support functions @@ -514,6 +515,8 @@ Otherwise, return the size of the message-id MSG" (let ((start pop3-read-point) end) (with-current-buffer (process-buffer process) (while (not (re-search-forward "^\\.\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (error "pop3 server closed the connection")) (pop3-accept-process-output process) (goto-char start)) (setq pop3-read-point (point-marker)) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index ab67fcfcdfd..5f3680630f4 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -287,6 +287,7 @@ matches exist. \(Keybindings for uniquely matched commands are exhibited within the square braces.)" (let* ((non-essential t) + (md (completion--field-metadata (field-beginning))) (comps (completion-all-sorted-completions)) (last (if (consp comps) (last comps))) (base-size (cdr last)) @@ -299,11 +300,11 @@ are exhibited within the square braces.)" (let* ((most-try (if (and base-size (> base-size 0)) (completion-try-completion - name candidates predicate (length name)) + name candidates predicate (length name) md) ;; If the `comps' are 0-based, the result should be ;; the same with `comps'. (completion-try-completion - name comps nil (length name)))) + name comps nil (length name) md))) (most (if (consp most-try) (car most-try) (if most-try (car comps) ""))) ;; Compare name and most, so we can determine if name is diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 3eda3503adc..bc1ca77d24a 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -943,15 +943,20 @@ The list is in preference order.") (process-send-string process "\r\n")) (defun smtpmail-send-data (process buffer) - (let ((data-continue t) sending-data) + (let ((data-continue t) sending-data + (pr (with-current-buffer buffer + (make-progress-reporter "Sending email" + (point-min) (point-max))))) (with-current-buffer buffer (goto-char (point-min))) (while data-continue (with-current-buffer buffer + (progress-reporter-update pr (point)) (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) (end-of-line 2) (setq data-continue (not (eobp)))) - (smtpmail-send-data-1 process sending-data)))) + (smtpmail-send-data-1 process sending-data)) + (progress-reporter-done pr))) (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO: <address>." diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 7af602c629b..0f96f7905eb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -61,10 +61,7 @@ ;; - for M-x, cycle-sort commands that have no key binding first. ;; - Make things like icomplete-mode or lightning-completion work with ;; completion-in-region-mode. -;; - extend `boundaries' to provide various other meta-data about the -;; output of `all-completions': -;; - preferred sorting order when displayed in *Completions*. -;; - annotations/text-properties to add when displayed in *Completions*. +;; - extend `metadata': ;; - quoting/unquoting (so we can complete files names with envvars ;; and backslashes, and all-completion can list names without ;; quoting backslashes and dollars). @@ -116,6 +113,32 @@ the closest directory separators." (cons (or (cadr boundaries) 0) (or (cddr boundaries) (length suffix))))) +(defun completion-metadata (string table pred) + "Return the metadata of elements to complete at the end of STRING. +This metadata is an alist. Currently understood keys are: +- `category': the kind of objects returned by `all-completions'. + Used by `completion-category-overrides'. +- `annotation-function': function to add annotations in *Completions*. + Takes one argument (STRING), which is a possible completion and + returns a string to append to STRING. +- `display-sort-function': function to sort entries in *Completions*. + Takes one argument (COMPLETIONS) and should return a new list + of completions. Can operate destructively. +- `cycle-sort-function': function to sort entries when cycling. + Works like `display-sort-function'." + (let ((metadata (if (functionp table) + (funcall table string pred 'metadata)))) + (if (eq (car-safe metadata) 'metadata) + (cdr metadata)))) + +(defun completion--field-metadata (field-start) + (completion-metadata (buffer-substring-no-properties field-start (point)) + minibuffer-completion-table + minibuffer-completion-predicate)) + +(defun completion-metadata-get (metadata prop) + (cdr (assq prop metadata))) + (defun completion--some (fun xs) "Apply FUN to each element of XS in turn. Return the first non-nil returned value. @@ -457,7 +480,34 @@ The available styles are listed in `completion-styles-alist'." :group 'minibuffer :version "23.1") -(defun completion-try-completion (string table pred point) +(defcustom completion-category-overrides + '((buffer (styles . (basic substring)))) + "List of overrides for specific categories. +Each override has the shape (CATEGORY . ALIST) where ALIST is +an association list that can specify properties such as: +- `styles': the list of `completion-styles' to use for that category. +- `cycle': the `completion-cycle-threshold' to use for that category." + :type `(alist :key-type (choice (const buffer) + (const file) + symbol) + :value-type + (set + (cons (const style) + (repeat ,@(mapcar (lambda (x) (list 'const (car x))) + completion-styles-alist))) + (cons (const cycle) + (choice (const :tag "No cycling" nil) + (const :tag "Always cycle" t) + (integer :tag "Threshold")))))) + +(defun completion--styles (metadata) + (let* ((cat (completion-metadata-get metadata 'category)) + (over (assq 'styles (cdr (assq cat completion-category-overrides))))) + (if over + (delete-dups (append (cdr over) (copy-sequence completion-styles))) + completion-styles))) + +(defun completion-try-completion (string table pred point metadata) "Try to complete STRING using completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -468,9 +518,9 @@ a new position for point." (completion--some (lambda (style) (funcall (nth 1 (assq style completion-styles-alist)) string table pred point)) - completion-styles)) + (completion--styles metadata))) -(defun completion-all-completions (string table pred point) +(defun completion-all-completions (string table pred point metadata) "List the possible completions of STRING in completion table TABLE. Only the elements of table that satisfy predicate PRED are considered. POINT is the position of point within STRING. @@ -481,7 +531,7 @@ in the last `cdr'." (completion--some (lambda (style) (funcall (nth 2 (assq style completion-styles-alist)) string table pred point)) - completion-styles)) + (completion--styles metadata))) (defun minibuffer--bitset (modified completions exact) (logior (if modified 4 0) @@ -532,6 +582,11 @@ candidates than this number." (const :tag "Always cycle" t) (integer :tag "Threshold"))) +(defun completion--cycle-threshold (metadata) + (let* ((cat (completion-metadata-get metadata 'category)) + (over (assq 'cycle (cdr (assq cat completion-category-overrides))))) + (if over (cdr over) completion-cycle-threshold))) + (defvar completion-all-sorted-completions nil) (make-variable-buffer-local 'completion-all-sorted-completions) (defvar completion-cycling nil) @@ -566,12 +621,14 @@ when the buffer's text is already an exact match." (let* ((beg (field-beginning)) (end (field-end)) (string (buffer-substring beg end)) + (md (completion--field-metadata beg)) (comp (funcall (or try-completion-function 'completion-try-completion) string minibuffer-completion-table minibuffer-completion-predicate - (- (point) beg)))) + (- (point) beg) + md))) (cond ((null comp) (minibuffer-hide-completions) @@ -610,16 +667,17 @@ when the buffer's text is already an exact match." (completion--do-completion try-completion-function expect-exact) ;; It did find a match. Do we match some possibility exactly now? - (let ((exact (test-completion completion + (let* ((exact (test-completion completion minibuffer-completion-table minibuffer-completion-predicate)) + (threshold (completion--cycle-threshold md)) (comps ;; Check to see if we want to do cycling. We do it ;; here, after having performed the normal completion, ;; so as to take advantage of the difference between ;; try-completion and all-completions, for things ;; like completion-ignored-extensions. - (when (and completion-cycle-threshold + (when (and threshold ;; Check that the completion didn't make ;; us jump to a different boundary. (or (not completed) @@ -636,7 +694,7 @@ when the buffer's text is already an exact match." (not (ignore-errors ;; This signal an (intended) error if comps is too ;; short or if completion-cycle-threshold is t. - (consp (nthcdr completion-cycle-threshold comps))))) + (consp (nthcdr threshold comps))))) ;; Fewer than completion-cycle-threshold remaining ;; completions: let's cycle. (setq completed t exact t) @@ -715,27 +773,25 @@ scroll the window of possible completions." (or completion-all-sorted-completions (let* ((start (field-beginning)) (end (field-end)) - (all (completion-all-completions (buffer-substring start end) - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) start))) + (string (buffer-substring start end)) + (all (completion-all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) start) + (completion--field-metadata start))) (last (last all)) - (base-size (or (cdr last) 0))) + (base-size (or (cdr last) 0)) + (all-md (completion-metadata (substring string 0 base-size) + minibuffer-completion-table + minibuffer-completion-predicate)) + (sort-fun (completion-metadata-get all-md 'cycle-sort-function))) (when last (setcdr last nil) - ;; Prefer shorter completions. - (setq all (sort all (lambda (c1 c2) - (let ((s1 (get-text-property - 0 :completion-cycle-penalty c1)) - (s2 (get-text-property - 0 :completion-cycle-penalty c2))) - (if (eq s1 s2) - (< (length c1) (length c2)) - (< (or s1 (length c1)) - (or s2 (length c2)))))))) + (setq all (if sort-fun (funcall sort-fun all) + ;; Prefer shorter completions, by default. + (sort all (lambda (c1 c2) (< (length c1) (length c2)))))) ;; Prefer recently used completions. - ;; FIXME: Additional sorting ideas: - ;; - for M-x, prefer commands that have no key binding. (when (minibufferp) (let ((hist (symbol-value minibuffer-history-variable))) (setq all (sort all (lambda (c1 c2) @@ -758,6 +814,7 @@ Repeated uses step through the possible completions." ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. (let* ((start (field-beginning)) (end (field-end)) + ;; (md (completion--field-metadata start)) (all (completion-all-sorted-completions)) (base (+ start (or (cdr (last all)) 0)))) (cond @@ -861,8 +918,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', nil)) (t nil)))))) -(defun completion--try-word-completion (string table predicate point) - (let ((comp (completion-try-completion string table predicate point))) +(defun completion--try-word-completion (string table predicate point md) + (let ((comp (completion-try-completion string table predicate point md))) (if (not (consp comp)) comp @@ -884,7 +941,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', (while (and exts (not (consp tem))) (setq tem (completion-try-completion (concat before (pop exts) after) - table predicate (1+ point)))) + table predicate (1+ point) md))) (if (consp tem) (setq comp tem)))) ;; Completing a single word is actually more difficult than completing @@ -1219,7 +1276,8 @@ variables.") string minibuffer-completion-table minibuffer-completion-predicate - (- (point) (field-beginning))))) + (- (point) (field-beginning)) + (completion--field-metadata start)))) (message nil) (if (or (null completions) (and (not (consp (cdr completions))) @@ -1235,9 +1293,16 @@ variables.") (let* ((last (last completions)) (base-size (cdr last)) (prefix (unless (zerop base-size) (substring string 0 base-size))) - (global-af (or (plist-get completion-extra-properties - :annotation-function) - completion-annotate-function)) + ;; FIXME: This function is for the output of all-completions, + ;; not completion-all-completions. Often it's the same, but + ;; not always. + (all-md (completion-metadata (substring string 0 base-size) + minibuffer-completion-table + minibuffer-completion-predicate)) + (afun (or (completion-metadata-get all-md 'annotation-function) + (plist-get completion-extra-properties + :annotation-function) + completion-annotate-function)) ;; If the *Completions* buffer is shown in a new ;; window, mark it as softly-dedicated, so bury-buffer in ;; minibuffer-hide-completions will know whether to @@ -1247,15 +1312,21 @@ variables.") ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) - (setq completions (sort completions 'string-lessp)) (setq completions - (cond - (global-af + ;; FIXME: This function is for the output of all-completions, + ;; not completion-all-completions. Often it's the same, but + ;; not always. + (let ((sort-fun (completion-metadata-get + all-md 'display-sort-function))) + (if sort-fun + (funcall sort-fun completions) + (sort completions 'string-lessp)))) + (when afun + (setq completions (mapcar (lambda (s) - (let ((ann (funcall global-af s))) + (let ((ann (funcall afun s))) (if ann (list s ann) s))) - completions)) - (t completions))) + completions))) (with-current-buffer standard-output (set (make-local-variable 'completion-base-position) @@ -1270,12 +1341,12 @@ variables.") (cpred minibuffer-completion-predicate) (cprops completion-extra-properties)) (lambda (start end choice) - (unless - (or (zerop (length prefix)) - (equal prefix - (buffer-substring-no-properties - (max (point-min) (- start (length prefix))) - start))) + (unless (or (zerop (length prefix)) + (equal prefix + (buffer-substring-no-properties + (max (point-min) + (- start (length prefix))) + start))) (message "*Completions* out of date")) ;; FIXME: Use `md' to do quoting&terminator here. (completion--replace start end choice) @@ -1632,6 +1703,7 @@ same as `substitute-in-file-name'." "Completion table for file names." (ignore-errors (cond + ((eq action 'metadata) '(metadata (category . file))) ((eq (car-safe action) 'boundaries) (let ((start (length (file-name-directory string))) (end (string-match-p "/" (cdr action)))) @@ -1852,6 +1924,11 @@ and `read-file-name-function'." (funcall (or read-file-name-function #'read-file-name-default) prompt dir default-filename mustmatch initial predicate)) +;; minibuffer-completing-file-name is a variable used internally in minibuf.c +;; to determine whether to use minibuffer-local-filename-completion-map or +;; minibuffer-local-completion-map. It shouldn't be exported to Elisp. +(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1") + (defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) "Default method for reading file names. See `read-file-name' for the meaning of the arguments." diff --git a/lisp/simple.el b/lisp/simple.el index 4cf38178357..18ae1367d74 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1158,6 +1158,7 @@ in *Help* buffer. See also the command `describe-char'." (defvar minibuffer-completing-symbol nil "Non-nil means completing a Lisp symbol in the minibuffer.") +(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1") (defvar minibuffer-default nil "The current default value or list of default values in the minibuffer. |