X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=47c130291374f144bfdc0e60ec691b530e92f10a;hb=8ea1f15fd54f5a6b6bc71dd0b6c155ab77f474c1;hp=8c52b5891855ede3d3c028ea4f3a31c3ee5bce71;hpb=ae7e02f827410c9c9419bff833811ac51b7c4ab6;p=gnus diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 8c52b5891..47c130291 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -103,15 +103,15 @@ (when (gnus-buffer-exists-p buf) (kill-buffer buf)))) -(fset 'gnus-point-at-bol - (if (fboundp 'point-at-bol) - 'point-at-bol - 'line-beginning-position)) +(defalias 'gnus-point-at-bol + (if (fboundp 'point-at-bol) + 'point-at-bol + 'line-beginning-position)) -(fset 'gnus-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position)) +(defalias 'gnus-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position)) (defun gnus-delete-first (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." @@ -311,11 +311,11 @@ Cache the result as a text property stored in DATE." time))))) (defsubst gnus-time-iso8601 (time) - "Return a string of TIME in YYMMDDTHHMMSS format." + "Return a string of TIME in YYYYMMDDTHHMMSS format." (format-time-string "%Y%m%dT%H%M%S" time)) (defun gnus-date-iso8601 (date) - "Convert the DATE to YYMMDDTHHMMSS." + "Convert the DATE to YYYYMMDDTHHMMSS." (condition-case () (gnus-time-iso8601 (gnus-date-get-time date)) (error ""))) @@ -451,14 +451,6 @@ If N, return the Nth ancestor instead." (file-name-nondirectory file)))) (copy-file file to)) -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays))))) - (defvar gnus-work-buffer " *gnus work*") (defun gnus-set-work-buffer () @@ -549,8 +541,9 @@ Bind `print-quoted' and `print-readably' to t while printing." "Write the current buffer's contents to FILE." ;; Make sure the directory exists. (gnus-make-directory (file-name-directory file)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly)) + (let ((file-name-coding-system nnmail-pathname-coding-system)) + ;; Write the buffer. + (write-region (point-min) (point-max) file nil 'quietly))) (defun gnus-delete-file (file) "Delete FILE if it exists." @@ -569,7 +562,7 @@ Bind `print-quoted' and `print-readably' to t while printing." (save-excursion (save-restriction (goto-char beg) - (while (re-search-forward "[ \t]+\\|[ \t]*\n" end 'move) + (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) (gnus-put-text-property beg (match-beginning 0) prop val) (setq beg (point))) (gnus-put-text-property beg (point) prop val))))) @@ -682,7 +675,8 @@ with potentially long computations." (save-excursion (set-buffer file-buffer) (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) (gnus-write-buffer filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) @@ -733,7 +727,8 @@ with potentially long computations." (let ((file-buffer (create-file-buffer filename))) (save-excursion (set-buffer file-buffer) - (let ((require-final-newline nil)) + (let ((require-final-newline nil) + (coding-system-for-write mm-text-coding-system)) (gnus-write-buffer filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) @@ -856,8 +851,10 @@ ARG is passed to the first function." (forward-line 1)) (nreverse result))))) -(defun gnus-netrc-machine (list machine &optional port) - "Return the netrc values from LIST for MACHINE or for the default entry." +(defun gnus-netrc-machine (list machine &optional port defaultport) + "Return the netrc values from LIST for MACHINE or for the default entry. +If PORT specified, only return entries with matching port tokens. +Entries without port tokens default to DEFAULTPORT." (let ((rest list) result) (while list @@ -873,9 +870,9 @@ ARG is passed to the first function." (when result (setq result (nreverse result)) (while (and result - (not (equal (or port "nntp") + (not (equal (or port defaultport "nntp") (or (gnus-netrc-get (car result) "port") - "nntp")))) + defaultport "nntp")))) (pop result)) (car result)))) @@ -958,23 +955,40 @@ ARG is passed to the first function." t)) (defun gnus-write-active-file (file hashtb &optional full-names) - (with-temp-file file - (mapatoms - (lambda (sym) - (when (and sym - (boundp sym) - (symbol-value sym)) - (insert (format "%S %d %d y\n" - (if full-names - sym - (intern (gnus-group-real-name (symbol-name sym)))) - (or (cdr (symbol-value sym)) - (car (symbol-value sym))) - (car (symbol-value sym)))))) - hashtb) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1)))) + (let ((coding-system-for-write nnmail-active-file-coding-system)) + (with-temp-file file + (mapatoms + (lambda (sym) + (when (and sym + (boundp sym) + (symbol-value sym)) + (insert (format "%S %d %d y\n" + (if full-names + sym + (intern (gnus-group-real-name (symbol-name sym)))) + (or (cdr (symbol-value sym)) + (car (symbol-value sym))) + (car (symbol-value sym)))))) + hashtb) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1))))) + +(if (fboundp 'union) + (defalias 'gnus-union 'union) + (defun gnus-union (l1 l2) + "Set union of lists L1 and L2." + (cond ((null l1) l2) + ((null l2) l1) + ((equal l1 l2) l1) + (t + (or (>= (length l1) (length l2)) + (setq l1 (prog1 l2 (setq l2 l1)))) + (while l2 + (or (member (car l2) l1) + (push (car l2) l1)) + (pop l2)) + l1)))) (provide 'gnus-util)