Skip to content

GitLab

Commit 1114abdb authored by Kenichi Handa's avatar Kenichi Handa
Browse files

merge trunk

parents 86282aab ee705a5c
Hide whitespace changes
Inline Side-by-side
Showing with 570 additions and 312 deletions
doc/misc/ChangeLog
View file @ 1114abdb
2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Expunging mailboxes): Update name of the expunging
command.
2010-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
* emacs-mime.texi (rfc2047): Update description for
......
doc/misc/gnus.texi
View file @ 1114abdb
......@@ -18384,7 +18384,7 @@ INBOX.mailbox).
@cindex expunge
@cindex manual expunging
@kindex G x (Group)
@findex gnus-group-nnimap-expunge
@findex gnus-group-expunge-group
 
If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
you may want the option of expunging all deleted articles in a mailbox
lisp/ChangeLog
View file @ 1114abdb
2010-09-21 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/smie.el (smie-debug--describe-cycle): Fix typo.
(smie-indent-comment): Be more careful with comment-start-skip.
(smie-indent-comment-close, smie-indent-comment-inside): New funs.
(smie-indent-functions): Use them.
2010-09-21 Michael Albinus <michael.albinus@gmx.de>
 
* net/ange-ftp.el (ange-ftp-skip-msgs): Add "^504 ..." message.
......
lisp/emacs-lisp/smie.el
View file @ 1114abdb
......@@ -338,7 +338,7 @@ CSTS is a list of pairs representing arcs in a graph."
res))
cycle)))
(mapconcat
(lambda (elems) (mapconcat 'indentity elems "="))
(lambda (elems) (mapconcat 'identity elems "="))
(append names (list (car names)))
" < ")))
......@@ -1173,7 +1173,11 @@ in order to figure out the indentation of some other (further down) point."
;; front of a comment" when doing virtual-indentation anyway. And if we are
;; (as can happen in octave-mode), moving forward can lead to inf-loops.
(and (smie-indent--bolp)
(looking-at comment-start-skip)
(let ((pos (point)))
(save-excursion
(beginning-of-line)
(and (re-search-forward comment-start-skip (line-end-position) t)
(eq pos (or (match-end 1) (match-beginning 0))))))
(save-excursion
(forward-comment (point-max))
(skip-chars-forward " \t\r\n")
......@@ -1194,6 +1198,20 @@ in order to figure out the indentation of some other (further down) point."
(if (looking-at (regexp-quote continue))
(current-column))))))))
(defun smie-indent-comment-close ()
(and (boundp 'comment-end-skip)
comment-end-skip
(not (looking-at " \t*$")) ;Not just a \n comment-closer.
(looking-at comment-end-skip)
(nth 4 (syntax-ppss))
(save-excursion
(goto-char (nth 8 (syntax-ppss)))
(current-column))))
(defun smie-indent-comment-inside ()
(and (nth 4 (syntax-ppss))
'noindent))
(defun smie-indent-after-keyword ()
;; Indentation right after a special keyword.
(save-excursion
......@@ -1275,9 +1293,10 @@ in order to figure out the indentation of some other (further down) point."
(current-column)))))))
(defvar smie-indent-functions
'(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment
smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword
smie-indent-exps)
'(smie-indent-fixindent smie-indent-bob smie-indent-close
smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword
smie-indent-exps)
"Functions to compute the indentation.
Each function is called with no argument, shouldn't move point, and should
return either nil if it has no opinion, or an integer representing the column
......
lisp/gnus/ChangeLog
View file @ 1114abdb
2010-09-21 Adam Sjøgren <asjo@koldfront.dk>
* gnus-sum.el (gnus-adjust-marked-articles): Fix typo.
2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-int.el (gnus-open-server): Give a better error message in the
"go offline" case.
* gnus-sum.el (gnus-adjust-marked-articles): Hack to avoid adjusting
marks for nnimap, which is seldom the right thing to do.
* gnus.el (gnus-sloppily-equal-method-parameters): Refactor out.
(gnus-same-method-different-name): New function.
* nnimap.el (parse-time): Require.
* gnus-start.el (gnus-get-unread-articles): Fix the prefixed select
method in the presence of many similar methods.
* nnmail.el (nnmail-expired-article-p): Fix typo: time-subtract.
* nnimap.el (nnimap-find-expired-articles): Don't refer to
nnml-inhibit-expiry.
* gnus-sum.el (gnus-summary-move-article): Use gnus-server-equal to
find out whether methods are equal.
* nnimap.el (nnimap-find-expired-articles): New function.
(nnimap-process-expiry-targets): New function.
(nnimap-request-move-article): Request the article before looking at
what the Message-ID is. Fix found by Andrew Cohen.
(nnimap-mark-and-expunge-incoming): Wait for the last sequence.
* nnmail.el (nnmail-expired-article-p): Allow returning the cutoff time
for oldness in addition to being a predicate.
* nnimap.el (nnimap-request-group): When we have zero articles, return
the right data to Gnus.
(nnimap-request-expire-articles): Only delete articles immediately if
the target is 'delete.
* gnus-sum.el (gnus-summary-move-article): When respooling to the same
method, this would bug out.
* gnus-group.el (gnus-group-expunge-group): Renamed from
gnus-group-nnimap-expunge, and implemented as a normal interface
function.
* gnus-int.el (gnus-request-expunge-group): New function.
* nnimap.el (nnimap-request-create-group): Implement.
(nnimap-request-expunge-group): New function.
2010-09-21 Julien Danjou <julien@danjou.info>
* gnus-html.el (gnus-html-image-cache-ttl): Add new variable.
(gnus-html-cache-expired): Add new function.
(gnus-html-wash-images): Use `gnus-html-cache-expired' to check
wethever we should display image for fetch it.
Compute alt-text earlier to pass it to the fetching function too.
(gnus-html-schedule-image-fetching): Change function argument to only
get one image at a time, not a list.
(gnus-html-image-fetched): Use `url-store-in-cache' to store image in
cache.
(gnus-html-get-image-data): New function to retrieve image data from
cache.
(gnus-html-put-image): Change buffer argument to use image data rather
than file, and place image above region rather than inserting a new
one. Do not take alt-text as argument, since it's useless now: we place
the image above alt-text.
(gnus-html-prune-cache): Remove.
(gnus-html-show-images): Start to fetch image when we find one, do not
push into a temporary list.
(gnus-html-prefetch-images): Only fetch image if they have expired.
(gnus-html-browse-image): Fix, use 'gnus-image-url.
(gnus-html-image-map): Add "v" to browse-url on undisplayed image.
2010-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
 
* rfc2047.el (rfc2047-encode-parameter): Doc fix.
......
lisp/gnus/gnus-group.el
View file @ 1114abdb
......@@ -509,7 +509,10 @@ simple manner.")
(gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
(t number)) ?s)
(?R gnus-tmp-number-of-read ?s)
(?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
(?U (if (gnus-active gnus-tmp-group)
(gnus-number-of-unseen-articles-in-group gnus-tmp-group)
"*")
?s)
(?t gnus-tmp-number-total ?d)
(?y gnus-tmp-number-of-unread ?s)
(?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
......@@ -675,7 +678,7 @@ simple manner.")
"R" gnus-group-make-rss-group
"c" gnus-group-customize
"z" gnus-group-compact-group
"x" gnus-group-nnimap-expunge
"x" gnus-group-expunge-group
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
......@@ -3163,21 +3166,17 @@ mail messages or news articles in files that have numeric names."
'summary 'group)))
(error "Couldn't enter %s" dir))))
(autoload 'nnimap-expunge "nnimap")
(autoload 'nnimap-acl-get "nnimap")
(autoload 'nnimap-acl-edit "nnimap")
(defun gnus-group-nnimap-expunge (group)
(defun gnus-group-expunge-group (group)
"Expunge deleted articles in current nnimap GROUP."
(interactive (list (gnus-group-group-name)))
(let ((mailbox (gnus-group-real-name group)) method)
(unless group
(error "No group on current line"))
(unless (gnus-get-info group)
(error "Killed group; can't be edited"))
(unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
(error "%s is not an nnimap group" group))
(nnimap-expunge mailbox (cadr method))))
(let ((method (gnus-find-method-for-group group)))
(if (not (gnus-check-backend-function
'request-expunge-group (car method)))
(error "%s does not support expunging" (car method))
(gnus-request-expunge-group group method))))
(autoload 'nnimap-acl-get "nnimap")
(autoload 'nnimap-acl-edit "nnimap")
(defun gnus-group-nnimap-edit-acl (group)
"Edit the Access Control List of current nnimap GROUP."
......
lisp/gnus/gnus-html.el
View file @ 1114abdb
......@@ -34,15 +34,10 @@
(require 'gnus-art)
(require 'mm-url)
(require 'url)
(require 'url-cache)
(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
"Where Gnus will cache images it downloads from the web."
:version "24.1"
:group 'gnus-art
:type 'directory)
(defcustom gnus-html-cache-size 500000000
"The size of the Gnus image cache."
(defcustom gnus-html-image-cache-ttl (days-to-time 7)
"Time in seconds used to cache the image on disk."
:version "24.1"
:group 'gnus-art
:type 'integer)
......@@ -73,6 +68,7 @@ fit these criteria."
(let ((map (make-sparse-keymap)))
(define-key map "u" 'gnus-article-copy-string)
(define-key map "i" 'gnus-html-insert-image)
(define-key map "v" 'gnus-html-browse-url)
map))
(defvar gnus-html-displayed-image-map
......@@ -84,6 +80,19 @@ fit these criteria."
(define-key map [tab] 'widget-forward)
map))
(defun gnus-html-cache-expired (url ttl)
"Check if URL is cached for more than TTL."
(cond (url-standalone-mode
(not (file-exists-p (url-cache-create-filename url))))
(t (let ((cache-time (url-is-cached url)))
(if cache-time
(time-less-p
(time-add
cache-time
ttl)
(current-time))
t)))))
;;;###autoload
(defun gnus-article-html (&optional handle)
(let ((article-buffer (current-buffer)))
......@@ -133,6 +142,7 @@ fit these criteria."
(replace-match "" t t)))
(defun gnus-html-wash-images ()
"Run through current buffer and replace img tags by images."
(let (tag parameters string start end images url)
(goto-char (point-min))
;; Search for all the images first.
......@@ -158,62 +168,68 @@ fit these criteria."
(setq image (gnus-create-image (buffer-string)
nil t))))
(when image
(let ((string (buffer-substring start end)))
(delete-region start end)
(gnus-put-image image (gnus-string-or string "*") 'cid)
(gnus-add-image 'cid image))))
(let ((string (buffer-substring start end)))
(delete-region start end)
(gnus-put-image image (gnus-string-or string "*") 'cid)
(gnus-add-image 'cid image))))
;; Normal, external URL.
(if (gnus-html-image-url-blocked-p
url
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
gnus-blocked-images)
gnus-blocked-images))
(progn
(widget-convert-button
'link start end
:action 'gnus-html-insert-image
:help-echo url
:keymap gnus-html-image-map
:button-keymap gnus-html-image-map)
(let ((overlay (gnus-make-overlay start end))
(spec (list url
(set-marker (make-marker) start)
(set-marker (make-marker) end))))
(gnus-overlay-put overlay 'local-map gnus-html-image-map)
(gnus-overlay-put overlay 'gnus-image spec)
(gnus-put-text-property
start end
'gnus-image spec)))
(let ((file (gnus-html-image-id url))
width height alt-text)
(when (string-match "height=\"?\\([0-9]+\\)" parameters)
(setq height (string-to-number (match-string 1 parameters))))
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
(setq width (string-to-number (match-string 1 parameters))))
(when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
parameters)
(setq alt-text (match-string 2 parameters)))
;; Don't fetch images that are really small. They're
;; probably tracking pictures.
(when (and (or (null height)
(> height 4))
(or (null width)
(> width 4)))
(if (file-exists-p file)
;; It's already cached, so just insert it.
(let ((string (buffer-substring start end)))
;; Delete the IMG text.
(delete-region start end)
(gnus-html-put-image file (point) string url alt-text))
;; We don't have it, so schedule it for fetching
;; asynchronously.
(push (list url
(set-marker (make-marker) start)
(point-marker))
images))))))))
(when images
(gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
(let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
parameters)
(match-string 2 parameters))))
(if (gnus-html-image-url-blocked-p
url
(if (buffer-live-p gnus-summary-buffer)
(with-current-buffer gnus-summary-buffer
gnus-blocked-images)
gnus-blocked-images))
(progn
(widget-convert-button
'link start end
:action 'gnus-html-insert-image
:help-echo url
:keymap gnus-html-image-map
:button-keymap gnus-html-image-map)
(let ((overlay (gnus-make-overlay start end))
(spec (list url
(set-marker (make-marker) start)
(set-marker (make-marker) end)
alt-text)))
(gnus-overlay-put overlay 'local-map gnus-html-image-map)
(gnus-overlay-put overlay 'gnus-image spec)
(gnus-put-text-property start end 'gnus-image-url url)
(gnus-put-text-property
start end
'gnus-image spec)))
;; Non-blocked url
(let ((width
(when (string-match "width=\"?\\([0-9]+\\)" parameters)
(string-to-number (match-string 1 parameters))))
(height
(when (string-match "height=\"?\\([0-9]+\\)" parameters)
(string-to-number (match-string 1 parameters)))))
;; Don't fetch images that are really small. They're
;; probably tracking pictures.
(when (and (or (null height)
(> height 4))
(or (null width)
(> width 4)))
(gnus-html-display-image url start end alt-text))))))))))
(defun gnus-html-display-image (url start end alt-text)
"Display image at URL on text from START to END.
Use ALT-TEXT for the image string."
(if (gnus-html-cache-expired url gnus-html-image-cache-ttl)
;; We don't have it, so schedule it for fetching
;; asynchronously.
(gnus-html-schedule-image-fetching
(current-buffer)
(list url
(set-marker (make-marker) start)
(set-marker (make-marker) end)
alt-text))
;; It's already cached, so just insert it.
(gnus-html-put-image (gnus-html-get-image-data url)
start end url alt-text)))
(defun gnus-html-wash-tags ()
(let (tag parameters string start end images url)
......@@ -300,8 +316,7 @@ fit these criteria."
(defun gnus-html-insert-image ()
"Fetch and insert the image under point."
(interactive)
(gnus-html-schedule-image-fetching
(current-buffer) (list (get-text-property (point) 'gnus-image))))
(apply 'gnus-html-display-image (get-text-property (point) 'gnus-image)))
(defun gnus-html-show-alt-text ()
"Show the ALT text of the image under point."
......@@ -311,7 +326,7 @@ fit these criteria."
(defun gnus-html-browse-image ()
"Browse the image under point."
(interactive)
(browse-url (get-text-property (point) 'gnus-image)))
(browse-url (get-text-property (point) 'gnus-image-url)))
(defun gnus-html-browse-url ()
"Browse the image under point."
......@@ -321,87 +336,89 @@ fit these criteria."
(message "No URL at point")
(browse-url url))))
(defun gnus-html-schedule-image-fetching (buffer images)
(gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
buffer images)
(dolist (image images)
(ignore-errors
(url-retrieve (car image)
'gnus-html-image-fetched
(list buffer image)))))
(defun gnus-html-image-id (url)
(expand-file-name (sha1 url) gnus-html-cache-directory))
(defun gnus-html-schedule-image-fetching (buffer image)
"Retrieve IMAGE, and place it into BUFFER on arrival."
(gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, image %s"
buffer image)
(ignore-errors
(url-retrieve (car image)
'gnus-html-image-fetched
(list buffer image))))
(defun gnus-html-image-fetched (status buffer image)
(let ((file (gnus-html-image-id (car image))))
;; Search the start of the image data
(url-store-in-cache (current-buffer))
(when (and (search-forward "\n\n" nil t)
(buffer-live-p buffer)
;; If the `image' has no marker, do not replace anything
(cadr image)
;; If the position of the marker is 1, then that
;; means that the text it was in has been deleted;
;; i.e., that the user has selected a different
;; article before the image arrived.
(not (= (marker-position (cadr image))
(with-current-buffer buffer
(point-min)))))
(let ((data (buffer-substring (point) (point-max))))
(with-current-buffer buffer
(let ((inhibit-read-only t))
(gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image))))))
(kill-buffer (current-buffer)))
(defun gnus-html-get-image-data (url)
"Get image data for URL.
Return a string with image data."
(with-temp-buffer
(mm-disable-multibyte)
(url-cache-extract (url-cache-create-filename url))
(when (search-forward "\n\n" nil t)
;; Write region (image data) silently
(write-region (point) (point-max) file nil 1)
(kill-buffer (current-buffer))
(when (and (buffer-live-p buffer)
;; If the `image' has no marker, do not replace anything
(cadr image)
;; If the position of the marker is 1, then that
;; means that the text it was in has been deleted;
;; i.e., that the user has selected a different
;; article before the image arrived.
(not (= (marker-position (cadr image)) (point-min))))
(with-current-buffer buffer
(let ((inhibit-read-only t)
(string (buffer-substring (cadr image) (caddr image))))
(delete-region (cadr image) (caddr image))
(gnus-html-put-image file (cadr image) (car image) string)))))))
(defun gnus-html-put-image (file point string &optional url alt-text)
(buffer-substring (point) (point-max)))))
(defun gnus-html-put-image (data start end &optional url alt-text)
(when (gnus-graphic-display-p)
(let* ((image (ignore-errors
(gnus-create-image file)))
(size (and image
(if (featurep 'xemacs)
(cons (glyph-width image) (glyph-height image))
(image-size image t)))))
(gnus-create-image data nil t)))
(size (and image
(if (featurep 'xemacs)
(cons (glyph-width image) (glyph-height image))
(image-size image t)))))
(save-excursion
(goto-char point)
(if (and image
;; Kludge to avoid displaying 30x30 gif images, which
;; seems to be a signal of a broken image.
(not (and (if (featurep 'xemacs)
(glyphp image)
(listp image))
(eq (if (featurep 'xemacs)
(let ((data (cdadar (specifier-spec-list
(glyph-image image)))))
(and (vectorp data)
(aref data 0)))
(plist-get (cdr image) :type))
'gif)
(= (car size) 30)
(= (cdr size) 30))))
(let ((start (point)))
(setq image (gnus-html-rescale-image image file size))
(gnus-put-image image
(gnus-string-or string "*")
'external)
(let ((overlay (gnus-make-overlay start (point))))
(gnus-overlay-put overlay 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image url)))
(gnus-add-image 'external image)
t)
(insert string)
(when (fboundp 'find-image)
(setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
(gnus-put-image image
(gnus-string-or string "*")
'internal)
(gnus-add-image 'internal image))
nil)))))
(defun gnus-html-rescale-image (image file size)
(goto-char start)
(let ((alt-text (or alt-text (buffer-substring-no-properties start end))))
(if (and image
;; Kludge to avoid displaying 30x30 gif images, which
;; seems to be a signal of a broken image.
(not (and (if (featurep 'xemacs)
(glyphp image)
(listp image))
(eq (if (featurep 'xemacs)
(let ((d (cdadar (specifier-spec-list
(glyph-image image)))))
(and (vectorp d)
(aref d 0)))
(plist-get (cdr image) :type))
'gif)
(= (car size) 30)
(= (cdr size) 30))))
;; Good image, add it!
(let ((image (gnus-html-rescale-image image data size)))
(delete-region start end)
(gnus-put-image image alt-text 'external)
(gnus-overlay-put (gnus-make-overlay start (point)) 'local-map
gnus-html-displayed-image-map)
(gnus-put-text-property start (point) 'gnus-alt-text alt-text)
(when url
(gnus-put-text-property start (point) 'gnus-image-url url))
(gnus-add-image 'external image)
t)
;; Bad image, try to show something else
(delete-region start end)
(when (fboundp 'find-image)
(setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
(gnus-put-image image alt-text 'internal)
(gnus-add-image 'internal image))
nil))))))
(defun gnus-html-rescale-image (image data size)
(if (or (not (fboundp 'imagemagick-types))
(not (get-buffer-window (current-buffer))))
image
......@@ -414,35 +431,17 @@ fit these criteria."
(- (nth 3 edges) (nth 1 edges)))))
scaled-image)
(when (> height window-height)
(setq image (or (create-image file 'imagemagick nil
(setq image (or (create-image data 'imagemagick t
:height window-height)
image))
(setq size (image-size image t)))
(when (> (car size) window-width)
(setq image (or
(create-image file 'imagemagick nil
(create-image data 'imagemagick t
:width window-width)
image)))
image)))
(defun gnus-html-prune-cache ()
(let ((total-size 0)
files)
(dolist (file (directory-files gnus-html-cache-directory t nil t))
(let ((attributes (file-attributes file)))
(unless (nth 0 attributes)
(incf total-size (nth 7 attributes))
(push (list (time-to-seconds (nth 5 attributes))
(nth 7 attributes) file)
files))))
(when (> total-size gnus-html-cache-size)
(setq files (sort files (lambda (f1 f2)
(< (car f1) (car f2)))))
(dolist (file files)
(when (> total-size gnus-html-cache-size)
(decf total-size (cadr file))
(delete-file (nth 2 file)))))))