(unless gnus-inhibit-hiding
(save-excursion
(save-restriction
- (let ((buffer-read-only nil)
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(case-fold-search t)
(max (1+ (length gnus-sorted-header-list)))
(ignored (when (not gnus-visible-headers)
(header-end (point-min))
header-start field-end field-start
(inhibit-point-motion-hooks t)
- (inhibit-read-only t)
- buffer-read-only)
+ (inhibit-read-only t))
(save-restriction
(widen)
(while (and (setq header-start
(condition-case ()
(let ((time (date-to-time date)))
(cond
- ;; Convert to the local timezone.
+ ;; Convert to the local timezone.
((eq type 'local)
(let ((tz (car (current-time-zone time))))
(format "Date: %s %s%02d%02d" (current-time-string time)
"\M-g" gnus-article-read-summary-keys)
;; Define almost undefined keys to `gnus-article-read-summary-keys'.
-(mapcar
- (lambda (key)
- (unless (lookup-key gnus-article-mode-map key)
- (define-key gnus-article-mode-map key
- 'gnus-article-read-summary-keys)))
- (delq nil
- (append
- (mapcar
- (lambda (elt)
- (let ((key (car elt)))
- (and (> (length key) 0)
- (not (eq 'menu-bar (aref key 0)))
- (symbolp (lookup-key gnus-summary-mode-map key))
- key)))
- (accessible-keymaps gnus-summary-mode-map))
- (let ((c 127)
- keys)
- (while (>= c 32)
- (push (char-to-string c) keys)
- (decf c))
- keys))))
-
-(eval-when-compile
- (defvar gnus-article-commands-menu))
-
-(defvar gnus-article-post-menu nil)
+(let (keys)
+ (let ((key 32))
+ (while (<= key 127)
+ (push (char-to-string key) keys)
+ (incf key))
+ (dolist (elem (accessible-keymaps gnus-summary-mode-map))
+ (setq key (car elem))
+ (when (and (> (length key) 0)
+ (not (eq 'menu-bar (aref key 0)))
+ (symbolp (lookup-key gnus-summary-mode-map key)))
+ (push key keys))))
+ (dolist (key keys)
+ (unless (lookup-key gnus-article-mode-map key)
+ (define-key gnus-article-mode-map key 'gnus-article-read-summary-keys))))
(defun gnus-article-make-menu-bar ()
+ (unless (boundp 'gnus-article-commands-menu)
+ (gnus-summary-make-menu-bar))
(gnus-turn-off-edit-menu 'article)
(unless (boundp 'gnus-article-article-menu)
(easy-menu-define
["Decode HZ" gnus-article-decode-HZ t]))
;; Note "Commands" menu is defined in gnus-sum.el for consistency
-
- (when (boundp 'gnus-summary-post-menu)
- (cond
- ((not (keymapp gnus-summary-post-menu))
- (setq gnus-article-post-menu gnus-summary-post-menu))
- ((not gnus-article-post-menu)
- ;; Don't share post menu.
- (setq gnus-article-post-menu
- (copy-keymap gnus-summary-post-menu))))
- (define-key gnus-article-mode-map [menu-bar post]
- (cons "Post" gnus-article-post-menu)))
+
+ ;; Note "Post" menu is defined in gnus-sum.el for consistency
(gnus-run-hooks 'gnus-article-menu-hook)))
result)
(save-excursion
(gnus-article-setup-buffer)
- (set-buffer gnus-original-article-buffer)
+ (set-buffer gnus-article-buffer)
;; Deactivate active regions.
(when (and (boundp 'transient-mark-mode)
transient-mark-mode)
;;;###autoload
(defun gnus-article-prepare-display ()
"Make the current buffer look like a nice article."
- (setq gnus-article-wash-types nil)
- (gnus-run-hooks 'gnus-tmp-internal-hook)
- (gnus-run-hooks 'gnus-article-prepare-hook)
+ (let ((gnus-article-buffer (current-buffer))
+ buffer-read-only)
+ (unless (eq major-mode 'gnus-article-mode)
+ (gnus-article-mode))
+ (setq buffer-read-only nil
+ gnus-button-marker-list nil
+ gnus-article-wash-types nil)
+ (save-restriction
+ (widen)
+ (static-if (featurep 'xemacs)
+ (map-extents (lambda (extent maparg) (delete-extent extent)))
+ (let ((lists (overlay-lists)))
+ (dolist (overlay (nconc (car lists) (cdr lists)))
+ (delete-overlay overlay)))))
+ (gnus-run-hooks 'gnus-tmp-internal-hook))
+ (set-buffer gnus-original-article-buffer)
;; Display message.
- (let (mime-display-header-hook mime-display-text/plain-hook)
- (funcall (if gnus-show-mime
- (progn
- (setq mime-message-structure gnus-current-headers)
- (mime-buffer-entity-set-buffer-internal
- mime-message-structure
- gnus-original-article-buffer)
- (mime-entity-set-representation-type-internal
- mime-message-structure 'mime-buffer-entity)
- (luna-send mime-message-structure
- 'initialize-instance
- mime-message-structure)
- gnus-article-display-method-for-mime)
- gnus-article-display-method-for-traditional)))
- ;; Associate this article with the current summary buffer.
- (setq gnus-article-current-summary gnus-summary-buffer)
+ (setq mime-message-structure gnus-current-headers)
+ (mime-buffer-entity-set-buffer-internal mime-message-structure
+ gnus-original-article-buffer)
+ (mime-entity-set-representation-type-internal mime-message-structure
+ 'mime-buffer-entity)
+ (luna-send mime-message-structure 'initialize-instance
+ mime-message-structure)
+ (if gnus-show-mime
+ (let (mime-display-header-hook mime-display-text/plain-hook)
+ (funcall gnus-article-display-method-for-mime))
+ (funcall gnus-article-display-method-for-traditional))
;; Call the treatment functions.
- (let ((inhibit-read-only t)
- buffer-read-only)
+ (let ((inhibit-read-only t))
(save-restriction
(widen)
(if gnus-show-mime
(narrow-to-region (point) (point-max))
(gnus-treat-article nil))
(put-text-property (point-min) (point-max) 'read-only nil)))
- ;; Perform the article display hooks. Incidentally, this hook is
- ;; an obsolete variable by now.
- (gnus-run-hooks 'gnus-article-display-hook))
+ (gnus-run-hooks 'gnus-article-prepare-hook))
(defun gnus-article-decode-article-as-default-mime-charset ()
"Decode an article as `default-mime-charset'. It won't work if the
value of the variable `gnus-show-mime' is non-nil."
(unless gnus-show-mime
+ (set (make-local-variable 'default-mime-charset)
+ (with-current-buffer gnus-summary-buffer
+ default-mime-charset))
(decode-mime-charset-region (point-min) (point-max)
- (with-current-buffer gnus-summary-buffer
- default-mime-charset))))
+ default-mime-charset)))
;;;
;;; Gnus MIME viewing functions
(defun gnus-article-mime-part-status ()
(with-current-buffer gnus-article-buffer
- (let ((entity (get-text-property (point-min) 'mime-view-entity)))
- (if (and entity (mime-entity-children entity))
- (format " (%d parts)" (length (mime-entity-children entity)))
+ (let ((entity (get-text-property (point-min) 'mime-view-entity))
+ children)
+ (if (and entity
+ (setq children (mime-entity-children entity))
+ (setq children (length children)))
+ (if (eq 1 children)
+ " (1 part)"
+ (format " (%d parts)" children))
""))))
(defvar gnus-mime-button-map
(goto-char b)))))
(defun gnus-mime-view-part-as-charset (&optional handle arg)
- "Insert the MIME part under point into the current buffer."
+ "Insert the MIME part under point into the current buffer using the
+specified charset."
(interactive (list nil current-prefix-arg))
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(defun gnus-mime-internalize-part (&optional handle)
"View the MIME part under point with an internal viewer.
-In no internal viewer is available, use an external viewer."
+If no internal viewer is available, use an external viewer."
(interactive)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(gnus-treat-article 'head))))))))
(defvar gnus-mime-display-multipart-as-mixed nil)
+(defvar gnus-mime-display-multipart-alternative-as-mixed nil)
+(defvar gnus-mime-display-multipart-related-as-mixed nil)
(defun gnus-mime-display-part (handle)
(cond
handle))
;; multipart/alternative
((and (equal (car handle) "multipart/alternative")
- (not gnus-mime-display-multipart-as-mixed))
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-alternative-as-mixed)))
(let ((id (1+ (length gnus-article-mime-handle-alist))))
(push (cons id handle) gnus-article-mime-handle-alist)
(gnus-mime-display-alternative (cdr handle) nil nil id)))
;; multipart/related
((and (equal (car handle) "multipart/related")
- (not gnus-mime-display-multipart-as-mixed))
+ (not (or gnus-mime-display-multipart-as-mixed
+ gnus-mime-display-multipart-related-as-mixed)))
;;;!!!We should find the start part, but we just default
;;;!!!to the first part.
;;(gnus-mime-display-part (cadr handle))
(save-excursion
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (elt key 0) unread-command-events)
- (setq key (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence "Describe key: "))
- (read-key-sequence "Describe key: "))))
+ (if (featurep 'xemacs)
+ (progn
+ (push (elt key 0) unread-command-events)
+ (setq key (events-to-keys
+ (read-key-sequence "Describe key: "))))
+ (setq unread-command-events
+ (mapcar
+ (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+ key))
+ (setq key (read-key-sequence "Describe key: "))))
(describe-key key))
(describe-key key)))
(save-excursion
(set-buffer gnus-article-current-summary)
(let (gnus-pick-mode)
- (push (elt key 0) unread-command-events)
- (setq key (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence "Describe key: "))
- (read-key-sequence "Describe key: "))))
+ (if (featurep 'xemacs)
+ (progn
+ (push (elt key 0) unread-command-events)
+ (setq key (events-to-keys
+ (read-key-sequence "Describe key: "))))
+ (setq unread-command-events
+ (mapcar
+ (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
+ key))
+ (setq key (read-key-sequence "Describe key: "))))
(describe-key-briefly key insert))
(describe-key-briefly key insert)))
(set-buffer gnus-article-buffer)
(gnus-article-edit-mode)
(funcall start-func)
+ (set-buffer-modified-p nil)
(gnus-configure-windows 'edit-article)
(setq gnus-article-edit-done-function exit-func)
(setq gnus-prev-winconf winconf)
(when gnus-article-edit-article-setup-function
(funcall gnus-article-edit-article-setup-function))
- (gnus-message 6 "C-c C-c to end edits")))
+ (gnus-message 6 "C-c C-c to end edits; C-c C-k to exit")))
(defun gnus-article-edit-done (&optional arg)
"Update the article edits and exit."
(start (window-start)))
(remove-hook 'gnus-article-mode-hook
'gnus-article-mime-edit-article-unwind)
- (gnus-article-edit-exit)
+ ;; We remove all text props from the article buffer.
+ (let ((content
+ (buffer-substring-no-properties (point-min) (point-max)))
+ (p (point)))
+ (erase-buffer)
+ (insert content)
+ (let ((winconf gnus-prev-winconf))
+ (gnus-article-mode)
+ (set-window-configuration winconf)
+ ;; Tippy-toe some to make sure that point remains where it was.
+ (save-current-buffer
+ (set-buffer buf)
+ (set-window-start (get-buffer-window (current-buffer)) start)
+ (goto-char p))))
(save-excursion
(set-buffer buf)
(let ((buffer-read-only nil))
(defun gnus-article-edit-exit ()
"Exit the article editing without updating."
(interactive)
- ;; We remove all text props from the article buffer.
- (let ((buf (buffer-substring-no-properties (point-min) (point-max)))
- (curbuf (current-buffer))
- (p (point))
- (window-start (window-start)))
- (erase-buffer)
- (insert buf)
- (let ((winconf gnus-prev-winconf))
- (gnus-article-mode)
- (set-window-configuration winconf)
- ;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
- (set-window-start (get-buffer-window (current-buffer)) window-start)
- (goto-char p)))))
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p "Article modified; kill anyway? "))
+ (let ((curbuf (current-buffer))
+ (p (point))
+ (window-start (window-start)))
+ (erase-buffer)
+ (if (gnus-buffer-live-p gnus-original-article-buffer)
+ (insert-buffer gnus-original-article-buffer))
+ (let ((winconf gnus-prev-winconf))
+ (gnus-article-mode)
+ (set-window-configuration winconf)
+ ;; Tippy-toe some to make sure that point remains where it was.
+ (save-current-buffer
+ (set-buffer curbuf)
+ (set-window-start (get-buffer-window (current-buffer)) window-start)
+ (goto-char p))))))
(defun gnus-article-edit-full-stops ()
"Interactively repair spacing at end of sentences."
(defun gnus-article-mime-edit-article-unwind ()
"Unwind `gnus-article-buffer' if article editing was given up."
(remove-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
- (when mime-edit-mode-flag
- (mime-edit-exit 'nomime 'no-error)
- (message ""))
(when (featurep 'font-lock)
(setq font-lock-defaults nil)
- (font-lock-mode 0)))
+ (font-lock-mode -1))
+ (when mime-edit-mode-flag
+ (mime-edit-exit 'nomime 'no-error)
+ (message "")))
(defun gnus-article-mime-edit-article-setup ()
"Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode
(setq gnus-article-edit-done-function
`(lambda (&rest args)
(when mime-edit-mode-flag
- (mime-edit-exit)
+ (let (mime-edit-insert-user-agent-field)
+ (mime-edit-exit))
(message ""))
(goto-char (point-min))
(let (case-fold-search)
(format "^%s$" (regexp-quote mail-header-separator))
nil t)
(replace-match "")))
- (when (featurep 'font-lock)
- (setq font-lock-defaults nil)
- (font-lock-mode 0))
(apply ,gnus-article-edit-done-function args)
- (set-buffer gnus-original-article-buffer)
- (erase-buffer)
- (insert-buffer gnus-article-buffer)
+ (insert
+ (prog1
+ (buffer-substring-no-properties (point-min) (point-max))
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (erase-buffer)))
(setq gnus-current-headers (gnus-article-make-full-mail-header))
+ (set-buffer gnus-article-buffer)
(gnus-article-prepare-display)))
- (substitute-key-definition
- 'gnus-article-edit-exit 'gnus-article-mime-edit-exit
- gnus-article-edit-mode-map)
+ (substitute-key-definition 'gnus-article-edit-done
+ 'gnus-article-mime-edit-done
+ gnus-article-edit-mode-map)
+ (substitute-key-definition 'gnus-article-edit-exit
+ 'gnus-article-mime-edit-exit
+ gnus-article-edit-mode-map)
(erase-buffer)
(insert-buffer gnus-original-article-buffer)
- (mime-edit-again)
+ (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
+ (fset 'mime-edit-decode-single-part-in-buffer
+ (lambda (&rest args)
+ (if (let ((content-type (car args)))
+ (and (eq 'message (mime-content-type-primary-type
+ content-type))
+ (eq 'rfc822 (mime-content-type-subtype content-type))))
+ (setcar (cdr args) 'not-decode-text))
+ (apply ofn args)))
+ (unwind-protect
+ (mime-edit-again)
+ (fset 'mime-edit-decode-single-part-in-buffer ofn)))
(when (featurep 'font-lock)
(set (make-local-variable 'font-lock-defaults)
'(message-font-lock-keywords t))
(font-lock-set-defaults)
(turn-on-font-lock))
+ (set-buffer-modified-p nil)
+ (delete-other-windows)
(add-hook 'gnus-article-mode-hook 'gnus-article-mime-edit-article-unwind)
(gnus-run-hooks 'gnus-article-mime-edit-article-setup-hook))
+(defun gnus-article-mime-edit-done (&optional arg)
+ "Update the article MIME edits and exit."
+ (interactive "P")
+ (when (featurep 'font-lock)
+ (setq font-lock-defaults nil)
+ (font-lock-mode -1))
+ (gnus-article-edit-done arg))
+
(defun gnus-article-mime-edit-exit ()
"Exit the article MIME editing without updating."
(interactive)
- (let ((winconf gnus-prev-winconf)
- buf)
+ (when (or (not (buffer-modified-p))
+ (yes-or-no-p "Article modified; kill anyway? "))
+ (when (featurep 'font-lock)
+ (setq font-lock-defaults nil)
+ (font-lock-mode -1))
(when mime-edit-mode-flag
- (mime-edit-exit)
+ (let (mime-edit-insert-user-agent-field)
+ (mime-edit-exit))
(message ""))
(goto-char (point-min))
(let (case-fold-search)
(when (re-search-forward
(format "^%s$" (regexp-quote mail-header-separator)) nil t)
(replace-match "")))
- (when (featurep 'font-lock)
- (setq font-lock-defaults nil)
- (font-lock-mode 0))
- ;; We remove all text props from the article buffer.
- (setq buf (buffer-substring-no-properties (point-min) (point-max)))
- (set-buffer (get-buffer-create gnus-original-article-buffer))
- (erase-buffer)
- (insert buf)
- (setq gnus-current-headers (gnus-article-make-full-mail-header))
- (gnus-article-prepare-display)
- (set-window-configuration winconf)))
+ (let ((winconf gnus-prev-winconf))
+ (insert (prog1
+ (buffer-substring-no-properties (point-min) (point-max))
+ (set-buffer (get-buffer-create gnus-original-article-buffer))
+ (erase-buffer)))
+ (setq gnus-current-headers (gnus-article-make-full-mail-header))
+ (set-buffer gnus-article-buffer)
+ (gnus-article-prepare-display)
+ (set-window-configuration winconf))))
;;;
;;; Article highlights
:type 'regexp)
(defcustom gnus-button-alist
- `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
- 0 t gnus-button-message-id 2)
- ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1)
+ `(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
+ 0 t gnus-button-handle-news 3)
+ ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
+ gnus-button-handle-news 2)
("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
1 t
gnus-button-fetch-group 4)
(gnus-message 1 "You must define `%S' to use this button"
(cons fun args)))))))
+(defun gnus-parse-news-url (url)
+ (let (scheme server group message-id articles)
+ (with-temp-buffer
+ (insert url)
+ (goto-char (point-min))
+ (when (looking-at "\\([A-Za-z]+\\):")
+ (setq scheme (match-string 1))
+ (goto-char (match-end 0)))
+ (when (looking-at "//\\([^/]+\\)/")
+ (setq server (match-string 1))
+ (goto-char (match-end 0)))
+
+ (cond
+ ((looking-at "\\(.*@.*\\)")
+ (setq message-id (match-string 1)))
+ ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)")
+ (setq group (match-string 1)
+ articles (split-string (match-string 2) "-")))
+ ((looking-at "\\([^/]+\\)/?")
+ (setq group (match-string 1)))
+ (t
+ (error "Unknown news URL syntax"))))
+ (list scheme server group message-id articles)))
+
+(defun gnus-button-handle-news (url)
+ "Fetch a news URL."
+ (destructuring-bind (scheme server group message-id articles)
+ (gnus-parse-news-url url)
+ (cond
+ (message-id
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if server
+ (let ((gnus-refer-article-method (list (list 'nntp server))))
+ (gnus-summary-refer-article message-id))
+ (gnus-summary-refer-article message-id))))
+ (group
+ (gnus-button-fetch-group url)))))
+
(defun gnus-button-message-id (message-id)
"Fetch MESSAGE-ID."
(save-excursion
projects / elisp / gnus.git- / blobdiff