mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-25 19:11:56 +00:00
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
* 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 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
This commit is contained in:
ShengHuo ZHU
parent
fefed09d42
commit
47b63dfa47
@ -1,3 +1,18 @@
|
||||
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
|
||||
|
||||
* 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 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
|
||||
|
||||
2001-11-14 Sam Steingold <sds@gnu.org>
|
||||
|
||||
* gnus-score.el: Fixed some doc strings to properly quote symbols.
|
||||
|
||||
@ -2560,8 +2560,10 @@ GROUP using BNews sys file syntax."
|
||||
;; 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 @@ GROUP using BNews sys file syntax."
|
||||
;; 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))
|
||||
|
||||
@ -6393,23 +6393,34 @@ If given a prefix, remove all limits."
|
||||
(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 @@ articles that are younger than AGE days."
|
||||
(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 @@ Optional argument BACKWARD means do search for backward.
|
||||
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 @@ in the comparisons."
|
||||
(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)
|
||||
|
||||
@ -1003,6 +1003,11 @@ Entries without port tokens default to DEFAULTPORT."
|
||||
(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
|
||||
|
||||
@ -4116,7 +4116,7 @@ header line with the old Message-ID."
|
||||
"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
|
||||
|
||||
@ -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 @@ used as the line break code type of the coding system."
|
||||
(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 @@ Only used in Emacs Mule 4."
|
||||
|
||||
(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 @@ If the charset is `composition', return the actual one."
|
||||
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'.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user