This commit was generated by cvs2svn to compensate for changes in r2834,

[elisp/gnus.git-] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 3ccd1c8..cba9137 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,8 +1,8 @@
-;;; 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.
 
@@ -35,6 +35,9 @@
 (require 'nnheader)
 (require 'timezone)
 (require 'message)
+(eval-when-compile
+  (when (locate-library "rmail")
+    (require 'rmail)))
 
 (eval-and-compile
   (autoload 'nnmail-date-to-time "nnmail")
@@ -75,6 +78,12 @@
         (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".
@@ -103,33 +112,25 @@
      (when (gnus-buffer-exists-p buf)
        (kill-buffer buf))))
 
-(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
+(if (fboundp 'point-at-bol)
+    (fset 'gnus-point-at-bol 'point-at-bol)
   (defun gnus-point-at-bol ()
     "Return point at the beginning of the line."
     (let ((p (point)))
       (beginning-of-line)
       (prog1
          (point)
-       (goto-char p))))))
-
-(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
+       (goto-char p)))))
+
+(if (fboundp 'point-at-eol)
+    (fset 'gnus-point-at-eol 'point-at-eol)
   (defun gnus-point-at-eol ()
     "Return point at the end of the line."
     (let ((p (point)))
       (end-of-line)
       (prog1
          (point)
-       (goto-char p))))))
+       (goto-char p)))))
 
 (defun gnus-delete-first (elt list)
   "Delete by side effect the first occurrence of ELT as a member of LIST."
@@ -609,6 +610,21 @@ Bind `print-quoted' and `print-readably' to t while printing."
   ;; 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)
@@ -728,7 +744,7 @@ with potentially long computations."
   (setq filename (expand-file-name filename))
   (setq rmail-default-rmail-file filename)
   (let ((artbuf (current-buffer))
-       (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
+       (tmpbuf (get-buffer-create " *Gnus-output*")))
     (save-excursion
       (or (get-file-buffer filename)
          (file-exists-p filename)
@@ -764,9 +780,12 @@ with potentially long computations."
            (when msg
              (goto-char (point-min))
              (widen)
-             (search-backward "\^_")
-             (narrow-to-region (point) (point-max))
-             (goto-char (1+ (point-min)))
+             (search-backward "\n\^_")
+             (narrow-to-region (point) (point-max))
+             (rmail-count-new-messages t)
+             (when (rmail-summary-exists)
+               (rmail-select-summary
+                (rmail-update-summary)))
              (rmail-count-new-messages t)
              (rmail-show-message msg))
            (save-buffer)))))
@@ -776,7 +795,7 @@ with potentially long computations."
   "Append the current article to a mail file named FILENAME."
   (setq filename (expand-file-name filename))
   (let ((artbuf (current-buffer))
-       (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
+       (tmpbuf (get-buffer-create " *Gnus-output*")))
     (save-excursion
       ;; Create the file, if it doesn't exist.
       (when (and (not (get-file-buffer filename))
@@ -788,7 +807,7 @@ with potentially long computations."
              (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)
@@ -815,7 +834,8 @@ with potentially long computations."
                    (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))