Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Merge from gnus--rel--5.10 Patches applied: * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-78 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-79 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-80 Update from CVS 2004-12-22 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-spec.el (gnus-spec-tab): Make a Lisp form which works correctly even if there are wide characters. 2004-12-21 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/rfc2231.el (rfc2231-parse-string): Decode encoded value after concatenating segments rather than before concatenating them. Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>. 2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/mm-util.el (mm-xemacs-find-mime-charset): New macro. 2004-12-17 Aidan Kehoe <kehoea@parhasard.net> * lisp/gnus/mm-util.el (mm-xemacs-find-mime-charset-1): New function used to unify Latin characters in XEmacs. (mm-find-mime-charset-region): Use it. 2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org> * lisp/gnus/gnus-util.el (gnus-delete-directory): New function. * lisp/gnus/gnus-agent.el (gnus-agent-delete-group): Use it. * lisp/gnus/gnus-cache.el (gnus-cache-delete-group): Use it.
This commit is contained in:
Miles Bader
parent
f3e4c362ff
commit
aa0a8561bb
7 changed files with 149 additions and 23 deletions
|
|
@ -4,6 +4,35 @@
|
|||
|
||||
* gnus-sum.el (gnus-summary-mode-map): Likewise.
|
||||
|
||||
2004-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* gnus-spec.el (gnus-spec-tab): Make a Lisp form which works
|
||||
correctly even if there are wide characters.
|
||||
|
||||
2004-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* rfc2231.el (rfc2231-parse-string): Decode encoded value after
|
||||
concatenating segments rather than before concatenating them.
|
||||
Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
|
||||
|
||||
2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* mm-util.el (mm-xemacs-find-mime-charset): New macro.
|
||||
|
||||
2004-12-17 Aidan Kehoe <kehoea@parhasard.net>
|
||||
|
||||
* mm-util.el (mm-xemacs-find-mime-charset-1): New function used to
|
||||
unify Latin characters in XEmacs.
|
||||
(mm-find-mime-charset-region): Use it.
|
||||
|
||||
2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
|
||||
|
||||
* gnus-util.el (gnus-delete-directory): New function.
|
||||
|
||||
* gnus-agent.el (gnus-agent-delete-group): Use it.
|
||||
|
||||
* gnus-cache.el (gnus-cache-delete-group): Use it.
|
||||
|
||||
2004-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
|
||||
|
|
|
|||
|
|
@ -891,7 +891,7 @@ next enabled. Depends upon the caller to determine whether group deletion is sup
|
|||
(path (directory-file-name
|
||||
(let (gnus-command-method command-method)
|
||||
(gnus-agent-group-pathname group)))))
|
||||
(gnus-delete-file path)
|
||||
(gnus-delete-directory path)
|
||||
|
||||
(let* ((real-group (gnus-group-real-name group)))
|
||||
(gnus-agent-save-group-info command-method real-group nil)
|
||||
|
|
|
|||
|
|
@ -754,7 +754,7 @@ next enabled. Depends upon the caller to determine whether group renaming is sup
|
|||
disabled, as the old cache files would corrupt gnus when the cache was
|
||||
next enabled. Depends upon the caller to determine whether group deletion is supported."
|
||||
(let ((dir (gnus-cache-file-name group "")))
|
||||
(gnus-delete-file dir))
|
||||
(gnus-delete-directory dir))
|
||||
|
||||
(let ((no-save gnus-cache-active-hashtb))
|
||||
(unless gnus-cache-active-hashtb
|
||||
|
|
|
|||
|
|
@ -275,21 +275,15 @@ Return a list of updated types."
|
|||
|
||||
(defun gnus-spec-tab (column)
|
||||
(if (> column 0)
|
||||
`(insert (make-string (max (- ,column (current-column)) 0) ? ))
|
||||
`(insert-char ? (max (- ,column (current-column)) 0))
|
||||
(let ((column (abs column)))
|
||||
(if gnus-use-correct-string-widths
|
||||
`(progn
|
||||
(if (> (current-column) ,column)
|
||||
(while (progn
|
||||
(delete-backward-char 1)
|
||||
(> (current-column) ,column))))
|
||||
(insert (make-string (max (- ,column (current-column)) 0) ? )))
|
||||
`(progn
|
||||
(if (> (current-column) ,column)
|
||||
(delete-region (point)
|
||||
(- (point) (- (current-column) ,column)))
|
||||
(insert (make-string (max (- ,column (current-column)) 0)
|
||||
? ))))))))
|
||||
`(if (> (current-column) ,column)
|
||||
(let ((end (point)))
|
||||
(if (= (move-to-column ,column) ,column)
|
||||
(delete-region (point) end)
|
||||
(delete-region (1- (point)) end)
|
||||
(insert " ")))
|
||||
(insert-char ? (max (- ,column (current-column)) 0))))))
|
||||
|
||||
(defun gnus-correct-length (string)
|
||||
"Return the correct width of STRING."
|
||||
|
|
|
|||
|
|
@ -708,6 +708,23 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and
|
|||
(when (file-exists-p file)
|
||||
(delete-file file)))
|
||||
|
||||
(defun gnus-delete-directory (directory)
|
||||
"Delete files in DIRECTORY. Subdirectories remain.
|
||||
If there's no subdirectory, delete DIRECTORY as well."
|
||||
(when (file-directory-p directory)
|
||||
(let ((files (directory-files
|
||||
directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
|
||||
file dir)
|
||||
(while files
|
||||
(setq file (pop files))
|
||||
(if (eq t (car (file-attributes file)))
|
||||
;; `file' is a subdirectory.
|
||||
(setq dir t)
|
||||
;; `file' is a file or a symlink.
|
||||
(delete-file file)))
|
||||
(unless dir
|
||||
(delete-directory directory)))))
|
||||
|
||||
(defun gnus-strip-whitespace (string)
|
||||
"Return STRING stripped of all whitespace."
|
||||
(while (string-match "[\r\n\t ]+" string)
|
||||
|
|
|
|||
|
|
@ -576,6 +576,83 @@ This affects whether coding conversion should be attempted generally."
|
|||
(length (memq (coding-system-base b) priorities)))
|
||||
t))))
|
||||
|
||||
(eval-when-compile
|
||||
(autoload 'latin-unity-massage-name "latin-unity")
|
||||
(autoload 'latin-unity-maybe-remap "latin-unity")
|
||||
(autoload 'latin-unity-representations-feasible-region "latin-unity")
|
||||
(autoload 'latin-unity-representations-present-region "latin-unity")
|
||||
(defvar latin-unity-coding-systems)
|
||||
(defvar latin-unity-ucs-list))
|
||||
|
||||
(defun mm-xemacs-find-mime-charset-1 (begin end)
|
||||
"Determine which MIME charset to use to send region as message.
|
||||
This uses the XEmacs-specific latin-unity package to better handle the
|
||||
case where identical characters from diverse ISO-8859-? character sets
|
||||
can be encoded using a single one of the corresponding coding systems.
|
||||
|
||||
It treats `mm-coding-system-priorities' as the list of preferred
|
||||
coding systems; a useful example setting for this list in Western
|
||||
Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default
|
||||
to the very standard Latin 1 coding system, and only move to coding
|
||||
systems that are less supported as is necessary to encode the
|
||||
characters that exist in the buffer.
|
||||
|
||||
Latin Unity doesn't know about those non-ASCII Roman characters that
|
||||
are available in various East Asian character sets. As such, its
|
||||
behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a
|
||||
buffer and it can otherwise be encoded as Latin 1, won't be ideal.
|
||||
But this is very much a corner case, so don't worry about it."
|
||||
(let ((systems mm-coding-system-priorities) csets psets curset)
|
||||
|
||||
;; Load the Latin Unity library, if available.
|
||||
(when (and (not (featurep 'latin-unity)) (locate-library "latin-unity"))
|
||||
(require 'latin-unity))
|
||||
|
||||
;; Now, can we use it?
|
||||
(if (featurep 'latin-unity)
|
||||
(progn
|
||||
(setq csets (latin-unity-representations-feasible-region begin end)
|
||||
psets (latin-unity-representations-present-region begin end))
|
||||
|
||||
(catch 'done
|
||||
|
||||
;; Pass back the first coding system in the preferred list
|
||||
;; that can encode the whole region.
|
||||
(dolist (curset systems)
|
||||
(setq curset (latin-unity-massage-name 'buffer-default curset))
|
||||
|
||||
;; If the coding system is a universal coding system, then
|
||||
;; it can certainly encode all the characters in the region.
|
||||
(if (memq curset latin-unity-ucs-list)
|
||||
(throw 'done (list curset)))
|
||||
|
||||
;; If a coding system isn't universal, and isn't in
|
||||
;; the list that latin unity knows about, we can't
|
||||
;; decide whether to use it here. Leave that until later
|
||||
;; in `mm-find-mime-charset-region' function, whence we
|
||||
;; have been called.
|
||||
(unless (memq curset latin-unity-coding-systems)
|
||||
(throw 'done nil))
|
||||
|
||||
;; Right, we know about this coding system, and it may
|
||||
;; conceivably be able to encode all the characters in
|
||||
;; the region.
|
||||
(if (latin-unity-maybe-remap begin end curset csets psets t)
|
||||
(throw 'done (list curset))))
|
||||
|
||||
;; Can't encode using anything from the
|
||||
;; `mm-coding-system-priorities' list.
|
||||
;; Leave `mm-find-mime-charset' to do most of the work.
|
||||
nil))
|
||||
|
||||
;; Right, latin unity isn't available; let `mm-find-charset-region'
|
||||
;; take its default action, which equally applies to GNU Emacs.
|
||||
nil)))
|
||||
|
||||
(defmacro mm-xemacs-find-mime-charset (begin end)
|
||||
(when (featurep 'xemacs)
|
||||
`(mm-xemacs-find-mime-charset-1 ,begin ,end)))
|
||||
|
||||
(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
|
||||
|
|
@ -617,8 +694,12 @@ charset, and a longer list means no appropriate charset."
|
|||
(setq systems nil
|
||||
charsets (list cs))))))
|
||||
charsets))
|
||||
;; Otherwise we're not multibyte, we're XEmacs, or a single
|
||||
;; coding system won't cover it.
|
||||
;; If we're XEmacs, and some coding system is appropriate,
|
||||
;; mm-xemacs-find-mime-charset will return an appropriate list.
|
||||
;; Otherwise, we'll get nil, and the next setq will get invoked.
|
||||
(setq charsets (mm-xemacs-find-mime-charset b e))
|
||||
|
||||
;; We're not multibyte, or a single coding system won't cover it.
|
||||
(setq charsets
|
||||
(mm-delete-duplicates
|
||||
(mapcar 'mm-mime-charset
|
||||
|
|
|
|||
|
|
@ -88,7 +88,6 @@ The list will be on the form
|
|||
(point) (progn (forward-sexp 1) (point))))))
|
||||
(error "Invalid header: %s" string))
|
||||
(setq c (char-after))
|
||||
(setq encoded nil)
|
||||
(when (eq c ?*)
|
||||
(forward-char 1)
|
||||
(setq c (char-after))
|
||||
|
|
@ -126,16 +125,22 @@ The list will be on the form
|
|||
(point) (progn (forward-sexp) (point)))))
|
||||
(t
|
||||
(error "Invalid header: %s" string)))
|
||||
(when encoded
|
||||
(setq value (rfc2231-decode-encoded-string value)))
|
||||
(if number
|
||||
(setq prev-attribute attribute
|
||||
prev-value (concat prev-value value))
|
||||
(push (cons attribute value) parameters))))
|
||||
(push (cons attribute
|
||||
(if encoded
|
||||
(rfc2231-decode-encoded-string value)
|
||||
value))
|
||||
parameters))))
|
||||
|
||||
;; Take care of any final continuations.
|
||||
(when prev-attribute
|
||||
(push (cons prev-attribute prev-value) parameters))
|
||||
(push (cons prev-attribute
|
||||
(if encoded
|
||||
(rfc2231-decode-encoded-string prev-value)
|
||||
prev-value))
|
||||
parameters))
|
||||
|
||||
(when type
|
||||
`(,type ,@(nreverse parameters)))))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue