X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-start.el;h=52a53a7be35638550a4579a8d52aa9a10bf99bd6;hp=cfedeb16a4b9d6bc9a167790c070e8e256e129d2;hb=HEAD;hpb=16b9dfbbeff811d8e55e60005d91e350103702a3 diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index cfedeb16a..52a53a7be 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -1,6 +1,6 @@ ;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996-2012 Free Software Foundation, Inc. +;; Copyright (C) 1996-2016 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -30,6 +30,7 @@ (require 'gnus-spec) (require 'gnus-range) (require 'gnus-util) +(ignore-errors (require 'gnus-cloud)) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent") @@ -110,7 +111,7 @@ ask the servers (primary, secondary, and archive servers) to list new groups since the last time it checked: 1. This variable is `ask-server'. 2. This variable is a list of select methods (see below). - 3. `gnus-read-active-file' is nil or `some'. + 3. Option `gnus-read-active-file' is nil or `some'. 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively. Thus, if this variable is `ask-server' or a list of select methods or @@ -121,9 +122,9 @@ This variable can be a list of select methods which Gnus will query with the `ask-server' method in addition to the primary, secondary, and archive servers. -Eg. +E.g.: (setq gnus-check-new-newsgroups - '((nntp \"some.server\") (nntp \"other.server\"))) + \\='((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to check for new newsgroups with \\\\[gnus-find-new-newsgroups]." @@ -291,7 +292,9 @@ claim them." function (repeat function))) -(defcustom gnus-subscribe-newsgroup-hooks nil +(define-obsolete-variable-alias 'gnus-subscribe-newsgroup-hooks + 'gnus-subscribe-newsgroup-functions "24.3") +(defcustom gnus-subscribe-newsgroup-functions nil "*Hooks run after you subscribe to a new group. The hooks will be called with new group's name as argument." :version "22.1" @@ -393,7 +396,16 @@ This hook is called after Gnus is connected to the NNTP server." (defcustom gnus-before-startup-hook nil "A hook called before startup. -This hook is called as the first thing when Gnus is started." +This hook is called as the first thing when Gnus is started. +See also `gnus-before-resume-hook'." + :group 'gnus-start + :type 'hook) + +(defcustom gnus-before-resume-hook nil + "A hook called before resuming Gnus after suspend. +This hook is called as the first thing when Gnus is resumed after a suspend. +See also `gnus-before-startup-hook'." + :version "24.4" :group 'gnus-start :type 'hook) @@ -639,7 +651,7 @@ the first newsgroup." gnus-level-killed (gnus-group-entry (or next "dummy.group"))) (gnus-request-update-group-status newsgroup 'subscribe) (gnus-message 5 "Subscribe newsgroup: %s" newsgroup) - (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup) + (run-hook-with-args 'gnus-subscribe-newsgroup-functions newsgroup) t)) (defun gnus-read-active-file-p () @@ -747,6 +759,7 @@ prompt the user for the name of an NNTP server to use." (if (gnus-alive-p) (progn + (gnus-run-hooks 'gnus-before-resume-hook) (switch-to-buffer gnus-group-buffer) (gnus-group-get-new-news (and (numberp arg) @@ -763,8 +776,8 @@ prompt the user for the name of an NNTP server to use." ;; Add "native" to gnus-predefined-server-alist just to have a ;; name for the native select method. (when gnus-select-method - (push (cons "native" gnus-select-method) - gnus-predefined-server-alist)) + (add-to-list 'gnus-predefined-server-alist + (cons "native" gnus-select-method))) (if gnus-agent (gnus-agentize)) @@ -876,6 +889,11 @@ If REGEXP is given, lines that match it will be deleted." (setq buffer-save-without-query t) (erase-buffer) (setq buffer-file-name dribble-file) + ;; The buffer may be shrunk a lot when deleting old entries. + ;; It caused the auto-saving to stop. + (if (featurep 'emacs) + (set (make-local-variable 'auto-save-include-big-deletions) t) + (set (make-local-variable 'disable-auto-save-when-buffer-shrinks) nil)) (auto-save-mode t) (buffer-disable-undo) (bury-buffer (current-buffer)) @@ -932,7 +950,8 @@ If REGEXP is given, lines that match it will be deleted." (when (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer)) (with-current-buffer gnus-dribble-buffer - (save-buffer)))) + (when (> (buffer-size) 0) + (save-buffer))))) (defun gnus-dribble-clear () (when (gnus-buffer-exists-p gnus-dribble-buffer) @@ -1369,11 +1388,6 @@ for new groups, and subscribe the new groups as zombies." (funcall gnus-group-change-level-function group level oldlevel previous))))) -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-group-entry newsgroup) gnus-level-killed)) - (defun gnus-check-bogus-newsgroups (&optional confirm) "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every @@ -1453,7 +1467,7 @@ newsgroup." "Check whether a group has been activated or not. If SCAN, request a scan of that group as well. If METHOD, use that select method instead of determining the method based on the -group name. If DONT-CHECK, don't check check whether the group +group name. If DONT-CHECK, don't check whether the group actually exists. If DONT-SUB-CHECK or DONT-CHECK, don't let the backend check whether the group actually exists." (let ((method (or method (inline (gnus-find-method-for-group group)))) @@ -1504,8 +1518,6 @@ backend check whether the group actually exists." ;; Return the new active info. active))))) -(defvar gnus-propagate-marks) ; gnus-sum - (defun gnus-get-unread-articles-in-group (info active &optional update) (when (and info active) ;; Allow the backend to update the info in the group. @@ -1515,13 +1527,6 @@ backend check whether the group actually exists." (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) - ;; Allow backends to update marks, - (when gnus-propagate-marks - (let ((method (inline (gnus-find-method-for-group - (gnus-info-group info))))) - (when (gnus-check-backend-function 'request-marks (car method)) - (gnus-request-marks info method)))) - (let* ((range (gnus-info-read info)) (num 0)) @@ -1809,6 +1814,9 @@ backend check whether the group actually exists." (or (not (gnus-agent-method-p method)) (gnus-online method))) (gnus-finish-retrieve-group-infos method infos early-data) + ;; We may have altered the data now, so mark the dribble buffer + ;; as dirty so that it gets saved. + (gnus-dribble-touch) (gnus-agent-save-active method)) ;; Most backends have -retrieve-groups. ((gnus-check-backend-function 'retrieve-groups (car method)) @@ -2230,7 +2238,7 @@ backend check whether the group actually exists." (gnus-online method) (gnus-agent-method-p method)) (progn - (gnus-agent-save-active method) + (gnus-agent-save-active method t) (gnus-active-to-gnus-format method hashtb nil real-active)) (goto-char (point-min)) @@ -2306,16 +2314,9 @@ If FORCE is non-nil, the .newsrc file is read." (gnus-convert-old-newsrc) (gnus-clean-old-newsrc)))) -(defun gnus-clean-old-newsrc () - (when gnus-newsrc-file-version - (when (< (gnus-continuum-version gnus-newsrc-file-version) - (gnus-continuum-version "Ma Gnus v0.02")) - ;; Remove old `exist' marks from old nnimap groups. - (dolist (info (cdr gnus-newsrc-alist)) - (let ((exist (assoc 'exist (gnus-info-marks info)))) - (when exist - (gnus-info-set-marks - info (delete exist (gnus-info-marks info))))))))) +(defun gnus-clean-old-newsrc (&optional force) + ;; Currently no cleanups. + ) (defun gnus-convert-old-newsrc () "Convert old newsrc formats into the current format, if needed." @@ -2368,7 +2369,7 @@ If FORCE is non-nil, the .newsrc file is read." (while (let (c (cursor-in-echo-area t) (echo-keystrokes 0)) - (message "Convert gnus from version '%s' to '%s'? (n/y/?)" + (message "Convert gnus from version `%s' to `%s'? (n/y/?)" gnus-newsrc-file-version gnus-version) (setq c (read-char-exclusive)) @@ -2389,8 +2390,8 @@ If FORCE is non-nil, the .newsrc file is read." (funcall func convert-to))) (gnus-dribble-enter - (format ";Converted gnus from version '%s' to '%s'." - gnus-newsrc-file-version gnus-version))))))) + (gnus-format-message ";Converted gnus from version `%s' to `%s'." + gnus-newsrc-file-version gnus-version))))))) (defun gnus-convert-mark-converter-prompt (converter no-prompt) "Indicate whether CONVERTER requires gnus-convert-old-newsrc to @@ -2454,7 +2455,9 @@ If FORCE is non-nil, the .newsrc file is read." (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (dolist (elem gnus-newsrc-alist) - (setcar elem (mm-string-as-unibyte (car elem)))) + ;; Protect against broken .newsrc.el files. + (when (car elem) + (setcar elem (mm-string-as-unibyte (car elem))))) (gnus-make-hashtable-from-newsrc-alist) (when (file-newer-than-file-p file ding-file) ;; Old format quick file @@ -2780,6 +2783,7 @@ If FORCE is non-nil, the .newsrc file is read." 'msdos-long-file-names (lambda () t)))) +(defvar gnus-save-newsrc-file-last-timestamp nil) (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed @@ -2818,12 +2822,29 @@ If FORCE is non-nil, the .newsrc file is read." (erase-buffer) (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) + ;; check timestamp of `gnus-current-startup-file'.eld against + ;; `gnus-save-newsrc-file-last-timestamp' + (let* ((checkfile (concat gnus-current-startup-file ".eld")) + (mtime (nth 5 (file-attributes checkfile)))) + (when (and gnus-save-newsrc-file-last-timestamp + (time-less-p gnus-save-newsrc-file-last-timestamp + mtime)) + (unless (y-or-n-p + (format "%s was updated externally after %s, save?" + checkfile + (format-time-string + "%c" + gnus-save-newsrc-file-last-timestamp))) + (error "Couldn't save %s: updated externally" checkfile)))) + (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)) + (save-buffer) + (setq gnus-save-newsrc-file-last-timestamp + (nth 5 (file-attributes buffer-file-name)))) (let ((coding-system-for-write gnus-ding-file-coding-system) (version-control gnus-backup-startup-file) (startup-file (concat gnus-current-startup-file ".eld")) @@ -2858,7 +2879,9 @@ If FORCE is non-nil, the .newsrc file is read." ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (gnus-set-file-modes startup-file setmodes))) + (gnus-set-file-modes startup-file setmodes) + (setq gnus-save-newsrc-file-last-timestamp + (nth 5 (file-attributes startup-file))))) (condition-case nil (delete-file working-file) (file-error nil)))))