aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorPaul Eggert2011-05-30 22:15:34 -0700
committerPaul Eggert2011-05-30 22:15:34 -0700
commit333d54dade1e7005d5a97612907158fe5ec3d310 (patch)
treea5b18c9c6a68d71fddae98aba0d81079068a8c46 /lisp
parent90856fe0b82ba19d1c3d73a4ba48007380201e66 (diff)
parent620c53a664e41788f6d4f8e3f687e1a0d448b857 (diff)
downloademacs-333d54dade1e7005d5a97612907158fe5ec3d310.tar.gz
emacs-333d54dade1e7005d5a97612907158fe5ec3d310.zip
Merge from trunk.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog32
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/gnus/ChangeLog31
-rw-r--r--lisp/gnus/gnus-group.el8
-rw-r--r--lisp/gnus/gnus-sum.el3
-rw-r--r--lisp/gnus/message.el2
-rw-r--r--lisp/gnus/mml1991.el53
-rw-r--r--lisp/gnus/nnimap.el4
-rw-r--r--lisp/gnus/nnvirtual.el9
-rw-r--r--lisp/gnus/pop3.el3
-rw-r--r--lisp/icomplete.el5
-rw-r--r--lisp/mail/smtpmail.el9
-rw-r--r--lisp/minibuffer.el173
-rw-r--r--lisp/net/rcirc.el12
-rw-r--r--lisp/simple.el1
15 files changed, 252 insertions, 95 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6d4752efec0..07f700f6987 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,35 @@
12011-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * minibuffer.el: Add metadata method to completion tables.
4 (completion-category-overrides): New defcustom.
5 (completion-metadata, completion--field-metadata)
6 (completion-metadata-get, completion--styles)
7 (completion--cycle-threshold): New functions.
8 (completion-try-completion, completion-all-completions):
9 Add `metadata' argument to choose completion-styles.
10 (completion--do-completion): Use metadata to choose cycling.
11 (completion-all-sorted-completions): Use metadata for sorting.
12 Remove :completion-cycle-penalty which is not needed any more.
13 (completion--try-word-completion): Add `metadata' argument.
14 (minibuffer-completion-help): Check metadata for annotation function
15 and sorting.
16 (completion-file-name-table): Return `category' metadata.
17 (minibuffer-completing-file-name): Make obsolete.
18 * simple.el (minibuffer-completing-symbol): Make obsolete.
19 * icomplete.el (icomplete-completions): Pass new `metadata' param to
20 completion-try-completion.
21
222011-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
23
24 * mail/smtpmail.el (smtpmail-send-data): Add progress reporter.
25
262011-05-30 Leo Liu <sdl.web@gmail.com>
27
28 * net/rcirc.el (rcirc-debug-buffer): Use visible buffer name.
29 (rcirc-print): Decode all incoming messages (bug#8744).
30 (rcirc-decode-coding-system): Allow value nil for automatic coding
31 system detection.
32
12011-05-29 Chong Yidong <cyd@stupidchicken.com> 332011-05-29 Chong Yidong <cyd@stupidchicken.com>
2 34
3 * image.el (image-animate-max-time): Allow nil and t values. 35 * image.el (image-animate-max-time): Allow nil and t values.
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."
4155 (if (eq fun 'defconst) 4155 (if (eq fun 'defconst)
4156 ;; `defconst' sets `var' unconditionally. 4156 ;; `defconst' sets `var' unconditionally.
4157 (let ((tmp (make-symbol "defconst-tmp-var"))) 4157 (let ((tmp (make-symbol "defconst-tmp-var")))
4158 ;; Quote with `quote' to prevent byte-compiling the body,
4159 ;; which would lead to an inf-loop.
4158 `(funcall '(lambda (,tmp) (defconst ,var ,tmp)) 4160 `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
4159 ,value)) 4161 ,value))
4160 ;; `defvar' sets `var' only when unbound. 4162 ;; `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 @@
12011-05-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * gnus-group.el (gnus-group-mark-article-read): It's possible that we
4 want to have `gnus-newsgroup-unselected' kept sorted. If this isn't
5 done, then unselected articles may be marked as read.
6
7 * pop3.el (pop3-open-server): Erase the buffer after the greeting,
8 since not doing this seems to lead to a race condition in pop3-logon.
9
10 * nnvirtual.el (nnvirtual-request-article): Bind `gnus-command-method'
11 so that the call chain it correct when we call "upwards".
12
13 * gnus-sum.el (gnus-select-newsgroup): Auto-expiry doesn't make sense
14 in read-only groups.
15
16 * gnus-group.el (gnus-group-mark-article-read): Ditto.
17
18 * message.el (message-cite-reply-position): Doc string fix.
19
20 * nnimap.el (nnimap-transform-headers): Simplify regexp to hopefully
21 avoid regexp overflow.
22 (nnimap-transform-split-mail): Ditto.
23
24 * pop3.el (pop3-retr): Error out if the server closes the connection.
25
262011-05-30 Stefan Monnier <monnier@iro.umontreal.ca>
27
28 * mml1991.el (mml1991-mailcrypt-encrypt): Remove use of ill-designed
29 mm-with-unibyte-current-buffer. The buffer should not contain any
30 multibyte chars anyway at this stage.
31
12011-05-29 Lars Magne Ingebrigtsen <larsi@gnus.org> 322011-05-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 33
3 * shr.el (shr-urlify): Use shr-add-font to make underlines be less ugly 34 * 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."
3567 (gnus-add-marked-articles group 'tick nil nil 'force) 3567 (gnus-add-marked-articles group 'tick nil nil 'force)
3568 (gnus-add-marked-articles group 'dormant nil nil 'force)) 3568 (gnus-add-marked-articles group 'dormant nil nil 'force))
3569 ;; Do auto-expirable marks if that's required. 3569 ;; Do auto-expirable marks if that's required.
3570 (when (gnus-group-auto-expirable-p group) 3570 (when (and (gnus-group-auto-expirable-p group)
3571 (not (gnus-group-read-only-p group)))
3571 (gnus-range-map 3572 (gnus-range-map
3572 (lambda (article) 3573 (lambda (article)
3573 (gnus-add-marked-articles group 'expire (list article)) 3574 (gnus-add-marked-articles group 'expire (list article))
@@ -4630,10 +4631,11 @@ This command may read the active file."
4630 (push n gnus-newsgroup-unselected)) 4631 (push n gnus-newsgroup-unselected))
4631 (setq n (1+ n))) 4632 (setq n (1+ n)))
4632 (setq gnus-newsgroup-unselected 4633 (setq gnus-newsgroup-unselected
4633 (nreverse gnus-newsgroup-unselected))))) 4634 (sort gnus-newsgroup-unselected '<)))))
4634 (gnus-activate-group group) 4635 (gnus-activate-group group)
4635 (gnus-group-make-articles-read group (list article)) 4636 (gnus-group-make-articles-read group (list article))
4636 (when (gnus-group-auto-expirable-p group) 4637 (when (and (gnus-group-auto-expirable-p group)
4638 (not (gnus-group-read-only-p group)))
4637 (gnus-add-marked-articles 4639 (gnus-add-marked-articles
4638 group 'expire (list article)))))) 4640 group 'expire (list article))))))
4639 4641
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."
5715 (gnus-summary-remove-list-identifiers) 5715 (gnus-summary-remove-list-identifiers)
5716 ;; Check whether auto-expire is to be done in this group. 5716 ;; Check whether auto-expire is to be done in this group.
5717 (setq gnus-newsgroup-auto-expire 5717 (setq gnus-newsgroup-auto-expire
5718 (gnus-group-auto-expirable-p group)) 5718 (and (gnus-group-auto-expirable-p group)
5719 (not (gnus-group-read-only-p group))))
5719 ;; Set up the article buffer now, if necessary. 5720 ;; Set up the article buffer now, if necessary.
5720 (unless (and gnus-single-article-buffer 5721 (unless (and gnus-single-article-buffer
5721 (equal gnus-article-buffer "*Article*")) 5722 (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
1091probably want to set this variable only for specific groups, 1091probably want to set this variable only for specific groups,
1092e.g. using `gnus-posting-styles': 1092e.g. using `gnus-posting-styles':
1093 1093
1094 (eval (set (make-local-variable 'message-cite-reply-above) 'above))" 1094 (eval (set (make-local-variable 'message-cite-reply-position) 'above))"
1095 :type '(choice (const :tag "Reply inline" 'traditional) 1095 :type '(choice (const :tag "Reply inline" 'traditional)
1096 (const :tag "Reply above" 'above) 1096 (const :tag "Reply above" 'above)
1097 (const :tag "Reply below" 'below)) 1097 (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
137 (while (looking-at "^Content[^ ]+:") (forward-line)) 137 (while (looking-at "^Content[^ ]+:") (forward-line))
138 (unless (bobp) 138 (unless (bobp)
139 (delete-region (point-min) (point))) 139 (delete-region (point-min) (point)))
140 (mm-with-unibyte-current-buffer 140 (with-temp-buffer
141 (with-temp-buffer 141 (inline (mm-disable-multibyte))
142 (inline (mm-disable-multibyte)) 142 (setq cipher (current-buffer))
143 (setq cipher (current-buffer)) 143 (insert-buffer-substring text)
144 (insert-buffer-substring text) 144 (unless (mc-encrypt-generic
145 (unless (mc-encrypt-generic 145 (or
146 (or 146 (message-options-get 'message-recipients)
147 (message-options-get 'message-recipients) 147 (message-options-set 'message-recipients
148 (message-options-set 'message-recipients 148 (read-string "Recipients: ")))
149 (read-string "Recipients: "))) 149 nil
150 nil 150 (point-min) (point-max)
151 (point-min) (point-max) 151 (message-options-get 'message-sender)
152 (message-options-get 'message-sender) 152 'sign)
153 'sign) 153 (unless (> (point-max) (point-min))
154 (unless (> (point-max) (point-min)) 154 (pop-to-buffer result-buffer)
155 (pop-to-buffer result-buffer) 155 (error "Encrypt error")))
156 (error "Encrypt error"))) 156 (goto-char (point-min))
157 (goto-char (point-min)) 157 (while (re-search-forward "\r+$" nil t)
158 (while (re-search-forward "\r+$" nil t) 158 (replace-match "" t t))
159 (replace-match "" t t)) 159 (set-buffer text)
160 (set-buffer text) 160 (delete-region (point-min) (point-max))
161 (delete-region (point-min) (point-max)) 161 ;;(insert "Content-Type: application/pgp-encrypted\n\n")
162 ;;(insert "Content-Type: application/pgp-encrypted\n\n") 162 ;;(insert "Version: 1\n\n")
163 ;;(insert "Version: 1\n\n") 163 (insert "\n")
164 (insert "\n") 164 (insert-buffer-substring cipher)
165 (insert-buffer-substring cipher) 165 (goto-char (point-max)))))
166 (goto-char (point-max))))))
167 166
168;; pgg wrapper 167;; pgg wrapper
169 168
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.")
190 (let (article bytes lines size string) 190 (let (article bytes lines size string)
191 (block nil 191 (block nil
192 (while (not (eobp)) 192 (while (not (eobp))
193 (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) 193 (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
194 (delete-region (point) (progn (forward-line 1) (point))) 194 (delete-region (point) (progn (forward-line 1) (point)))
195 (when (eobp) 195 (when (eobp)
196 (return))) 196 (return)))
@@ -1904,7 +1904,7 @@ textual parts.")
1904 (let (article bytes) 1904 (let (article bytes)
1905 (block nil 1905 (block nil
1906 (while (not (eobp)) 1906 (while (not (eobp))
1907 (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) 1907 (while (not (looking-at "\\* [0-9]+ FETCH.+UID \\([0-9]+\\)"))
1908 (delete-region (point) (progn (forward-line 1) (point))) 1908 (delete-region (point) (progn (forward-line 1) (point)))
1909 (when (eobp) 1909 (when (eobp)
1910 (return))) 1910 (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.")
194 (when buffer 194 (when buffer
195 (set-buffer buffer)) 195 (set-buffer buffer))
196 (let* ((gnus-override-method nil) 196 (let* ((gnus-override-method nil)
197 (method (gnus-find-method-for-group 197 (gnus-command-method
198 nnvirtual-last-accessed-component-group))) 198 (gnus-find-method-for-group
199 (funcall (gnus-get-function method 'request-article) 199 nnvirtual-last-accessed-component-group)))
200 article nil (nth 1 method) buffer))))) 200 (funcall (gnus-get-function gnus-command-method 'request-article)
201 article nil (nth 1 gnus-command-method) buffer)))))
201 ;; This is a fetch by number. 202 ;; This is a fetch by number.
202 (let* ((amap (nnvirtual-map-article article)) 203 (let* ((amap (nnvirtual-map-article article))
203 (cgroup (car amap))) 204 (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."
319 (substring response (or (string-match "<" response) 0) 319 (substring response (or (string-match "<" response) 0)
320 (+ 1 (or (string-match ">" response) -1))))) 320 (+ 1 (or (string-match ">" response) -1)))))
321 (pop3-set-process-query-on-exit-flag (car result) nil) 321 (pop3-set-process-query-on-exit-flag (car result) nil)
322 (erase-buffer)
322 (car result))))) 323 (car result)))))
323 324
324;; Support functions 325;; Support functions
@@ -514,6 +515,8 @@ Otherwise, return the size of the message-id MSG"
514 (let ((start pop3-read-point) end) 515 (let ((start pop3-read-point) end)
515 (with-current-buffer (process-buffer process) 516 (with-current-buffer (process-buffer process)
516 (while (not (re-search-forward "^\\.\r\n" nil t)) 517 (while (not (re-search-forward "^\\.\r\n" nil t))
518 (unless (memq (process-status process) '(open run))
519 (error "pop3 server closed the connection"))
517 (pop3-accept-process-output process) 520 (pop3-accept-process-output process)
518 (goto-char start)) 521 (goto-char start))
519 (setq pop3-read-point (point-marker)) 522 (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
287are exhibited within the square braces.)" 287are exhibited within the square braces.)"
288 288
289 (let* ((non-essential t) 289 (let* ((non-essential t)
290 (md (completion--field-metadata (field-beginning)))
290 (comps (completion-all-sorted-completions)) 291 (comps (completion-all-sorted-completions))
291 (last (if (consp comps) (last comps))) 292 (last (if (consp comps) (last comps)))
292 (base-size (cdr last)) 293 (base-size (cdr last))
@@ -299,11 +300,11 @@ are exhibited within the square braces.)"
299 (let* ((most-try 300 (let* ((most-try
300 (if (and base-size (> base-size 0)) 301 (if (and base-size (> base-size 0))
301 (completion-try-completion 302 (completion-try-completion
302 name candidates predicate (length name)) 303 name candidates predicate (length name) md)
303 ;; If the `comps' are 0-based, the result should be 304 ;; If the `comps' are 0-based, the result should be
304 ;; the same with `comps'. 305 ;; the same with `comps'.
305 (completion-try-completion 306 (completion-try-completion
306 name comps nil (length name)))) 307 name comps nil (length name) md)))
307 (most (if (consp most-try) (car most-try) 308 (most (if (consp most-try) (car most-try)
308 (if most-try (car comps) ""))) 309 (if most-try (car comps) "")))
309 ;; Compare name and most, so we can determine if name is 310 ;; 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.")
943 (process-send-string process "\r\n")) 943 (process-send-string process "\r\n"))
944 944
945(defun smtpmail-send-data (process buffer) 945(defun smtpmail-send-data (process buffer)
946 (let ((data-continue t) sending-data) 946 (let ((data-continue t) sending-data
947 (pr (with-current-buffer buffer
948 (make-progress-reporter "Sending email"
949 (point-min) (point-max)))))
947 (with-current-buffer buffer 950 (with-current-buffer buffer
948 (goto-char (point-min))) 951 (goto-char (point-min)))
949 (while data-continue 952 (while data-continue
950 (with-current-buffer buffer 953 (with-current-buffer buffer
954 (progress-reporter-update pr (point))
951 (setq sending-data (buffer-substring (point-at-bol) (point-at-eol))) 955 (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
952 (end-of-line 2) 956 (end-of-line 2)
953 (setq data-continue (not (eobp)))) 957 (setq data-continue (not (eobp))))
954 (smtpmail-send-data-1 process sending-data)))) 958 (smtpmail-send-data-1 process sending-data))
959 (progress-reporter-done pr)))
955 960
956(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) 961(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
957 "Get address list suitable for smtp RCPT TO: <address>." 962 "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 @@
61;; - for M-x, cycle-sort commands that have no key binding first. 61;; - for M-x, cycle-sort commands that have no key binding first.
62;; - Make things like icomplete-mode or lightning-completion work with 62;; - Make things like icomplete-mode or lightning-completion work with
63;; completion-in-region-mode. 63;; completion-in-region-mode.
64;; - extend `boundaries' to provide various other meta-data about the 64;; - extend `metadata':
65;; output of `all-completions':
66;; - preferred sorting order when displayed in *Completions*.
67;; - annotations/text-properties to add when displayed in *Completions*.
68;; - quoting/unquoting (so we can complete files names with envvars 65;; - quoting/unquoting (so we can complete files names with envvars
69;; and backslashes, and all-completion can list names without 66;; and backslashes, and all-completion can list names without
70;; quoting backslashes and dollars). 67;; quoting backslashes and dollars).
@@ -116,6 +113,32 @@ the closest directory separators."
116 (cons (or (cadr boundaries) 0) 113 (cons (or (cadr boundaries) 0)
117 (or (cddr boundaries) (length suffix))))) 114 (or (cddr boundaries) (length suffix)))))
118 115
116(defun completion-metadata (string table pred)
117 "Return the metadata of elements to complete at the end of STRING.
118This metadata is an alist. Currently understood keys are:
119- `category': the kind of objects returned by `all-completions'.
120 Used by `completion-category-overrides'.
121- `annotation-function': function to add annotations in *Completions*.
122 Takes one argument (STRING), which is a possible completion and
123 returns a string to append to STRING.
124- `display-sort-function': function to sort entries in *Completions*.
125 Takes one argument (COMPLETIONS) and should return a new list
126 of completions. Can operate destructively.
127- `cycle-sort-function': function to sort entries when cycling.
128 Works like `display-sort-function'."
129 (let ((metadata (if (functionp table)
130 (funcall table string pred 'metadata))))
131 (if (eq (car-safe metadata) 'metadata)
132 (cdr metadata))))
133
134(defun completion--field-metadata (field-start)
135 (completion-metadata (buffer-substring-no-properties field-start (point))
136 minibuffer-completion-table
137 minibuffer-completion-predicate))
138
139(defun completion-metadata-get (metadata prop)
140 (cdr (assq prop metadata)))
141
119(defun completion--some (fun xs) 142(defun completion--some (fun xs)
120 "Apply FUN to each element of XS in turn. 143 "Apply FUN to each element of XS in turn.
121Return the first non-nil returned value. 144Return the first non-nil returned value.
@@ -457,7 +480,34 @@ The available styles are listed in `completion-styles-alist'."
457 :group 'minibuffer 480 :group 'minibuffer
458 :version "23.1") 481 :version "23.1")
459 482
460(defun completion-try-completion (string table pred point) 483(defcustom completion-category-overrides
484 '((buffer (styles . (basic substring))))
485 "List of overrides for specific categories.
486Each override has the shape (CATEGORY . ALIST) where ALIST is
487an association list that can specify properties such as:
488- `styles': the list of `completion-styles' to use for that category.
489- `cycle': the `completion-cycle-threshold' to use for that category."
490 :type `(alist :key-type (choice (const buffer)
491 (const file)
492 symbol)
493 :value-type
494 (set
495 (cons (const style)
496 (repeat ,@(mapcar (lambda (x) (list 'const (car x)))
497 completion-styles-alist)))
498 (cons (const cycle)
499 (choice (const :tag "No cycling" nil)
500 (const :tag "Always cycle" t)
501 (integer :tag "Threshold"))))))
502
503(defun completion--styles (metadata)
504 (let* ((cat (completion-metadata-get metadata 'category))
505 (over (assq 'styles (cdr (assq cat completion-category-overrides)))))
506 (if over
507 (delete-dups (append (cdr over) (copy-sequence completion-styles)))
508 completion-styles)))
509
510(defun completion-try-completion (string table pred point metadata)
461 "Try to complete STRING using completion table TABLE. 511 "Try to complete STRING using completion table TABLE.
462Only the elements of table that satisfy predicate PRED are considered. 512Only the elements of table that satisfy predicate PRED are considered.
463POINT is the position of point within STRING. 513POINT is the position of point within STRING.
@@ -468,9 +518,9 @@ a new position for point."
468 (completion--some (lambda (style) 518 (completion--some (lambda (style)
469 (funcall (nth 1 (assq style completion-styles-alist)) 519 (funcall (nth 1 (assq style completion-styles-alist))
470 string table pred point)) 520 string table pred point))
471 completion-styles)) 521 (completion--styles metadata)))
472 522
473(defun completion-all-completions (string table pred point) 523(defun completion-all-completions (string table pred point metadata)
474 "List the possible completions of STRING in completion table TABLE. 524 "List the possible completions of STRING in completion table TABLE.
475Only the elements of table that satisfy predicate PRED are considered. 525Only the elements of table that satisfy predicate PRED are considered.
476POINT is the position of point within STRING. 526POINT is the position of point within STRING.
@@ -481,7 +531,7 @@ in the last `cdr'."
481 (completion--some (lambda (style) 531 (completion--some (lambda (style)
482 (funcall (nth 2 (assq style completion-styles-alist)) 532 (funcall (nth 2 (assq style completion-styles-alist))
483 string table pred point)) 533 string table pred point))
484 completion-styles)) 534 (completion--styles metadata)))
485 535
486(defun minibuffer--bitset (modified completions exact) 536(defun minibuffer--bitset (modified completions exact)
487 (logior (if modified 4 0) 537 (logior (if modified 4 0)
@@ -532,6 +582,11 @@ candidates than this number."
532 (const :tag "Always cycle" t) 582 (const :tag "Always cycle" t)
533 (integer :tag "Threshold"))) 583 (integer :tag "Threshold")))
534 584
585(defun completion--cycle-threshold (metadata)
586 (let* ((cat (completion-metadata-get metadata 'category))
587 (over (assq 'cycle (cdr (assq cat completion-category-overrides)))))
588 (if over (cdr over) completion-cycle-threshold)))
589
535(defvar completion-all-sorted-completions nil) 590(defvar completion-all-sorted-completions nil)
536(make-variable-buffer-local 'completion-all-sorted-completions) 591(make-variable-buffer-local 'completion-all-sorted-completions)
537(defvar completion-cycling nil) 592(defvar completion-cycling nil)
@@ -566,12 +621,14 @@ when the buffer's text is already an exact match."
566 (let* ((beg (field-beginning)) 621 (let* ((beg (field-beginning))
567 (end (field-end)) 622 (end (field-end))
568 (string (buffer-substring beg end)) 623 (string (buffer-substring beg end))
624 (md (completion--field-metadata beg))
569 (comp (funcall (or try-completion-function 625 (comp (funcall (or try-completion-function
570 'completion-try-completion) 626 'completion-try-completion)
571 string 627 string
572 minibuffer-completion-table 628 minibuffer-completion-table
573 minibuffer-completion-predicate 629 minibuffer-completion-predicate
574 (- (point) beg)))) 630 (- (point) beg)
631 md)))
575 (cond 632 (cond
576 ((null comp) 633 ((null comp)
577 (minibuffer-hide-completions) 634 (minibuffer-hide-completions)
@@ -610,16 +667,17 @@ when the buffer's text is already an exact match."
610 (completion--do-completion try-completion-function expect-exact) 667 (completion--do-completion try-completion-function expect-exact)
611 668
612 ;; It did find a match. Do we match some possibility exactly now? 669 ;; It did find a match. Do we match some possibility exactly now?
613 (let ((exact (test-completion completion 670 (let* ((exact (test-completion completion
614 minibuffer-completion-table 671 minibuffer-completion-table
615 minibuffer-completion-predicate)) 672 minibuffer-completion-predicate))
673 (threshold (completion--cycle-threshold md))
616 (comps 674 (comps
617 ;; Check to see if we want to do cycling. We do it 675 ;; Check to see if we want to do cycling. We do it
618 ;; here, after having performed the normal completion, 676 ;; here, after having performed the normal completion,
619 ;; so as to take advantage of the difference between 677 ;; so as to take advantage of the difference between
620 ;; try-completion and all-completions, for things 678 ;; try-completion and all-completions, for things
621 ;; like completion-ignored-extensions. 679 ;; like completion-ignored-extensions.
622 (when (and completion-cycle-threshold 680 (when (and threshold
623 ;; Check that the completion didn't make 681 ;; Check that the completion didn't make
624 ;; us jump to a different boundary. 682 ;; us jump to a different boundary.
625 (or (not completed) 683 (or (not completed)
@@ -636,7 +694,7 @@ when the buffer's text is already an exact match."
636 (not (ignore-errors 694 (not (ignore-errors
637 ;; This signal an (intended) error if comps is too 695 ;; This signal an (intended) error if comps is too
638 ;; short or if completion-cycle-threshold is t. 696 ;; short or if completion-cycle-threshold is t.
639 (consp (nthcdr completion-cycle-threshold comps))))) 697 (consp (nthcdr threshold comps)))))
640 ;; Fewer than completion-cycle-threshold remaining 698 ;; Fewer than completion-cycle-threshold remaining
641 ;; completions: let's cycle. 699 ;; completions: let's cycle.
642 (setq completed t exact t) 700 (setq completed t exact t)
@@ -715,27 +773,25 @@ scroll the window of possible completions."
715 (or completion-all-sorted-completions 773 (or completion-all-sorted-completions
716 (let* ((start (field-beginning)) 774 (let* ((start (field-beginning))
717 (end (field-end)) 775 (end (field-end))
718 (all (completion-all-completions (buffer-substring start end) 776 (string (buffer-substring start end))
719 minibuffer-completion-table 777 (all (completion-all-completions
720 minibuffer-completion-predicate 778 string
721 (- (point) start))) 779 minibuffer-completion-table
780 minibuffer-completion-predicate
781 (- (point) start)
782 (completion--field-metadata start)))
722 (last (last all)) 783 (last (last all))
723 (base-size (or (cdr last) 0))) 784 (base-size (or (cdr last) 0))
785 (all-md (completion-metadata (substring string 0 base-size)
786 minibuffer-completion-table
787 minibuffer-completion-predicate))
788 (sort-fun (completion-metadata-get all-md 'cycle-sort-function)))
724 (when last 789 (when last
725 (setcdr last nil) 790 (setcdr last nil)
726 ;; Prefer shorter completions. 791 (setq all (if sort-fun (funcall sort-fun all)
727 (setq all (sort all (lambda (c1 c2) 792 ;; Prefer shorter completions, by default.
728 (let ((s1 (get-text-property 793 (sort all (lambda (c1 c2) (< (length c1) (length c2))))))
729 0 :completion-cycle-penalty c1))
730 (s2 (get-text-property
731 0 :completion-cycle-penalty c2)))
732 (if (eq s1 s2)
733 (< (length c1) (length c2))
734 (< (or s1 (length c1))
735 (or s2 (length c2))))))))
736 ;; Prefer recently used completions. 794 ;; Prefer recently used completions.
737 ;; FIXME: Additional sorting ideas:
738 ;; - for M-x, prefer commands that have no key binding.
739 (when (minibufferp) 795 (when (minibufferp)
740 (let ((hist (symbol-value minibuffer-history-variable))) 796 (let ((hist (symbol-value minibuffer-history-variable)))
741 (setq all (sort all (lambda (c1 c2) 797 (setq all (sort all (lambda (c1 c2)
@@ -758,6 +814,7 @@ Repeated uses step through the possible completions."
758 ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el. 814 ;; ~/src/emacs/trunk/ and throws away lisp/minibuffer.el.
759 (let* ((start (field-beginning)) 815 (let* ((start (field-beginning))
760 (end (field-end)) 816 (end (field-end))
817 ;; (md (completion--field-metadata start))
761 (all (completion-all-sorted-completions)) 818 (all (completion-all-sorted-completions))
762 (base (+ start (or (cdr (last all)) 0)))) 819 (base (+ start (or (cdr (last all)) 0))))
763 (cond 820 (cond
@@ -861,8 +918,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
861 nil)) 918 nil))
862 (t nil)))))) 919 (t nil))))))
863 920
864(defun completion--try-word-completion (string table predicate point) 921(defun completion--try-word-completion (string table predicate point md)
865 (let ((comp (completion-try-completion string table predicate point))) 922 (let ((comp (completion-try-completion string table predicate point md)))
866 (if (not (consp comp)) 923 (if (not (consp comp))
867 comp 924 comp
868 925
@@ -884,7 +941,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion',
884 (while (and exts (not (consp tem))) 941 (while (and exts (not (consp tem)))
885 (setq tem (completion-try-completion 942 (setq tem (completion-try-completion
886 (concat before (pop exts) after) 943 (concat before (pop exts) after)
887 table predicate (1+ point)))) 944 table predicate (1+ point) md)))
888 (if (consp tem) (setq comp tem)))) 945 (if (consp tem) (setq comp tem))))
889 946
890 ;; Completing a single word is actually more difficult than completing 947 ;; Completing a single word is actually more difficult than completing
@@ -1219,7 +1276,8 @@ variables.")
1219 string 1276 string
1220 minibuffer-completion-table 1277 minibuffer-completion-table
1221 minibuffer-completion-predicate 1278 minibuffer-completion-predicate
1222 (- (point) (field-beginning))))) 1279 (- (point) (field-beginning))
1280 (completion--field-metadata start))))
1223 (message nil) 1281 (message nil)
1224 (if (or (null completions) 1282 (if (or (null completions)
1225 (and (not (consp (cdr completions))) 1283 (and (not (consp (cdr completions)))
@@ -1235,9 +1293,16 @@ variables.")
1235 (let* ((last (last completions)) 1293 (let* ((last (last completions))
1236 (base-size (cdr last)) 1294 (base-size (cdr last))
1237 (prefix (unless (zerop base-size) (substring string 0 base-size))) 1295 (prefix (unless (zerop base-size) (substring string 0 base-size)))
1238 (global-af (or (plist-get completion-extra-properties 1296 ;; FIXME: This function is for the output of all-completions,
1239 :annotation-function) 1297 ;; not completion-all-completions. Often it's the same, but
1240 completion-annotate-function)) 1298 ;; not always.
1299 (all-md (completion-metadata (substring string 0 base-size)
1300 minibuffer-completion-table
1301 minibuffer-completion-predicate))
1302 (afun (or (completion-metadata-get all-md 'annotation-function)
1303 (plist-get completion-extra-properties
1304 :annotation-function)
1305 completion-annotate-function))
1241 ;; If the *Completions* buffer is shown in a new 1306 ;; If the *Completions* buffer is shown in a new
1242 ;; window, mark it as softly-dedicated, so bury-buffer in 1307 ;; window, mark it as softly-dedicated, so bury-buffer in
1243 ;; minibuffer-hide-completions will know whether to 1308 ;; minibuffer-hide-completions will know whether to
@@ -1247,15 +1312,21 @@ variables.")
1247 ;; Remove the base-size tail because `sort' requires a properly 1312 ;; Remove the base-size tail because `sort' requires a properly
1248 ;; nil-terminated list. 1313 ;; nil-terminated list.
1249 (when last (setcdr last nil)) 1314 (when last (setcdr last nil))
1250 (setq completions (sort completions 'string-lessp))
1251 (setq completions 1315 (setq completions
1252 (cond 1316 ;; FIXME: This function is for the output of all-completions,
1253 (global-af 1317 ;; not completion-all-completions. Often it's the same, but
1318 ;; not always.
1319 (let ((sort-fun (completion-metadata-get
1320 all-md 'display-sort-function)))
1321 (if sort-fun
1322 (funcall sort-fun completions)
1323 (sort completions 'string-lessp))))
1324 (when afun
1325 (setq completions
1254 (mapcar (lambda (s) 1326 (mapcar (lambda (s)
1255 (let ((ann (funcall global-af s))) 1327 (let ((ann (funcall afun s)))
1256 (if ann (list s ann) s))) 1328 (if ann (list s ann) s)))
1257 completions)) 1329 completions)))
1258 (t completions)))
1259 1330
1260 (with-current-buffer standard-output 1331 (with-current-buffer standard-output
1261 (set (make-local-variable 'completion-base-position) 1332 (set (make-local-variable 'completion-base-position)
@@ -1270,12 +1341,12 @@ variables.")
1270 (cpred minibuffer-completion-predicate) 1341 (cpred minibuffer-completion-predicate)
1271 (cprops completion-extra-properties)) 1342 (cprops completion-extra-properties))
1272 (lambda (start end choice) 1343 (lambda (start end choice)
1273 (unless 1344 (unless (or (zerop (length prefix))
1274 (or (zerop (length prefix)) 1345 (equal prefix
1275 (equal prefix 1346 (buffer-substring-no-properties
1276 (buffer-substring-no-properties 1347 (max (point-min)
1277 (max (point-min) (- start (length prefix))) 1348 (- start (length prefix)))
1278 start))) 1349 start)))
1279 (message "*Completions* out of date")) 1350 (message "*Completions* out of date"))
1280 ;; FIXME: Use `md' to do quoting&terminator here. 1351 ;; FIXME: Use `md' to do quoting&terminator here.
1281 (completion--replace start end choice) 1352 (completion--replace start end choice)
@@ -1632,6 +1703,7 @@ same as `substitute-in-file-name'."
1632 "Completion table for file names." 1703 "Completion table for file names."
1633 (ignore-errors 1704 (ignore-errors
1634 (cond 1705 (cond
1706 ((eq action 'metadata) '(metadata (category . file)))
1635 ((eq (car-safe action) 'boundaries) 1707 ((eq (car-safe action) 'boundaries)
1636 (let ((start (length (file-name-directory string))) 1708 (let ((start (length (file-name-directory string)))
1637 (end (string-match-p "/" (cdr action)))) 1709 (end (string-match-p "/" (cdr action))))
@@ -1852,6 +1924,11 @@ and `read-file-name-function'."
1852 (funcall (or read-file-name-function #'read-file-name-default) 1924 (funcall (or read-file-name-function #'read-file-name-default)
1853 prompt dir default-filename mustmatch initial predicate)) 1925 prompt dir default-filename mustmatch initial predicate))
1854 1926
1927;; minibuffer-completing-file-name is a variable used internally in minibuf.c
1928;; to determine whether to use minibuffer-local-filename-completion-map or
1929;; minibuffer-local-completion-map. It shouldn't be exported to Elisp.
1930(make-obsolete-variable 'minibuffer-completing-file-name nil "24.1")
1931
1855(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate) 1932(defun read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate)
1856 "Default method for reading file names. 1933 "Default method for reading file names.
1857See `read-file-name' for the meaning of the arguments." 1934See `read-file-name' for the meaning of the arguments."
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 47085af85f0..b1ee4c45373 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -314,9 +314,11 @@ Called with 5 arguments, PROCESS, SENDER, RESPONSE, TARGET and TEXT."
314 :type 'boolean 314 :type 'boolean
315 :group 'rcirc) 315 :group 'rcirc)
316 316
317(defcustom rcirc-decode-coding-system 'utf-8 317(defcustom rcirc-decode-coding-system nil
318 "Coding system used to decode incoming irc messages." 318 "Coding system used to decode incoming irc messages.
319If nil automatically detect the coding system."
319 :type 'coding-system 320 :type 'coding-system
321 :version "24.1"
320 :group 'rcirc) 322 :group 'rcirc)
321 323
322(defcustom rcirc-encode-coding-system 'utf-8 324(defcustom rcirc-encode-coding-system 'utf-8
@@ -616,7 +618,7 @@ last ping."
616 (setq header-line-format (format "%f" (- (rcirc-float-time) 618 (setq header-line-format (format "%f" (- (rcirc-float-time)
617 (string-to-number message)))))) 619 (string-to-number message))))))
618 620
619(defvar rcirc-debug-buffer " *rcirc debug*") 621(defvar rcirc-debug-buffer "*rcirc debug*")
620(defvar rcirc-debug-flag nil 622(defvar rcirc-debug-flag nil
621 "If non-nil, write information to `rcirc-debug-buffer'.") 623 "If non-nil, write information to `rcirc-debug-buffer'.")
622(defun rcirc-debug (process text) 624(defun rcirc-debug (process text)
@@ -1480,9 +1482,9 @@ record activity."
1480 (old-point (point-marker)) 1482 (old-point (point-marker))
1481 (fill-start (marker-position rcirc-prompt-start-marker))) 1483 (fill-start (marker-position rcirc-prompt-start-marker)))
1482 1484
1485 (setq text (decode-coding-string text (or rcirc-decode-coding-system
1486 (detect-coding-string text t))))
1483 (unless (string= sender (rcirc-nick process)) 1487 (unless (string= sender (rcirc-nick process))
1484 ;; only decode text from other senders, not ours
1485 (setq text (decode-coding-string text rcirc-decode-coding-system))
1486 ;; mark the line with overlay arrow 1488 ;; mark the line with overlay arrow
1487 (unless (or (marker-position overlay-arrow-position) 1489 (unless (or (marker-position overlay-arrow-position)
1488 (get-buffer-window (current-buffer)) 1490 (get-buffer-window (current-buffer))
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'."
1158 1158
1159(defvar minibuffer-completing-symbol nil 1159(defvar minibuffer-completing-symbol nil
1160 "Non-nil means completing a Lisp symbol in the minibuffer.") 1160 "Non-nil means completing a Lisp symbol in the minibuffer.")
1161(make-obsolete-variable 'minibuffer-completing-symbol nil "24.1")
1161 1162
1162(defvar minibuffer-default nil 1163(defvar minibuffer-default nil
1163 "The current default value or list of default values in the minibuffer. 1164 "The current default value or list of default values in the minibuffer.