X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=utils%2Frfc2368.el;h=a2ab61ebf7ede262929e20a82b1fd70eb84b839b;hb=ad53866b9dc2027a3badf6be4691e7320479eda0;hp=8137c9a040e49702fcdbd58b961f667a9a828d5b;hpb=6a922a71b819f0c7b0d2e2435df5b0a768466c64;p=elisp%2Fwanderlust.git

diff --git a/utils/rfc2368.el b/utils/rfc2368.el
index 8137c9a..a2ab61e 100644
--- a/utils/rfc2368.el
+++ b/utils/rfc2368.el
@@ -1,21 +1,34 @@
-;;; rfc2368.el --- support for rfc 2368
-
-;;; Copyright 1999 Sen Nagata <sen@eccosys.com>
+;;; rfc2368.el --- support for rfc2368
 
 ;; Author: Sen Nagata <sen@eccosys.com>
-;; Version: 0.3
-;; Keywords: rfc 2368, mailto, mail
-;; License: GPL 2
+;; Keywords: mail
+
+;; Copyright (C) 1998, 2000 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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.
 
-;; This file is not a part of GNU Emacs.
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 ;;
 ;; notes:
 ;;
 ;;   -repeat after me: "the colon is not part of the header name..."
-;;   -if w3 becomes part of Emacs, then it may make sense to have this
-;;    file depend on w3 -- the maintainer of w3 says merging w/ emacs
+;;   -if w3 becomes part of emacs, then it may make sense to have this
+;;    file depend on w3 -- the maintainer of w3 says merging w/ Emacs
 ;;    is planned!
 ;;
 ;; historical note:
@@ -26,7 +39,7 @@
 ;;
 ;;   the functions that deal w/ unhexifying in this file were basically
 ;; taken from w3 -- i hope to replace them w/ something else soon OR
-;; perhaps if w3 becomes a part of Emacs soon, use the functions from w3.
+;; perhaps if w3 becomes a part of emacs soon, use the functions from w3.
 
 ;;; History:
 ;;
@@ -46,7 +59,6 @@
 ;;  initial implementation
 
 ;;; Code:
-(defconst rfc2368-version "rfc2368.el 0.3")
 
 ;; only an approximation?
 ;; see rfc 1738
@@ -64,39 +76,21 @@
 (defconst rfc2368-mailto-query-index 4
   "Describes the portion of the url after '?'.")
 
-;; for dealing w/ unhexifying strings, my preferred approach is to use
-;; a 'string-replace-match-using-function' which can perform a
-;; string-replace-match and compute the replacement text based on a
-;; passed function -- however, emacs doesn't seem to have such a
-;; function yet :-(
-
-;; for the moment a rip-off of url-unhex (w3/url.el)
-(defun rfc2368-unhexify-char (char)
-  "Unhexify CHAR -- e.g. %20 -> <SPC>."
-  (if (> char ?9)
-      (if (>= char ?a)
-	  (+ 10 (- char ?a))
-	(+ 10 (- char ?A)))
-    (- char ?0)))
-
-;; for the moment a rip-off of url-unhex-string (w3/url.el) (slightly modified)
 (defun rfc2368-unhexify-string (string)
   "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
-  (let ((case-fold-search t)
-	(result ""))
-    (while (string-match "%[0-9a-f][0-9a-f]" string)
-      (let* ((start (match-beginning 0))
-	     (hex-code (+ (* 16
-			     (rfc2368-unhexify-char (elt string (+ start 1))))
-			  (rfc2368-unhexify-char (elt string (+ start 2))))))
-	(setq result (concat
-		      result (substring string 0 start)
-		      (char-to-string hex-code))
-	      string (substring string (match-end 0)))))
-    ;; it seems clearer to do things this way than to just return:
-    ;; (concat result string)
-    (setq result (concat result string))
-    result))
+  (let ((start 0)
+	(buf))
+    (while (string-match "+\\|%\\(0D%0A\\|\\([0-9a-fA-F][0-9a-fA-F]\\)\\)"
+			 string start)
+      (push (substring string start (match-beginning 0)) buf)
+      (push (cond
+	     ((match-beginning 2)
+	      (vector (string-to-number (match-string 2 string) 16)))
+	     ((match-beginning 1) "\n")
+	     (t " "))
+	    buf)
+      (setq start (match-end 0)))
+    (apply 'concat (nreverse (cons (substring string start) buf)))))
 
 (defun rfc2368-parse-mailto-url (mailto-url)
   "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
@@ -107,13 +101,20 @@ Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. &amp; -> &), before
 calling this function."
   (let ((case-fold-search t)
 	prequery query headers-alist)
-
+    ;; Remove newline
+    (setq mailto-url
+	  (with-temp-buffer
+	    (insert mailto-url)
+	    (goto-char (point-min))
+	    (while (re-search-forward "\n" nil t)
+	      (replace-match ""))
+	    (buffer-string)))
     (if (string-match rfc2368-mailto-regexp mailto-url)
 	(progn
 
 	  (setq prequery
 		(match-string rfc2368-mailto-prequery-index mailto-url))
-	  
+
 	  (setq query
 		(match-string rfc2368-mailto-query-index mailto-url))
 
@@ -134,17 +135,18 @@ calling this function."
 	  ;; deal w/ multiple 'To' recipients
 	  (if prequery
 	      (progn
+		(setq prequery (rfc2368-unhexify-string prequery))
 		(if (assoc "To" headers-alist)
 		    (let* ((our-cons-cell
 			    (assoc "To" headers-alist))
 			   (our-cdr
 			    (cdr our-cons-cell)))
-		      (setcdr our-cons-cell (concat our-cdr ", " prequery)))
+		      (setcdr our-cons-cell (concat prequery ", " our-cdr)))
 		  (setq headers-alist
 			(cons (cons "To" prequery) headers-alist)))))
-	  
+
 	  headers-alist)
-      
+
       (error "Failed to match a mailto: url"))
     ))