aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2010-09-22 11:56:28 +0900
committerKenichi Handa2010-09-22 11:56:28 +0900
commit1114abdb3d5a0f4f86d7a28f8c523c6f07790208 (patch)
tree49871b5c4ffce9d6c281ccbc79a79b231e5f41b4
parent86282aabd0094aac190834788200bd049a976fc9 (diff)
parentee705a5c54c4054bcd1608e5cd5be193e679d0db (diff)
downloademacs-1114abdb3d5a0f4f86d7a28f8c523c6f07790208.tar.gz
emacs-1114abdb3d5a0f4f86d7a28f8c523c6f07790208.zip
merge trunk
-rw-r--r--doc/misc/ChangeLog5
-rw-r--r--doc/misc/gnus.texi2
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/emacs-lisp/smie.el29
-rw-r--r--lisp/gnus/ChangeLog78
-rw-r--r--lisp/gnus/gnus-group.el29
-rw-r--r--lisp/gnus/gnus-html.el341
-rw-r--r--lisp/gnus/gnus-int.el14
-rw-r--r--lisp/gnus/gnus-start.el22
-rw-r--r--lisp/gnus/gnus-sum.el9
-rw-r--r--lisp/gnus/gnus.el84
-rw-r--r--lisp/gnus/nnimap.el162
-rw-r--r--lisp/gnus/nnmail.el15
-rw-r--r--lisp/gnus/nnml.el33
-rwxr-xr-xnt/configure.bat40
-rw-r--r--src/ChangeLog9
-rw-r--r--src/doc.c2
-rw-r--r--src/makefile.w32-in1
18 files changed, 570 insertions, 312 deletions
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 68d6d3c8f00..3e723cd8c83 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,8 @@
12010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * gnus.texi (Expunging mailboxes): Update name of the expunging
4 command.
5
12010-09-20 Katsumi Yamaoka <yamaoka@jpl.org> 62010-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
2 7
3 * emacs-mime.texi (rfc2047): Update description for 8 * emacs-mime.texi (rfc2047): Update description for
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 841cf8c510c..52c8bb642f0 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -18384,7 +18384,7 @@ INBOX.mailbox).
18384@cindex expunge 18384@cindex expunge
18385@cindex manual expunging 18385@cindex manual expunging
18386@kindex G x (Group) 18386@kindex G x (Group)
18387@findex gnus-group-nnimap-expunge 18387@findex gnus-group-expunge-group
18388 18388
18389If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, 18389If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
18390you may want the option of expunging all deleted articles in a mailbox 18390you may want the option of expunging all deleted articles in a mailbox
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e293d7612ba..9900472a59d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
12010-09-21 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/smie.el (smie-debug--describe-cycle): Fix typo.
4 (smie-indent-comment): Be more careful with comment-start-skip.
5 (smie-indent-comment-close, smie-indent-comment-inside): New funs.
6 (smie-indent-functions): Use them.
7
12010-09-21 Michael Albinus <michael.albinus@gmx.de> 82010-09-21 Michael Albinus <michael.albinus@gmx.de>
2 9
3 * net/ange-ftp.el (ange-ftp-skip-msgs): Add "^504 ..." message. 10 * net/ange-ftp.el (ange-ftp-skip-msgs): Add "^504 ..." message.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 0267e9771f5..55516d276da 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -338,7 +338,7 @@ CSTS is a list of pairs representing arcs in a graph."
338 res)) 338 res))
339 cycle))) 339 cycle)))
340 (mapconcat 340 (mapconcat
341 (lambda (elems) (mapconcat 'indentity elems "=")) 341 (lambda (elems) (mapconcat 'identity elems "="))
342 (append names (list (car names))) 342 (append names (list (car names)))
343 " < "))) 343 " < ")))
344 344
@@ -1173,7 +1173,11 @@ in order to figure out the indentation of some other (further down) point."
1173 ;; front of a comment" when doing virtual-indentation anyway. And if we are 1173 ;; front of a comment" when doing virtual-indentation anyway. And if we are
1174 ;; (as can happen in octave-mode), moving forward can lead to inf-loops. 1174 ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
1175 (and (smie-indent--bolp) 1175 (and (smie-indent--bolp)
1176 (looking-at comment-start-skip) 1176 (let ((pos (point)))
1177 (save-excursion
1178 (beginning-of-line)
1179 (and (re-search-forward comment-start-skip (line-end-position) t)
1180 (eq pos (or (match-end 1) (match-beginning 0))))))
1177 (save-excursion 1181 (save-excursion
1178 (forward-comment (point-max)) 1182 (forward-comment (point-max))
1179 (skip-chars-forward " \t\r\n") 1183 (skip-chars-forward " \t\r\n")
@@ -1194,6 +1198,20 @@ in order to figure out the indentation of some other (further down) point."
1194 (if (looking-at (regexp-quote continue)) 1198 (if (looking-at (regexp-quote continue))
1195 (current-column)))))))) 1199 (current-column))))))))
1196 1200
1201(defun smie-indent-comment-close ()
1202 (and (boundp 'comment-end-skip)
1203 comment-end-skip
1204 (not (looking-at " \t*$")) ;Not just a \n comment-closer.
1205 (looking-at comment-end-skip)
1206 (nth 4 (syntax-ppss))
1207 (save-excursion
1208 (goto-char (nth 8 (syntax-ppss)))
1209 (current-column))))
1210
1211(defun smie-indent-comment-inside ()
1212 (and (nth 4 (syntax-ppss))
1213 'noindent))
1214
1197(defun smie-indent-after-keyword () 1215(defun smie-indent-after-keyword ()
1198 ;; Indentation right after a special keyword. 1216 ;; Indentation right after a special keyword.
1199 (save-excursion 1217 (save-excursion
@@ -1275,9 +1293,10 @@ in order to figure out the indentation of some other (further down) point."
1275 (current-column))))))) 1293 (current-column)))))))
1276 1294
1277(defvar smie-indent-functions 1295(defvar smie-indent-functions
1278 '(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment 1296 '(smie-indent-fixindent smie-indent-bob smie-indent-close
1279 smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword 1297 smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
1280 smie-indent-exps) 1298 smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword
1299 smie-indent-exps)
1281 "Functions to compute the indentation. 1300 "Functions to compute the indentation.
1282Each function is called with no argument, shouldn't move point, and should 1301Each function is called with no argument, shouldn't move point, and should
1283return either nil if it has no opinion, or an integer representing the column 1302return either nil if it has no opinion, or an integer representing the column
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index b85618ae705..eeba68f81a2 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,81 @@
12010-09-21 Adam Sjøgren <asjo@koldfront.dk>
2
3 * gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
4
52010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
6
7 * gnus-int.el (gnus-open-server): Give a better error message in the
8 "go offline" case.
9
10 * gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting
11 marks for nnimap, which is seldom the right thing to do.
12
13 * gnus.el (gnus-sloppily-equal-method-parameters): Refactor out.
14 (gnus-same-method-different-name): New function.
15
16 * nnimap.el (parse-time): Require.
17
18 * gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
19 method in the presence of many similar methods.
20
21 * nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract.
22
23 * nnimap.el (nnimap-find-expired-articles): Don't refer to
24 nnml-inhibit-expiry.
25
26 * gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to
27 find out whether methods are equal.
28
29 * nnimap.el (nnimap-find-expired-articles): New function.
30 (nnimap-process-expiry-targets): New function.
31 (nnimap-request-move-article): Request the article before looking at
32 what the Message-ID is. Fix found by Andrew Cohen.
33 (nnimap-mark-and-expunge-incoming): Wait for the last sequence.
34
35 * nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time
36 for oldness in addition to being a predicate.
37
38 * nnimap.el (nnimap-request-group): When we have zero articles, return
39 the right data to Gnus.
40 (nnimap-request-expire-articles): Only delete articles immediately if
41 the target is 'delete.
42
43 * gnus-sum.el (gnus-summary-move-article): When respooling to the same
44 method, this would bug out.
45
46 * gnus-group.el (gnus-group-expunge-group): Renamed from
47 gnus-group-nnimap-expunge, and implemented as a normal interface
48 function.
49
50 * gnus-int.el (gnus-request-expunge-group): New function.
51
52 * nnimap.el (nnimap-request-create-group): Implement.
53 (nnimap-request-expunge-group): New function.
54
552010-09-21 Julien Danjou <julien@danjou.info>
56
57 * gnus-html.el (gnus-html-image-cache-ttl): Add new variable.
58 (gnus-html-cache-expired): Add new function.
59 (gnus-html-wash-images): Use `gnus-html-cache-expired' to check
60 wethever we should display image for fetch it.
61 Compute alt-text earlier to pass it to the fetching function too.
62 (gnus-html-schedule-image-fetching): Change function argument to only
63 get one image at a time, not a list.
64 (gnus-html-image-fetched): Use `url-store-in-cache' to store image in
65 cache.
66 (gnus-html-get-image-data): New function to retrieve image data from
67 cache.
68 (gnus-html-put-image): Change buffer argument to use image data rather
69 than file, and place image above region rather than inserting a new
70 one. Do not take alt-text as argument, since it's useless now: we place
71 the image above alt-text.
72 (gnus-html-prune-cache): Remove.
73 (gnus-html-show-images): Start to fetch image when we find one, do not
74 push into a temporary list.
75 (gnus-html-prefetch-images): Only fetch image if they have expired.
76 (gnus-html-browse-image): Fix, use 'gnus-image-url.
77 (gnus-html-image-map): Add "v" to browse-url on undisplayed image.
78
12010-09-20 Katsumi Yamaoka <yamaoka@jpl.org> 792010-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
2 80
3 * rfc2047.el (rfc2047-encode-parameter): Doc fix. 81 * rfc2047.el (rfc2047-encode-parameter): Doc fix.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index fa6ae51886c..80cf580b84a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -509,7 +509,10 @@ simple manner.")
509 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) 509 (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
510 (t number)) ?s) 510 (t number)) ?s)
511 (?R gnus-tmp-number-of-read ?s) 511 (?R gnus-tmp-number-of-read ?s)
512 (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d) 512 (?U (if (gnus-active gnus-tmp-group)
513 (gnus-number-of-unseen-articles-in-group gnus-tmp-group)
514 "*")
515 ?s)
513 (?t gnus-tmp-number-total ?d) 516 (?t gnus-tmp-number-total ?d)
514 (?y gnus-tmp-number-of-unread ?s) 517 (?y gnus-tmp-number-of-unread ?s)
515 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) 518 (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
@@ -675,7 +678,7 @@ simple manner.")
675 "R" gnus-group-make-rss-group 678 "R" gnus-group-make-rss-group
676 "c" gnus-group-customize 679 "c" gnus-group-customize
677 "z" gnus-group-compact-group 680 "z" gnus-group-compact-group
678 "x" gnus-group-nnimap-expunge 681 "x" gnus-group-expunge-group
679 "\177" gnus-group-delete-group 682 "\177" gnus-group-delete-group
680 [delete] gnus-group-delete-group) 683 [delete] gnus-group-delete-group)
681 684
@@ -3163,21 +3166,17 @@ mail messages or news articles in files that have numeric names."
3163 'summary 'group))) 3166 'summary 'group)))
3164 (error "Couldn't enter %s" dir)))) 3167 (error "Couldn't enter %s" dir))))
3165 3168
3166(autoload 'nnimap-expunge "nnimap") 3169(defun gnus-group-expunge-group (group)
3167(autoload 'nnimap-acl-get "nnimap")
3168(autoload 'nnimap-acl-edit "nnimap")
3169
3170(defun gnus-group-nnimap-expunge (group)
3171 "Expunge deleted articles in current nnimap GROUP." 3170 "Expunge deleted articles in current nnimap GROUP."
3172 (interactive (list (gnus-group-group-name))) 3171 (interactive (list (gnus-group-group-name)))
3173 (let ((mailbox (gnus-group-real-name group)) method) 3172 (let ((method (gnus-find-method-for-group group)))
3174 (unless group 3173 (if (not (gnus-check-backend-function
3175 (error "No group on current line")) 3174 'request-expunge-group (car method)))
3176 (unless (gnus-get-info group) 3175 (error "%s does not support expunging" (car method))
3177 (error "Killed group; can't be edited")) 3176 (gnus-request-expunge-group group method))))
3178 (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group)))) 3177
3179 (error "%s is not an nnimap group" group)) 3178(autoload 'nnimap-acl-get "nnimap")
3180 (nnimap-expunge mailbox (cadr method)))) 3179(autoload 'nnimap-acl-edit "nnimap")
3181 3180
3182(defun gnus-group-nnimap-edit-acl (group) 3181(defun gnus-group-nnimap-edit-acl (group)
3183 "Edit the Access Control List of current nnimap GROUP." 3182 "Edit the Access Control List of current nnimap GROUP."
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index 78bb7ca18b5..34dbb4dd878 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -34,15 +34,10 @@
34(require 'gnus-art) 34(require 'gnus-art)
35(require 'mm-url) 35(require 'mm-url)
36(require 'url) 36(require 'url)
37(require 'url-cache)
37 38
38(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") 39(defcustom gnus-html-image-cache-ttl (days-to-time 7)
39 "Where Gnus will cache images it downloads from the web." 40 "Time in seconds used to cache the image on disk."
40 :version "24.1"
41 :group 'gnus-art
42 :type 'directory)
43
44(defcustom gnus-html-cache-size 500000000
45 "The size of the Gnus image cache."
46 :version "24.1" 41 :version "24.1"
47 :group 'gnus-art 42 :group 'gnus-art
48 :type 'integer) 43 :type 'integer)
@@ -73,6 +68,7 @@ fit these criteria."
73 (let ((map (make-sparse-keymap))) 68 (let ((map (make-sparse-keymap)))
74 (define-key map "u" 'gnus-article-copy-string) 69 (define-key map "u" 'gnus-article-copy-string)
75 (define-key map "i" 'gnus-html-insert-image) 70 (define-key map "i" 'gnus-html-insert-image)
71 (define-key map "v" 'gnus-html-browse-url)
76 map)) 72 map))
77 73
78(defvar gnus-html-displayed-image-map 74(defvar gnus-html-displayed-image-map
@@ -84,6 +80,19 @@ fit these criteria."
84 (define-key map [tab] 'widget-forward) 80 (define-key map [tab] 'widget-forward)
85 map)) 81 map))
86 82
83(defun gnus-html-cache-expired (url ttl)
84 "Check if URL is cached for more than TTL."
85 (cond (url-standalone-mode
86 (not (file-exists-p (url-cache-create-filename url))))
87 (t (let ((cache-time (url-is-cached url)))
88 (if cache-time
89 (time-less-p
90 (time-add
91 cache-time
92 ttl)
93 (current-time))
94 t)))))
95
87;;;###autoload 96;;;###autoload
88(defun gnus-article-html (&optional handle) 97(defun gnus-article-html (&optional handle)
89 (let ((article-buffer (current-buffer))) 98 (let ((article-buffer (current-buffer)))
@@ -133,6 +142,7 @@ fit these criteria."
133 (replace-match "" t t))) 142 (replace-match "" t t)))
134 143
135(defun gnus-html-wash-images () 144(defun gnus-html-wash-images ()
145 "Run through current buffer and replace img tags by images."
136 (let (tag parameters string start end images url) 146 (let (tag parameters string start end images url)
137 (goto-char (point-min)) 147 (goto-char (point-min))
138 ;; Search for all the images first. 148 ;; Search for all the images first.
@@ -158,62 +168,68 @@ fit these criteria."
158 (setq image (gnus-create-image (buffer-string) 168 (setq image (gnus-create-image (buffer-string)
159 nil t)))) 169 nil t))))
160 (when image 170 (when image
161 (let ((string (buffer-substring start end))) 171 (let ((string (buffer-substring start end)))
162 (delete-region start end) 172 (delete-region start end)
163 (gnus-put-image image (gnus-string-or string "*") 'cid) 173 (gnus-put-image image (gnus-string-or string "*") 'cid)
164 (gnus-add-image 'cid image)))) 174 (gnus-add-image 'cid image))))
165 ;; Normal, external URL. 175 ;; Normal, external URL.
166 (if (gnus-html-image-url-blocked-p 176 (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
167 url 177 parameters)
168 (if (buffer-live-p gnus-summary-buffer) 178 (match-string 2 parameters))))
169 (with-current-buffer gnus-summary-buffer 179 (if (gnus-html-image-url-blocked-p
170 gnus-blocked-images) 180 url
171 gnus-blocked-images)) 181 (if (buffer-live-p gnus-summary-buffer)
172 (progn 182 (with-current-buffer gnus-summary-buffer
173 (widget-convert-button 183 gnus-blocked-images)
174 'link start end 184 gnus-blocked-images))
175 :action 'gnus-html-insert-image 185 (progn
176 :help-echo url 186 (widget-convert-button
177 :keymap gnus-html-image-map 187 'link start end
178 :button-keymap gnus-html-image-map) 188 :action 'gnus-html-insert-image
179 (let ((overlay (gnus-make-overlay start end)) 189 :help-echo url
180 (spec (list url 190 :keymap gnus-html-image-map
181 (set-marker (make-marker) start) 191 :button-keymap gnus-html-image-map)
182 (set-marker (make-marker) end)))) 192 (let ((overlay (gnus-make-overlay start end))
183 (gnus-overlay-put overlay 'local-map gnus-html-image-map) 193 (spec (list url
184 (gnus-overlay-put overlay 'gnus-image spec) 194 (set-marker (make-marker) start)
185 (gnus-put-text-property 195 (set-marker (make-marker) end)
186 start end 196 alt-text)))
187 'gnus-image spec))) 197 (gnus-overlay-put overlay 'local-map gnus-html-image-map)
188 (let ((file (gnus-html-image-id url)) 198 (gnus-overlay-put overlay 'gnus-image spec)
189 width height alt-text) 199 (gnus-put-text-property start end 'gnus-image-url url)
190 (when (string-match "height=\"?\\([0-9]+\\)" parameters) 200 (gnus-put-text-property
191 (setq height (string-to-number (match-string 1 parameters)))) 201 start end
192 (when (string-match "width=\"?\\([0-9]+\\)" parameters) 202 'gnus-image spec)))
193 (setq width (string-to-number (match-string 1 parameters)))) 203 ;; Non-blocked url
194 (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" 204 (let ((width
195 parameters) 205 (when (string-match "width=\"?\\([0-9]+\\)" parameters)
196 (setq alt-text (match-string 2 parameters))) 206 (string-to-number (match-string 1 parameters))))
197 ;; Don't fetch images that are really small. They're 207 (height
198 ;; probably tracking pictures. 208 (when (string-match "height=\"?\\([0-9]+\\)" parameters)
199 (when (and (or (null height) 209 (string-to-number (match-string 1 parameters)))))
200 (> height 4)) 210 ;; Don't fetch images that are really small. They're
201 (or (null width) 211 ;; probably tracking pictures.
202 (> width 4))) 212 (when (and (or (null height)
203 (if (file-exists-p file) 213 (> height 4))
204 ;; It's already cached, so just insert it. 214 (or (null width)
205 (let ((string (buffer-substring start end))) 215 (> width 4)))
206 ;; Delete the IMG text. 216 (gnus-html-display-image url start end alt-text))))))))))
207 (delete-region start end) 217
208 (gnus-html-put-image file (point) string url alt-text)) 218(defun gnus-html-display-image (url start end alt-text)
209 ;; We don't have it, so schedule it for fetching 219 "Display image at URL on text from START to END.
210 ;; asynchronously. 220Use ALT-TEXT for the image string."
211 (push (list url 221 (if (gnus-html-cache-expired url gnus-html-image-cache-ttl)
212 (set-marker (make-marker) start) 222 ;; We don't have it, so schedule it for fetching
213 (point-marker)) 223 ;; asynchronously.
214 images)))))))) 224 (gnus-html-schedule-image-fetching
215 (when images 225 (current-buffer)
216 (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) 226 (list url
227 (set-marker (make-marker) start)
228 (set-marker (make-marker) end)
229 alt-text))
230 ;; It's already cached, so just insert it.
231 (gnus-html-put-image (gnus-html-get-image-data url)
232 start end url alt-text)))
217 233
218(defun gnus-html-wash-tags () 234(defun gnus-html-wash-tags ()
219 (let (tag parameters string start end images url) 235 (let (tag parameters string start end images url)
@@ -300,8 +316,7 @@ fit these criteria."
300(defun gnus-html-insert-image () 316(defun gnus-html-insert-image ()
301 "Fetch and insert the image under point." 317 "Fetch and insert the image under point."
302 (interactive) 318 (interactive)
303 (gnus-html-schedule-image-fetching 319 (apply 'gnus-html-display-image (get-text-property (point) 'gnus-image)))
304 (current-buffer) (list (get-text-property (point) 'gnus-image))))
305 320
306(defun gnus-html-show-alt-text () 321(defun gnus-html-show-alt-text ()
307 "Show the ALT text of the image under point." 322 "Show the ALT text of the image under point."
@@ -311,7 +326,7 @@ fit these criteria."
311(defun gnus-html-browse-image () 326(defun gnus-html-browse-image ()
312 "Browse the image under point." 327 "Browse the image under point."
313 (interactive) 328 (interactive)
314 (browse-url (get-text-property (point) 'gnus-image))) 329 (browse-url (get-text-property (point) 'gnus-image-url)))
315 330
316(defun gnus-html-browse-url () 331(defun gnus-html-browse-url ()
317 "Browse the image under point." 332 "Browse the image under point."
@@ -321,87 +336,89 @@ fit these criteria."
321 (message "No URL at point") 336 (message "No URL at point")
322 (browse-url url)))) 337 (browse-url url))))
323 338
324(defun gnus-html-schedule-image-fetching (buffer images) 339(defun gnus-html-schedule-image-fetching (buffer image)
325 (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" 340 "Retrieve IMAGE, and place it into BUFFER on arrival."
326 buffer images) 341 (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s"
327 (dolist (image images) 342 buffer image)
328 (ignore-errors 343 (ignore-errors
329 (url-retrieve (car image) 344 (url-retrieve (car image)
330 'gnus-html-image-fetched 345 'gnus-html-image-fetched
331 (list buffer image))))) 346 (list buffer image))))
332
333(defun gnus-html-image-id (url)
334 (expand-file-name (sha1 url) gnus-html-cache-directory))
335 347
336(defun gnus-html-image-fetched (status buffer image) 348(defun gnus-html-image-fetched (status buffer image)
337 (let ((file (gnus-html-image-id (car image)))) 349 (url-store-in-cache (current-buffer))
338 ;; Search the start of the image data 350 (when (and (search-forward "\n\n" nil t)
351 (buffer-live-p buffer)
352 ;; If the `image' has no marker, do not replace anything
353 (cadr image)
354 ;; If the position of the marker is 1, then that
355 ;; means that the text it was in has been deleted;
356 ;; i.e., that the user has selected a different
357 ;; article before the image arrived.
358 (not (= (marker-position (cadr image))
359 (with-current-buffer buffer
360 (point-min)))))
361 (let ((data (buffer-substring (point) (point-max))))
362 (with-current-buffer buffer
363 (let ((inhibit-read-only t))
364 (gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image))))))
365 (kill-buffer (current-buffer)))
366
367(defun gnus-html-get-image-data (url)
368 "Get image data for URL.
369Return a string with image data."
370 (with-temp-buffer
371 (mm-disable-multibyte)
372 (url-cache-extract (url-cache-create-filename url))
339 (when (search-forward "\n\n" nil t) 373 (when (search-forward "\n\n" nil t)
340 ;; Write region (image data) silently 374 (buffer-substring (point) (point-max)))))
341 (write-region (point) (point-max) file nil 1) 375
342 (kill-buffer (current-buffer)) 376(defun gnus-html-put-image (data start end &optional url alt-text)
343 (when (and (buffer-live-p buffer)
344 ;; If the `image' has no marker, do not replace anything
345 (cadr image)
346 ;; If the position of the marker is 1, then that
347 ;; means that the text it was in has been deleted;
348 ;; i.e., that the user has selected a different
349 ;; article before the image arrived.
350 (not (= (marker-position (cadr image)) (point-min))))
351 (with-current-buffer buffer
352 (let ((inhibit-read-only t)
353 (string (buffer-substring (cadr image) (caddr image))))
354 (delete-region (cadr image) (caddr image))
355 (gnus-html-put-image file (cadr image) (car image) string)))))))
356
357(defun gnus-html-put-image (file point string &optional url alt-text)
358 (when (gnus-graphic-display-p) 377 (when (gnus-graphic-display-p)
359 (let* ((image (ignore-errors 378 (let* ((image (ignore-errors
360 (gnus-create-image file))) 379 (gnus-create-image data nil t)))
361 (size (and image 380 (size (and image
362 (if (featurep 'xemacs) 381 (if (featurep 'xemacs)
363 (cons (glyph-width image) (glyph-height image)) 382 (cons (glyph-width image) (glyph-height image))
364 (image-size image t))))) 383 (image-size image t)))))
365 (save-excursion 384 (save-excursion
366 (goto-char point) 385 (goto-char start)
367 (if (and image 386 (let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
368 ;; Kludge to avoid displaying 30x30 gif images, which 387 (if (and image
369 ;; seems to be a signal of a broken image. 388 ;; Kludge to avoid displaying 30x30 gif images, which
370 (not (and (if (featurep 'xemacs) 389 ;; seems to be a signal of a broken image.
371 (glyphp image) 390 (not (and (if (featurep 'xemacs)
372 (listp image)) 391 (glyphp image)
373 (eq (if (featurep 'xemacs) 392 (listp image))
374 (let ((data (cdadar (specifier-spec-list 393 (eq (if (featurep 'xemacs)
375 (glyph-image image))))) 394 (let ((d (cdadar (specifier-spec-list
376 (and (vectorp data) 395 (glyph-image image)))))
377 (aref data 0))) 396 (and (vectorp d)
378 (plist-get (cdr image) :type)) 397 (aref d 0)))
379 'gif) 398 (plist-get (cdr image) :type))
380 (= (car size) 30) 399 'gif)
381 (= (cdr size) 30)))) 400 (= (car size) 30)
382 (let ((start (point))) 401 (= (cdr size) 30))))
383 (setq image (gnus-html-rescale-image image file size)) 402 ;; Good image, add it!
384 (gnus-put-image image 403 (let ((image (gnus-html-rescale-image image data size)))
385 (gnus-string-or string "*") 404 (delete-region start end)
386 'external) 405 (gnus-put-image image alt-text 'external)
387 (let ((overlay (gnus-make-overlay start (point)))) 406 (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
388 (gnus-overlay-put overlay 'local-map 407 gnus-html-displayed-image-map)
389 gnus-html-displayed-image-map) 408 (gnus-put-text-property start (point) 'gnus-alt-text alt-text)
390 (gnus-put-text-property start (point) 'gnus-alt-text alt-text) 409 (when url
391 (when url 410 (gnus-put-text-property start (point) 'gnus-image-url url))
392 (gnus-put-text-property start (point) 'gnus-image url))) 411 (gnus-add-image 'external image)
393 (gnus-add-image 'external image) 412 t)
394 t) 413 ;; Bad image, try to show something else
395 (insert string) 414 (delete-region start end)
396 (when (fboundp 'find-image) 415 (when (fboundp 'find-image)
397 (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) 416 (setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
398 (gnus-put-image image 417 (gnus-put-image image alt-text 'internal)
399 (gnus-string-or string "*") 418 (gnus-add-image 'internal image))
400 'internal) 419 nil))))))
401 (gnus-add-image 'internal image)) 420
402 nil))))) 421(defun gnus-html-rescale-image (image data size)
403
404(defun gnus-html-rescale-image (image file size)
405 (if (or (not (fboundp 'imagemagick-types)) 422 (if (or (not (fboundp 'imagemagick-types))
406 (not (get-buffer-window (current-buffer)))) 423 (not (get-buffer-window (current-buffer))))
407 image 424 image
@@ -414,35 +431,17 @@ fit these criteria."
414 (- (nth 3 edges) (nth 1 edges))))) 431 (- (nth 3 edges) (nth 1 edges)))))
415 scaled-image) 432 scaled-image)
416 (when (> height window-height) 433 (when (> height window-height)
417 (setq image (or (create-image file 'imagemagick nil 434 (setq image (or (create-image data 'imagemagick t
418 :height window-height) 435 :height window-height)
419 image)) 436 image))
420 (setq size (image-size image t))) 437 (setq size (image-size image t)))
421 (when (> (car size) window-width) 438 (when (> (car size) window-width)
422 (setq image (or 439 (setq image (or
423 (create-image file 'imagemagick nil 440 (create-image data 'imagemagick t
424 :width window-width) 441 :width window-width)
425 image))) 442 image)))
426 image))) 443 image)))
427 444
428(defun gnus-html-prune-cache ()
429 (let ((total-size 0)
430 files)
431 (dolist (file (directory-files gnus-html-cache-directory t nil t))
432 (let ((attributes (file-attributes file)))
433 (unless (nth 0 attributes)
434 (incf total-size (nth 7 attributes))
435 (push (list (time-to-seconds (nth 5 attributes))
436 (nth 7 attributes) file)
437 files))))
438 (when (> total-size gnus-html-cache-size)
439 (setq files (sort files (lambda (f1 f2)
440 (< (car f1) (car f2)))))
441 (dolist (file files)
442 (when (> total-size gnus-html-cache-size)
443 (decf total-size (cadr file))
444 (delete-file (nth 2 file)))))))
445
446(defun gnus-html-image-url-blocked-p (url blocked-images) 445(defun gnus-html-image-url-blocked-p (url blocked-images)
447 "Find out if URL is blocked by BLOCKED-IMAGES." 446 "Find out if URL is blocked by BLOCKED-IMAGES."
448 (let ((ret (and blocked-images 447 (let ((ret (and blocked-images
@@ -459,14 +458,10 @@ fit these criteria."
459This only works if the article in question is HTML." 458This only works if the article in question is HTML."
460 (interactive) 459 (interactive)
461 (gnus-with-article-buffer 460 (gnus-with-article-buffer
462 (let ((overlays (overlays-in (point-min) (point-max))) 461 (dolist (overlay (overlays-in (point-min) (point-max)))
463 overlay images) 462 (let ((o (overlay-get overlay 'gnus-image)))
464 (while (setq overlay (pop overlays)) 463 (when o
465 (when (overlay-get overlay 'gnus-image) 464 (apply 'gnus-html-display-image o))))))
466 (push (overlay-get overlay 'gnus-image) images)))
467 (if (not images)
468 (message "No images to show")
469 (gnus-html-schedule-image-fetching (current-buffer) images)))))
470 465
471;;;###autoload 466;;;###autoload
472(defun gnus-html-prefetch-images (summary) 467(defun gnus-html-prefetch-images (summary)
@@ -477,11 +472,9 @@ This only works if the article in question is HTML."
477 (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) 472 (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
478 (let ((url (match-string 1))) 473 (let ((url (match-string 1)))
479 (unless (gnus-html-image-url-blocked-p url blocked-images) 474 (unless (gnus-html-image-url-blocked-p url blocked-images)
480 (unless (file-exists-p (gnus-html-image-id url)) 475 (when (gnus-html-cache-expired url gnus-html-image-cache-ttl)
481 (ignore-errors 476 (gnus-html-schedule-image-fetching nil
482 (url-retrieve (mm-url-decode-entities-string url) 477 (list url))))))))))
483 'gnus-html-image-fetched
484 (list nil (list url))))))))))))
485 478
486(provide 'gnus-html) 479(provide 'gnus-html)
487 480
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index f245907ed1b..5ef58834df7 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -275,8 +275,10 @@ If it is down, start it up (again)."
275 (not gnus-batch-mode) 275 (not gnus-batch-mode)
276 (gnus-y-or-n-p 276 (gnus-y-or-n-p
277 (format 277 (format
278 "Unable to open server %s, go offline? " 278 "Unable to open server %s (%s), go offline? "
279 server))) 279 server
280 (nnheader-get-report
281 (car gnus-command-method)))))
280 (setq open-offline t) 282 (setq open-offline t)
281 'offline) 283 'offline)
282 (t 284 (t
@@ -552,6 +554,14 @@ If BUFFER, insert the article in that group."
552 (funcall (gnus-get-function gnus-command-method 'request-post) 554 (funcall (gnus-get-function gnus-command-method 'request-post)
553 (nth 1 gnus-command-method))) 555 (nth 1 gnus-command-method)))
554 556
557(defun gnus-request-expunge-group (group gnus-command-method)
558 "Expunge GROUP, which is removing articles that have been marked as deleted."
559 (when (stringp gnus-command-method)
560 (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
561 (funcall (gnus-get-function gnus-command-method 'request-expunge-group)
562 (gnus-group-real-name group)
563 (nth 1 gnus-command-method)))
564
555(defun gnus-request-scan (group gnus-command-method) 565(defun gnus-request-scan (group gnus-command-method)
556 "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD. 566 "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
557If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." 567If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index f4745c184e5..c2f09a83c07 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -705,6 +705,7 @@ the first newsgroup."
705 nnoo-state-alist nil 705 nnoo-state-alist nil
706 gnus-current-select-method nil 706 gnus-current-select-method nil
707 nnmail-split-history nil 707 nnmail-split-history nil
708 gnus-extended-servers nil
708 gnus-ephemeral-servers nil) 709 gnus-ephemeral-servers nil)
709 (gnus-shutdown 'gnus) 710 (gnus-shutdown 'gnus)
710 ;; Kill the startup file. 711 ;; Kill the startup file.
@@ -1693,28 +1694,19 @@ If SCAN, request a scan of that group as well."
1693 (while newsrc 1694 (while newsrc
1694 (setq active (gnus-active (setq group (gnus-info-group 1695 (setq active (gnus-active (setq group (gnus-info-group
1695 (setq info (pop newsrc)))))) 1696 (setq info (pop newsrc))))))
1696
1697 ;; Check newsgroups. If the user doesn't want to check them, or
1698 ;; they can't be checked (for instance, if the news server can't
1699 ;; be reached) we just set the number of unread articles in this
1700 ;; newsgroup to t. This means that Gnus thinks that there are
1701 ;; unread articles, but it has no idea how many.
1702
1703 ;; To be more explicit:
1704 ;; >0 for an active group with messages
1705 ;; 0 for an active group with no unread messages
1706 ;; nil for non-foreign groups that the user has requested not be checked
1707 ;; t for unchecked foreign groups or bogus groups, or groups that can't
1708 ;; be checked, for one reason or other.
1709
1710 ;; First go through all the groups, see what select methods they 1697 ;; First go through all the groups, see what select methods they
1711 ;; belong to, and then collect them into lists per unique select 1698 ;; belong to, and then collect them into lists per unique select
1712 ;; method. 1699 ;; method.
1713 (if (not (setq method (gnus-info-method info))) 1700 (if (not (setq method (gnus-info-method info)))
1714 (setq method gnus-select-method) 1701 (setq method gnus-select-method)
1702 ;; There may be several similar methods. Possibly extend the
1703 ;; method.
1715 (if (setq cmethod (assoc method methods-cache)) 1704 (if (setq cmethod (assoc method methods-cache))
1716 (setq method (cdr cmethod)) 1705 (setq method (cdr cmethod))
1717 (setq cmethod (inline (gnus-server-get-method nil method))) 1706 (setq cmethod (if (stringp method)
1707 (gnus-server-to-method method)
1708 (inline (gnus-find-method-for-group
1709 (gnus-info-group info) info))))
1718 (push (cons method cmethod) methods-cache) 1710 (push (cons method cmethod) methods-cache)
1719 (setq method cmethod))) 1711 (setq method cmethod)))
1720 (setq method-group-list (assoc method type-cache)) 1712 (setq method-group-list (assoc method type-cache))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index d0c50c8fec0..5997339a335 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5850,6 +5850,10 @@ If SELECT-ARTICLES, only select those articles from GROUP."
5850 (types gnus-article-mark-lists) 5850 (types gnus-article-mark-lists)
5851 marks var articles article mark mark-type 5851 marks var articles article mark mark-type
5852 bgn end) 5852 bgn end)
5853 ;; Hack to avoid adjusting marks for imap.
5854 (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
5855 'nnimap)
5856 (setq min 1))
5853 5857
5854 (dolist (marks marked-lists) 5858 (dolist (marks marked-lists)
5855 (setq mark (car marks) 5859 (setq mark (car marks)
@@ -9681,7 +9685,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9681 gnus-newsgroup-name)) 9685 gnus-newsgroup-name))
9682 (to-method (or select-method 9686 (to-method (or select-method
9683 (gnus-find-method-for-group to-newsgroup))) 9687 (gnus-find-method-for-group to-newsgroup)))
9684 (move-is-internal (gnus-method-equal from-method to-method))) 9688 (move-is-internal (gnus-server-equal from-method to-method)))
9685 (gnus-request-move-article 9689 (gnus-request-move-article
9686 article ; Article to move 9690 article ; Article to move
9687 gnus-newsgroup-name ; From newsgroup 9691 gnus-newsgroup-name ; From newsgroup
@@ -9692,7 +9696,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
9692 (not articles) t) ; Accept form 9696 (not articles) t) ; Accept form
9693 (not articles) ; Only save nov last time 9697 (not articles) ; Only save nov last time
9694 (and move-is-internal 9698 (and move-is-internal
9695 (gnus-group-real-name to-newsgroup))))) ; is this move internal? 9699 to-newsgroup ; Not respooling
9700 (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
9696 ;; Copy the article. 9701 ;; Copy the article.
9697 ((eq action 'copy) 9702 ((eq action 'copy)
9698 (with-current-buffer copy-buf 9703 (with-current-buffer copy-buf
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 68f7f5f5e1a..3f18858fc64 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2682,6 +2682,7 @@ a string, be sure to use a valid format, see RFC 2616."
2682(defvar gnus-newsgroup-name nil) 2682(defvar gnus-newsgroup-name nil)
2683(defvar gnus-ephemeral-servers nil) 2683(defvar gnus-ephemeral-servers nil)
2684(defvar gnus-server-method-cache nil) 2684(defvar gnus-server-method-cache nil)
2685(defvar gnus-extended-servers nil)
2685 2686
2686(defvar gnus-agent-fetching nil 2687(defvar gnus-agent-fetching nil
2687 "Whether Gnus agent is in fetching mode.") 2688 "Whether Gnus agent is in fetching mode.")
@@ -3686,32 +3687,35 @@ that that variable is buffer-local to the summary buffers."
3686 (and 3687 (and
3687 (eq (car m1) (car m2)) 3688 (eq (car m1) (car m2))
3688 (equal (cadr m1) (cadr m2)) 3689 (equal (cadr m1) (cadr m2))
3689 ;; Check parameters for sloppy equalness. 3690 (gnus-sloppily-equal-method-parameters m1 m2))))
3690 (let ((p1 (copy-list (cddr m1))) 3691
3691 (p2 (copy-list (cddr m2))) 3692(defsubst gnus-sloppily-equal-method-parameters (m1 m2)
3692 e1 e2) 3693 ;; Check parameters for sloppy equalness.
3693 (block nil 3694 (let ((p1 (copy-list (cddr m1)))
3694 (while (setq e1 (pop p1)) 3695 (p2 (copy-list (cddr m2)))
3695 (unless (setq e2 (assq (car e1) p2)) 3696 e1 e2)
3696 ;; The parameter doesn't exist in p2. 3697 (block nil
3697 (return nil)) 3698 (while (setq e1 (pop p1))
3698 (setq p2 (delq e2 p2)) 3699 (unless (setq e2 (assq (car e1) p2))
3699 (unless (equalp e1 e2) 3700 ;; The parameter doesn't exist in p2.
3700 (if (not (and (stringp (cadr e1)) 3701 (return nil))
3701 (stringp (cadr e2)))) 3702 (setq p2 (delq e2 p2))
3702 (return nil) 3703 (unless (equalp e1 e2)
3703 ;; Special-case string parameter comparison so that we 3704 (if (not (and (stringp (cadr e1))
3704 ;; can uniquify them. 3705 (stringp (cadr e2))))
3705 (let ((s1 (cadr e1)) 3706 (return nil)
3706 (s2 (cadr e2))) 3707 ;; Special-case string parameter comparison so that we
3707 (when (string-match "/$" s1) 3708 ;; can uniquify them.
3708 (setq s1 (directory-file-name s1))) 3709 (let ((s1 (cadr e1))
3709 (when (string-match "/$" s2) 3710 (s2 (cadr e2)))
3710 (setq s2 (directory-file-name s2))) 3711 (when (string-match "/$" s1)
3711 (unless (equal s1 s2) 3712 (setq s1 (directory-file-name s1)))
3712 (return nil)))))) 3713 (when (string-match "/$" s2)
3713 ;; If p2 now is empty, they were equal. 3714 (setq s2 (directory-file-name s2)))
3714 (null p2)))))) 3715 (unless (equal s1 s2)
3716 (return nil))))))
3717 ;; If p2 now is empty, they were equal.
3718 (null p2))))
3715 3719
3716(defun gnus-server-equal (m1 m2) 3720(defun gnus-server-equal (m1 m2)
3717 "Say whether two methods are equal." 3721 "Say whether two methods are equal."
@@ -4200,9 +4204,12 @@ parameters."
4200 (if (or (not (inline (gnus-similar-server-opened method))) 4204 (if (or (not (inline (gnus-similar-server-opened method)))
4201 (not (cddr method))) 4205 (not (cddr method)))
4202 method 4206 method
4203 `(,(car method) ,(concat (cadr method) "+" group) 4207 (setq method
4204 (,(intern (format "%s-address" (car method))) ,(cadr method)) 4208 `(,(car method) ,(concat (cadr method) "+" group)
4205 ,@(cddr method)))) 4209 (,(intern (format "%s-address" (car method))) ,(cadr method))
4210 ,@(cddr method)))
4211 (push method gnus-extended-servers)
4212 method))
4206 4213
4207(defun gnus-server-status (method) 4214(defun gnus-server-status (method)
4208 "Return the status of METHOD." 4215 "Return the status of METHOD."
@@ -4227,6 +4234,20 @@ parameters."
4227 (format "%s using %s" address (car server)) 4234 (format "%s using %s" address (car server))
4228 (format "%s" (car server))))) 4235 (format "%s" (car server)))))
4229 4236
4237(defun gnus-same-method-different-name (method)
4238 (let ((slot (intern (concat (symbol-name (car method)) "-address"))))
4239 (unless (assq slot (cddr method))
4240 (setq method
4241 (append method (list (list slot (nth 1 method)))))))
4242 (let ((methods gnus-extended-servers)
4243 open found)
4244 (while (and (not found)
4245 (setq open (pop methods)))
4246 (when (and (eq (car method) (car open))
4247 (gnus-sloppily-equal-method-parameters method open))
4248 (setq found open)))
4249 found))
4250
4230(defun gnus-find-method-for-group (group &optional info) 4251(defun gnus-find-method-for-group (group &optional info)
4231 "Find the select method that GROUP uses." 4252 "Find the select method that GROUP uses."
4232 (or gnus-override-method 4253 (or gnus-override-method
@@ -4249,7 +4270,10 @@ parameters."
4249 (cond ((stringp method) 4270 (cond ((stringp method)
4250 (inline (gnus-server-to-method method))) 4271 (inline (gnus-server-to-method method)))
4251 ((stringp (cadr method)) 4272 ((stringp (cadr method))
4252 (inline (gnus-server-extend-method group method))) 4273 (or
4274 (inline
4275 (gnus-same-method-different-name method))
4276 (inline (gnus-server-extend-method group method))))
4253 (t 4277 (t
4254 method))) 4278 method)))
4255 (cond ((equal (cadr method) "") 4279 (cond ((equal (cadr method) "")
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 434ad01bc19..e43cd2d8afb 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -37,6 +37,7 @@
37(require 'gnus) 37(require 'gnus)
38(require 'nnoo) 38(require 'nnoo)
39(require 'netrc) 39(require 'netrc)
40(require 'parse-time)
40 41
41(nnoo-declare nnimap) 42(nnoo-declare nnimap)
42 43
@@ -77,6 +78,8 @@ will fetch all parts that have types that match that string. A
77likely value would be \"text/\" to automatically fetch all 78likely value would be \"text/\" to automatically fetch all
78textual parts.") 79textual parts.")
79 80
81(defvoo nnimap-expunge nil)
82
80(defvoo nnimap-connection-alist nil) 83(defvoo nnimap-connection-alist nil)
81 84
82(defvoo nnimap-current-infos nil) 85(defvoo nnimap-current-infos nil)
@@ -405,7 +408,7 @@ textual parts.")
405 (with-current-buffer (nnimap-buffer) 408 (with-current-buffer (nnimap-buffer)
406 (erase-buffer) 409 (erase-buffer)
407 (let ((group-sequence 410 (let ((group-sequence
408 (nnimap-send-command "SELECT %S" (utf7-encode group))) 411 (nnimap-send-command "SELECT %S" (utf7-encode group t)))
409 (flag-sequence 412 (flag-sequence
410 (nnimap-send-command "UID FETCH 1:* FLAGS"))) 413 (nnimap-send-command "UID FETCH 1:* FLAGS")))
411 (nnimap-wait-for-response flag-sequence) 414 (nnimap-wait-for-response flag-sequence)
@@ -421,20 +424,28 @@ textual parts.")
421 (setq high (nth 3 (car marks)) 424 (setq high (nth 3 (car marks))
422 low (nth 4 (car marks)))) 425 low (nth 4 (car marks))))
423 ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t) 426 ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t)
424 (setq high (string-to-number (match-string 1)) 427 (setq high (1- (string-to-number (match-string 1)))
425 low 1))))) 428 low 1)))))
426 (erase-buffer) 429 (erase-buffer)
427 (insert 430 (insert
428 (format 431 (format
429 "211 %d %d %d %S\n" 432 "211 %d %d %d %S\n" (1+ (- high low)) low high group)))
430 (1+ (- high low)) 433 t))))
431 low high group)))) 434
432 t))) 435(deffoo nnimap-request-create-group (group &optional server args)
436 (when (nnimap-possibly-change-group nil server)
437 (with-current-buffer (nnimap-buffer)
438 (car (nnimap-command "CREATE %S" (utf7-encode group t))))))
433 439
434(deffoo nnimap-request-delete-group (group &optional force server) 440(deffoo nnimap-request-delete-group (group &optional force server)
435 (when (nnimap-possibly-change-group nil server) 441 (when (nnimap-possibly-change-group nil server)
436 (with-current-buffer (nnimap-buffer) 442 (with-current-buffer (nnimap-buffer)
437 (car (nnimap-command "DELETE %S" (utf7-encode group)))))) 443 (car (nnimap-command "DELETE %S" (utf7-encode group t))))))
444
445(deffoo nnimap-request-expunge-group (group &optional server)
446 (when (nnimap-possibly-change-group group server)
447 (with-current-buffer (nnimap-buffer)
448 (car (nnimap-command "EXPUNGE")))))
438 449
439(defun nnimap-get-flags (spec) 450(defun nnimap-get-flags (spec)
440 (let ((articles nil) 451 (let ((articles nil)
@@ -456,38 +467,95 @@ textual parts.")
456 467
457(deffoo nnimap-request-move-article (article group server accept-form 468(deffoo nnimap-request-move-article (article group server accept-form
458 &optional last internal-move-group) 469 &optional last internal-move-group)
459 (when (nnimap-possibly-change-group group server) 470 (with-temp-buffer
460 ;; If the move is internal (on the same server), just do it the easy 471 (when (nnimap-request-article article group server (current-buffer))
461 ;; way. 472 ;; If the move is internal (on the same server), just do it the easy
462 (let ((message-id (message-field-value "message-id"))) 473 ;; way.
463 (if internal-move-group 474 (let ((message-id (message-field-value "message-id")))
464 (let ((result 475 (if internal-move-group
465 (with-current-buffer (nnimap-buffer) 476 (let ((result
466 (nnimap-command "UID COPY %d %S" 477 (with-current-buffer (nnimap-buffer)
467 article 478 (nnimap-command "UID COPY %d %S"
468 (utf7-encode internal-move-group t))))) 479 article
469 (when (car result) 480 (utf7-encode internal-move-group t)))))
470 (nnimap-delete-article article) 481 (when (car result)
471 (cons internal-move-group
472 (nnimap-find-article-by-message-id
473 internal-move-group message-id))))
474 (with-temp-buffer
475 (when (nnimap-request-article article group server (current-buffer))
476 (let ((result (eval accept-form)))
477 (when result
478 (nnimap-delete-article article) 482 (nnimap-delete-article article)
479 result)))))))) 483 (cons internal-move-group
484 (nnimap-find-article-by-message-id
485 internal-move-group message-id))))
486 ;; Move the article to a different method.
487 (let ((result (eval accept-form)))
488 (when result
489 (nnimap-delete-article article)
490 result)))))))
480 491
481(deffoo nnimap-request-expire-articles (articles group &optional server force) 492(deffoo nnimap-request-expire-articles (articles group &optional server force)
482 (cond 493 (cond
494 ((null articles)
495 nil)
483 ((not (nnimap-possibly-change-group group server)) 496 ((not (nnimap-possibly-change-group group server))
484 articles) 497 articles)
485 (force 498 ((and force
499 (eq nnmail-expiry-target 'delete))
486 (unless (nnimap-delete-article articles) 500 (unless (nnimap-delete-article articles)
487 (message "Article marked for deletion, but not expunged.")) 501 (message "Article marked for deletion, but not expunged."))
488 nil) 502 nil)
489 (t 503 (t
490 articles))) 504 (let ((deletable-articles
505 (if force
506 articles
507 (gnus-sorted-intersection
508 articles
509 (nnimap-find-expired-articles group)))))
510 (if (null deletable-articles)
511 articles
512 (if (eq nnmail-expiry-target 'delete)
513 (nnimap-delete-article deletable-articles)
514 (setq deletable-articles
515 (nnimap-process-expiry-targets
516 deletable-articles group server)))
517 ;; Return the articles we didn't delete.
518 (gnus-sorted-complement articles deletable-articles))))))
519
520(defun nnimap-process-expiry-targets (articles group server)
521 (let ((deleted-articles nil))
522 (dolist (article articles)
523 (let ((target nnmail-expiry-target))
524 (with-temp-buffer
525 (when (nnimap-request-article article group server (current-buffer))
526 (message "Expiring article %s:%d" group article)
527 (when (functionp target)
528 (setq target (funcall target group)))
529 (when (and target
530 (not (eq target 'delete)))
531 (if (or (gnus-request-group target t)
532 (gnus-request-create-group target))
533 (nnmail-expiry-target-group target group)
534 (setq target nil)))
535 (when target
536 (push article deleted-articles))))))
537 ;; Change back to the current group again.
538 (nnimap-possibly-change-group group server)
539 (setq deleted-articles (nreverse deleted-articles))
540 (nnimap-delete-article deleted-articles)
541 deleted-articles))
542
543(defun nnimap-find-expired-articles (group)
544 (let ((cutoff (nnmail-expired-article-p group nil nil)))
545 (with-current-buffer (nnimap-buffer)
546 (let ((result
547 (nnimap-command
548 "UID SEARCH SENTBEFORE %s"
549 (format-time-string
550 (format "%%d-%s-%%Y"
551 (upcase
552 (car (rassoc (nth 4 (decode-time cutoff))
553 parse-time-months))))
554 cutoff))))
555 (and (car result)
556 (delete 0 (mapcar #'string-to-number
557 (cdr (assoc "SEARCH" (cdr result))))))))))
558
491 559
492(defun nnimap-find-article-by-message-id (group message-id) 560(defun nnimap-find-article-by-message-id (group message-id)
493 (when (nnimap-possibly-change-group group nil) 561 (when (nnimap-possibly-change-group group nil)
@@ -505,10 +573,14 @@ textual parts.")
505 (with-current-buffer (nnimap-buffer) 573 (with-current-buffer (nnimap-buffer)
506 (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)" 574 (nnimap-command "UID STORE %s +FLAGS.SILENT (\\Deleted)"
507 (nnimap-article-ranges articles)) 575 (nnimap-article-ranges articles))
508 (when (member "UIDPLUS" (nnimap-capabilities nnimap-object)) 576 (cond
509 (nnimap-send-command "UID EXPUNGE %s" 577 ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
510 (nnimap-article-ranges articles)) 578 (nnimap-command "UID EXPUNGE %s"
511 t))) 579 (nnimap-article-ranges articles))
580 t)
581 (nnimap-expunge
582 (nnimap-command "EXPUNGE")
583 t))))
512 584
513(deffoo nnimap-request-scan (&optional group server) 585(deffoo nnimap-request-scan (&optional group server)
514 (when (and (nnimap-possibly-change-group nil server) 586 (when (and (nnimap-possibly-change-group nil server)
@@ -1040,17 +1112,19 @@ textual parts.")
1040(defun nnimap-mark-and-expunge-incoming (range) 1112(defun nnimap-mark-and-expunge-incoming (range)
1041 (when range 1113 (when range
1042 (setq range (nnimap-article-ranges range)) 1114 (setq range (nnimap-article-ranges range))
1043 (nnimap-send-command 1115 (let ((sequence
1044 "UID STORE %s +FLAGS.SILENT (\\Deleted)" range) 1116 (nnimap-send-command
1045 (cond 1117 "UID STORE %s +FLAGS.SILENT (\\Deleted)" range)))
1046 ;; If the server supports it, we now delete the message we have 1118 (cond
1047 ;; just copied over. 1119 ;; If the server supports it, we now delete the message we have
1048 ((member "UIDPLUS" (nnimap-capabilities nnimap-object)) 1120 ;; just copied over.
1049 (nnimap-send-command "UID EXPUNGE %s" range)) 1121 ((member "UIDPLUS" (nnimap-capabilities nnimap-object))
1050 ;; If it doesn't support UID EXPUNGE, then we only expunge if the 1122 (setq sequence (nnimap-send-command "UID EXPUNGE %s" range)))
1051 ;; user has configured it. 1123 ;; If it doesn't support UID EXPUNGE, then we only expunge if the
1052 (nnimap-expunge-inbox 1124 ;; user has configured it.
1053 (nnimap-send-command "EXPUNGE"))))) 1125 (nnimap-expunge-inbox
1126 (setq sequence (nnimap-send-command "EXPUNGE"))))
1127 (nnimap-wait-for-response sequence))))
1054 1128
1055(defun nnimap-parse-copied-articles (sequences) 1129(defun nnimap-parse-copied-articles (sequences)
1056 (let (sequence copied range) 1130 (let (sequence copied range)
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 3e6cee82521..95a98352f00 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1858,9 +1858,12 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1858 (run-hooks 'nnmail-post-get-new-mail-hook)))) 1858 (run-hooks 'nnmail-post-get-new-mail-hook))))
1859 1859
1860(defun nnmail-expired-article-p (group time force &optional inhibit) 1860(defun nnmail-expired-article-p (group time force &optional inhibit)
1861 "Say whether an article that is TIME old in GROUP should be expired." 1861 "Say whether an article that is TIME old in GROUP should be expired.
1862If TIME is nil, then return the cutoff time for oldness instead."
1862 (if force 1863 (if force
1863 t 1864 (if (null time)
1865 (current-time)
1866 t)
1864 (let ((days (or (and nnmail-expiry-wait-function 1867 (let ((days (or (and nnmail-expiry-wait-function
1865 (funcall nnmail-expiry-wait-function group)) 1868 (funcall nnmail-expiry-wait-function group))
1866 nnmail-expiry-wait))) 1869 nnmail-expiry-wait)))
@@ -1871,14 +1874,18 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
1871 nil) 1874 nil)
1872 ((eq days 'immediate) 1875 ((eq days 'immediate)
1873 ;; We expire all articles on sight. 1876 ;; We expire all articles on sight.
1874 t) 1877 (if (null time)
1878 (current-time)
1879 t))
1875 ((equal time '(0 0)) 1880 ((equal time '(0 0))
1876 ;; This is an ange-ftp group, and we don't have any dates. 1881 ;; This is an ange-ftp group, and we don't have any dates.
1877 nil) 1882 nil)
1878 ((numberp days) 1883 ((numberp days)
1879 (setq days (days-to-time days)) 1884 (setq days (days-to-time days))
1880 ;; Compare the time with the current time. 1885 ;; Compare the time with the current time.
1881 (ignore-errors (time-less-p days (time-since time)))))))) 1886 (if (null time)
1887 (time-subtract (current-time) days)
1888 (ignore-errors (time-less-p days (time-since time)))))))))
1882 1889
1883(declare-function gnus-group-mark-article-read "gnus-group" (group article)) 1890(declare-function gnus-group-mark-article-read "gnus-group" (group article))
1884 1891
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 11cdfd768c3..d05485b32f3 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -942,22 +942,23 @@ Unless no-active is non-nil, update the active file too."
942 (when (file-exists-p nov) 942 (when (file-exists-p nov)
943 (funcall nnmail-delete-file-function nov)) 943 (funcall nnmail-delete-file-function nov))
944 (dolist (file files) 944 (dolist (file files)
945 (unless (file-directory-p (setq file (concat dir (cdr file)))) 945 (let ((path (concat dir (cdr file))))
946 (erase-buffer) 946 (unless (file-directory-p path)
947 (nnheader-insert-file-contents file) 947 (erase-buffer)
948 (narrow-to-region 948 (nnheader-insert-file-contents path)
949 (goto-char (point-min)) 949 (narrow-to-region
950 (progn 950 (goto-char (point-min))
951 (re-search-forward "\n\r?\n" nil t) 951 (progn
952 (setq chars (- (point-max) (point))) 952 (re-search-forward "\n\r?\n" nil t)
953 (max (point-min) (1- (point))))) 953 (setq chars (- (point-max) (point)))
954 (unless (zerop (buffer-size)) 954 (max (point-min) (1- (point)))))
955 (goto-char (point-min)) 955 (unless (zerop (buffer-size))
956 (setq headers (nnml-parse-head chars (car file))) 956 (goto-char (point-min))
957 (with-current-buffer nov-buffer 957 (setq headers (nnml-parse-head chars (car file)))
958 (goto-char (point-max)) 958 (with-current-buffer nov-buffer
959 (nnheader-insert-nov headers))) 959 (goto-char (point-max))
960 (widen))) 960 (nnheader-insert-nov headers)))
961 (widen))))
961 (with-current-buffer nov-buffer 962 (with-current-buffer nov-buffer
962 (nnmail-write-region (point-min) (point-max) nov nil 'nomesg) 963 (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
963 (kill-buffer (current-buffer)))))) 964 (kill-buffer (current-buffer))))))
diff --git a/nt/configure.bat b/nt/configure.bat
index c7bfad35189..74c7e1af137 100755
--- a/nt/configure.bat
+++ b/nt/configure.bat
@@ -1,6 +1,6 @@
1@echo off 1@echo off
2rem ---------------------------------------------------------------------- 2rem ----------------------------------------------------------------------
3rem Configuration script for MS Windows 95/98/Me and NT/2000/XP 3rem Configuration script for MS Windows operating systems
4rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 4rem Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5rem 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. 5rem 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 6
@@ -22,7 +22,7 @@ rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
22rem ---------------------------------------------------------------------- 22rem ----------------------------------------------------------------------
23rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS: 23rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
24rem 24rem
25rem + MS Windows 95/98/Me or NT/2000/XP 25rem + MS Windows 95, NT or later
26rem + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75 26rem + either MSVC 2.x or later, or gcc-2.95 or later (with GNU make 3.75
27rem or later) and the Mingw32 and W32 API headers and libraries. 27rem or later) and the Mingw32 and W32 API headers and libraries.
28rem + Visual Studio 2005 is not supported at this time. 28rem + Visual Studio 2005 is not supported at this time.
@@ -116,6 +116,7 @@ if "%1" == "--without-xpm" goto withoutxpm
116if "%1" == "--with-svg" goto withsvg 116if "%1" == "--with-svg" goto withsvg
117if "%1" == "--distfiles" goto distfiles 117if "%1" == "--distfiles" goto distfiles
118if "%1" == "" goto checkutils 118if "%1" == "" goto checkutils
119
119:usage 120:usage
120echo Usage: configure [options] 121echo Usage: configure [options]
121echo Options: 122echo Options:
@@ -137,61 +138,82 @@ echo. --without-xpm do not use XPM library even if it is installed
137echo. --with-svg use the RSVG library (experimental) 138echo. --with-svg use the RSVG library (experimental)
138echo. --distfiles path to files for make dist, e.g. libXpm.dll 139echo. --distfiles path to files for make dist, e.g. libXpm.dll
139goto end 140goto end
141
140rem ---------------------------------------------------------------------- 142rem ----------------------------------------------------------------------
143
141:setprefix 144:setprefix
142shift 145shift
143set prefix=%1 146set prefix=%1
144shift 147shift
145goto again 148goto again
149
146rem ---------------------------------------------------------------------- 150rem ----------------------------------------------------------------------
151
147:withgcc 152:withgcc
148set COMPILER=gcc 153set COMPILER=gcc
149shift 154shift
150goto again 155goto again
156
151rem ---------------------------------------------------------------------- 157rem ----------------------------------------------------------------------
158
152:withmsvc 159:withmsvc
153set COMPILER=cl 160set COMPILER=cl
154shift 161shift
155goto again 162goto again
163
156rem ---------------------------------------------------------------------- 164rem ----------------------------------------------------------------------
165
157:nodebug 166:nodebug
158set nodebug=Y 167set nodebug=Y
159shift 168shift
160goto again 169goto again
170
161rem ---------------------------------------------------------------------- 171rem ----------------------------------------------------------------------
172
162:noopt 173:noopt
163set noopt=Y 174set noopt=Y
164shift 175shift
165goto again 176goto again
177
166rem ---------------------------------------------------------------------- 178rem ----------------------------------------------------------------------
179
167:enablechecking 180:enablechecking
168set enablechecking=Y 181set enablechecking=Y
169shift 182shift
170goto again 183goto again
184
171rem ---------------------------------------------------------------------- 185rem ----------------------------------------------------------------------
186
172:profile 187:profile
173set profile=Y 188set profile=Y
174shift 189shift
175goto again 190goto again
191
176rem ---------------------------------------------------------------------- 192rem ----------------------------------------------------------------------
193
177:nocygwin 194:nocygwin
178set nocygwin=Y 195set nocygwin=Y
179shift 196shift
180goto again 197goto again
198
181rem ---------------------------------------------------------------------- 199rem ----------------------------------------------------------------------
200
182:usercflags 201:usercflags
183shift 202shift
184set usercflags=%usercflags%%sep1%%1 203set usercflags=%usercflags%%sep1%%1
185set sep1= %nothing% 204set sep1= %nothing%
186shift 205shift
187goto again 206goto again
207
188rem ---------------------------------------------------------------------- 208rem ----------------------------------------------------------------------
209
189:userldflags 210:userldflags
190shift 211shift
191set userldflags=%userldflags%%sep2%%1 212set userldflags=%userldflags%%sep2%%1
192set sep2= %nothing% 213set sep2= %nothing%
193shift 214shift
194goto again 215goto again
216
195rem ---------------------------------------------------------------------- 217rem ----------------------------------------------------------------------
196 218
197:withoutpng 219:withoutpng
@@ -249,6 +271,7 @@ goto again
249 271
250rem ---------------------------------------------------------------------- 272rem ----------------------------------------------------------------------
251rem Check that necessary utilities (cp and rm) are present. 273rem Check that necessary utilities (cp and rm) are present.
274
252:checkutils 275:checkutils
253echo Checking for 'cp'... 276echo Checking for 'cp'...
254cp configure.bat junk.bat 277cp configure.bat junk.bat
@@ -257,9 +280,11 @@ echo Checking for 'rm'...
257rm junk.bat 280rm junk.bat
258if exist junk.bat goto needrm 281if exist junk.bat goto needrm
259goto checkcompiler 282goto checkcompiler
283
260:needcp 284:needcp
261echo You need 'cp' (the Unix file copy program) to build Emacs. 285echo You need 'cp' (the Unix file copy program) to build Emacs.
262goto end 286goto end
287
263:needrm 288:needrm
264del junk.bat 289del junk.bat
265echo You need 'rm' (the Unix file delete program) to build Emacs. 290echo You need 'rm' (the Unix file delete program) to build Emacs.
@@ -267,6 +292,7 @@ goto end
267 292
268rem ---------------------------------------------------------------------- 293rem ----------------------------------------------------------------------
269rem Auto-detect compiler if not specified, and validate GCC if chosen. 294rem Auto-detect compiler if not specified, and validate GCC if chosen.
295
270:checkcompiler 296:checkcompiler
271if (%COMPILER%)==(cl) goto compilercheckdone 297if (%COMPILER%)==(cl) goto compilercheckdone
272if (%COMPILER%)==(gcc) goto checkgcc 298if (%COMPILER%)==(gcc) goto checkgcc
@@ -301,6 +327,7 @@ if exist junk.o set nocygwin=Y
301:chkapi 327:chkapi
302echo The failed program was: >>config.log 328echo The failed program was: >>config.log
303type junk.c >>config.log 329type junk.c >>config.log
330
304:chkapiN 331:chkapiN
305rm -f junk.c junk.o 332rm -f junk.c junk.o
306rem ---------------------------------------------------------------------- 333rem ----------------------------------------------------------------------
@@ -320,8 +347,10 @@ echo {PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader);} >>junk.c
320if (%nocygwin%) == (Y) goto chkapi1 347if (%nocygwin%) == (Y) goto chkapi1
321set cf=%usercflags% 348set cf=%usercflags%
322goto chkapi2 349goto chkapi2
350
323:chkapi1 351:chkapi1
324set cf=%usercflags% -mno-cygwin 352set cf=%usercflags% -mno-cygwin
353
325:chkapi2 354:chkapi2
326echo on 355echo on
327gcc %cf% -c junk.c 356gcc %cf% -c junk.c
@@ -357,10 +386,12 @@ type junk.c >>config.log
357set mf=-mcpu=i686 386set mf=-mcpu=i686
358rm -f junk.c junk.o 387rm -f junk.c junk.o
359goto gccdebug 388goto gccdebug
389
360:gccMtuneOk 390:gccMtuneOk
361echo GCC supports -mtune=pentium4 >>config.log 391echo GCC supports -mtune=pentium4 >>config.log
362set mf=-mtune=pentium4 392set mf=-mtune=pentium4
363rm -f junk.c junk.o 393rm -f junk.c junk.o
394
364:gccdebug 395:gccdebug
365rem Check for DWARF-2 debug info support, else default to stabs 396rem Check for DWARF-2 debug info support, else default to stabs
366echo main(){} >junk.c 397echo main(){} >junk.c
@@ -372,6 +403,7 @@ type junk.c >>config.log
372set dbginfo=-gstabs+ 403set dbginfo=-gstabs+
373rm -f junk.c junk.o 404rm -f junk.c junk.o
374goto compilercheckdone 405goto compilercheckdone
406
375:gccdwarf 407:gccdwarf
376echo GCC supports DWARF-2 >>config.log 408echo GCC supports DWARF-2 >>config.log
377set dbginfo=-gdwarf-2 -g3 409set dbginfo=-gdwarf-2 -g3
@@ -565,6 +597,7 @@ goto :distfilesDone
565set fileNotFound= 597set fileNotFound=
566 598
567rem ---------------------------------------------------------------------- 599rem ----------------------------------------------------------------------
600
568:genmakefiles 601:genmakefiles
569echo Generating makefiles 602echo Generating makefiles
570if %COMPILER% == gcc set MAKECMD=gmake 603if %COMPILER% == gcc set MAKECMD=gmake
@@ -619,6 +652,7 @@ fc /b config.tmp ..\src\config.h >nul 2>&1
619if errorlevel 1 goto doCopy 652if errorlevel 1 goto doCopy
620fc /b paths.h ..\src\epaths.h >nul 2>&1 653fc /b paths.h ..\src\epaths.h >nul 2>&1
621if errorlevel 0 goto dontCopy 654if errorlevel 0 goto dontCopy
655
622:doCopy 656:doCopy
623copy config.tmp ..\src\config.h 657copy config.tmp ..\src\config.h
624copy paths.h ..\src\epaths.h 658copy paths.h ..\src\epaths.h
@@ -648,6 +682,7 @@ fc /b foo.bar foo.bar >nul 2>&1
648if not errorlevel 2 goto doUpdateSubdirs 682if not errorlevel 2 goto doUpdateSubdirs
649fc /b subdirs.el ..\site-lisp\subdirs.el >nul 2>&1 683fc /b subdirs.el ..\site-lisp\subdirs.el >nul 2>&1
650if not errorlevel 1 goto dontUpdateSubdirs 684if not errorlevel 1 goto dontUpdateSubdirs
685
651:doUpdateSubdirs 686:doUpdateSubdirs
652if exist ..\site-lisp\subdirs.el del ..\site-lisp\subdirs.el 687if exist ..\site-lisp\subdirs.el del ..\site-lisp\subdirs.el
653copy subdirs.el ..\site-lisp\subdirs.el 688copy subdirs.el ..\site-lisp\subdirs.el
@@ -716,6 +751,7 @@ goto end
716echo Your environment size is too small. Please enlarge it and rerun configure. 751echo Your environment size is too small. Please enlarge it and rerun configure.
717echo For example, type "command.com /e:2048" to have 2048 bytes available. 752echo For example, type "command.com /e:2048" to have 2048 bytes available.
718set $foo$= 753set $foo$=
754
719:end 755:end
720set prefix= 756set prefix=
721set nodebug= 757set nodebug=
diff --git a/src/ChangeLog b/src/ChangeLog
index 063d65475ef..a44d97d96a1 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -10,6 +10,15 @@
10 current display element is a grapheme cluster in bidi-reordered 10 current display element is a grapheme cluster in bidi-reordered
11 region. 11 region.
12 12
132010-09-21 Ari Roponen <ari.roponen@gmail.com> (tiny change)
14
15 * doc.c (Fsnarf_documentation): Use memmove instead of memcpy as
16 the regions may overlap.
17
182010-09-21 Juanma Barranquero <lekktu@gmail.com>
19
20 * makefile.w32-in ($(BLD)/sysdep.$(O)): Update dependencies.
21
132010-09-21 Dan Nicolaescu <dann@ics.uci.edu> 222010-09-21 Dan Nicolaescu <dann@ics.uci.edu>
14 23
15 * emacs.c: Do not include sys/ioctl.h, not needed. 24 * emacs.c: Do not include sys/ioctl.h, not needed.
diff --git a/src/doc.c b/src/doc.c
index f8ab9d081b9..36f7c0e882a 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -678,7 +678,7 @@ the same file name is found in the `doc-directory'. */)
678 } 678 }
679 pos += end - buf; 679 pos += end - buf;
680 filled -= end - buf; 680 filled -= end - buf;
681 memcpy (buf, end, filled); 681 memmove (buf, end, filled);
682 } 682 }
683 emacs_close (fd); 683 emacs_close (fd);
684 return Qnil; 684 return Qnil;
diff --git a/src/makefile.w32-in b/src/makefile.w32-in
index 8d99d6cedfe..752a3c211b3 100644
--- a/src/makefile.w32-in
+++ b/src/makefile.w32-in
@@ -1344,7 +1344,6 @@ $(BLD)/sysdep.$(O) : \
1344 $(EMACS_ROOT)/nt/inc/pwd.h \ 1344 $(EMACS_ROOT)/nt/inc/pwd.h \
1345 $(EMACS_ROOT)/nt/inc/unistd.h \ 1345 $(EMACS_ROOT)/nt/inc/unistd.h \
1346 $(EMACS_ROOT)/nt/inc/sys/file.h \ 1346 $(EMACS_ROOT)/nt/inc/sys/file.h \
1347 $(EMACS_ROOT)/nt/inc/sys/ioctl.h \
1348 $(EMACS_ROOT)/nt/inc/sys/socket.h \ 1347 $(EMACS_ROOT)/nt/inc/sys/socket.h \
1349 $(EMACS_ROOT)/nt/inc/sys/time.h \ 1348 $(EMACS_ROOT)/nt/inc/sys/time.h \
1350 $(SRC)/lisp.h \ 1349 $(SRC)/lisp.h \