Sync up with Gnus 5.6.24.
[elisp/gnus.git-] / lisp / gnus-util.el
index 82e7f94..23dd313 100644 (file)
@@ -580,6 +580,7 @@ Timezone package is used."
 Bind `print-quoted' and `print-readably' to t while printing."
   (let ((print-quoted t)
        (print-readably t)
+       (print-escape-multibyte nil)
        print-level print-length)
     (prin1 form (current-buffer))))
 
@@ -878,50 +879,59 @@ ARG is passed to the first function."
                      "password" "account" "macdef" "force"))
            alist elem result pair)
        (nnheader-set-temp-buffer " *netrc*")
-       (set-syntax-table gnus-netrc-syntax-table)
-       (insert-file-contents file)
-       (goto-char (point-min))
-       ;; Go through the file, line by line.
-       (while (not (eobp))
-         (narrow-to-region (point) (gnus-point-at-eol))
-         ;; For each line, get the tokens and values.
-         (while (not (eobp))
-           (skip-chars-forward "\t ")
-           (unless (eobp)
-             (setq elem (buffer-substring
-                         (point) (progn (forward-sexp 1) (point))))
-             (cond
-              ((equal elem "macdef")
-               ;; We skip past the macro definition.
+       (unwind-protect
+           (progn
+             (set-syntax-table gnus-netrc-syntax-table)
+             (insert-file-contents file)
+             (goto-char (point-min))
+             ;; Go through the file, line by line.
+             (while (not (eobp))
+               (narrow-to-region (point) (gnus-point-at-eol))
+               ;; For each line, get the tokens and values.
+               (while (not (eobp))
+                 (skip-chars-forward "\t ")
+                 (unless (eobp)
+                   (setq elem (buffer-substring
+                               (point) (progn (forward-sexp 1) (point))))
+                   (cond
+                    ((equal elem "macdef")
+                     ;; We skip past the macro definition.
+                     (widen)
+                     (while (and (zerop (forward-line 1))
+                                 (looking-at "$")))
+                     (narrow-to-region (point) (point)))
+                    ((member elem tokens)
+                     ;; Tokens that don't have a following value are ignored,
+                     ;; except "default".
+                     (when (and pair (or (cdr pair)
+                                         (equal (car pair) "default")))
+                       (push pair alist))
+                     (setq pair (list elem)))
+                    (t
+                     ;; Values that haven't got a preceding token are ignored.
+                     (when pair
+                       (setcdr pair elem)
+                       (push pair alist)
+                       (setq pair nil))))))
+               (if alist
+                   (push (nreverse alist) result))
+               (setq alist nil
+                     pair nil)
                (widen)
-               (while (and (zerop (forward-line 1))
-                           (looking-at "$")))
-               (narrow-to-region (point) (point)))
-              ((member elem tokens)
-               ;; Tokens that don't have a following value are ignored.
-               (when (and pair (cdr pair))
-                 (push pair alist))
-               (setq pair (list elem)))
-              (t
-               ;; Values that haven't got a preceding token are ignored.
-               (when pair
-                 (setcdr pair elem)
-                 (push pair alist)
-                 (setq pair nil))))))
-         (push alist result)
-         (setq alist nil
-               pair nil)
-         (widen)
-         (forward-line 1))
-       result))))
+               (forward-line 1))
+             (nreverse result))
+         (kill-buffer " *netrc*"))))))
 
 (defun gnus-netrc-machine (list machine)
-  "Return the netrc values from LIST for MACHINE."
-  (while (and list
-             (not (equal (cdr (assoc "machine" (car list))) machine)))
-    (pop list))
-  (when list
-    (car list)))
+  "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)))
+      (pop list))
+    (car (or list
+            (progn (while (and rest (not (assoc "default" (car rest))))
+                     (pop rest))
+                   rest)))))
 
 (defun gnus-netrc-get (alist type)
   "Return the value of token TYPE from ALIST."
@@ -949,7 +959,7 @@ ARG is passed to the first function."
   "Delete elements from LIST that satisfy PREDICATE."
   (let (out)
     (while list
-      (when (funcall predicate (car list))
+      (unless (funcall predicate (car list))
        (push (car list) out))
       (pop list))
     (nreverse out)))