-;;; gnus-util.el --- utility functions for Gnus
+;;; gnus-util.el --- utility functions for Semi-gnus
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(progn
(set-buffer gnus-work-buffer)
(erase-buffer))
- (set-buffer (get-buffer-create gnus-work-buffer))
+ (set-buffer (gnus-get-buffer-create gnus-work-buffer))
(kill-all-local-variables)
(buffer-disable-undo (current-buffer))))
Bind `print-quoted' and `print-readably' to t while printing."
(let ((print-quoted t)
(print-readably t)
+ (print-escape-multibyte nil)
print-level print-length)
(prin1 form (current-buffer))))
(setq filename (expand-file-name filename))
(setq rmail-default-rmail-file filename)
(let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
(save-excursion
(or (get-file-buffer filename)
(file-exists-p filename)
"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*")))
+ (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
(save-excursion
;; Create the file, if it doesn't exist.
(when (and (not (get-file-buffer filename))
(let ((file-buffer (create-file-buffer filename)))
(save-excursion
(set-buffer file-buffer)
- (let ((require-final-newline nil))
+ (let ((require-final-newline nil)
+ (coding-system-for-write 'binary))
(gnus-write-buffer filename)))
(kill-buffer file-buffer))
(error "Output file does not exist")))
;; 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))
+ (let ((buffer-read-only nil)
+ (coding-system-for-write 'binary))
(save-excursion
(goto-char (point-max))
(forward-char -2)
(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)
"password" "account" "macdef" "force"))
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.
+ (unwind-protect
+ (progn
+ (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,
+ ;; except "default".
+ (when (and pair (or (cdr pair)
+ (equal (car pair) "default")))
+ (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))))))
+ (if alist
+ (push (nreverse alist) result))
+ (setq alist nil
+ pair nil)
(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))))
+ (forward-line 1))
+ (nreverse result))
+ (kill-buffer " *netrc*"))))))
(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)))
+ "Return the netrc values from LIST for MACHINE or for the default entry."
+ (let ((rest list))
+ (while (and list
+ (not (equal (cdr (assoc "machine" (car list))) machine)))
+ (pop list))
+ (car (or list
+ (progn (while (and rest (not (assoc "default" (car rest))))
+ (pop rest))
+ rest)))))
(defun gnus-netrc-get (alist type)
"Return the value of token TYPE from ALIST."
(error "Not a symbol: %s" alist))
`(setq ,alist (delq (assq ,key ,alist) ,alist)))
+(defun gnus-globalify-regexp (re)
+ "Returns a regexp that matches a whole line, iff RE matches a part of it."
+ (concat (unless (string-match "^\\^" re) "^.*")
+ re
+ (unless (string-match "\\$$" re) ".*$")))
+
(provide 'gnus-util)
;;; gnus-util.el ends here
projects / elisp / gnus.git- / blobdiff