;;; Code:
-(require 'gnus-load)
+(require 'gnus)
(require 'gnus-sum)
(require 'article)
(require 'gnus-spec)
* gnus-summary-save-in-rmail (Rmail format)
* gnus-summary-save-in-mail (Unix mail format)
* gnus-summary-save-in-folder (MH folder)
-* gnus-summary-save-in-file (article format).
-* gnus-summary-save-in-vm (use VM's folder format)."
+* gnus-summary-save-in-file (article format)
+* gnus-summary-save-in-vm (use VM's folder format)
+* gnus-summary-write-to-file (article format -- overwrite)."
:group 'article
:type '(radio (function-item gnus-summary-save-in-rmail)
(function-item gnus-summary-save-in-mail)
(function-item gnus-summary-save-in-folder)
(function-item gnus-summary-save-in-file)
- (function-item gnus-summary-save-in-vm)))
+ (function-item gnus-summary-save-in-vm)
+ (function-item gnus-summary-write-to-file)))
(defcustom gnus-rmail-save-name 'gnus-plain-save-name
"A function generating a file name to save articles in Rmail format.
(item :tag "skip" nil)
(face :value default)))))
+(defvar gnus-article-mode-syntax-table
+ (copy-syntax-table text-mode-syntax-table)
+ "Syntax table used in article mode buffers.
+Initialized from `text-mode-syntax-table.")
+
;;; Internal variables
(defvar gnus-article-mode-line-format-alist
nil)
(t file)))
(gnus-number-of-articles-to-be-saved
- (when (eq gnus-prompt-before-saving t) num))) ; Magic
+ (when (eq gnus-prompt-before-saving t)
+ num))) ; Magic
(set-buffer gnus-summary-buffer)
- (funcall gnus-default-article-saver filename)))))
+ (funcall gnus-default-article-saver filename)))))
(defun gnus-read-save-file-name (prompt default-name &optional filename)
(cond
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-mail filename)))
-(defun gnus-summary-save-in-file (&optional filename)
+(defun gnus-summary-save-in-file (&optional filename overwrite)
"Append this article to file.
Optional argument FILENAME specifies file name.
Directory to save to is default to `gnus-article-save-directory'."
(save-excursion
(save-restriction
(widen)
+ (when (and overwrite
+ (file-exists-p filename))
+ (delete-file filename))
(gnus-output-to-file filename))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-file filename)))
+(defun gnus-summary-write-to-file (&optional filename)
+ "Write this article to a file.
+Optional argument FILENAME specifies file name.
+The directory to save in defaults to `gnus-article-save-directory'."
+ (interactive)
+ (gnus-summary-save-in-file nil t))
+
+
(defun gnus-summary-save-body-in-file (&optional filename)
"Append this article body to a file.
Optional argument FILENAME specifies file name.
(save-restriction
(widen)
(goto-char (point-min))
- (and (search-forward "\n\n" nil t)
- (narrow-to-region (point) (point-max)))
+ (when (search-forward "\n\n" nil t)
+ (narrow-to-region (point) (point-max)))
(gnus-output-to-file filename))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-file filename)))
(command command)
(t (read-string "Shell command on article: "
gnus-last-shell-command))))
- (if (string-equal command "")
- (setq command gnus-last-shell-command))
+ (when (string-equal command "")
+ (setq command gnus-last-shell-command))
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
(widen)
(defun gnus-capitalize-newsgroup (newsgroup)
"Capitalize NEWSGROUP name."
- (and (not (zerop (length newsgroup)))
- (concat (char-to-string (upcase (aref newsgroup 0)))
- (substring newsgroup 1))))
+ (when (not (zerop (length newsgroup)))
+ (concat (char-to-string (upcase (aref newsgroup 0)))
+ (substring newsgroup 1))))
(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
"\C-c\C-b" gnus-bug
"\C-d" gnus-article-read-summary-keys
+ "\M-*" gnus-article-read-summary-keys
"\M-g" gnus-article-read-summary-keys)
(substitute-key-definition
(gnus-set-default-directory)
(buffer-disable-undo (current-buffer))
(setq buffer-read-only t)
+ (set-syntax-table gnus-article-mode-syntax-table)
(run-hooks 'gnus-article-mode-hook))
(defun gnus-article-setup-buffer ()
;; The result from the `request' was an actual article -
;; or at least some text that is now displayed in the
;; article buffer.
- (if (and (numberp article)
- (not (eq article gnus-current-article)))
- ;; Seems like a new article has been selected.
- ;; `gnus-current-article' must be an article number.
- (save-excursion
- (set-buffer summary-buffer)
- (setq gnus-last-article gnus-current-article
- gnus-newsgroup-history (cons gnus-current-article
- gnus-newsgroup-history)
- gnus-current-article article
- gnus-current-headers
- (gnus-summary-article-header gnus-current-article)
- gnus-article-current
- (cons gnus-newsgroup-name gnus-current-article))
- (unless (vectorp gnus-current-headers)
- (setq gnus-current-headers nil))
- (gnus-summary-show-thread)
- (run-hooks 'gnus-mark-article-hook)
- (gnus-set-mode-line 'summary)
- (and (gnus-visual-p 'article-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook))
- ;; Set the global newsgroup variables here.
- ;; Suggested by Jim Sisolak
- ;; <sisolak@trans4.neep.wisc.edu>.
- (gnus-set-global-variables)
- (setq gnus-have-all-headers
- (or all-headers gnus-show-all-headers))
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (gnus-cache-possibly-enter-article
- group article
- (gnus-summary-article-header article)
- (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-unreads)))))
+ (when (and (numberp article)
+ (not (eq article gnus-current-article)))
+ ;; Seems like a new article has been selected.
+ ;; `gnus-current-article' must be an article number.
+ (save-excursion
+ (set-buffer summary-buffer)
+ (setq gnus-last-article gnus-current-article
+ gnus-newsgroup-history (cons gnus-current-article
+ gnus-newsgroup-history)
+ gnus-current-article article
+ gnus-current-headers
+ (gnus-summary-article-header gnus-current-article)
+ gnus-article-current
+ (cons gnus-newsgroup-name gnus-current-article))
+ (unless (vectorp gnus-current-headers)
+ (setq gnus-current-headers nil))
+ (gnus-summary-show-thread)
+ (run-hooks 'gnus-mark-article-hook)
+ (gnus-set-mode-line 'summary)
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook))
+ ;; Set the global newsgroup variables here.
+ ;; Suggested by Jim Sisolak
+ ;; <sisolak@trans4.neep.wisc.edu>.
+ (gnus-set-global-variables)
+ (setq gnus-have-all-headers
+ (or all-headers gnus-show-all-headers))
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (gnus-cache-possibly-enter-article
+ group article
+ (gnus-summary-article-header article)
+ (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-dormant)
+ (memq article gnus-newsgroup-unreads)))))
(when (or (numberp article)
(stringp article))
;; Hooks for getting information from the article.
(run-hooks 'internal-hook)
(run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
- (if gnus-show-mime
- (if (or (not gnus-strict-mime)
- (gnus-fetch-field "Mime-Version"))
- (funcall gnus-show-mime-method)
- (funcall gnus-decode-encoded-word-method)))
+ (when gnus-show-mime
+ (if (or (not gnus-strict-mime)
+ (gnus-fetch-field "Mime-Version"))
+ (funcall gnus-show-mime-method)
+ (funcall gnus-decode-encoded-word-method)))
;; Perform the article display hooks.
(run-hooks 'gnus-article-display-hook))
;; Do page break.
(goto-char (point-min))
- (and gnus-break-pages (gnus-narrow-to-page)))
+ (when gnus-break-pages
+ (gnus-narrow-to-page)))
(gnus-set-mode-line 'article)
(gnus-configure-windows 'article)
(goto-char (point-min))
(set-buffer file-buffer)
(rmail-insert-rmail-file-header)
(let ((require-final-newline nil))
- (write-region (point-min) (point-max) file-name t 1)))
+ (gnus-write-buffer file-name)))
(kill-buffer file-buffer))
(error "Output file does not exist")))
(set-buffer tmpbuf)
(msg (and (boundp 'rmail-current-message)
(symbol-value 'rmail-current-message))))
;; If MSG is non-nil, buffer is in RMAIL mode.
- (if msg
- (progn (widen)
- (narrow-to-region (point-max) (point-max))))
+ (when msg
+ (widen)
+ (narrow-to-region (point-max) (point-max)))
(insert-buffer-substring tmpbuf)
- (if msg
- (progn
- (goto-char (point-min))
- (widen)
- (search-backward "\^_")
- (narrow-to-region (point) (point-max))
- (goto-char (1+ (point-min)))
- (rmail-count-new-messages t)
- (rmail-show-message msg)))))))
+ (when msg
+ (goto-char (point-min))
+ (widen)
+ (search-backward "\^_")
+ (narrow-to-region (point) (point-max))
+ (goto-char (1+ (point-min)))
+ (rmail-count-new-messages t)
+ (rmail-show-message msg))))))
(kill-buffer tmpbuf)))
(defun gnus-output-to-file (file-name)
(defun gnus-article-maybe-highlight ()
"Do some article highlighting if `article-visual' is non-nil."
- (if (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
+ (when (gnus-visual-p 'article-highlight 'highlight)
+ (gnus-article-highlight-some)))
(defun gnus-request-article-this-buffer (article group)
"Get an article and insert it into this buffer."
(save-excursion
(set-buffer gnus-summary-buffer)
(let ((header (gnus-summary-article-header article)))
- (if (< article 0)
- (cond
- ((memq article gnus-newsgroup-sparse)
- ;; This is a sparse gap article.
- (setq do-update-line article)
- (setq article (mail-header-id header))
- (let ((gnus-override-method gnus-refer-article-method))
- (gnus-read-header article))
- (setq gnus-newsgroup-sparse
- (delq article gnus-newsgroup-sparse)))
- ((vectorp header)
- ;; It's a real article.
- (setq article (mail-header-id header)))
- (t
- ;; It is an extracted pseudo-article.
- (setq article 'pseudo)
- (gnus-request-pseudo-article header))))
+ (when (< article 0)
+ (cond
+ ((memq article gnus-newsgroup-sparse)
+ ;; This is a sparse gap article.
+ (setq do-update-line article)
+ (setq article (mail-header-id header))
+ (let ((gnus-override-method gnus-refer-article-method))
+ (gnus-read-header article))
+ (setq gnus-newsgroup-sparse
+ (delq article gnus-newsgroup-sparse)))
+ ((vectorp header)
+ ;; It's a real article.
+ (setq article (mail-header-id header)))
+ (t
+ ;; It is an extracted pseudo-article.
+ (setq article 'pseudo)
+ (gnus-request-pseudo-article header))))
(let ((method (gnus-find-method-for-group
gnus-newsgroup-name)))
()
(let ((dir (concat (file-name-as-directory (nth 1 method))
(mail-header-subject header))))
- (if (file-directory-p dir)
- (progn
- (setq article 'nneething)
- (gnus-group-enter-directory dir)))))))))
+ (when (file-directory-p dir)
+ (setq article 'nneething)
+ (gnus-group-enter-directory dir))))))))
(cond
;; Refuse to select canceled articles.
gnus-button-fetch-group 3)
("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
gnus-button-message-id 3)
- ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
+ ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-url-mailto 2)
;; This is how URLs _should_ be embedded in text...
("<URL: *\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
;; Next regexp stolen from highlight-headers.el.
(let* ((pos (posn-point (event-start event)))
(data (get-text-property pos 'gnus-data))
(fun (get-text-property pos 'gnus-callback)))
- (if fun (funcall fun data))))
+ (when fun
+ (funcall fun data))))
(defun gnus-article-press-button ()
"Check text at point for a callback function.
(interactive)
(let* ((data (get-text-property (point) 'gnus-data))
(fun (get-text-property (point) 'gnus-callback)))
- (if fun (funcall fun data))))
+ (when fun
+ (funcall fun data))))
(defun gnus-article-prev-button (n)
"Move point to N buttons backward.
(not (eobp)))
(beginning-of-line)
(setq from (point))
- (or (search-forward ":" nil t)
- (forward-char 1))
+ (unless (search-forward ":" nil t)
+ (forward-char 1))
(when (and header-face
(not (memq (point) hpoints)))
(push (point) hpoints)
(end (match-end (nth 1 entry)))
(form (nth 2 entry)))
(goto-char (match-end 0))
- (and (eval form)
- (gnus-article-add-button
- start end (nth 3 entry)
- (buffer-substring (match-beginning (nth 4 entry))
- (match-end (nth 4 entry)))))))
+ (when (eval form)
+ (gnus-article-add-button
+ start end (nth 3 entry)
+ (buffer-substring (match-beginning (nth 4 entry))
+ (match-end (nth 4 entry)))))))
(goto-char end))))
(widen)))
(defun gnus-article-add-button (from to fun &optional data)
"Create a button between FROM and TO with callback FUN and data DATA."
- (and gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay from to)
- 'face gnus-article-button-face))
+ (when gnus-article-button-face
+ (gnus-overlay-put (gnus-make-overlay from to)
+ 'face gnus-article-button-face))
(gnus-add-text-properties
from to
(nconc (and gnus-article-mouse-face
(let* ((entry (gnus-button-entry))
(inhibit-point-motion-hooks t)
(fun (nth 3 entry))
- (args (mapcar (lambda (group)
+ (args (mapcar (lambda (group)
(let ((string (buffer-substring
(match-beginning group)
(match-end group))))
(match-string 3 address)
"nntp"))))))
+(defun gnus-split-string (string pattern)
+ "Return a list of substrings of STRING which are separated by PATTERN."
+ (let (parts (start 0))
+ (while (string-match pattern string start)
+ (setq parts (cons (substring string start (match-beginning 0)) parts)
+ start (match-end 0)))
+ (nreverse (cons (substring string start) parts))))
+
+(defun gnus-url-parse-query-string (query &optional downcase)
+ (let (retval pairs cur key val)
+ (setq pairs (gnus-split-string query "&"))
+ (while pairs
+ (setq cur (car pairs)
+ pairs (cdr pairs))
+ (if (not (string-match "=" cur))
+ nil ; Grace
+ (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
+ val (gnus-url-unhex-string (substring cur (match-end 0) nil)))
+ (if downcase
+ (setq key (downcase key)))
+ (setq cur (assoc key retval))
+ (if cur
+ (setcdr cur (cons val (cdr cur)))
+ (setq retval (cons (list key val) retval)))))
+ retval))
+
+(defun gnus-url-unhex (x)
+ (if (> x ?9)
+ (if (>= x ?a)
+ (+ 10 (- x ?a))
+ (+ 10 (- x ?A)))
+ (- x ?0)))
+
+(defun gnus-url-unhex-string (str &optional allow-newlines)
+ "Remove %XXX embedded spaces, etc in a url.
+If optional second argument ALLOW-NEWLINES is non-nil, then allow the
+decoding of carriage returns and line feeds in the string, which is normally
+forbidden in URL encoding."
+ (setq str (or str ""))
+ (let ((tmp "")
+ (case-fold-search t))
+ (while (string-match "%[0-9a-f][0-9a-f]" str)
+ (let* ((start (match-beginning 0))
+ (ch1 (gnus-url-unhex (elt str (+ start 1))))
+ (code (+ (* 16 ch1)
+ (gnus-url-unhex (elt str (+ start 2))))))
+ (setq tmp (concat
+ tmp (substring str 0 start)
+ (cond
+ (allow-newlines
+ (char-to-string code))
+ ((or (= code ?\n) (= code ?\r))
+ " ")
+ (t (char-to-string code))))
+ str (substring str (match-end 0)))))
+ (setq tmp (concat tmp str))
+ tmp))
+
+(defun gnus-url-mailto (url)
+ ;; Send mail to someone
+ (if (not (string-match "mailto:/*\\(.*\\)" url))
+ (error "Malformed mailto link: %s" url))
+ (setq url (substring url (match-beginning 1) nil))
+ (let (to args source-url subject func)
+ (if (string-match (regexp-quote "?") url)
+ (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0)))
+ args (gnus-url-parse-query-string
+ (substring url (match-end 0) nil) t))
+ (setq to (gnus-url-unhex-string url)))
+ (setq args (cons (list "to" to) args)
+ subject (cdr-safe (assoc "subject" args)))
+ (message-mail)
+ (while args
+ (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
+ (if (fboundp func)
+ (funcall func)
+ (message-position-on-field (caar args)))
+ (insert (mapconcat 'identity (cdar args) ", "))
+ (setq args (cdr args)))
+ (if subject
+ (message-goto-body)
+ (message-goto-subject))))
+
(defun gnus-button-mailto (address)
;; Mail to ADDRESS.
(set-buffer (gnus-copy-article-buffer))
(let ((win (selected-window)))
(select-window (get-buffer-window gnus-article-buffer t))
(gnus-article-prev-page)
- (select-window win)))
+ (select-window win)))
(provide 'gnus-art)
+(run-hooks 'gnus-art-load-hook)
+
;;; gnus-art.el ends here
projects / gnus / blobdiff