Importing Gnus v5.8.6.

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

diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 350926c..1df730a 100644 (file)
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -1,5 +1,6 @@
 ;;; gnus-util.el --- utility functions for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -164,8 +165,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."
@@ -291,7 +292,9 @@
 
 (defun gnus-dd-mmm (messy-date)
   "Return a string like DD-MMM from a big messy string."
-  (format-time-string "%d-%b" (safe-date-to-time messy-date)))
+  (condition-case ()
+      (format-time-string "%d-%b" (safe-date-to-time messy-date))
+    (error "  -   ")))
 
 (defmacro gnus-date-get-time (date)
   "Convert DATE string to Emacs time.
@@ -504,6 +507,7 @@ If N, return the Nth ancestor instead."
              first 't2
              last 't1))
        ((gnus-functionp function)
+       ;; Do nothing.
        )
        (t
        (error "Invalid sort spec: %s" function))))
@@ -688,7 +692,7 @@ with potentially long computations."
       ;; Decide whether to append to a file or to an Emacs buffer.
       (let ((outbuf (get-file-buffer filename)))
        (if (not outbuf)
-           (append-to-file (point-min) (point-max) filename)
+           (mm-append-to-file (point-min) (point-max) filename)
          ;; File has been visited, in buffer OUTBUF.
          (set-buffer outbuf)
          (let ((buffer-read-only nil)
@@ -756,7 +760,7 @@ with potentially long computations."
                    (insert "\n"))
                  (insert "\n"))
                (goto-char (point-max))
-               (append-to-file (point-min) (point-max) filename)))
+               (mm-append-to-file (point-min) (point-max) filename)))
          ;; File has been visited, in buffer OUTBUF.
          (set-buffer outbuf)
          (let ((buffer-read-only nil))
@@ -802,7 +806,8 @@ ARG is passed to the first function."
   (when (file-exists-p file)
     (with-temp-buffer
       (let ((tokens '("machine" "default" "login"
-                     "password" "account" "macdef" "force"))
+                     "password" "account" "macdef" "force"
+                     "port"))
            alist elem result pair)
        (insert-file-contents file)
        (goto-char (point-min))
@@ -816,9 +821,12 @@ ARG is passed to the first function."
            (if (eq (char-after) ?#)
                (goto-char (point-max))
              (unless (eobp)
-               (setq elem (buffer-substring
-                           (point) (progn (skip-chars-forward "^\t ")
-                                          (point))))
+               (setq elem
+                     (if (= (following-char) ?\")
+                         (read (current-buffer))
+                       (buffer-substring
+                        (point) (progn (skip-chars-forward "^\t ")
+                                       (point)))))
                (cond
                 ((equal elem "macdef")
                  ;; We skip past the macro definition.
@@ -847,16 +855,28 @@ ARG is passed to the first function."
          (forward-line 1))
        (nreverse result)))))
 
-(defun gnus-netrc-machine (list machine)
+(defun gnus-netrc-machine (list machine &optional port)
   "Return the netrc values from LIST for MACHINE or for the default entry."
-  (let ((rest list))
-    (while (and list
-               (not (equal (cdr (assoc "machine" (car list))) machine)))
+  (let ((rest list)
+       result)
+    (while list
+      (when (equal (cdr (assoc "machine" (car list))) machine)
+       (push (car list) result))
       (pop list))
-    (car (or list
-            (progn (while (and rest (not (assoc "default" (car rest))))
-                     (pop rest))
-                   rest)))))
+    (unless result
+      ;; No machine name matches, so we look for default entries.
+      (while rest
+       (when (assoc "default" (car rest))
+         (push (car rest) result))
+       (pop rest)))
+    (when result
+      (setq result (nreverse result))
+      (while (and result
+                 (not (equal (or port "nntp")
+                             (or (gnus-netrc-get (car result) "port")
+                                 "nntp"))))
+       (pop result))
+      (car result))))
 
 (defun gnus-netrc-get (alist type)
   "Return the value of token TYPE from ALIST."
@@ -936,18 +956,24 @@ ARG is passed to the first function."
        (throw 'found nil)))
     t))
 
-(defun gnus-write-active-file (file hashtb)
+(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"
-                        (gnus-group-real-name (symbol-name sym)) 
-                        (cdr (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)))
+     hashtb)
+    (goto-char (point-max))
+    (while (search-backward "\\." nil t)
+      (delete-char 1))))
 
 (provide 'gnus-util)