-;;; gnus-util.el --- utility functions for Gnus
+;;; gnus-util.el --- utility functions for Semi-gnus
;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news
+;; Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(require 'nnheader)
(require 'message)
(require 'time-date)
+(eval-when-compile (require 'static))
(eval-and-compile
(autoload 'rmail-insert-rmail-file-header "rmail")
(set symbol nil))
symbol))
+;; Avoid byte-compile warning.
+;; In Mule, this function will be redefined to `truncate-string',
+;; which takes 3 or 4 args.
+(defun gnus-truncate-string (str width &rest ignore)
+ (substring str 0 width))
+
;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
;; to limit the length of a string. This function is necessary since
;; `(substr "abc" 0 30)' pukes with "Args out of range".
(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."
(set-buffer gnus-work-buffer)
(erase-buffer))
(set-buffer (gnus-get-buffer-create gnus-work-buffer))
- (kill-all-local-variables)
- (mm-enable-multibyte)))
+ (kill-all-local-variables)))
(defmacro gnus-group-real-name (group)
"Find the real name of a foreign newsgroup."
;; Write the buffer.
(write-region (point-min) (point-max) file nil 'quietly))
+(defun gnus-write-buffer-as-binary (file)
+ "Write the current buffer's contents to FILE without code conversion."
+ ;; Make sure the directory exists.
+ (gnus-make-directory (file-name-directory file))
+ ;; Write the buffer.
+ (write-region-as-binary (point-min) (point-max) file nil 'quietly))
+
+(defun gnus-write-buffer-as-coding-system (coding-system file)
+ "Write the current buffer's contents to FILE with code conversion."
+ ;; Make sure the directory exists.
+ (gnus-make-directory (file-name-directory file))
+ ;; Write the buffer.
+ (write-region-as-coding-system
+ coding-system (point-min) (point-max) file nil 'quietly))
+
(defun gnus-delete-file (file)
"Delete FILE if it exists."
(when (file-exists-p file)
(save-excursion
(set-buffer file-buffer)
(let ((require-final-newline nil))
- (gnus-write-buffer filename)))
+ (gnus-write-buffer-as-binary filename)))
(kill-buffer file-buffer))
(error "Output file does not exist")))
(set-buffer tmpbuf)
(insert "\n"))
(insert "\n"))
(goto-char (point-max))
- (append-to-file (point-min) (point-max) filename)))
+ (write-region-as-binary (point-min) (point-max)
+ filename 'append)))
;; File has been visited, in buffer OUTBUF.
(set-buffer outbuf)
(let ((buffer-read-only nil))
;;; .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."
(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