gnus-msg: remove nastygram

[gnus] / lisp / gnus-int.el

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 2ca3205..bcfff34 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -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")
@@ -41,6 +42,16 @@
   :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
@@ -89,16 +100,13 @@ If CONFIRM is non-nil, the user will be asked for an NNTP server."
        ;; Stream is already opened.
        nil
       ;; Open NNTP server.
-      (unless gnus-nntp-service
-       (setq gnus-nntp-server nil))
       (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 +189,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 +294,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 +480,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 +489,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))))
 
@@ -494,6 +502,23 @@ If BUFFER, insert the article in that group."
             article (gnus-group-real-name group)
             (nth 1 gnus-command-method) buffer)))
 
+(defun gnus-request-thread (id)
+  "Request the headers in the thread containing the article
+specified by Message-ID id."
+  (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
+    (funcall (gnus-get-function gnus-command-method 'request-thread)
+            id)))
+
+(defun gnus-warp-to-article ()
+  "Warps from an article in a virtual group to the article in its
+real group. Does nothing on a real group."
+  (interactive)
+  (let ((gnus-command-method
+        (gnus-find-method-for-group gnus-newsgroup-name)))
+    (when (gnus-check-backend-function
+          'warp-to-article (car gnus-command-method))
+      (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+
 (defun gnus-request-head (article group)
   "Request the head of ARTICLE in GROUP."
   (let* ((gnus-command-method (gnus-find-method-for-group group))
@@ -639,7 +664,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
         (result (funcall (gnus-get-function gnus-command-method
                                             'request-move-article)
                          article (gnus-group-real-name group)
-                         (nth 1 gnus-command-method) accept-function last move-is-internal)))
+                         (nth 1 gnus-command-method) accept-function
+                         last move-is-internal)))
     (when (and result gnus-agent
               (gnus-agent-method-p gnus-command-method))
       (gnus-agent-unfetch-articles group (list article)))