Sync with latest Gnus.
authoryamaoka <yamaoka>
Tue, 18 Apr 2000 22:55:01 +0000 (22:55 +0000)
committeryamaoka <yamaoka>
Tue, 18 Apr 2000 22:55:01 +0000 (22:55 +0000)
contrib/README [new file with mode: 0644]
contrib/one-line-cookie.diff [new file with mode: 0644]
contrib/vcard.el [new file with mode: 0644]

diff --git a/contrib/README b/contrib/README
new file mode 100644 (file)
index 0000000..76d0e5c
--- /dev/null
@@ -0,0 +1,3 @@
+The files in this directory are not (yet) part of the
+Gnus distribution proper.  They may later become part
+of the distribution, or they may disappear altogether.
diff --git a/contrib/one-line-cookie.diff b/contrib/one-line-cookie.diff
new file mode 100644 (file)
index 0000000..1cab64a
--- /dev/null
@@ -0,0 +1,28 @@
+Index: url-cookie.el
+===================================================================
+RCS file: /gd/gnu/anoncvsroot/url/lisp/url-cookie.el,v
+retrieving revision 1.1.1.1
+diff -u -r1.1.1.1 url-cookie.el
+--- url-cookie.el      1999/11/26 12:11:47     1.1.1.1
++++ url-cookie.el      1999/12/10 06:53:05
+@@ -255,6 +255,10 @@
+               (setq retval (cons cur retval))))))
+     retval))
++(defvar url-cookie-multiple-line t
++  "If nil, use one line cookie.
++Some web servers, such as hotmail, only accept one line cookie.")
++
+ ;;;###autolaod
+ (defun url-cookie-generate-header-lines (host path secure)
+   (let* ((cookies (url-cookie-retrieve host path secure))
+@@ -272,7 +276,8 @@
+       (setq cur (car cookies)
+           cookies (cdr cookies)
+           chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
+-          retval (if (< 80 (+ (length retval) (length chunk) 4))
++          retval (if (and url-cookie-multiple-line
++                      (< 80 (+ (length retval) (length chunk) 4)))
+                      (concat retval "\r\nCookie: " chunk)
+                    (if retval
+                        (concat retval "; " chunk)
diff --git a/contrib/vcard.el b/contrib/vcard.el
new file mode 100644 (file)
index 0000000..ade35d7
--- /dev/null
@@ -0,0 +1,310 @@
+;;; vcard.el --- vcard parsing and display routines
+
+;; Copyright (C) 1997 Noah S. Friedman
+
+;; Author: Noah Friedman <friedman@splode.com>
+;; Maintainer: friedman@splode.com
+;; Keywords: extensions
+;; Created: 1997-09-27
+
+;; $Id: vcard.el,v 1.1.2.1 2000-04-18 22:55:01 yamaoka Exp $
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, you can either send email to this
+;; program's maintainer or write to: The Free Software Foundation,
+;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The display routines here are just an example.  The primitives in the
+;; first section can be used to construct other vcard formatters.
+
+;;; Code:
+
+(defvar vcard-standard-filters '(vcard-filter-html)
+  "*Standard list of filters to apply to parsed vcard data.
+These filters are applied sequentially to vcard data records when
+the function `vcard-standard-filter' is supplied as the second argument to
+`vcard-parse-string'.")
+
+(defun vcard-parse-string (raw &optional filter)
+  "Parse RAW vcard data as a string, and return an alist representing data.
+
+If the optional function FILTER is specified, apply that filter to the
+data record of each key before splitting fields.  Filters should accept
+two arguments: the key and the data.  They are expected to operate on
+\(and return\) a modified data value.
+
+Vcard data is normally in the form
+
+    begin:        vcard
+    key1:         field
+    key2;subkey1: field
+    key2;subkey2: field1;field2;field3
+    end:          vcard
+
+\(Whitespace after the colon separating the key and field is optional.\)
+If supplied to this function an alist of the form
+
+    ((\"key1\" \"field\")
+     (\"key2\"
+      (\"subkey2\" \"field1\" \"field2\" \"field3\")
+      (\"subkey1\" \"field\")))
+
+would be returned."
+  (save-match-data
+    (let ((raw-pos 0)
+          (vcard-data nil)
+          key data)
+      (string-match "^[ \t]*begin:[ \t]*vcard[ \t]*[\r\n]+" raw raw-pos)
+      (setq raw-pos (match-end 0))
+      (while (and (< raw-pos (length raw))
+                  (string-match
+                   "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*[\n\r]+"
+                   raw raw-pos))
+        (setq key (vcard-matching-substring 1 raw))
+        (setq data (vcard-matching-substring 2 raw))
+        (setq raw-pos (match-end 0))
+        (cond
+         ((string= key "end")
+          (setq raw-pos (length raw)))
+         (t
+          (and filter
+               (setq data (funcall filter key data)))
+          (setq vcard-data
+                (vcard-set-alist-slot vcard-data
+                                      (vcard-split-string key ";")
+                                      (vcard-split-string data ";"))))))
+      (nreverse vcard-data))))
+
+(defun vcard-ref (key vcard-data)
+  "Return the vcard data associated with KEY in VCARD-DATA.
+Key may be a list of nested keys or a single string of colon-separated
+keys."
+  (cond ((listp key)
+         (vcard-alist-assoc key vcard-data))
+        ((and (stringp key)
+              (save-match-data
+                (string-match ";" key)))
+         (vcard-alist-assoc (vcard-split-string key ";") vcard-data))
+        ((stringp key)
+         (cdr (assoc key vcard-data)))))
+
+\f
+;;; Vcard data filters.
+
+;; These receive both the key and data, but are expected to operate on (and
+;; return) just the data.
+;;
+;; There is probably no overwhelming need for this, except that some lusers
+;; put HTML in their vcards under the misguided notion that it's a standard
+;; feature of vcards just because Netscape supports this feature.  (Or
+;; perhaps those lusers just don't care that their vcards look like shit in
+;; every other MUA).
+;;
+;; On the other hand, perhaps someone will devise some other use for these
+;; filters, such as noticing common phone number formats and re-formatting
+;; them to fit personal preferences.
+
+(defun vcard-filter-apply-filter-list (filter-list key data)
+  (while filter-list
+    (setq data (funcall (car filter-list) key data))
+    (setq filter-list (cdr filter-list)))
+  data)
+
+(defun vcard-standard-filter (key data)
+  (vcard-filter-apply-filter-list vcard-standard-filters key data))
+
+(defun vcard-filter-html (key data)
+  (save-match-data
+    (while (string-match "<[^<>\n]+>" data)
+      (setq data (concat (substring data 0 (match-beginning 0))
+                         (substring data (match-end 0)))))
+    data))
+
+\f
+;;; Utility routines.
+
+;; This does most of the dirty work of key lookup for vcard-ref.
+(defun vcard-alist-assoc (keys alist)
+  (while (and keys alist)
+    (setq alist (cdr (assoc (car keys) alist)))
+    (setq keys (cdr keys)))
+  alist)
+
+;; In ALIST, set KEY-LIST's value to VALUE, and return new value of ALIST.
+;; KEY-LIST should be a list of nested keys, if ALIST is an alist of alists.
+;; If any key is not present in an alist, the key and value pair will be
+;; inserted into the parent alist.
+(defun vcard-set-alist-slot (alist key-list value)
+  (let* ((key (car key-list))
+         (elt (assoc key alist)))
+    (setq key-list (cdr key-list))
+    (cond ((and (cdr elt) key-list)
+           (vcard-set-alist-slot (cdr elt) key-list value))
+          ((and elt key-list)
+           (setcdr elt (vcard-set-alist-slot nil key-list value)))
+          (elt (setcdr elt value))
+          (t
+           (let ((new))
+             (setq key-list (nreverse (cons key key-list)))
+             (while key-list
+               (if new
+                   (setq new (cons (car key-list) (cons new nil)))
+                 (setq new (cons (car key-list) value)))
+               (setq key-list (cdr key-list)))
+
+             (cond ((null alist)
+                    (setq alist (cons new nil)))
+                   (t
+                    (setcdr alist (cons (car alist) (cdr alist)))
+                    (setcar alist new))))))
+    alist))
+
+;; Return substring matched by last search.
+;; N specifies which match data pair to use
+;; Value is nil if there is no Nth match.
+;; If STRING is not specified, the current buffer is used.
+(defun vcard-matching-substring (n &optional string)
+  (if (match-beginning n)
+      (if string
+         (substring string (match-beginning n) (match-end n))
+       (buffer-substring (match-beginning n) (match-end n)))))
+
+;; Split STRING at occurences of SEPARATOR.  Return a list of substrings.
+;; SEPARATOR can be any regexp, but anything matching the separator will
+;; never appear in any of the returned substrings.
+(defun vcard-split-string (string separator)
+  (let* ((list nil)
+         (pos 0))
+    (save-match-data
+      (while (string-match separator string pos)
+        (setq list (cons (substring string pos (match-beginning 0)) list))
+        (setq pos (match-end 0)))
+      (nreverse (cons (substring string pos) list)))))
+
+(defun vcard-flatten (l)
+  (if (consp l)
+      (apply 'nconc (mapcar 'vcard-flatten l))
+    (list l)))
+
+\f
+;;; Sample formatting routines.
+
+(defun vcard-format-box (vcard-data)
+  "Like `vcard-format-string', but put an ascii box around text."
+  (let* ((lines (vcard-format-lines vcard-data))
+         (len (vcard-format-max-length lines))
+         (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n"))
+         (line-fmt (format "| %%-%ds |" len))
+         (formatted-lines
+          (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n")))
+    (if (string= formatted-lines "")
+        formatted-lines
+      (concat edge formatted-lines edge))))
+
+(defun vcard-format-string (vcard-data)
+  "Format VCARD-DATA into a string suitable for presentation.
+VCARD-DATA should be a parsed vcard alist.  The result is a string
+with formatted vcard information which can be inserted into a mime
+presentation buffer."
+  (mapconcat 'identity (vcard-format-lines vcard-data) "\n"))
+
+(defun vcard-format-lines (vcard-data)
+  (let* ((name  (vcard-format-get-name      vcard-data))
+         (title (vcard-format-ref "title"   vcard-data))
+         (org   (vcard-format-ref "org"     vcard-data))
+         (addr  (vcard-format-get-address   vcard-data))
+         (tel   (vcard-format-get-telephone vcard-data))
+         (lines (delete nil (vcard-flatten (list name title org addr))))
+         (col-template (format "%%-%ds%%s"
+                               (vcard-format-offset lines tel)))
+         (l lines))
+    (while tel
+      (setcar l (format col-template (car l) (car tel)))
+      ;; If we stripped away too many nil slots from l, add empty strings
+      ;; back in so setcar above will work on next iteration.
+      (and (cdr tel)
+           (null (cdr l))
+           (setcdr l (cons "" nil)))
+      (setq l (cdr l))
+      (setq tel (cdr tel)))
+    lines))
+
+
+(defun vcard-format-get-name (vcard-data)
+  (let ((name (vcard-format-ref "fn" vcard-data))
+        (email (or (vcard-format-ref '("email" "internet") vcard-data)
+                   (vcard-format-ref "email" vcard-data))))
+    (if email
+        (format "%s <%s>" name email)
+      name)))
+
+(defun vcard-format-get-address (vcard-data)
+  (let* ((addr-raw (or (vcard-format-ref '("adr" "dom") vcard-data)
+                       (vcard-format-ref "adr" vcard-data)))
+         (addr (if (consp addr-raw)
+                   addr-raw
+                 (list addr-raw)))
+         (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr))))
+         (city-list (delete "" (nthcdr 3 addr)))
+         (city (cond ((null (car city-list)) nil)
+                     ((cdr city-list)
+                      (format "%s, %s"
+                              (car city-list)
+                              (mapconcat 'identity (cdr city-list) " ")))
+                     (t (car city-list)))))
+    (delete nil
+            (if city
+                (append street (list city))
+              street))))
+
+(defun vcard-format-get-telephone (vcard-data)
+  (delete nil
+          (mapcar (function (lambda (x)
+                              (let ((result (vcard-format-ref (car x)
+                                                              vcard-data)))
+                                (and result
+                                     (concat (cdr x) result)))))
+                  '((("tel" "work") . "Work: ")
+                    (("tel" "home") . "Home: ")
+                    (("tel" "fax")  . "Fax:  ")))))
+
+(defun vcard-format-ref (key vcard-data)
+  (setq key (vcard-ref key vcard-data))
+  (or (cdr key)
+      (setq key (car key)))
+  (and (stringp key)
+       (string= key "")
+       (setq key nil))
+  key)
+
+(defun vcard-format-offset (row1 row2 &optional maxwidth)
+  (or maxwidth (setq maxwidth (frame-width)))
+  (let ((max1 (vcard-format-max-length row1))
+        (max2 (vcard-format-max-length row2)))
+    (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2)))))))
+
+(defun vcard-format-max-length (strings)
+  (let ((maxlen 0)
+        (len 0))
+    (while strings
+      (setq len (length (car strings)))
+      (setq strings (cdr strings))
+      (and (> len maxlen)
+           (setq maxlen len)))
+    maxlen))
+
+(provide 'vcard)
+
+;;; vcard.el ends here.