From: yamaoka Date: Mon, 2 Apr 2001 05:14:54 +0000 (+0000) Subject: * lisp/gnus-msg.el (gnus-inews-yank-articles): Make it to work with multiple X-Git-Tag: t-gnus-6_15_0-10-quimby~3 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ec1b8555e75fc8d9e21fbf3bd4e3a4bd7eb8a2f5;p=elisp%2Fgnus.git- * 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. Synch with Oort Gnus. --- diff --git a/ChangeLog b/ChangeLog index ee20333..656a9af 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2001-04-02 Katsumi Yamaoka + + * 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 * lisp/mm-decode.el (mm-copy-to-buffer): Copy buffer in unibyte diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bc9fa3c..d2c846d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2001-04-02 00:40:12 Lars Magne Ingebrigtsen + + * 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 * gnus-score.el (gnus-score-orphans): Clean up. diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index e992da3..6a8d9bd 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -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) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 0b2a392..a4fe65d 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -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) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index 06dbe70..4839e7d 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -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 () diff --git a/lisp/message.el b/lisp/message.el index d4fa9f7..eb53fbc 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -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