* 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\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
+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\e,A_\e(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.
;; 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
;; 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))
(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)
(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))
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)
(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)
(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
"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
"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.
(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:
(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)
(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.
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'.
projects / emacs.git / commitdiff