(message-make-date): Autoload rather than
[gnus] / lisp / gnus-start.el
index 0d3e7b0..65b6241 100644 (file)
@@ -32,7 +32,7 @@
 (require 'gnus-spec)
 (require 'gnus-range)
 (require 'gnus-util)
-(require 'message)
+(autoload 'message-make-date "message")
 (eval-when-compile (require 'cl))
 
 (defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
   :group 'gnus-start
   :type 'file)
 
+(defcustom gnus-backup-startup-file 'never
+  "Whether to create backup files.
+This variable takes the same values as the `version-control'
+variable."
+  :group 'gnus-start
+  :type '(choice (const :tag "Never" never)
+                (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."
@@ -369,6 +387,11 @@ This hook is called as the first thing when Gnus is started."
   :group 'gnus-start
   :type 'hook)
 
+(defcustom gnus-get-top-new-news-hook nil
+  "A hook run just before Gnus checks for new news globally."
+  :group 'gnus-group-new
+  :type 'hook)
+
 (defcustom gnus-get-new-news-hook nil
   "A hook run just before Gnus checks for new news."
   :group 'gnus-group-new
@@ -381,6 +404,11 @@ This hook is called as the first thing when Gnus is started."
   :group 'gnus-group-new
   :type 'hook)
 
+(defcustom gnus-read-newsrc-el-hook nil
+  "A hook called after reading the newsrc.eld? file."
+  :group 'gnus-newsrc
+  :type 'hook)
+
 (defcustom gnus-save-newsrc-hook nil
   "A hook called before saving any of the newsrc files."
   :group 'gnus-newsrc
@@ -593,16 +621,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."
@@ -754,17 +787,6 @@ prompt the user for the name of an NNTP server to use."
     (gnus-group-set-parameter
      "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
 
-;;;###autoload
-(defun gnus-unload ()
-  "Unload all Gnus features.
-\(For some value of `all' or `Gnus'.)  Currently, features whose names
-have prefixes `gnus-', `nn', `mm-' or `rfc' are unloaded.  Use
-cautiously -- unloading may cause trouble."
-  (interactive)
-  (dolist (feature features)
-    (if (string-match "^\\(gnus-\\|nn\\|mm-\\|rfc\\)" (symbol-name feature))
-       (unload-feature feature 'force))))
-
 \f
 ;;;
 ;;; Dribble file
@@ -1452,7 +1474,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
@@ -1553,7 +1575,8 @@ newsgroup."
          (setq range (cdr range)))
        (setq num (max 0 (- (cdr active) num)))))
       ;; Set the number of unread articles.
-      (when info
+      (when (and info
+                (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
        (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
       num)))
 
@@ -2202,7 +2225,8 @@ If FORCE is non-nil, the .newsrc file is read."
       (gnus-message 5 "Reading %s..." file)
       ;; The .el file is newer than the .eld file, so we read that one
       ;; as well.
-      (gnus-read-old-newsrc-el-file file))))
+      (gnus-read-old-newsrc-el-file file)))
+  (gnus-run-hooks 'gnus-read-newsrc-el-hook))
 
 ;; Parse the old-style quick startup file
 (defun gnus-read-old-newsrc-el-file (file)
@@ -2514,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
@@ -2540,17 +2570,61 @@ If FORCE is non-nil, the .newsrc file is read."
          ;; Save .newsrc.eld.
          (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
          (make-local-variable 'version-control)
-         (setq version-control 'never)
+         (setq version-control gnus-backup-startup-file)
          (setq buffer-file-name
                (concat gnus-current-startup-file ".eld"))
          (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))
@@ -2558,18 +2632,23 @@ 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")
-    (let* ((gnus-killed-list
+    (princ "(setq gnus-newsrc-file-version ")
+    (princ (gnus-prin1-to-string gnus-version))
+    (princ ")\n")
+    (let* ((print-quoted t)
+           (print-readably t)
+           (print-escape-multibyte nil)
+           (print-escape-nonascii t)
+           (print-length nil)
+           (print-level nil)
+           (print-escape-newlines t)
+          (gnus-killed-list
            (if (and gnus-save-killed-list
                     (stringp gnus-save-killed-list))
                (gnus-strip-killed-list)
@@ -2586,9 +2665,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'."
@@ -2803,6 +2884,7 @@ If FORCE is non-nil, the .newsrc file is read."
                      (or (gnus-group-name-charset method name)
                          (gnus-parameter-charset name)
                          gnus-default-charset)))
+               ;; Fixme: Don't decode in unibyte mode.
                (when (and str charset (featurep 'mule))
                  (setq str (mm-decode-coding-string str charset)))
                (set group str)))
@@ -2836,10 +2918,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 ()