* lisp/gnus.el (gnus-version-number): Update to 6.10.024.

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

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 0c63370..c31a804 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.
 
@@ -74,6 +74,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".
@@ -291,7 +297,7 @@
 
 (defun gnus-dd-mmm (messy-date)
   "Return a string like DD-MMM from a big messy string."
-  (format-time-string "%2d-%b" (safe-date-to-time messy-date)))
+  (format-time-string "%d-%b" (safe-date-to-time messy-date)))
 
 (defmacro gnus-date-get-time (date)
   "Convert DATE string to Emacs time.
@@ -465,8 +471,7 @@ If N, return the Nth ancestor instead."
        (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."
@@ -639,6 +644,61 @@ with potentially long computations."
 
 ;;; 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 (gnus-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 "\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)))))
+    (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))
@@ -654,7 +714,8 @@ with potentially long computations."
            (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")))
@@ -672,7 +733,8 @@ with potentially long computations."
       ;; 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)
@@ -853,6 +915,12 @@ ARG is passed to the first function."
          re
          (unless (string-match "\\$$" re) ".*$")))
 
+(defun gnus-set-window-start (&optional point)
+  "Set the window start to POINT, or (point) if nil."
+  (let ((win (get-buffer-window (current-buffer) t)))
+    (when win
+      (set-window-start win (or point (point))))))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here