1555 |
(interactive) |
(interactive) |
1556 |
;; This function might be inhibited. |
;; This function might be inhibited. |
1557 |
(unless gnus-inhibit-hiding |
(unless gnus-inhibit-hiding |
1558 |
(save-excursion |
(let ((inhibit-read-only nil) |
1559 |
(save-restriction |
(case-fold-search t) |
1560 |
(let ((inhibit-read-only t) |
(max (1+ (length gnus-sorted-header-list))) |
1561 |
(case-fold-search t) |
(inhibit-point-motion-hooks t) |
1562 |
(max (1+ (length gnus-sorted-header-list))) |
(cur (current-buffer)) |
1563 |
(ignored (when (not gnus-visible-headers) |
ignored visible beg) |
1564 |
(cond ((stringp gnus-ignored-headers) |
(save-excursion |
1565 |
gnus-ignored-headers) |
;; `gnus-ignored-headers' and `gnus-visible-headers' may be |
1566 |
((listp gnus-ignored-headers) |
;; group parameters, so we should go to the summary buffer. |
1567 |
(mapconcat 'identity gnus-ignored-headers |
(when (prog1 |
1568 |
"\\|"))))) |
(condition-case nil |
1569 |
(visible |
(progn (set-buffer gnus-summary-buffer) t) |
1570 |
(cond ((stringp gnus-visible-headers) |
(error nil)) |
1571 |
gnus-visible-headers) |
(setq ignored (when (not gnus-visible-headers) |
1572 |
((and gnus-visible-headers |
(cond ((stringp gnus-ignored-headers) |
1573 |
(listp gnus-visible-headers)) |
gnus-ignored-headers) |
1574 |
(mapconcat 'identity gnus-visible-headers "\\|")))) |
((listp gnus-ignored-headers) |
1575 |
(inhibit-point-motion-hooks t) |
(mapconcat 'identity |
1576 |
beg) |
gnus-ignored-headers |
1577 |
|
"\\|")))) |
1578 |
|
visible (cond ((stringp gnus-visible-headers) |
1579 |
|
gnus-visible-headers) |
1580 |
|
((and gnus-visible-headers |
1581 |
|
(listp gnus-visible-headers)) |
1582 |
|
(mapconcat 'identity |
1583 |
|
gnus-visible-headers |
1584 |
|
"\\|"))))) |
1585 |
|
(set-buffer cur)) |
1586 |
|
(save-restriction |
1587 |
;; First we narrow to just the headers. |
;; First we narrow to just the headers. |
1588 |
(article-narrow-to-head) |
(article-narrow-to-head) |
1589 |
;; Hide any "From " lines at the beginning of (mail) articles. |
;; Hide any "From " lines at the beginning of (mail) articles. |
2392 |
(mm-setup-w3m) |
(mm-setup-w3m) |
2393 |
(save-restriction |
(save-restriction |
2394 |
(narrow-to-region (point) (point-max)) |
(narrow-to-region (point) (point-max)) |
2395 |
(let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images |
(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) |
|
nil |
|
|
"\\`cid:")) |
|
2396 |
w3m-force-redisplay) |
w3m-force-redisplay) |
2397 |
(w3m-region (point-min) (point-max))) |
(w3m-region (point-min) (point-max))) |
2398 |
(when mm-inline-text-html-with-w3m-keymap |
(when (and mm-inline-text-html-with-w3m-keymap |
2399 |
|
(boundp 'w3m-minor-mode-map) |
2400 |
|
w3m-minor-mode-map) |
2401 |
(add-text-properties |
(add-text-properties |
2402 |
(point-min) (point-max) |
(point-min) (point-max) |
2403 |
(nconc (mm-w3m-local-map-property) |
(list 'keymap w3m-minor-mode-map |
2404 |
'(mm-inline-text-html-with-w3m t)))))) |
;; Put the mark meaning this part was rendered by emacs-w3m. |
2405 |
|
'mm-inline-text-html-with-w3m t))))) |
2406 |
|
|
2407 |
(defun article-hide-list-identifiers () |
(defun article-hide-list-identifiers () |
2408 |
"Remove list identifies from the Subject header. |
"Remove list identifies from the Subject header. |
3953 |
"Save the MIME part under point then replace it with an external body." |
"Save the MIME part under point then replace it with an external body." |
3954 |
(interactive) |
(interactive) |
3955 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
3956 |
(let* ((data (get-text-property (point) 'gnus-data)) |
(when (gnus-group-read-only-p) |
3957 |
file param |
(error "The current group does not support deleting of parts")) |
3958 |
(handles gnus-article-mime-handles)) |
(when (mm-complicated-handles gnus-article-mime-handles) |
3959 |
(if (mm-multiple-handles gnus-article-mime-handles) |
(error "\ |
3960 |
(error "This function is not implemented")) |
The current article has a complicated MIME structure, giving up...")) |
3961 |
(setq file (and data (mm-save-part data))) |
(when (gnus-yes-or-no-p "\ |
3962 |
(when file |
Deleting parts may malfunction or destroy the article; continue? ") |
3963 |
(with-current-buffer (mm-handle-buffer data) |
(let* ((data (get-text-property (point) 'gnus-data)) |
3964 |
(erase-buffer) |
file param |
3965 |
(insert "Content-Type: " (mm-handle-media-type data)) |
(handles gnus-article-mime-handles)) |
3966 |
(mml-insert-parameter-string (cdr (mm-handle-type data)) |
(setq file (and data (mm-save-part data))) |
3967 |
'(charset)) |
(when file |
3968 |
(insert "\n") |
(with-current-buffer (mm-handle-buffer data) |
3969 |
(insert "Content-ID: " (message-make-message-id) "\n") |
(erase-buffer) |
3970 |
(insert "Content-Transfer-Encoding: binary\n") |
(insert "Content-Type: " (mm-handle-media-type data)) |
3971 |
(insert "\n")) |
(mml-insert-parameter-string (cdr (mm-handle-type data)) |
3972 |
(setcdr data |
'(charset)) |
3973 |
(cdr (mm-make-handle nil |
(insert "\n") |
3974 |
`("message/external-body" |
(insert "Content-ID: " (message-make-message-id) "\n") |
3975 |
(access-type . "LOCAL-FILE") |
(insert "Content-Transfer-Encoding: binary\n") |
3976 |
(name . ,file))))) |
(insert "\n")) |
3977 |
(set-buffer gnus-summary-buffer) |
(setcdr data |
3978 |
(gnus-article-edit-article |
(cdr (mm-make-handle nil |
3979 |
`(lambda () |
`("message/external-body" |
3980 |
(erase-buffer) |
(access-type . "LOCAL-FILE") |
3981 |
(let ((mail-parse-charset (or gnus-article-charset |
(name . ,file))))) |
3982 |
',gnus-newsgroup-charset)) |
(set-buffer gnus-summary-buffer) |
3983 |
(mail-parse-ignored-charsets |
(gnus-article-edit-article |
3984 |
(or gnus-article-ignored-charsets |
`(lambda () |
3985 |
',gnus-newsgroup-ignored-charsets)) |
(erase-buffer) |
3986 |
(mbl mml-buffer-list)) |
(let ((mail-parse-charset (or gnus-article-charset |
3987 |
(setq mml-buffer-list nil) |
',gnus-newsgroup-charset)) |
3988 |
(insert-buffer gnus-original-article-buffer) |
(mail-parse-ignored-charsets |
3989 |
(mime-to-mml ',handles) |
(or gnus-article-ignored-charsets |
3990 |
(setq gnus-article-mime-handles nil) |
',gnus-newsgroup-ignored-charsets)) |
3991 |
(let ((mbl1 mml-buffer-list)) |
(mbl mml-buffer-list)) |
3992 |
(setq mml-buffer-list mbl) |
(setq mml-buffer-list nil) |
3993 |
(set (make-local-variable 'mml-buffer-list) mbl1)) |
(insert-buffer gnus-original-article-buffer) |
3994 |
(gnus-make-local-hook 'kill-buffer-hook) |
(mime-to-mml ',handles) |
3995 |
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) |
(setq gnus-article-mime-handles nil) |
3996 |
`(lambda (no-highlight) |
(let ((mbl1 mml-buffer-list)) |
3997 |
(let ((mail-parse-charset (or gnus-article-charset |
(setq mml-buffer-list mbl) |
3998 |
',gnus-newsgroup-charset)) |
(set (make-local-variable 'mml-buffer-list) mbl1)) |
3999 |
(message-options message-options) |
(gnus-make-local-hook 'kill-buffer-hook) |
4000 |
(message-options-set-recipient) |
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) |
4001 |
(mail-parse-ignored-charsets |
`(lambda (no-highlight) |
4002 |
(or gnus-article-ignored-charsets |
(let ((mail-parse-charset (or gnus-article-charset |
4003 |
',gnus-newsgroup-ignored-charsets))) |
',gnus-newsgroup-charset)) |
4004 |
(mml-to-mime) |
(message-options message-options) |
4005 |
(mml-destroy-buffers) |
(message-options-set-recipient) |
4006 |
(remove-hook 'kill-buffer-hook |
(mail-parse-ignored-charsets |
4007 |
'mml-destroy-buffers t) |
(or gnus-article-ignored-charsets |
4008 |
(kill-local-variable 'mml-buffer-list)) |
',gnus-newsgroup-ignored-charsets))) |
4009 |
(gnus-summary-edit-article-done |
(mml-to-mime) |
4010 |
,(or (mail-header-references gnus-current-headers) "") |
(mml-destroy-buffers) |
4011 |
,(gnus-group-read-only-p) |
(remove-hook 'kill-buffer-hook |
4012 |
,gnus-summary-buffer no-highlight)))))) |
'mml-destroy-buffers t) |
4013 |
|
(kill-local-variable 'mml-buffer-list)) |
4014 |
|
(gnus-summary-edit-article-done |
4015 |
|
,(or (mail-header-references gnus-current-headers) "") |
4016 |
|
,(gnus-group-read-only-p) |
4017 |
|
,gnus-summary-buffer no-highlight))))))) |
4018 |
|
|
4019 |
(defun gnus-mime-delete-part () |
(defun gnus-mime-delete-part () |
4020 |
"Delete the MIME part under point. |
"Delete the MIME part under point. |
4021 |
Replace it with some information about the removed part." |
Replace it with some information about the removed part." |
4022 |
(interactive) |
(interactive) |
4023 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4024 |
(unless (and gnus-novice-user |
(when (gnus-group-read-only-p) |
4025 |
(not (gnus-yes-or-no-p |
(error "The current group does not support deleting of parts")) |
4026 |
"Really delete attachment forever? "))) |
(when (mm-complicated-handles gnus-article-mime-handles) |
4027 |
|
(error "\ |
4028 |
|
The current article has a complicated MIME structure, giving up...")) |
4029 |
|
(when (gnus-yes-or-no-p "\ |
4030 |
|
Deleting parts may malfunction or destroy the article; continue? ") |
4031 |
(let* ((data (get-text-property (point) 'gnus-data)) |
(let* ((data (get-text-property (point) 'gnus-data)) |
4032 |
(handles gnus-article-mime-handles) |
(handles gnus-article-mime-handles) |
4033 |
(none "(none)") |
(none "(none)") |
4039 |
(or (mail-content-type-get (mm-handle-disposition data) 'filename) |
(or (mail-content-type-get (mm-handle-disposition data) 'filename) |
4040 |
none)) |
none)) |
4041 |
(type (mm-handle-media-type data))) |
(type (mm-handle-media-type data))) |
4042 |
(if (mm-multiple-handles gnus-article-mime-handles) |
(unless data |
4043 |
(error "This function is not implemented")) |
(error "No MIME part under point")) |
4044 |
(with-current-buffer (mm-handle-buffer data) |
(with-current-buffer (mm-handle-buffer data) |
4045 |
(let ((bsize (format "%s" (buffer-size)))) |
(let ((bsize (format "%s" (buffer-size)))) |
4046 |
(erase-buffer) |
(erase-buffer) |
5036 |
(save-excursion |
(save-excursion |
5037 |
(save-restriction |
(save-restriction |
5038 |
(widen) |
(widen) |
5039 |
|
(forward-line) |
5040 |
(eobp)))) ;Real end-of-buffer? |
(eobp)))) ;Real end-of-buffer? |
5041 |
(progn |
(progn |
5042 |
(when gnus-article-over-scroll |
(when gnus-article-over-scroll |
5194 |
(let ((obuf (current-buffer)) |
(let ((obuf (current-buffer)) |
5195 |
(owin (current-window-configuration)) |
(owin (current-window-configuration)) |
5196 |
(opoint (point)) |
(opoint (point)) |
5197 |
(summary gnus-article-current-summary) |
win func in-buffer selected new-sum-start new-sum-hscroll) |
5198 |
func in-buffer selected) |
(cond (not-restore-window |
5199 |
(if not-restore-window |
(pop-to-buffer gnus-article-current-summary 'norecord)) |
5200 |
(pop-to-buffer summary 'norecord) |
((setq win (get-buffer-window gnus-article-current-summary)) |
5201 |
(switch-to-buffer summary 'norecord)) |
(select-window win)) |
5202 |
|
(t |
5203 |
|
(switch-to-buffer gnus-article-current-summary 'norecord))) |
5204 |
(setq in-buffer (current-buffer)) |
(setq in-buffer (current-buffer)) |
5205 |
;; We disable the pick minor mode commands. |
;; We disable the pick minor mode commands. |
5206 |
(if (and (setq func (let (gnus-pick-mode) |
(if (and (setq func (let (gnus-pick-mode) |
5208 |
(functionp func)) |
(functionp func)) |
5209 |
(progn |
(progn |
5210 |
(call-interactively func) |
(call-interactively func) |
5211 |
(setq new-sum-point (point)) |
(when (eq win (selected-window)) |
5212 |
|
(setq new-sum-point (point) |
5213 |
|
new-sum-start (window-start win) |
5214 |
|
new-sum-hscroll (window-hscroll win)) |
5215 |
(when (eq in-buffer (current-buffer)) |
(when (eq in-buffer (current-buffer)) |
5216 |
(setq selected (gnus-summary-select-article)) |
(setq selected (gnus-summary-select-article)) |
5217 |
(set-buffer obuf) |
(set-buffer obuf) |
5223 |
1) |
1) |
5224 |
(set-window-point (get-buffer-window (current-buffer)) |
(set-window-point (get-buffer-window (current-buffer)) |
5225 |
(point))) |
(point))) |
5226 |
(let ((win (get-buffer-window gnus-article-current-summary))) |
(when (and (not not-restore-window) |
5227 |
(when win |
new-sum-point) |
5228 |
(set-window-point win new-sum-point)))) ) |
(set-window-point win new-sum-point) |
5229 |
(switch-to-buffer gnus-article-buffer) |
(set-window-start win new-sum-start) |
5230 |
|
(set-window-hscroll win new-sum-hscroll))))) |
5231 |
|
(set-window-configuration owin) |
5232 |
(ding)))))) |
(ding)))))) |
5233 |
|
|
5234 |
(defun gnus-article-describe-key (key) |
(defun gnus-article-describe-key (key) |
6706 |
(define-key map "\r" 'gnus-button-prev-page) |
(define-key map "\r" 'gnus-button-prev-page) |
6707 |
map)) |
map)) |
6708 |
|
|
6709 |
|
(defvar gnus-next-page-map |
6710 |
|
(let ((map (make-sparse-keymap))) |
6711 |
|
(unless (>= emacs-major-version 21) |
6712 |
|
;; XEmacs doesn't care. |
6713 |
|
(set-keymap-parent map gnus-article-mode-map)) |
6714 |
|
(define-key map gnus-mouse-2 'gnus-button-next-page) |
6715 |
|
(define-key map "\r" 'gnus-button-next-page) |
6716 |
|
map)) |
6717 |
|
|
6718 |
(defun gnus-insert-prev-page-button () |
(defun gnus-insert-prev-page-button () |
6719 |
(let ((b (point)) |
(let ((b (point)) |
6720 |
(inhibit-read-only t)) |
(inhibit-read-only t)) |
6732 |
:action 'gnus-button-prev-page |
:action 'gnus-button-prev-page |
6733 |
:button-keymap gnus-prev-page-map))) |
:button-keymap gnus-prev-page-map))) |
6734 |
|
|
|
(defvar gnus-prev-page-map |
|
|
(let ((map (make-sparse-keymap))) |
|
|
(unless (>= emacs-major-version 21) |
|
|
;; XEmacs doesn't care. |
|
|
(set-keymap-parent map gnus-article-mode-map)) |
|
|
(define-key map gnus-mouse-2 'gnus-button-prev-page) |
|
|
(define-key map "\r" 'gnus-button-prev-page) |
|
|
map)) |
|
|
|
|
|
(defvar gnus-next-page-map |
|
|
(let ((map (make-sparse-keymap))) |
|
|
(unless (>= emacs-major-version 21) |
|
|
;; XEmacs doesn't care. |
|
|
(set-keymap-parent map gnus-article-mode-map)) |
|
|
(define-key map gnus-mouse-2 'gnus-button-next-page) |
|
|
(define-key map "\r" 'gnus-button-next-page) |
|
|
map)) |
|
|
|
|
6735 |
(defun gnus-button-next-page (&optional args more-args) |
(defun gnus-button-next-page (&optional args more-args) |
6736 |
"Go to the next page." |
"Go to the next page." |
6737 |
(interactive) |
(interactive) |