(require 'nnheader)
(require 'message)
(require 'time-date)
+(eval-when-compile (require 'static))
(eval-and-compile
(autoload 'rmail-insert-rmail-file-header "rmail")
(when (gnus-buffer-exists-p buf)
(kill-buffer buf))))
-(fset 'gnus-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
-(fset 'gnus-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position))
+(static-cond
+ ((fboundp 'point-at-bol)
+ (fset 'gnus-point-at-bol 'point-at-bol))
+ ((fboundp 'line-beginning-position)
+ (fset 'gnus-point-at-bol 'line-beginning-position))
+ (t
+ (defun gnus-point-at-bol ()
+ "Return point at the beginning of the line."
+ (let ((p (point)))
+ (beginning-of-line)
+ (prog1
+ (point)
+ (goto-char p))))
+ ))
+(static-cond
+ ((fboundp 'point-at-eol)
+ (fset 'gnus-point-at-eol 'point-at-eol))
+ ((fboundp 'line-end-position)
+ (fset 'gnus-point-at-eol 'line-end-position))
+ (t
+ (defun gnus-point-at-eol ()
+ "Return point at the end of the line."
+ (let ((p (point)))
+ (end-of-line)
+ (prog1
+ (point)
+ (goto-char p))))
+ ))
(defun gnus-delete-first (elt list)
"Delete by side effect the first occurrence of ELT as a member of LIST."
((gnus-functionp function)
)
(t
- (error "Invalid sort spec: %s" function))))if
+ (error "Invalid sort spec: %s" function))))
(if (cdr funs)
`(or (,function ,first ,last)
(and (not (,function ,last ,first))
;;; .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)
- (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
+ (when (file-exists-p file)
+ (with-temp-buffer
(let ((tokens '("machine" "default" "login"
"password" "account" "macdef" "force"))
alist elem result pair)
- (nnheader-set-temp-buffer " *netrc*")
- (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)
- (forward-line 1))
- (nreverse result))
- (kill-buffer " *netrc*"))))))
+ (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 ")
+ ;; Skip lines that begin with a "#".
+ (if (eq (char-after) ?#)
+ (goto-char (point-max))
+ (unless (eobp)
+ (setq elem (buffer-substring
+ (point) (progn (skip-chars-forward "^\t ")
+ (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)))))))
+ (when alist
+ (push (nreverse alist) result))
+ (setq alist nil
+ pair nil)
+ (widen)
+ (forward-line 1))
+ (nreverse result)))))
(defun gnus-netrc-machine (list machine)
"Return the netrc values from LIST for MACHINE or for the default entry."
;;; Various
-(defvar gnus-group-buffer) ; Compiler directive
+(defvar gnus-group-buffer) ; Compiler directive
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
(and (boundp 'gnus-group-buffer)
(eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
(text-property-any b e 'gnus-undeletable t)))
+(defun gnus-or (&rest elems)
+ "Return non-nil if any of the elements are non-nil."
+ (catch 'found
+ (while elems
+ (when (pop elems)
+ (throw 'found t)))))
+
+(defun gnus-and (&rest elems)
+ "Return non-nil if all of the elements are non-nil."
+ (catch 'found
+ (while elems
+ (unless (pop elems)
+ (throw 'found nil)))
+ t))
+
+(static-if (boundp 'MULE)
+ (defun gnus-write-active-file-as-coding-system (coding-system file hashtb)
+ (let ((output-coding-system coding-system))
+ (with-temp-file file
+ (mapatoms
+ (lambda (sym)
+ (when (and sym
+ (boundp sym)
+ (symbol-value sym))
+ (insert (format "%s %d %d y\n"
+ (symbol-name sym) (cdr (symbol-value sym))
+ (car (symbol-value sym))))))
+ hashtb))))
+ (defun gnus-write-active-file-as-coding-system (coding-system file hashtb)
+ (let ((coding-system-for-write coding-system))
+ (with-temp-file file
+ (mapatoms
+ (lambda (sym)
+ (when (and sym
+ (boundp sym)
+ (symbol-value sym))
+ (insert (format "%s %d %d y\n"
+ (symbol-name sym) (cdr (symbol-value sym))
+ (car (symbol-value sym))))))
+ hashtb))))
+ )
+
(provide 'gnus-util)
;;; gnus-util.el ends here
projects / elisp / gnus.git- / blobdiff