;;; gnus-art.el --- article mode commands for Gnus
-;; Copyright (C) 1996-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:type gnus-article-treat-custom)
(put 'gnus-treat-highlight-signature 'highlight t)
-(defcustom gnus-treat-buttonize 100000
+(defcustom gnus-treat-buttonize '(and 100000 (typep "text/plain"))
"Add buttons.
Valid values are nil, t, `head', `first', `last', an integer or a
predicate. See Info node `(gnus)Customizing Articles'."
(setq gnus-article-browse-html-temp-list nil))
gnus-article-browse-html-temp-list)
-(defun gnus-article-browse-html-save-cid-content (cid handles directory)
+(defun gnus-article-browse-html-save-cid-content (cid handles directory abs)
"Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return file name."
+Return absolute file name if ABS is non-nil, otherwise relative to
+the parent of DIRECTORY."
(save-match-data
- (let (file)
+ (let (file afile)
(catch 'found
(dolist (handle handles)
(cond
((not (or (bufferp (car handle)) (stringp (car handle)))))
((equal (mm-handle-media-supertype handle) "multipart")
(when (setq file (gnus-article-browse-html-save-cid-content
- cid handle directory))
+ cid handle directory abs))
(throw 'found file)))
((equal (concat "<" cid ">") (mm-handle-id handle))
- (setq file
- (expand-file-name
- (or (mm-handle-filename handle)
- (concat
- (make-temp-name "cid")
- (car (rassoc (car (mm-handle-type handle))
- mailcap-mime-extensions))))
- directory))
- (mm-save-part-to-file handle file)
- (throw 'found file))))))))
+ (setq file (or (mm-handle-filename handle)
+ (concat
+ (make-temp-name "cid")
+ (car (rassoc (car (mm-handle-type handle))
+ mailcap-mime-extensions))))
+ afile (expand-file-name file directory))
+ (mm-save-part-to-file handle afile)
+ (throw 'found (if abs
+ afile
+ (concat (file-name-nondirectory
+ (directory-file-name directory))
+ "/" file))))))))))
(defun gnus-article-browse-html-parts (list &optional header)
"View all \"text/html\" parts from LIST.
(insert content)
;; resolve cid contents
(let ((case-fold-search t)
- cid-file)
+ abs st cid-file)
(goto-char (point-min))
+ (when (re-search-forward "<head[\t\n >]" nil t)
+ (setq st (match-end 0)
+ abs (or
+ (not (re-search-forward "</head[\t\n >]" nil t))
+ (re-search-backward "<base[\t\n >]" st t))))
(while (re-search-forward "\
<img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
nil t)
(match-string 2)
(with-current-buffer gnus-article-buffer
gnus-article-mime-handles)
- cid-dir))
- (when (eq system-type 'cygwin)
+ cid-dir abs))
+ (when abs
(setq cid-file
- (concat "/" (substring
+ (if (eq system-type 'cygwin)
+ (concat "file:///"
+ (substring
(with-output-to-string
(call-process "cygpath" nil
standard-output
nil "-m" cid-file))
- 0 -1))))
- (replace-match (concat "file://" cid-file)
- nil nil nil 1))))
+ 0 -1))
+ (concat "file://" cid-file))))
+ (replace-match cid-file nil nil nil 1))))
(unless content (setq content (buffer-string))))
(when (or charset header (not file))
(setq tmp-file (mm-make-temp-file
(let ((gnus-mime-buttonized-part-id current-id))
(gnus-article-edit-done))
(gnus-configure-windows 'article)
+ (sit-for 0)
(when (and current-id (integerp gnus-auto-select-part))
(gnus-article-jump-to-part
(min (max (+ current-id gnus-auto-select-part) 1)
'gnus-data))))
(setq b btn))
(if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
+ (progn
+ (setq b (copy-marker b)
+ btn (copy-marker btn))
+ (mm-remove-part handle))
(cond
((not arg) nil)
((numberp arg)
(forward-line 1))
(mm-display-inline handle))
;; Toggle the button appearance between `[button]...' and `[button]'.
+ (when (markerp btn)
+ (setq btn (prog1 (marker-position btn)
+ (set-marker btn nil))))
(goto-char btn)
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-insert-mime-button handle (get-text-property btn 'gnus-part)
'((gnus-treat-highlight-headers
gnus-article-highlight-headers))))
(gnus-treat-article 'head)))))
+ (when (markerp b)
+ (setq b (prog1 (marker-position b)
+ (set-marker b nil))))
(goto-char b))))
(defun gnus-mime-set-charset-parameters (handle charset)
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-safe-url-regexp (mm-display-part handle))))))
+ (gnus-bind-safe-url-regexp
+ (mm-display-part handle nil t))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at \(point\)."
point (previous-single-property-change start 'gnus-data))
(if (mm-handle-displayed-p handle)
;; This will remove the part.
- (setq retval (mm-display-part handle))
+ (setq point (copy-marker point)
+ retval (mm-display-part handle))
(let ((part (or (and (mm-inlinable-p handle)
(mm-inlined-p handle)
t)
,(point-max-marker)))))))
(part
(mm-display-inline handle))))))
+ (when (markerp point)
+ (setq point (prog1 (marker-position point)
+ (set-marker point nil))))
(goto-char point)
;; Toggle the button appearance between `[button]...' and `[button]'.
(let ((displayed-p (mm-handle-displayed-p handle)))
(gnus-article-insert-newline)
(if (prog1
(= (skip-chars-backward "\n") -1)
- (forward-char 1))
+ (unless (eobp) (forward-char 1)))
(gnus-article-insert-newline)
(put-text-property (point) (point-max) 'gnus-undeletable t))
(goto-char (point-max)))
(dolist (button (nreverse buttons))
(setq st (point))
(insert " ")
- (mm-handle-set-undisplayer
- (setq handle (copy-sequence (cdr button))) nil)
+ (mm-handle-set-undisplayer (setq handle (cdr button)) nil)
(gnus-insert-mime-button handle (car button))
(skip-chars-backward "\t\n ")
(delete-region (point) (point-max))
(set-buffer buf))))))
(defun gnus-block-private-groups (group)
+ "Allows images in newsgroups to be shown, blocks images in all
+other groups."
(if (or (gnus-news-group-p group)
(gnus-member-of-valid 'global group))
;; Block nothing in news groups.
projects / gnus / blobdiff