X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-util.el;h=5cdedd21d488e642141c9dc2d8c82fc0dececaa9;hb=e9b6e1088c1079e93d9290976459825b434328d0;hp=366e76c9f6e7ccbbe7483f03d7878e67d1a726b8;hpb=968bbc582f15837fad116c2df98e6fc6d646bc89;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 366e76c..5cdedd2 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -118,9 +118,9 @@ (static-cond ((fboundp 'point-at-bol) - (fset 'gnus-point-at-bol 'point-at-bol)) + (defalias 'gnus-point-at-bol 'point-at-bol)) ((fboundp 'line-beginning-position) - (fset 'gnus-point-at-bol 'line-beginning-position)) + (defalias 'gnus-point-at-bol 'line-beginning-position)) (t (defun gnus-point-at-bol () "Return point at the beginning of the line." @@ -132,9 +132,9 @@ )) (static-cond ((fboundp 'point-at-eol) - (fset 'gnus-point-at-eol 'point-at-eol)) + (defalias 'gnus-point-at-eol 'point-at-eol)) ((fboundp 'line-end-position) - (fset 'gnus-point-at-eol 'line-end-position)) + (defalias 'gnus-point-at-eol 'line-end-position)) (t (defun gnus-point-at-eol () "Return point at the end of the line." @@ -343,11 +343,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 ""))) @@ -483,14 +483,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 () @@ -570,17 +562,21 @@ Bind `print-quoted' and `print-readably' to t while printing." (defun gnus-make-directory (directory) "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) + (let ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system)) + (when (and directory + (not (file-exists-p directory))) + (make-directory directory t))) t) (defun gnus-write-buffer (file) "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) + (pathname-coding-system nnmail-pathname-coding-system)) + ;; Write the buffer. + (write-region (point-min) (point-max) file nil 'quietly))) (defun gnus-write-buffer-as-binary (file) "Write the current buffer's contents to FILE without code conversion." @@ -614,7 +610,7 @@ Bind `print-quoted' and `print-readably' to t while printing." (save-excursion (save-restriction (goto-char beg) - (while (re-search-forward "[ \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))))) @@ -728,7 +724,8 @@ with potentially long computations." (set-buffer file-buffer) (rmail-insert-rmail-file-header) (let ((require-final-newline nil)) - (gnus-write-buffer filename))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -779,7 +776,8 @@ with potentially long computations." (save-excursion (set-buffer file-buffer) (let ((require-final-newline nil)) - (gnus-write-buffer-as-binary filename))) + (gnus-write-buffer-as-coding-system + nnheader-text-coding-system filename))) (kill-buffer file-buffer)) (error "Output file does not exist"))) (set-buffer tmpbuf) @@ -902,8 +900,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 @@ -919,9 +919,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)))) @@ -1003,11 +1003,9 @@ ARG is passed to the first function." (throw 'found nil))) t)) -(defun gnus-write-active-file-as-coding-system (coding-system file hashtb - &optional - full-names) - (let ((output-coding-system coding-system) - (coding-system-for-write coding-system)) +(defun gnus-write-active-file (file hashtb &optional full-names) + (let ((output-coding-system nnmail-active-file-coding-system) + (coding-system-for-write nnmail-active-file-coding-system)) (with-temp-file file (mapatoms (lambda (sym) @@ -1026,6 +1024,44 @@ ARG is passed to the first function." (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)))) + +(defun gnus-add-text-properties-when + (property value start end properties &optional object) + "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (setq point (text-property-not-all start end property value))) + (gnus-add-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (gnus-add-text-properties start end properties object)))) + +(defun gnus-remove-text-properties-when + (property value start end properties &optional object) + "Like `remove-text-properties', only applied on where PROPERTY is VALUE." + (let (point) + (while (and start + (setq point (text-property-not-all start end property value))) + (remove-text-properties start point properties object) + (setq start (text-property-any point end property value))) + (if start + (remove-text-properties start end properties object)))) + (provide 'gnus-util) ;;; gnus-util.el ends here