* gnus-start.el (): Added defvar statements to resolve compilation
authorKevin Greiner <kevin.greiner@compsol.cc>
Mon, 3 Mar 2003 01:11:34 +0000 (01:11 +0000)
committerKevin Greiner <kevin.greiner@compsol.cc>
Mon, 3 Mar 2003 01:11:34 +0000 (01:11 +0000)
warnings.
(gnus-long-file-names): New function. Isolates platform dependent
msdos-long-file-names.
(gnus-save-startup-file-via-temp-buffer): New variable. Provides
option of writing directly to file.  Avoids memory exhausted
errors when .newsrc.eld is huge.
(gnus-save-newsrc-file): Uses new
gnus-save-startup-file-via-temp-buffer.
(gnus-gnus-to-quick-newsrc-format): Rewritten to write to
standard-output.
(gnus-display-time-event-handler): Changed to alias from a defun
to avoid a compile-time warning when display-time-event-handler is
not defined.

lisp/gnus-start.el

index c1d9022..71b1dae 100644 (file)
@@ -50,6 +50,15 @@ variable."
                 (const :tag "If existing" nil)
                 (other :tag "Always" t)))
 
+(defcustom gnus-save-startup-file-via-temp-buffer t
+  "Whether to write the startup file contents to a buffer then save
+the buffer or write directly to the file.  The buffer is faster
+because all of the contents are written at once.  The direct write
+uses considerably less memory."
+  :group 'gnus-start
+  :type '(choice (const :tag "Write via buffer" t)
+                 (const :tag "Write directly to file" nil)))
+
 (defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
   "Your Gnus Emacs-Lisp startup file name.
 If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
@@ -602,16 +611,21 @@ the first newsgroup."
 ;;; General various misc type functions.
 
 ;; Silence byte-compiler.
-(defvar gnus-current-headers)
-(defvar gnus-thread-indent-array)
-(defvar gnus-newsgroup-name)
-(defvar gnus-newsgroup-headers)
-(defvar gnus-group-list-mode)
-(defvar gnus-group-mark-positions)
-(defvar gnus-newsgroup-data)
-(defvar gnus-newsgroup-unreads)
-(defvar nnoo-state-alist)
-(defvar gnus-current-select-method)
+(eval-when-compile
+  (defvar gnus-current-headers)
+  (defvar gnus-thread-indent-array)
+  (defvar gnus-newsgroup-name)
+  (defvar gnus-newsgroup-headers)
+  (defvar gnus-group-list-mode)
+  (defvar gnus-group-mark-positions)
+  (defvar gnus-newsgroup-data)
+  (defvar gnus-newsgroup-unreads)
+  (defvar nnoo-state-alist)
+  (defvar gnus-current-select-method)
+  (defvar mail-sources)
+  (defvar nnmail-scan-directory-mail-source-once)
+  (defvar nnmail-split-history)
+  (defvar nnmail-spool-file))
 
 (defun gnus-close-all-servers ()
   "Close all servers."
@@ -1461,7 +1475,7 @@ newsgroup."
           t)
         (if (or debug-on-error debug-on-quit)
             (inline (gnus-request-group group dont-check method))
-          (condition-case ()
+          (condition-case nil
               (inline (gnus-request-group group dont-check method))
             ;;(error nil)
             (quit
@@ -2524,6 +2538,12 @@ If FORCE is non-nil, the .newsrc file is read."
 
       (setq gnus-newsrc-options-n out))))
 
+(eval-and-compile
+  (defalias 'gnus-long-file-names
+    (if (fboundp 'msdos-long-file-names)
+      'msdos-long-file-names
+      (lambda () t))))
+
 (defun gnus-save-newsrc-file (&optional force)
   "Save .newsrc file."
   ;; Note: We cannot save .newsrc file if all newsgroups are removed
@@ -2556,11 +2576,56 @@ If FORCE is non-nil, the .newsrc file is read."
          (setq default-directory (file-name-directory buffer-file-name))
          (buffer-disable-undo)
          (erase-buffer)
-         (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
-         (gnus-gnus-to-quick-newsrc-format)
-         (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
-         (let ((coding-system-for-write gnus-ding-file-coding-system))
-           (save-buffer))
+          (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+
+          (if gnus-save-startup-file-via-temp-buffer
+              (let ((coding-system-for-write gnus-ding-file-coding-system)
+                    (standard-output (current-buffer)))
+                (gnus-gnus-to-quick-newsrc-format)
+                (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
+                (save-buffer))
+            (let ((coding-system-for-write gnus-ding-file-coding-system)
+                  (version-control gnus-backup-startup-file)
+                  (startup-file (concat gnus-current-startup-file ".eld"))
+                  (working-dir (file-name-directory gnus-current-startup-file))
+                  working-file
+                  (i -1))
+              ;; Generate the name of a non-existent file.
+              (while (progn (setq working-file
+                                  (format
+                                   (if (and (eq system-type 'ms-dos)
+                                            (not (gnus-long-file-names)))
+                                       "%s#%d.tm#" ; MSDOS limits files to 8+3
+                                     (if (memq system-type '(vax-vms axp-vms))
+                                         "%s$tmp$%d"
+                                       "%s#tmp#%d"))
+                                   working-dir (setq i (1+ i))))
+                            (file-exists-p working-file)))
+
+              (unwind-protect
+                  (progn
+                    (gnus-with-output-to-file
+                     working-file
+                     (gnus-gnus-to-quick-newsrc-format)
+                     (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
+
+                    ;; These bindings will mislead the current buffer
+                    ;; into thinking that it is visiting the startup
+                    ;; file.
+                    (let ((buffer-backed-up nil)
+                          (buffer-file-name startup-file)
+                          (file-precious-flag t)
+                          (setmodes (file-modes startup-file)))
+                      ;; Backup the current version of the startup file.
+                      (backup-buffer)
+
+                      ;; Replace the existing startup file with the temp file.
+                      (rename-file working-file startup-file t)
+                      (set-file-modes startup-file setmodes)))
+                (condition-case nil
+                    (delete-file working-file)
+                  (file-error nil)))))
+
          (gnus-kill-buffer (current-buffer))
          (gnus-message
           5 "Saving %s.eld...done" gnus-current-startup-file))
@@ -2568,17 +2633,15 @@ If FORCE is non-nil, the .newsrc file is read."
        (gnus-group-set-mode-line)))))
 
 (defun gnus-gnus-to-quick-newsrc-format ()
-  "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
-  (let ((print-quoted t)
-       (print-escape-newlines t))
-
-    (insert ";; -*- emacs-lisp -*-\n")
-    (insert ";; Gnus startup file.\n")
-    (insert "\
+  "Print Gnus variables such as gnus-newsrc-alist in lisp format."
+    (princ ";; -*- emacs-lisp -*-\n")
+    (princ ";; Gnus startup file.\n")
+    (princ "\
 ;; Never delete this file -- if you want to force Gnus to read the
 ;; .newsrc file (if you have one), touch .newsrc instead.\n")
-    (insert "(setq gnus-newsrc-file-version "
-           (gnus-prin1-to-string gnus-version) ")\n")
+    (princ "(setq gnus-newsrc-file-version ")
+    (princ (gnus-prin1-to-string gnus-version))
+    (princ ")\n")
     (let* ((gnus-killed-list
            (if (and gnus-save-killed-list
                     (stringp gnus-save-killed-list))
@@ -2596,9 +2659,11 @@ If FORCE is non-nil, the .newsrc file is read."
       (while variables
        (when (and (boundp (setq variable (pop variables)))
                   (symbol-value variable))
-         (insert "(setq " (symbol-name variable) " '")
-         (gnus-prin1 (symbol-value variable))
-         (insert ")\n"))))))
+         (princ "(setq ")
+          (princ (symbol-name variable))
+          (princ " '")
+         (prin1 (symbol-value variable))
+         (princ ")\n")))))
 
 (defun gnus-strip-killed-list ()
   "Return the killed list minus the groups that match `gnus-save-killed-list'."
@@ -2846,10 +2911,12 @@ If this variable is nil, don't do anything."
            (file-name-as-directory (expand-file-name gnus-default-directory))
          default-directory)))
 
-(defun gnus-display-time-event-handler ()
-  "Like `display-time-event-handler', but test `display-time-timer'."
-  (when (gnus-boundp 'display-time-timer)
-    (display-time-event-handler)))
+(eval-and-compile
+(defalias 'gnus-display-time-event-handler 
+  (if (gnus-boundp 'display-time-timer)
+      'display-time-event-handler
+    (lambda () "Does nothing as `display-time-timer' is not bound.
+Would otherwise be an alias for `display-time-event-handler'." nil))))
 
 ;;;###autoload
 (defun gnus-fixup-nnimap-unread-after-getting-new-news ()