X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=65b6241c97b4eb246eaa7643bd5df1b0f4c582db;hb=2ce164f1d823f9de944ff2a5822d0f00251b1c79;hp=2a93dd4f642ec9630fc3cb694dc2ea8991fe9f97;hpb=7459b8dbc025d8f86c97389ecec4522a7e38fdf5;p=gnus diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 2a93dd4f6..65b6241c9 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,5 +1,5 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -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") @@ -41,6 +41,24 @@ :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." @@ -303,7 +321,7 @@ hierarchy in its entirety." :type 'boolean) (defcustom gnus-auto-subscribed-groups - "nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" + "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir" "*All new groups that match this regexp will be subscribed automatically. Note that this variable only deals with new groups. It has no effect whatsoever on old groups. @@ -363,22 +381,34 @@ This hook is called as the first thing when Gnus is started." :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook nil +(defcustom gnus-setup-news-hook + '(gnus-fixup-nnimap-unread-after-getting-new-news) "A hook after reading the .newsrc file, but before generating the buffer." :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 :type 'hook) (defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler) + '(gnus-display-time-event-handler + gnus-fixup-nnimap-unread-after-getting-new-news) "*A hook run after Gnus checks for new news when Gnus is already running." :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 @@ -396,16 +426,22 @@ Can be used to turn version control on or off." :group 'gnus-newsrc :type 'hook) +(defcustom gnus-group-mode-hook nil + "Hook for Gnus group mode." + :group 'gnus-group-various + :options '(gnus-topic-mode) + :type 'hook) + (defcustom gnus-always-read-dribble-file nil "Unconditionally read the dribble file." :group 'gnus-newsrc :type 'boolean) -(defvar gnus-startup-file-coding-system 'binary - "*Coding system for startup file.") - ;;; Internal variables +(defvar gnus-ding-file-coding-system mm-universal-coding-system + "Coding system for ding file.") + (defvar gnus-newsrc-file-version nil) (defvar gnus-override-subscribe-method nil) (defvar gnus-dribble-buffer nil) @@ -432,21 +468,15 @@ Can be used to turn version control on or off." (if gnus-init-inhibit (setq gnus-init-inhibit nil) (setq gnus-init-inhibit inhibit-next) - (let ((files (list gnus-site-init-file gnus-init-file)) - file) - (while files - (and (setq file (pop files)) - (or (and (file-exists-p file) - ;; Don't try to load a directory. - (not (file-directory-p file))) - (file-exists-p (concat file ".el")) - (file-exists-p (concat file ".elc"))) - (condition-case var - (let ((coding-system-for-read - gnus-startup-file-coding-system)) - (load file nil t)) - (error - (error "Error in %s: %s" file var))))))))) + (dolist (file (list gnus-site-init-file gnus-init-file)) + (when (and file + (locate-library file)) + (if (or debug-on-error debug-on-quit) + (load file nil t) + (condition-case var + (load file nil t) + (error + (error "Error in %s: %s" file (cadr var)))))))))) ;; For subscribing new newsgroup @@ -591,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." @@ -611,7 +646,7 @@ the first newsgroup." (defun gnus-clear-system () "Clear all variables and buffers." ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -652,9 +687,8 @@ the first newsgroup." (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. - (let ((buffers (gnus-buffers))) - (when buffers - (mapcar 'kill-buffer buffers))) + (dolist (buffer (gnus-buffers)) + (gnus-kill-buffer buffer)) ;; Remove Gnus frames. (gnus-kill-gnus-frames)) @@ -692,6 +726,8 @@ prompt the user for the name of an NNTP server to use." (nnheader-init-server-buffer) (setq gnus-slave slave) (gnus-read-init-file) + (if gnus-agent + (gnus-agentize)) (when gnus-simple-splash (setq gnus-simple-splash nil) @@ -729,6 +765,9 @@ prompt the user for the name of an NNTP server to use." (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) ;; Do the actual startup. + (if gnus-agent + (gnus-request-create-group "queue" '(nndraft ""))) + (gnus-request-create-group "drafts" '(nndraft "")) (gnus-setup-news nil level dont-connect) (gnus-run-hooks 'gnus-setup-news-hook) (gnus-start-draft-setup) @@ -748,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)))) - ;;; ;;; Dribble file @@ -785,7 +813,11 @@ cautiously -- unloading may cause trouble." (set-buffer gnus-dribble-buffer) (goto-char (point-max)) (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) + ;; This has been commented by Josh Huber + ;; It causes problems with both XEmacs and Emacs 21, and doesn't + ;; seem to be of much value. (FIXME: remove this after we make sure + ;; it's not needed). + ;; (set-window-point (get-buffer-window (current-buffer)) (point-max)) (bury-buffer gnus-dribble-buffer) (save-excursion (set-buffer gnus-group-buffer) @@ -897,10 +929,17 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." ;; Make sure the archive server is available to all and sundry. (when gnus-message-archive-method - (setq gnus-server-alist (delq (assoc "archive" gnus-server-alist) - gnus-server-alist)) - (push (cons "archive" gnus-message-archive-method) - gnus-server-alist)) + (unless (assoc "archive" gnus-server-alist) + (push `("archive" + nnfolder + "archive" + (nnfolder-directory + ,(nnheader-concat message-directory "archive")) + (nnfolder-active-file + ,(nnheader-concat message-directory "archive/active")) + (nnfolder-get-new-mail nil) + (nnfolder-inhibit-expiry t)) + gnus-server-alist))) ;; If we don't read the complete active file, we fill in the ;; hashtb here. @@ -1158,10 +1197,8 @@ for new groups, and subscribe the new groups as zombies." (catch 'ended ;; First check if any of the following files exist. If they do, ;; it's not the first time the user has used Gnus. - (dolist (file (list gnus-current-startup-file - (concat gnus-current-startup-file ".el") + (dolist (file (list (concat gnus-current-startup-file ".el") (concat gnus-current-startup-file ".eld") - gnus-startup-file (concat gnus-startup-file ".el") (concat gnus-startup-file ".eld"))) (when (file-exists-p file) @@ -1198,7 +1235,9 @@ for new groups, and subscribe the new groups as zombies." group gnus-level-default-subscribed gnus-level-killed))) (save-excursion (set-buffer gnus-group-buffer) - (gnus-group-make-help-group)) + ;; Don't error if the group already exists. This happens when a + ;; first-time user types 'F'. -- didier + (gnus-group-make-help-group t)) (when gnus-novice-user (gnus-message 7 "`A k' to list killed groups")))))) @@ -1361,7 +1400,7 @@ newsgroup." group (gnus-info-group info)) (unless (or (gnus-active group) ; Active (and (gnus-info-method info) - (not (gnus-secondary-method-p + (not (gnus-secondary-method-p (gnus-info-method info))))) ; Foreign ;; Found a bogus newsgroup. (push group bogus))) @@ -1433,24 +1472,27 @@ newsgroup." (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan group method)) t) - (condition-case () + (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - ;;(error nil) - (quit - (message "Quit activating %s" group) - nil)) - (setq active (gnus-parse-active)) - ;; If there are no articles in the group, the GROUP - ;; command may have responded with the `(0 . 0)'. We - ;; ignore this if we already have an active entry - ;; for the group. - (if (and (zerop (car active)) - (zerop (cdr active)) - (gnus-active group)) - (gnus-active group) - (gnus-set-active group active) - ;; Return the new active info. - active)))) + (condition-case nil + (inline (gnus-request-group group dont-check method)) + ;;(error nil) + (quit + (message "Quit activating %s" group) + nil))) + (unless dont-check + (setq active (gnus-parse-active)) + ;; If there are no articles in the group, the GROUP + ;; command may have responded with the `(0 . 0)'. We + ;; ignore this if we already have an active entry + ;; for the group. + (if (and (zerop (car active)) + (zerop (cdr active)) + (gnus-active group)) + (gnus-active group) + (gnus-set-active group active) + ;; Return the new active info. + active))))) (defun gnus-get-unread-articles-in-group (info active &optional update) (when active @@ -1533,13 +1575,15 @@ 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))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. (defun gnus-get-unread-articles (&optional level) + (setq gnus-server-method-cache nil) (let* ((newsrc (cdr gnus-newsrc-alist)) (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level @@ -1552,7 +1596,7 @@ newsgroup." (t 0)) level)) scanned-methods info group active method retrieve-groups) - (gnus-message 5 "Checking new news...") + (gnus-message 6 "Checking new news...") (while newsrc (setq active (gnus-active (setq group (gnus-info-group @@ -1578,9 +1622,9 @@ newsgroup." (not (gnus-secondary-method-p method))) ;; These groups are foreign. Check the level. (when (and (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan))) + (setq active (gnus-activate-group group 'scan))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent gnus-plugged active) + (when (and gnus-agent active (gnus-online method)) (gnus-agent-save-group-info method (gnus-group-real-name group) active)) (unless (inline (gnus-virtual-group-p group)) @@ -1619,8 +1663,8 @@ newsgroup." (setq active (gnus-activate-group group)) (setq active (gnus-activate-group group 'scan)) (push method scanned-methods)) - (when active - (gnus-close-group group)))))) + (when active + (gnus-close-group group)))))) ;; Get the number of unread articles in the group. (cond @@ -1643,24 +1687,24 @@ newsgroup." (let ((method (or (car rg) gnus-select-method)) (groups (cdr rg))) (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (gnus-read-active-file-2 + ;; Request that the backend scan its incoming messages. + (when (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan nil method)) + (gnus-read-active-file-2 (mapcar (lambda (group) (gnus-group-real-name group)) groups) method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) - - (gnus-message 5 "Checking new news...done"))) + (dolist (group groups) + (cond + ((setq active (gnus-active (gnus-info-group + (setq info (gnus-get-info group))))) + (inline (gnus-get-unread-articles-in-group info active t))) + (t + ;; The group couldn't be reached, so we nix out the number of + ;; unread articles and stuff. + (gnus-set-active group nil) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t))))))) + + (gnus-message 6 "Checking new news...done"))) ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. @@ -1720,8 +1764,82 @@ newsgroup." (setq article (pop articles)) ranges) (push article news))) (when news + ;; Enter this list into the group info. (gnus-info-set-read info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) + + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group info (gnus-active group)) + + ;; Insert the change into the group buffer and the dribble file. + (gnus-group-update-group group t)))) + +(defun gnus-make-ascending-articles-unread (group articles) + "Mark ascending ARTICLES in GROUP as unread." + (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb) + (gnus-gethash (gnus-group-real-name group) + gnus-newsrc-hashtb))) + (info (nth 2 entry)) + (ranges (gnus-info-read info)) + (r ranges) + modified) + + (while articles + (let ((article (pop articles))) ; get the next article to remove from ranges + (while (let ((range (car ranges))) ; note the current range + (if (atom range) ; single value range + (cond ((not range) + ;; the articles extend past the end of the ranges + ;; OK - I'm done + (setq articles nil)) + ((< range article) + ;; this range preceeds the article. Leave the range unmodified. + (pop ranges) + ranges) + ((= range article) + ;; this range exactly matches the article; REMOVE THE RANGE. + ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end. + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges)) + (setq modified (if (car ranges) t 'remove-null)) + nil)) + (let ((min (car range)) + (max (cdr range))) + ;; I have a min/max range to consider + (cond ((> min max) ; invalid range introduced by splitter + (setcar ranges (cadr ranges)) + (setcdr ranges (cddr ranges)) + (setq modified (if (car ranges) t 'remove-null)) + ranges) + ((= min max) + ;; replace min/max range with a single-value range + (setcar ranges min) + ranges) + ((< max article) + ;; this range preceeds the article. Leave the range unmodified. + (pop ranges) + ranges) + ((< article min) + ;; this article preceeds the range. Return null to move to the + ;; next article + nil) + (t + ;; this article splits the range into two parts + (setcdr ranges (cons (cons (1+ article) max) (cdr ranges))) + (setcdr range (1- article)) + (setq modified t) + ranges)))))))) + + (when modified + (when (eq modified 'remove-null) + (setq r (delq nil r))) + ;; Enter this list into the group info. + (gnus-info-set-read info r) + + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (gnus-get-unread-articles-in-group info (gnus-active group)) + + ;; Insert the change into the group buffer and the dribble file. (gnus-group-update-group group t)))) ;; Enter all dead groups into the hashtb. @@ -1787,13 +1905,15 @@ newsgroup." ;; Only do each method once, in case the methods appear more ;; than once in this list. (unless (member method methods) - (condition-case () + (if (or debug-on-error debug-on-quit) (gnus-read-active-file-1 method force) - ;; We catch C-g so that we can continue past servers - ;; that do not respond. - (quit - (message "Quit reading the active file") - nil))))))) + (condition-case () + (gnus-read-active-file-1 method force) + ;; We catch C-g so that we can continue past servers + ;; that do not respond. + (quit + (message "Quit reading the active file") + nil)))))))) (defun gnus-read-active-file-1 (method force) (let (where mesg) @@ -1885,7 +2005,7 @@ newsgroup." (insert ?\\))) ;; Let the Gnus agent save the active file. - (when (and gnus-agent real-active gnus-plugged) + (when (and gnus-agent real-active (gnus-online method)) (gnus-agent-save-active method)) ;; If these are groups from a foreign select method, we insert the @@ -1905,7 +2025,7 @@ newsgroup." (goto-char (point-min)) (let (group max min) (while (not (eobp)) - (condition-case err + (condition-case () (progn (narrow-to-region (point) (gnus-point-at-eol)) ;; group gets set to a symbol interned in the hash table @@ -1961,7 +2081,7 @@ newsgroup." ;; Let the Gnus agent save the active file. (if (and gnus-agent real-active - gnus-plugged + (gnus-online method) (gnus-agent-method-p method)) (progn (gnus-agent-save-groups method) @@ -2002,7 +2122,7 @@ newsgroup." "Read startup file. If FORCE is non-nil, the .newsrc file is read." ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) + (let ((variables (remove 'gnus-format-specs gnus-variable-list))) (while variables (set (car variables) nil) (setq variables (cdr variables)))) @@ -2065,36 +2185,48 @@ If FORCE is non-nil, the .newsrc file is read." (nconc (gnus-uncompress-range dormant) (gnus-uncompress-range ticked))))))))) +(defun gnus-load (file) + "Load FILE, but in such a way that read errors can be reported." + (with-temp-buffer + (insert-file-contents file) + (while (not (eobp)) + (condition-case type + (let ((form (read (current-buffer)))) + (eval form)) + (error + (unless (eq (car type) 'end-of-file) + (let ((error (format "Error in %s line %d" file + (count-lines (point-min) (point))))) + (ding) + (unless (gnus-yes-or-no-p (concat error "; continue? ")) + (error "%s" error))))))))) + (defun gnus-read-newsrc-el-file (file) (let ((ding-file (concat file "d"))) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (condition-case nil - (let ((coding-system-for-read gnus-startup-file-coding-system)) - (load ding-file t t t)) - (error - (ding) - (unless (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file)))) - ;; Older versions of `gnus-format-specs' are no longer valid - ;; in Oort Gnus 0.01. - (let ((version - (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (when (or (not version) - (< version 5.090002)) - (setq gnus-format-specs nil))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) + (when (file-exists-p ding-file) + ;; We always, always read the .eld file. + (gnus-message 5 "Reading %s..." ding-file) + (let (gnus-newsrc-assoc) + (let ((coding-system-for-read gnus-ding-file-coding-system)) + (gnus-load ding-file)) + ;; Older versions of `gnus-format-specs' are no longer valid + ;; in Oort Gnus 0.01. + (let ((version + (and gnus-newsrc-file-version + (gnus-continuum-version gnus-newsrc-file-version)))) + (when (or (not version) + (< version 5.090009)) + (setq gnus-format-specs gnus-default-format-specs))) + (when gnus-newsrc-assoc + (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file (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) @@ -2406,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 @@ -2432,36 +2570,85 @@ 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-startup-file-coding-system)) - (save-buffer)) - (kill-buffer (current-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)) (gnus-dribble-delete-file) (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 " - (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) @@ -2478,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'." @@ -2564,10 +2753,10 @@ If FORCE is non-nil, the .newsrc file is read." (save-excursion (set-buffer gnus-dribble-buffer) (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) + (mm-make-temp-file (concat gnus-current-startup-file "-slave-"))) (modes (ignore-errors (file-modes (concat gnus-current-startup-file ".eld"))))) - (let ((coding-system-for-write gnus-startup-file-coding-system)) + (let ((coding-system-for-write gnus-ding-file-coding-system)) (gnus-write-buffer slave-name)) (when modes (set-file-modes slave-name modes))))) @@ -2693,7 +2882,9 @@ If FORCE is non-nil, the .newsrc file is read." (name (symbol-name group)) (charset (or (gnus-group-name-charset method name) - (gnus-parameter-charset 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))) @@ -2727,11 +2918,30 @@ 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 () + (let (server group info) + (mapatoms + (lambda (sym) + (when (and (setq group (symbol-name sym)) + (gnus-group-entry group) + (setq info (symbol-value sym))) + (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) + gnus-newsrc-hashtb))) + (if (boundp 'nnimap-mailbox-info) + (symbol-value 'nnimap-mailbox-info) + (make-vector 1 0))))) + (provide 'gnus-start) ;;; gnus-start.el ends here + +