* Makefile.in (install-package-ja): Compile and install lisp files first.

[elisp/gnus.git-] / lisp / gnus-util.el

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index c6ea284..e566243 100644 (file)
--- 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."
@@ -197,8 +197,8 @@
        (and (string-match "(.*" from)
             (setq name (substring from (1+ (match-beginning 0))
                                   (match-end 0)))))
-    ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-    (list (or name from) (or address from))))
+    (list (if (string= name "") nil name) (or address from))))
+
 
 (defun gnus-fetch-field (field)
   "Return the value of the header FIELD of current article."
@@ -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,22 @@ 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))))
+
 (provide 'gnus-util)
 
 ;;; gnus-util.el ends here