* shr.el (shr-insert): Fix up the white space only regexp.
[gnus] / lisp / gnus-int.el
index 2ca3205..b210df4 100644 (file)
@@ -31,6 +31,7 @@
 (require 'message)
 (require 'gnus-range)
 
+(autoload 'gnus-run-hook-with-args "gnus-util")
 (autoload 'gnus-agent-expire "gnus-agent")
 (autoload 'gnus-agent-regenerate-group "gnus-agent")
 (autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
   :group 'gnus-start
   :type 'hook)
 
+(defcustom gnus-after-set-mark-hook nil
+  "Hook called just after marks are set in a group."
+  :group 'gnus-start
+  :type 'hook)
+
+(defcustom gnus-before-update-mark-hook nil
+  "Hook called just before marks are updated in a group."
+  :group 'gnus-start
+  :type 'hook)
+
 (defcustom gnus-server-unopen-status nil
   "The default status if the server is not able to open.
 If the server is covered by Gnus agent, the possible values are
@@ -94,11 +105,10 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
       (when confirm
        ;; Read server name with completion.
        (setq gnus-nntp-server
-             (completing-read "NNTP server: "
-                              (mapcar 'list
-                                      (cons (list gnus-nntp-server)
-                                            gnus-secondary-servers))
-                              nil nil gnus-nntp-server)))
+             (gnus-completing-read "NNTP server"
+                                    (cons gnus-nntp-server
+                                          gnus-secondary-servers)
+                                    nil gnus-nntp-server)))
 
       (when (and gnus-nntp-server
                 (stringp gnus-nntp-server)
@@ -181,10 +191,15 @@ If it is down, start it up (again)."
       (prog1
          (setq result (gnus-open-server method))
        (unless silent
-         (gnus-message 5 "Opening %s server%s...%s" (car method)
-                       (if (equal (nth 1 method) "") ""
-                         (format " on %s" (nth 1 method)))
-                       (if result "done" "failed")))))))
+         (gnus-message
+          (if result 5 3)
+          "Opening %s server%s...%s" (car method)
+          (if (equal (nth 1 method) "") ""
+            (format " on %s" (nth 1 method)))
+          (if result
+              "done"
+            (format "failed: %s"
+                    (nnheader-get-report-string (car method))))))))))
 
 (defun gnus-get-function (method function &optional noerror)
   "Return a function symbol based on METHOD and FUNCTION."
@@ -281,14 +296,7 @@ If it is down, start it up (again)."
                  ;; recurse to open the agent's backend.
                  (setq open-offline (eq gnus-server-unopen-status 'offline))
                  gnus-server-unopen-status)
-                ((and
-                  (not gnus-batch-mode)
-                  (gnus-y-or-n-p
-                   (format
-                    "Unable to open server %s (%s), go offline? "
-                    server
-                    (nnheader-get-report
-                     (car gnus-command-method)))))
+                ((not gnus-batch-mode)
                  (setq open-offline t)
                  'offline)
                 (t
@@ -474,7 +482,8 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
        action
       (funcall (gnus-get-function gnus-command-method 'request-set-mark)
               (gnus-group-real-name group) action
-              (nth 1 gnus-command-method)))))
+              (nth 1 gnus-command-method))
+      (gnus-run-hook-with-args gnus-after-set-mark-hook group action))))
 
 (defun gnus-request-update-mark (group article mark)
   "Allow the back end to change the mark the user tries to put on an article."
@@ -482,6 +491,7 @@ If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
     (if (not (gnus-check-backend-function
              'request-update-mark (car gnus-command-method)))
        mark
+      (gnus-run-hook-with-args gnus-before-update-mark-hook group article mark)
       (funcall (gnus-get-function gnus-command-method 'request-update-mark)
               (gnus-group-real-name group) article mark))))