* lisp/gnus-msg.el (gnus-inews-yank-articles): Make it to work with multiple
authoryamaoka <yamaoka>
Mon, 2 Apr 2001 05:14:54 +0000 (05:14 +0000)
committeryamaoka <yamaoka>
Mon, 2 Apr 2001 05:14:54 +0000 (05:14 +0000)
 articles even if there is a detached minibuffer frame on some window managers.

Synch with Oort Gnus.

ChangeLog
lisp/ChangeLog
lisp/gnus-group.el
lisp/gnus-msg.el
lisp/gnus-start.el
lisp/message.el

index ee20333..656a9af 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2001-04-02  Katsumi Yamaoka <yamaoka@jpl.org>
+
+       * lisp/gnus-msg.el (gnus-inews-yank-articles): Make it to work with
+       multiple articles even if there is a detached minibuffer frame on
+       some window managers.
+
 2001-03-21  Thierry Emery <thierry.emery@club-internet.fr>
 
        * lisp/mm-decode.el (mm-copy-to-buffer): Copy buffer in unibyte
index bc9fa3c..d2c846d 100644 (file)
@@ -1,3 +1,14 @@
+2001-04-02 00:40:12  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * message.el (message-check-news-header-syntax): Question even
+       when Gnus doesn't know the group names.
+       (message-send-news): Clean up.
+
+       * gnus-start.el (gnus-dribble-read-file): Say whether Gnus was
+       exited on purpose without saving.
+
+       * gnus-group.el (gnus-group-quit): Mark the dribble file as `Q'.
+
 2001-04-01 00:37:14  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * gnus-score.el (gnus-score-orphans): Clean up.
index e992da3..6a8d9bd 100644 (file)
@@ -3707,6 +3707,8 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
                     (file-name-nondirectory gnus-current-startup-file))))
     (gnus-run-hooks 'gnus-exit-gnus-hook)
     (gnus-configure-windows 'group t)
+    (gnus-dribble-enter
+     ";;; Gnus was exited on purpose without saving the .newsrc files.")
     (gnus-dribble-save)
     (gnus-close-backends)
     (gnus-clear-system)
index 0b2a392..a4fe65d 100644 (file)
@@ -433,25 +433,25 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (gnus-summary-followup (gnus-summary-work-articles arg) t))
 
 (defun gnus-inews-yank-articles (articles)
-  (let* ((more-than-one (cdr articles))
-        (frame (when (and message-use-multi-frames more-than-one)
-                 (window-frame (get-buffer-window (current-buffer)))))
-        refs beg article)
+  (let ((more-than-one (cdr articles))
+       (cur (current-buffer))
+       refs beg article window)
     (message-goto-body)
     (while (setq article (pop articles))
       (save-window-excursion
        (set-buffer gnus-summary-buffer)
        (gnus-summary-select-article nil nil nil article)
        (gnus-summary-remove-process-mark article))
-      (when frame
-       (select-frame frame))
 
       ;; Gathering references.
       (when more-than-one
        (setq refs (message-list-references
                    refs
                    (mail-header-references gnus-current-headers)
-                   (mail-header-message-id gnus-current-headers))))
+                   (mail-header-message-id gnus-current-headers)))
+       (when message-use-multi-frames
+         (when (setq window (get-buffer-window cur t))
+           (select-frame (window-frame window)))))
 
       (gnus-copy-article-buffer)
       (let ((message-reply-buffer gnus-article-copy)
index 06dbe70..4839e7d 100644 (file)
@@ -833,6 +833,7 @@ cautiously -- unloading may cause trouble."
       (set-buffer-modified-p nil)
       (let ((auto (make-auto-save-file-name))
            (gnus-dribble-ignore t)
+           (purpose nil)
            modes)
        (when (or (file-exists-p auto) (file-exists-p dribble-file))
          ;; Load whichever file is newest -- the auto save file
@@ -848,10 +849,15 @@ cautiously -- unloading may cause trouble."
                     (file-exists-p dribble-file)
                     (setq modes (file-modes gnus-current-startup-file)))
            (set-file-modes dribble-file modes))
+         (goto-char (point-min))
+         (when (search-forward "Gnus was exited on purpose" nil t)
+           (setq purpose t))
          ;; Possibly eval the file later.
          (when (or gnus-always-read-dribble-file
                    (gnus-y-or-n-p
-                    "Gnus auto-save file exists.  Do you want to read it? "))
+                    (if purpose
+                        "Gnus exited on purpose without saving; read auto-save file anyway? "
+                    "Gnus auto-save file exists.  Do you want to read it? ")))
            (setq gnus-dribble-eval-file t)))))))
 
 (defun gnus-dribble-eval-file ()
index d4fa9f7..eb53fbc 100644 (file)
@@ -3378,10 +3378,10 @@ This sub function is for exclusive use of `message-send-news'."
       (message-generate-headers message-required-news-headers)
       ;; Let the user do all of the above.
       (run-hooks 'message-header-hook))
-    (if group-name-charset
-       (setq message-syntax-checks
-             (cons '(valid-newsgroups . disabled)
-                   message-syntax-checks)))
+    (when group-name-charset
+      (setq message-syntax-checks
+           (cons '(valid-newsgroups . disabled)
+                 message-syntax-checks)))
     (message-cleanup-headers)
     (if (not (message-check-news-syntax))
        nil
@@ -3567,87 +3567,100 @@ This sub function is for exclusive use of `message-send-news'."
            (hashtb (and (boundp 'gnus-active-hashtb)
                         gnus-active-hashtb))
            errors)
-       (if (or (not hashtb)
-              (not (boundp 'gnus-read-active-file))
-              (not gnus-read-active-file)
-              (eq gnus-read-active-file 'some))
-          t
-        (while groups
-          (when (and (not (boundp (intern (car groups) hashtb)))
-                     (not (equal (car groups) "poster")))
-            (push (car groups) errors))
-          (pop groups))
-        (if (not errors)
-            t
-          (y-or-n-p
-           (format
-            "Really post to %s unknown group%s: %s? "
-            (if (= (length errors) 1) "this" "these")
-            (if (= (length errors) 1) "" "s")
-            (mapconcat 'identity errors ", ")))))))
-   ;; Check the Newsgroups & Followup-To headers for syntax errors.
-   (message-check 'valid-newsgroups
-     (let ((case-fold-search t)
-          (headers '("Newsgroups" "Followup-To"))
-          header error)
-       (while (and headers (not error))
-        (when (setq header (mail-fetch-field (car headers)))
-          (if (or
-               (not
-                (string-match
-                 "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
-                 header))
-               (memq
-                nil (mapcar
-                     (lambda (g)
-                       (not (string-match "\\.\\'\\|\\.\\." g)))
-                     (message-tokenize-header header ","))))
-              (setq error t)))
-        (unless error
-          (pop headers)))
-       (if (not error)
-          t
+       (while groups
+        (when (and (not (boundp (intern (car groups) hashtb)))
+                   (not (equal (car groups) "poster")))
+          (push (car groups) errors))
+        (pop groups))
+       (cond
+       ;; Gnus is not running.
+       ((or (not hashtb)
+            (not (boundp 'gnus-read-active-file)))
+        t)
+       ;; We don't have all the group names.
+       ((and (or (not gnus-read-active-file)
+                 (eq gnus-read-active-file 'some))
+             errors)
         (y-or-n-p
-         (format "The %s header looks odd: \"%s\".  Really post? "
-                 (car headers) header)))))
-   (message-check 'repeated-newsgroups
-     (let ((case-fold-search t)
-          (headers '("Newsgroups" "Followup-To"))
-          header error groups group)
-       (while (and headers
-                  (not error))
-        (when (setq header (mail-fetch-field (pop headers)))
-          (setq groups (message-tokenize-header header ","))
-          (while (setq group (pop groups))
-            (when (member group groups)
-              (setq error group
-                    groups nil)))))
-       (if (not error)
-          t
+         (format
+          "Really post to %s possibly unknown group%s: %s? "
+          (if (= (length errors) 1) "this" "these")
+          (if (= (length errors) 1) "" "s")
+          (mapconcat 'identity errors ", "))))
+       ;; There were no errors.
+       ((not errors)
+        t)
+       ;; There are unknown groups.
+       (t
         (y-or-n-p
-         (format "Group %s is repeated in headers.  Really post? " error)))))
-   ;; Check the From header.
-   (message-check 'from
-     (let* ((case-fold-search t)
-           (from (message-fetch-field "from"))
-           ad)
-       (cond
-       ((not from)
-        (message "There is no From line.  Posting is denied.")
-        nil)
-       ((or (not (string-match
-                  "@[^\\.]*\\."
-                  (setq ad (nth 1 (mail-extract-address-components
-                                   from))))) ;larsi@ifi
-            (string-match "\\.\\." ad) ;larsi@ifi..uio
-            (string-match "@\\." ad)   ;larsi@.ifi.uio
-            (string-match "\\.$" ad)   ;larsi@ifi.uio.
-            (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
-            (string-match "(.*).*(.*)" from)) ;(lars) (lars)
-        (message
-         "Denied posting -- the From looks strange: \"%s\"." from)
-        nil)
-       (t t))))))
+         (format
+          "Really post to %s unknown group%s: %s? "
+          (if (= (length errors) 1) "this" "these")
+          (if (= (length errors) 1) "" "s")
+          (mapconcat 'identity errors ", ")))))))
+     ;; Check the Newsgroups & Followup-To headers for syntax errors.
+     (message-check 'valid-newsgroups
+       (let ((case-fold-search t)
+            (headers '("Newsgroups" "Followup-To"))
+            header error)
+        (while (and headers (not error))
+          (when (setq header (mail-fetch-field (car headers)))
+            (if (or
+                 (not
+                  (string-match
+                   "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
+                   header))
+                 (memq
+                  nil (mapcar
+                       (lambda (g)
+                         (not (string-match "\\.\\'\\|\\.\\." g)))
+                       (message-tokenize-header header ","))))
+                (setq error t)))
+          (unless error
+            (pop headers)))
+        (if (not error)
+            t
+          (y-or-n-p
+           (format "The %s header looks odd: \"%s\".  Really post? "
+                   (car headers) header)))))
+     (message-check 'repeated-newsgroups
+       (let ((case-fold-search t)
+            (headers '("Newsgroups" "Followup-To"))
+            header error groups group)
+        (while (and headers
+                    (not error))
+          (when (setq header (mail-fetch-field (pop headers)))
+            (setq groups (message-tokenize-header header ","))
+            (while (setq group (pop groups))
+              (when (member group groups)
+                (setq error group
+                      groups nil)))))
+        (if (not error)
+            t
+          (y-or-n-p
+           (format "Group %s is repeated in headers.  Really post? " error)))))
+     ;; Check the From header.
+     (message-check 'from
+       (let* ((case-fold-search t)
+             (from (message-fetch-field "from"))
+             ad)
+        (cond
+         ((not from)
+          (message "There is no From line.  Posting is denied.")
+          nil)
+         ((or (not (string-match
+                    "@[^\\.]*\\."
+                    (setq ad (nth 1 (mail-extract-address-components
+                                     from))))) ;larsi@ifi
+              (string-match "\\.\\." ad) ;larsi@ifi..uio
+              (string-match "@\\." ad) ;larsi@.ifi.uio
+              (string-match "\\.$" ad) ;larsi@ifi.uio.
+              (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
+              (string-match "(.*).*(.*)" from)) ;(lars) (lars)
+          (message
+           "Denied posting -- the From looks strange: \"%s\"." from)
+          nil)
+         (t t))))))
 
 (defun message-check-news-body-syntax ()
   (and