# HG changeset patch # User ShengHuo ZHU # Date 1006701444 0 # Node ID 933ab100fb4a820639ed56f3ceccfd9f394a43d4 # Parent d85992144288c52ea83cc72ec691172d6190eb68 2001-11-25 ShengHuo ZHU * gnus-util.el (gnus-directory-sep-char-regexp): New. * gnus-score.el (gnus-score-find-bnews): Sync with Gnus CVS. * mm-util.el: Sync. * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version. (gnus-summary-limit-to-author): Ditto. (gnus-summary-limit-to-extra): Ditto. (gnus-summary-find-matching): Support not-matching argument. * message.el (message-wash-subject): Use `insert' rather than `insert-string', which is deprecated. From Kai Gro,A_(Bjohann diff -r d85992144288 -r 933ab100fb4a lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/ChangeLog Sun Nov 25 15:17:24 2001 +0000 @@ -1,3 +1,18 @@ +2001-11-25 ShengHuo ZHU + + * gnus-util.el (gnus-directory-sep-char-regexp): New. + * gnus-score.el (gnus-score-find-bnews): Sync with Gnus CVS. + * mm-util.el: Sync. + + * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version. + (gnus-summary-limit-to-author): Ditto. + (gnus-summary-limit-to-extra): Ditto. + (gnus-summary-find-matching): Support not-matching argument. + + * message.el (message-wash-subject): Use `insert' rather than + `insert-string', which is deprecated. + From Kai Gro,A_(Bjohann + 2001-11-14 Sam Steingold * gnus-score.el: Fixed some doc strings to properly quote symbols. diff -r d85992144288 -r 933ab100fb4a lisp/gnus/gnus-score.el --- a/lisp/gnus/gnus-score.el Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/gnus-score.el Sun Nov 25 15:17:24 2001 +0000 @@ -2560,8 +2560,10 @@ ;; too much. (delete-char (min (1- (point-max)) klen)) (goto-char (point-max)) - (search-backward (string directory-sep-char)) - (delete-region (1+ (point)) (point-min))) + (if (re-search-backward gnus-directory-sep-char-regexp nil t) + (delete-region (1+ (point)) (point-min)) + (gnus-message 1 "Can't find directory separator in %s" + (car sfiles)))) ;; If short file names were used, we have to translate slashes. (goto-char (point-min)) (let ((regexp (concat @@ -2595,10 +2597,10 @@ ;; we add this score file to the list of score files ;; applicable to this group. (when (or (and not-match - (ignore-errors + (ignore-errors (not (string-match regexp group-trans)))) - (and (not not-match) - (ignore-errors (string-match regexp group-trans)))) + (and (not not-match) + (ignore-errors (string-match regexp group-trans)))) (push (car sfiles) ofiles))) (setq sfiles (cdr sfiles))) (kill-buffer (current-buffer)) diff -r d85992144288 -r 933ab100fb4a lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/gnus-sum.el Sun Nov 25 15:17:24 2001 +0000 @@ -6393,23 +6393,34 @@ (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sLimit to subject (regexp): ") +(defun gnus-summary-limit-to-subject (subject &optional header not-matching) + "Limit the summary buffer to articles that have subjects that match a regexp. +If NOT-MATCHING, excluding articles that have subjects that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude subject (regexp): " + "Limit to subject (regexp): ")) + nil current-prefix-arg)) (unless header (setq header "subject")) (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) + (or header "subject") subject 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) (defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sLimit to author (regexp): ") + "Limit the summary buffer to articles that have authors that match a regexp. +If NOT-MATCHING, excluding articles that have authors that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude author (regexp): " + "Limit to author (regexp): ")) + nil current-prefix-arg)) (gnus-summary-limit-to-subject from "from")) (defun gnus-summary-limit-to-age (age &optional younger-p) @@ -6450,25 +6461,31 @@ (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-extra (header regexp) +(defun gnus-summary-limit-to-extra (header regexp &optional not-matching) "Limit the summary buffer to articles that match an 'extra' header." (interactive (let ((header (intern (gnus-completing-read (symbol-name (car gnus-extra-headers)) - "Limit extra header:" + (if current-prefix-arg + "Exclude extra header:" + "Limit extra header:") (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) nil t)))) (list header - (read-string (format "Limit to header %s (regexp): " header))))) + (read-string (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg))) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching - (cons 'extra header) regexp 'all))) + (cons 'extra header) regexp 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" regexp)) (gnus-summary-limit articles)) @@ -7215,17 +7232,15 @@ t))) (defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) + not-case-fold not-matching) "Return a list of all articles that match REGEXP on HEADER. The search stars on the current article and goes forwards unless BACKWARD is non-nil. If BACKWARD is `all', do all articles. If UNREAD is non-nil, only unread articles will be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." - (let ((data (if (eq backward 'all) gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list backward)))) - (case-fold-search (not not-case-fold)) +in the comparisons. If NOT-MATCHING, return a list of all articles that +not match REGEXP on HEADER." + (let ((case-fold-search (not not-case-fold)) articles d func) (if (consp header) (if (eq (car header) 'extra) @@ -7237,14 +7252,21 @@ (unless (fboundp (intern (concat "mail-header-" header))) (error "%s is not a valid header" header)) (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) - (while data - (setq d (car data)) - (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (push (gnus-data-number d) articles)) ; Success! - (setq data (cdr data))) + (dolist (d (if (eq backward 'all) + gnus-newsgroup-data + (gnus-data-find-list + (gnus-summary-article-number) + (gnus-data-list backward)))) + (when (and (or (not unread) ; We want all articles... + (gnus-data-unread-p d)) ; Or just unreads. + (vectorp (gnus-data-header d)) ; It's not a pseudo. + (if not-matching + (not (string-match + regexp + (funcall func (gnus-data-header d)))) + (string-match regexp + (funcall func (gnus-data-header d))))) + (push (gnus-data-number d) articles))) ; Success! (nreverse articles))) (defun gnus-summary-execute-command (header regexp command &optional backward) diff -r d85992144288 -r 933ab100fb4a lisp/gnus/gnus-util.el --- a/lisp/gnus/gnus-util.el Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/gnus-util.el Sun Nov 25 15:17:24 2001 +0000 @@ -1003,6 +1003,11 @@ (remove-text-properties start end properties object)) t)) +(defvar gnus-directory-sep-char-regexp "/" + "The regexp of directory separator character. +If you find some problem with the directory separator character, try +\"[/\\\\\]\" for some systems.") + (provide 'gnus-util) ;;; gnus-util.el ends here diff -r d85992144288 -r 933ab100fb4a lisp/gnus/message.el --- a/lisp/gnus/message.el Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/message.el Sun Nov 25 15:17:24 2001 +0000 @@ -4116,7 +4116,7 @@ "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT. Previous forwarders, replyers, etc. may add it." (with-temp-buffer - (insert-string subject) + (insert subject) (goto-char (point-min)) ;; strip Re/Fwd stuff off the beginning (while (re-search-forward diff -r d85992144288 -r 933ab100fb4a lisp/gnus/mm-util.el --- a/lisp/gnus/mm-util.el Sun Nov 25 15:11:22 2001 +0000 +++ b/lisp/gnus/mm-util.el Sun Nov 25 15:17:24 2001 +0000 @@ -163,7 +163,7 @@ "Coding system of auto save file.") (defvar mm-universal-coding-system mm-auto-save-coding-system - "The universal Coding system.") + "The universal coding system.") ;; Fixme: some of the cars here aren't valid MIME charsets. That ;; should only matter with XEmacs, though. @@ -238,6 +238,49 @@ (coding-system-get cs 'safe-charsets)))))) (sort-coding-systems (coding-system-list 'base-only)))))) +(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2) + "A list of special charsets. +Valid elements include: +`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists. +`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists." +) + +(defvar mm-iso-8859-15-compatible + '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE") + (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE")) + "ISO-8859-15 exchangeable coding systems and inconvertible characters.") + +(defvar mm-iso-8859-x-to-15-table + (and (fboundp 'coding-system-p) + (mm-coding-system-p 'iso-8859-15) + (mapcar + (lambda (cs) + (if (mm-coding-system-p (car cs)) + (let ((c (string-to-char + (decode-coding-string "\341" (car cs))))) + (cons (char-charset c) + (cons + (- (string-to-char + (decode-coding-string "\341" 'iso-8859-15)) c) + (string-to-list (decode-coding-string (car (cdr cs)) + (car cs)))))) + '(gnus-charset 0))) + mm-iso-8859-15-compatible)) + "A table of the difference character between ISO-8859-X and ISO-8859-15.") + +(defvar mm-coding-system-priorities nil + "Preferred coding systems for encoding outgoing mails. + +More than one suitable coding systems may be found for some texts. By +default, a coding system with the highest priority is used to encode +outgoing mails (see `sort-coding-systems'). If this variable is set, +it overrides the default priority. For example, Japanese users may +prefer iso-2022-jp to japanese-shift-jis: + +\(setq mm-coding-system-priorities + '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis utf-8)) +") + ;;; Internal variables: ;;; Functions: @@ -270,6 +313,8 @@ (when lbt (setq charset (intern (format "%s-%s" charset lbt)))) (cond + ((null charset) + charset) ;; Running in a non-MULE environment. ((null (mm-get-coding-system-list)) charset) @@ -348,8 +393,8 @@ (defun mm-preferred-coding-system (charset) ;; A typo in some Emacs versions. - (or (get-charset-property charset 'prefered-coding-system) - (get-charset-property charset 'preferred-coding-system))) + (or (get-charset-property charset 'preferred-coding-system) + (get-charset-property charset 'prefered-coding-system))) (defun mm-charset-after (&optional pos) "Return charset of a character in current buffer at position POS. @@ -420,38 +465,70 @@ enable-multibyte-characters (featurep 'mule))) -(defun mm-find-mime-charset-region (b e) +(defun mm-iso-8859-x-to-15-region (&optional b e) + (if (fboundp 'char-charset) + (let (charset item c inconvertible) + (save-restriction + (if e (narrow-to-region b e)) + (goto-char (point-min)) + (skip-chars-forward "\0-\177") + (while (not (eobp)) + (cond + ((not (setq item (assq (char-charset (setq c (char-after))) + mm-iso-8859-x-to-15-table))) + (forward-char)) + ((memq c (cdr (cdr item))) + (setq inconvertible t) + (forward-char)) + (t + (insert (prog1 (+ c (car (cdr item))) (delete-char 1)))) + (skip-chars-forward "\0-\177")))) + (not inconvertible)))) + +(defun mm-sort-coding-systems-predicate (a b) + (> (length (memq a mm-coding-system-priorities)) + (length (memq b mm-coding-system-priorities)))) + +(defun mm-find-mime-charset-region (b e &optional hack-charsets) "Return the MIME charsets needed to encode the region between B and E. Nil means ASCII, a single-element list represents an appropriate MIME charset, and a longer list means no appropriate charset." - ;; The return possibilities of this function are a mess... - (or (and - (mm-multibyte-p) - (fboundp 'find-coding-systems-region) - ;; Find the mime-charset of the most preferred coding - ;; system that has one. - (let ((systems (find-coding-systems-region b e)) - result) - ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' - ;; is not in the IANA list. - (setq systems (delq 'compound-text systems)) - (unless (equal systems '(undecided)) - (while systems - (let ((cs (coding-system-get (pop systems) 'mime-charset))) - (if cs - (setq systems nil - result (list cs)))))) - result)) - ;; Otherwise we're not multibyte, XEmacs or a single coding - ;; system won't cover it. - (let ((charsets - (mm-delete-duplicates - (mapcar 'mm-mime-charset - (delq 'ascii - (mm-find-charset-region b e)))))) - (if (memq 'iso-2022-jp-2 charsets) - (delq 'iso-2022-jp charsets) - charsets)))) + (let (charsets) + ;; The return possibilities of this function are a mess... + (or (and (mm-multibyte-p) + (fboundp 'find-coding-systems-region) + ;; Find the mime-charset of the most preferred coding + ;; system that has one. + (let ((systems (find-coding-systems-region b e))) + (when mm-coding-system-priorities + (setq systems + (sort systems 'mm-sort-coding-systems-predicate))) + ;; Fixme: The `mime-charset' (`x-ctext') of `compound-text' + ;; is not in the IANA list. + (setq systems (delq 'compound-text systems)) + (unless (equal systems '(undecided)) + (while systems + (let ((cs (coding-system-get (pop systems) 'mime-charset))) + (if cs + (setq systems nil + charsets (list cs)))))) + charsets)) + ;; Otherwise we're not multibyte, XEmacs or a single coding + ;; system won't cover it. + (setq charsets + (mm-delete-duplicates + (mapcar 'mm-mime-charset + (delq 'ascii + (mm-find-charset-region b e)))))) + (if (and (memq 'iso-8859-15 charsets) + (memq 'iso-8859-15 hack-charsets) + (save-excursion (mm-iso-8859-x-to-15-region b e))) + (mapcar (lambda (x) (setq charsets (delq (car x) charsets))) + mm-iso-8859-15-compatible)) + (if (and (memq 'iso-2022-jp-2 charsets) + (memq 'iso-2022-jp-2 hack-charsets)) + (setq charsets (delq 'iso-2022-jp charsets))) + charsets)) (defmacro mm-with-unibyte-buffer (&rest forms) "Create a temporary buffer, and evaluate FORMS there like `progn'.