+;;; Functions for saving to babyl/mail files.
+
+(defvar rmail-default-rmail-file)
+(defun gnus-output-to-rmail (filename &optional ask)
+ "Append the current article to an Rmail file named FILENAME."
+ (require 'rmail)
+ ;; Most of these codes are borrowed from rmailout.el.
+ (setq filename (expand-file-name filename))
+ (setq rmail-default-rmail-file filename)
+ (let ((artbuf (current-buffer))
+ (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (save-excursion
+ (or (get-file-buffer filename)
+ (file-exists-p filename)
+ (if (or (not ask)
+ (gnus-yes-or-no-p
+ (concat "\"" filename "\" does not exist, create it? ")))
+ (let ((file-buffer (create-file-buffer filename)))
+ (save-excursion
+ (set-buffer file-buffer)
+ (rmail-insert-rmail-file-header)
+ (let ((require-final-newline nil))
+ (gnus-write-buffer filename)))
+ (kill-buffer file-buffer))
+ (error "Output file does not exist")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ (gnus-convert-article-to-rmail)
+ ;; Decide whether to append to a file or to an Emacs buffer.
+ (let ((outbuf (get-file-buffer filename)))
+ (if (not outbuf)
+ (append-to-file (point-min) (point-max) filename)
+ ;; File has been visited, in buffer OUTBUF.
+ (set-buffer outbuf)
+ (let ((buffer-read-only nil)
+ (msg (and (boundp 'rmail-current-message)
+ (symbol-value 'rmail-current-message))))
+ ;; If MSG is non-nil, buffer is in RMAIL mode.
+ (when msg
+ (widen)
+ (narrow-to-region (point-max) (point-max)))
+ (insert-buffer-substring tmpbuf)
+ (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))
+ (save-buffer)))))
+ (kill-buffer tmpbuf)))
+
+(defun gnus-output-to-mail (filename &optional ask)
+ "Append the current article to a mail file named FILENAME."
+ (setq filename (expand-file-name filename))
+ (let ((artbuf (current-buffer))
+ (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (save-excursion
+ ;; Create the file, if it doesn't exist.
+ (when (and (not (get-file-buffer filename))
+ (not (file-exists-p filename)))
+ (if (or (not ask)
+ (gnus-y-or-n-p
+ (concat "\"" filename "\" does not exist, create it? ")))
+ (let ((file-buffer (create-file-buffer filename)))
+ (save-excursion
+ (set-buffer file-buffer)
+ (let ((require-final-newline nil))
+ (gnus-write-buffer filename)))
+ (kill-buffer file-buffer))
+ (error "Output file does not exist")))
+ (set-buffer tmpbuf)
+ (erase-buffer)
+ (insert-buffer-substring artbuf)
+ (goto-char (point-min))
+ (if (looking-at "From ")
+ (forward-line 1)
+ (insert "From nobody " (current-time-string) "\n"))
+ (let (case-fold-search)
+ (while (re-search-forward "^From " nil t)
+ (beginning-of-line)
+ (insert ">")))
+ ;; Decide whether to append to a file or to an Emacs buffer.
+ (let ((outbuf (get-file-buffer filename)))
+ (if (not outbuf)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (goto-char (point-max))
+ (forward-char -2)
+ (unless (looking-at "\n\n")
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert "\n"))
+ (goto-char (point-max))
+ (append-to-file (point-min) (point-max) filename)))
+ ;; File has been visited, in buffer OUTBUF.
+ (set-buffer outbuf)
+ (let ((buffer-read-only nil))
+ (goto-char (point-max))
+ (unless (eobp)
+ (insert "\n"))
+ (insert "\n")
+ (insert-buffer-substring tmpbuf)))))
+ (kill-buffer tmpbuf)))
+
+(defun gnus-convert-article-to-rmail ()
+ "Convert article in current buffer to Rmail message format."
+ (let ((buffer-read-only nil))
+ ;; Convert article directly into Babyl format.
+ (goto-char (point-min))
+ (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
+ (while (search-forward "\n\^_" nil t) ;single char
+ (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
+ (goto-char (point-max))
+ (insert "\^_")))
+
+(defun gnus-map-function (funs arg)
+ "Applies the result of the first function in FUNS to the second, and so on.
+ARG is passed to the first function."
+ (let ((myfuns funs)
+ (myarg arg))
+ (while myfuns
+ (setq arg (funcall (pop myfuns) arg)))
+ arg))
+
+(defun gnus-run-hooks (&rest funcs)
+ "Does the same as `run-hooks', but saves excursion."
+ (let ((buf (current-buffer)))
+ (unwind-protect
+ (apply 'run-hooks funcs)
+ (set-buffer buf))))
+
+;;;
+;;; .netrc and .authinforc parsing
+;;;
+
+(defvar gnus-netrc-syntax-table
+ (let ((table (copy-syntax-table text-mode-syntax-table)))
+ (modify-syntax-entry ?- "w" table)
+ (modify-syntax-entry ?_ "w" table)
+ (modify-syntax-entry ?! "w" table)
+ (modify-syntax-entry ?. "w" table)
+ (modify-syntax-entry ?, "w" table)
+ (modify-syntax-entry ?: "w" table)
+ (modify-syntax-entry ?\; "w" table)
+ (modify-syntax-entry ?% "w" table)
+ (modify-syntax-entry ?) "w" table)
+ (modify-syntax-entry ?( "w" table)
+ table)
+ "Syntax table when parsing .netrc files.")
+
+(defun gnus-parse-netrc (file)
+ "Parse FILE and return an list of all entries in the file."
+ (if (not (file-exists-p file))
+ ()
+ (save-excursion
+ (let ((tokens '("machine" "default" "login"
+ "password" "account" "macdef"))
+ alist elem result pair)
+ (nnheader-set-temp-buffer " *netrc*")
+ (set-syntax-table gnus-netrc-syntax-table)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ ;; Go through the file, line by line.
+ (while (not (eobp))
+ (narrow-to-region (point) (gnus-point-at-eol))
+ ;; For each line, get the tokens and values.
+ (while (not (eobp))
+ (skip-chars-forward "\t ")
+ (unless (eobp)
+ (setq elem (buffer-substring
+ (point) (progn (forward-sexp 1) (point))))
+ (cond
+ ((equal elem "macdef")
+ ;; We skip past the macro definition.
+ (widen)
+ (while (and (zerop (forward-line 1))
+ (looking-at "$")))
+ (narrow-to-region (point) (point)))
+ ((member elem tokens)
+ ;; Tokens that don't have a following value are ignored.
+ (when (and pair (cdr pair))
+ (push pair alist))
+ (setq pair (list elem)))
+ (t
+ ;; Values that haven't got a preceding token are ignored.
+ (when pair
+ (setcdr pair elem)
+ (push pair alist)
+ (setq pair nil))))))
+ (push alist result)
+ (setq alist nil
+ pair nil)
+ (widen)
+ (forward-line 1))
+ result))))
+
+(defun gnus-netrc-machine (list machine)
+ "Return the netrc values from LIST for MACHINE."
+ (while (and list
+ (not (equal (cdr (assoc "machine" (car list))) machine)))
+ (pop list))
+ (when list
+ (car list)))
+
+(defun gnus-netrc-get (alist type)
+ "Return the value of token TYPE from ALIST."
+ (cdr (assoc type alist)))
+