From e465f6547aedc3769b71a6a5606c8c684ed584a6 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Thu, 19 Nov 1998 04:54:27 +0000 Subject: [PATCH] Sync up with Pterodactyl Gnus v0.51. --- lisp/ChangeLog | 41 +++++++++++++++++++++++ lisp/gnus-art.el | 95 ++++++++++++++++++++++++++-------------------------- lisp/gnus-cache.el | 8 +++-- lisp/gnus-cus.el | 4 +-- lisp/gnus-group.el | 1 - lisp/gnus-score.el | 5 ++- lisp/gnus-sum.el | 7 ++++ lisp/gnus.el | 9 +++-- lisp/message.el | 49 +++++++++++++++------------ lisp/mml.el | 53 ++++++++++++++++++----------- lisp/nntp.el | 6 ++-- 11 files changed, 177 insertions(+), 101 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 65948da..2dcd382 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,44 @@ +Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.51 is released. + +1998-11-19 04:02:34 Lars Magne Ingebrigtsen + + * gnus.el: Applied patches from 5.6.45. + + * gnus-score.el (gnus-score-find-trace): Print complete file + paths. + (gnus-score-find-trace): Truncate lines. + + * gnus.el (gnus-message-archive-group): Allow function. + + * message.el (message-encode-message-body): Remove Mime-Version + before inserting. + + * gnus-cus.el (gnus-group-customize): Optional topic. + + * gnus-sum.el (gnus-summary-customize-parameters): New command and + keystroke. + +Wed Nov 18 13:46:08 1998 Shenghuo ZHU + + * message.el (message-encode-message-body): Rewrite. + +1998-11-18 07:37:47 Lars Magne Ingebrigtsen + + * mml.el (mml-base-boundary): New variable. + (mml-make-boundary): New function. + + * gnus-cache.el (gnus-cache-coding-system): New variable. + (gnus-cache-request-article): Use it. + + * message.el (message-insert-mime-part): Delete duplicates. + +Wed Nov 18 11:52:19 1998 Shenghuo ZHU + + * gnus-art.el (gnus-mime-display-alternative): Set end of + multipart and display even when nothing is preferred. + Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen * gnus.el: Pterodactyl Gnus v0.50 is released. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 8c9a2dc..03d0aa5 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2553,25 +2553,49 @@ If ALL-HEADERS is non-nil, no headers are hidden." (ihandles handles) (point (point)) handle buffer-read-only from props begend not-pref) - (when preferred - (save-restriction - (when ibegend - (narrow-to-region (car ibegend) (cdr ibegend)) - (delete-region (point-min) (point-max)) - (mm-remove-parts handles)) - (setq begend (list (point-marker))) - ;; Do the toggle. - (unless (setq not-pref (cadr (member preferred ihandles))) - (setq not-pref (car ihandles))) + (save-restriction + (when ibegend + (narrow-to-region (car ibegend) (cdr ibegend)) + (delete-region (point-min) (point-max)) + (mm-remove-parts handles)) + (setq begend (list (point-marker))) + ;; Do the toggle. + (unless (setq not-pref (cadr (member preferred ihandles))) + (setq not-pref (car ihandles))) + (gnus-add-text-properties + (setq from (point)) + (progn + (insert (format "%d. " id)) + (point)) + `(gnus-callback + (lambda (handles) + (gnus-mime-display-alternative + ',ihandles ',not-pref + ',begend ,id)) + local-map ,gnus-mime-button-map + ,gnus-mouse-face-prop ,gnus-article-mouse-face + face ,gnus-article-button-face + keymap ,gnus-mime-button-map + gnus-part ,id + gnus-data ,handle)) + (widget-convert-button 'link from (point) + :action 'gnus-widget-press-button + :button-keymap gnus-widget-button-keymap) + ;; Do the handles + (while (setq handle (pop handles)) (gnus-add-text-properties (setq from (point)) (progn - (insert (format "%d. " id)) + (insert (format "[%c] %-18s" + (if (equal handle preferred) ?* ? ) + (if (stringp (car handle)) + (car handle) + (car (mm-handle-type handle))))) (point)) `(gnus-callback (lambda (handles) (gnus-mime-display-alternative - ',ihandles ',not-pref + ',ihandles ',handle ',begend ,id)) local-map ,gnus-mime-button-map ,gnus-mouse-face-prop ,gnus-article-mouse-face @@ -2582,41 +2606,16 @@ If ALL-HEADERS is non-nil, no headers are hidden." (widget-convert-button 'link from (point) :action 'gnus-widget-press-button :button-keymap gnus-widget-button-keymap) - ;; Do the handles - (while (setq handle (pop handles)) - (gnus-add-text-properties - (setq from (point)) - (progn - (insert (format "[%c] %-18s" - (if (equal handle preferred) ?* ? ) - (if (stringp (car handle)) - (car handle) - (car (mm-handle-type handle))))) - (point)) - `(gnus-callback - (lambda (handles) - (gnus-mime-display-alternative - ',ihandles ',handle - ',begend ,id)) - local-map ,gnus-mime-button-map - ,gnus-mouse-face-prop ,gnus-article-mouse-face - face ,gnus-article-button-face - keymap ,gnus-mime-button-map - gnus-part ,id - gnus-data ,handle)) - (widget-convert-button 'link from (point) - :action 'gnus-widget-press-button - :button-keymap gnus-widget-button-keymap) - (insert " ")) - (insert "\n\n") - (when preferred - (if (stringp (car preferred)) - (gnus-display-mime preferred) - (mm-display-part preferred) - (goto-char (point-max)) - (setcdr begend (point-marker))))) - (when ibegend - (goto-char point))))) + (insert " ")) + (insert "\n\n") + (when preferred + (if (stringp (car preferred)) + (gnus-display-mime preferred) + (mm-display-part preferred) + (goto-char (point-max))) + (setcdr begend (point-marker)))) + (when ibegend + (goto-char point)))) (defun gnus-article-wash-status () "Return a string which display status of article washing." @@ -3296,7 +3295,7 @@ after replacing with the original article." :type 'regexp) (defcustom gnus-button-alist - `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^)!;:,>\n\t ]*\\)>" + `(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) ("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el index b681aa1..c621a6e 100644 --- a/lisp/gnus-cache.el +++ b/lisp/gnus-cache.el @@ -78,6 +78,9 @@ it's not cached." (defvar gnus-cache-overview-coding-system 'raw-text "Coding system used on Gnus cache files.") +(defvar gnus-cache-coding-system 'binary + "Coding system used on Gnus cache files.") + ;;; Internal variables. @@ -259,7 +262,8 @@ it's not cached." (when (file-exists-p file) (erase-buffer) (gnus-kill-all-overlays) - (nnheader-insert-file-contents file) + (let ((nnheader-file-coding-system gnus-cache-coding-system)) + (nnheader-insert-file-contents file)) t))) (defun gnus-cache-possibly-alter-active (group active) @@ -648,7 +652,7 @@ If LOW, update the lower bound instead." ;; Go through all the other files. (while alphs (when (and (file-directory-p (car alphs)) - (not (string-match "^\\.\\.?$" + (not (string-match "^\\." (file-name-nondirectory (car alphs))))) ;; We descend directories. (gnus-cache-generate-active (car alphs))) diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index b71e2a9..5a839e8 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -176,8 +176,8 @@ DOC is a documentation string for the parameter.") (defvar gnus-custom-group) (defvar gnus-custom-topic) -(defun gnus-group-customize (group topic) - "Edit the group or topicon the current line." +(defun gnus-group-customize (group &optional topic) + "Edit the group or topic on the current line." (interactive (list (gnus-group-group-name) (gnus-group-topic-name))) (let (info (types (mapcar (lambda (entry) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index fcbcea5..be3a549 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -3068,7 +3068,6 @@ to use." (mapatoms (lambda (group) (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) (push (symbol-name group) groups))) gnus-description-hashtb)) (if (not groups) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index 5fc3660..bd20597 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -2341,11 +2341,10 @@ EXTRA is the possible non-standard header." 1 "No score rules apply to the current article (default score %d)." gnus-summary-default-score) (set-buffer "*Score Trace*") + (setq truncate-lines t) (while trace (insert (format "%S -> %s\n" (cdar trace) - (if (caar trace) - (file-name-nondirectory (caar trace)) - "(non-file rule)"))) + (or (caar trace) "(non-file rule)"))) (setq trace (cdr trace))) (goto-char (point-min)) (gnus-configure-windows 'score-trace))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 0727a77..39ccda8 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1262,6 +1262,7 @@ increase the score of each group you read." "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document "\M-\C-e" gnus-summary-edit-parameters + "\M-\C-g" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1769,6 +1770,7 @@ increase the score of each group you read." ["Edit local kill file" gnus-summary-edit-local-kill t] ["Edit main kill file" gnus-summary-edit-global-kill t] ["Edit group parameters" gnus-summary-edit-parameters t] + ["Customize group parameters" gnus-summary-customize-parameters t] ["Send a bug report" gnus-bug t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] @@ -6576,6 +6578,11 @@ or `gnus-select-method', no matter what backend the article comes from." (interactive) (gnus-group-edit-group gnus-newsgroup-name 'params)) +(defun gnus-summary-customize-parameters () + "Customize the group parameters of the current group." + (interactive) + (gnus-group-customize gnus-newsgroup-name)) + (defun gnus-summary-enter-digest-group (&optional force) "Enter an nndoc group based on the current article. If FORCE, force a digest interpretation. If not, try diff --git a/lisp/gnus.el b/lisp/gnus.el index c2f7ba5..cb1d9bf 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -259,10 +259,10 @@ is restarted, and sometimes reloaded." (defconst gnus-product-name "T-gnus" "Product name of this version of gnus.") -(defconst gnus-version-number "6.10.036" +(defconst gnus-version-number "6.10.037" "Version number for this version of gnus.") -(defconst gnus-original-version-number "0.50" +(defconst gnus-original-version-number "0.51" "Version number for this version of Gnus.") (defconst gnus-original-product-name "Pterodactyl Gnus" @@ -949,6 +949,8 @@ that case, just return a fully prefixed name of the group -- \"nnml+private:mail.misc\", for instance." :group 'gnus-message :type '(choice (const :tag "none" nil) + function + sexp string)) (defcustom gnus-secondary-servers nil @@ -1676,7 +1678,8 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("rmailout" rmail-output rmail-output-to-rmail-file) ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) + rmail-show-message rmail-summary-exists + rmail-select-summary rmail-update-summary) ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("gnus-soup" :interactive t diff --git a/lisp/message.el b/lisp/message.el index b7a5091..101ff01 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4738,32 +4738,39 @@ regexp varstr." (list file (completing-read (format "MIME type for %s: " file) - (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions) + (delete-duplicates + (mapcar (lambda (m) (list (cdr m))) mailcap-mime-extensions)) nil nil type)))) (insert (format "<#part type=%s filename=\"%s\"><#/part>\n" type file))) (defun message-encode-message-body () - (message-goto-body) - (save-restriction - (narrow-to-region (point) (point-max)) - (let ((new (mml-generate-mime))) - (delete-region (point-min) (point-max)) - (insert new) - (goto-char (point-min)) - (widen) - (forward-line -1) - (let ((beg (point)) - (line (buffer-substring (point) (progn (forward-line 1) (point))))) - (delete-region beg (point)) - (insert "Mime-Version: 1.0\n") - (search-forward "\n\n") - (forward-char -1) - (insert line) - (when (save-excursion - (re-search-backward "^Content-Type: multipart/" nil t)) - (insert "This is a MIME multipart message. If you are reading\n") - (insert "this, you shouldn't.\n")))))) + (let (lines multipart-p) + (message-goto-body) + (save-restriction + (narrow-to-region (point) (point-max)) + (let ((new (mml-generate-mime))) + (delete-region (point-min) (point-max)) + (insert new) + (goto-char (point-min)) + (if (eq (aref new 0) ?\n) + (delete-char 1) + (search-forward "\n\n") + (setq lines (buffer-substring (point-min) (1- (point)))) + (delete-region (point-min) (point))))) + (save-restriction + (message-narrow-to-headers-or-head) + (message-remove-header "Mime-Version") + (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") + (when lines + (insert lines)) + (setq multipart-p + (re-search-backward "^Content-Type: multipart/" nil t))) + (when multipart-p + (message-goto-body) + (insert "This is a MIME multipart message. If you are reading\n") + (insert "this, you shouldn't.\n")))) (defvar message-save-buffer " *encoding") (defun message-save-drafts () diff --git a/lisp/mml.el b/lisp/mml.el index 3920f9a..01c4773 100644 --- a/lisp/mml.el +++ b/lisp/mml.el @@ -23,6 +23,10 @@ ;;; Code: +(require 'mm-util) +(require 'mm-bodies) +(require 'mm-encode) + (defvar mml-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\\ "/" table) @@ -50,7 +54,7 @@ "Parse the current buffer as an MML document." (let (struct) (while (and (not (eobp)) - (not (looking-at " mml-multipart-number 17) + (format "%x" mml-multipart-number) + "") + mml-base-boundary)) + +(defun mml-make-string (num string) + (let ((out "")) + (while (not (zerop (decf num))) + (setq out (concat out string))) + out)) (provide 'mml) diff --git a/lisp/nntp.el b/lisp/nntp.el index 6ef1110..d532a93 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -653,7 +653,7 @@ If this variable is nil, which is the default, no timers are set.") (deffoo nntp-request-group (group &optional server dont-check) (nntp-possibly-change-group nil server) - (when (nntp-send-command "^21.*\n" "GROUP" group) + (when (nntp-send-command "^[245].*\n" "GROUP" group) (let ((entry (nntp-find-connection-entry nntp-server-buffer))) (setcar (cddr entry) group)))) @@ -979,7 +979,9 @@ password contained in '~/.nntp-authinfo'." (set-buffer (process-buffer (car entry))) (erase-buffer) (nntp-send-string (car entry) (concat "GROUP " group)) - (nntp-wait-for-string "^2.*\n") + ;; allow for unexpected responses, since this can be called + ;; from a timer with quit inhibited + (nntp-wait-for-string "^[245].*\n") (setcar (cddr entry) group) (erase-buffer)))))) -- 1.7.10.4