[bpt/emacs.git] / lisp / mail / rfc2368.el

;;; rfc2368.el --- support for rfc2368

;; Author: Sen Nagata <sen@eccosys.com>
;; 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.

;; 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
;;    is planned!
;;
;; historical note:
;;
;;   this is intended as a replacement for mailto.el
;;
;; acknowledgements:
;;
;;   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.

;;; History:
;;
;; 0.3:
;;
;;  added the constant rfc2368-version
;;  implemented first potential fix for a bug in rfc2368-mailto-regexp
;;  implemented first potential fix for a bug in rfc2368-parse-mailto
;;  (both bugs reported by Kenichi OKADA)
;;
;; 0.2:
;;
;;  started to use checkdoc
;;
;; 0.1:
;;
;;  initial implementation

;;; Code:

;; only an approximation?
;; see rfc 1738
(defconst rfc2368-mailto-regexp
  "^\\(mailto:\\)\\([^?]+\\)*\\(\\?\\(.*\\)\\)*"
  "Regular expression to match and aid in parsing a mailto url.")

;; describes 'mailto:'
(defconst rfc2368-mailto-scheme-index 1
  "Describes the 'mailto:' portion of the url.")
;; i'm going to call this part the 'prequery'
(defconst rfc2368-mailto-prequery-index 2
  "Describes the portion of the url between 'mailto:' and '?'.")
;; i'm going to call this part the 'query'
(defconst rfc2368-mailto-query-index 4
  "Describes the portion of the url after '?'.")

(defun rfc2368-unhexify-string (string)
  "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
  (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
			    (lambda (match)
			      (string (string-to-number (substring match 1)
							16)))
			    string t t))

(defun rfc2368-parse-mailto-url (mailto-url)
  "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
MAILTO-URL should be a RFC 2368 (mailto) compliant url.  A cons cell w/ a
key of 'Body' is a special case and is considered a header for this purpose.
The returned alist is intended for use w/ the `compose-mail' interface.
Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. &amp; -> &), before
calling this function."
  (let ((case-fold-search t)
	prequery query headers-alist)

    (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))

	  ;; build alist of header name-value pairs
	  (if (not (null query))
	      (setq headers-alist
		    (mapcar
		     (lambda (x)
		       (let* ((temp-list (split-string x "="))
			      (header-name (car temp-list))
			      (header-value (cadr temp-list)))
			 ;; return ("Header-Name" . "header-value")
			 (cons
			  (capitalize (rfc2368-unhexify-string header-name))
			  (rfc2368-unhexify-string header-value))))
		     (split-string query "&"))))

	  ;; deal w/ multiple 'To' recipients
	  (if prequery
	      (progn
		(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)))
		  (setq headers-alist
			(cons (cons "To" prequery) headers-alist)))))

	  headers-alist)

      (error "Failed to match a mailto: url"))
    ))

(provide 'rfc2368)

;;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95
;;; rfc2368.el ends here
Commit	Line	Data
62f20204 GM	1	;;; rfc2368.el --- support for rfc2368
62f20204 GM	2
4bcb5a9e	3	;; Author: Sen Nagata <sen@eccosys.com>
62f20204 GM	4	;; Keywords: mail
	5
	6	;; Copyright (C) 1998, 2000 Free Software Foundation, Inc.
	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
	24
	25	;;; Commentary:
	26	;;
	27	;; notes:
	28	;;
	29	;; -repeat after me: "the colon is not part of the header name..."
	30	;; -if w3 becomes part of emacs, then it may make sense to have this
	31	;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs
	32	;; is planned!
	33	;;
	34	;; historical note:
	35	;;
	36	;; this is intended as a replacement for mailto.el
	37	;;
	38	;; acknowledgements:
	39	;;
	40	;; the functions that deal w/ unhexifying in this file were basically
	41	;; taken from w3 -- i hope to replace them w/ something else soon OR
	42	;; perhaps if w3 becomes a part of emacs soon, use the functions from w3.
	43
	44	;;; History:
	45	;;
	46	;; 0.3:
	47	;;
	48	;; added the constant rfc2368-version
	49	;; implemented first potential fix for a bug in rfc2368-mailto-regexp
	50	;; implemented first potential fix for a bug in rfc2368-parse-mailto
	51	;; (both bugs reported by Kenichi OKADA)
	52	;;
	53	;; 0.2:
	54	;;
	55	;; started to use checkdoc
	56	;;
	57	;; 0.1:
	58	;;
	59	;; initial implementation
	60
	61	;;; Code:
	62
	63	;; only an approximation?
	64	;; see rfc 1738
	65	(defconst rfc2368-mailto-regexp
	66	"^\\(mailto:\\)\\([^?]+\\)\\(\\?\\(.\\)\\)*"
	67	"Regular expression to match and aid in parsing a mailto url.")
68
69	;; describes 'mailto:'
70	(defconst rfc2368-mailto-scheme-index 1
71	"Describes the 'mailto:' portion of the url.")
72	;; i'm going to call this part the 'prequery'
73	(defconst rfc2368-mailto-prequery-index 2
74	"Describes the portion of the url between 'mailto:' and '?'.")
75	;; i'm going to call this part the 'query'
76	(defconst rfc2368-mailto-query-index 4
77	"Describes the portion of the url after '?'.")
78
62f20204 GM	79	(defun rfc2368-unhexify-string (string)
62f20204 GM	80	"Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
651f4d9f EZ	81	(replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
	82	(lambda (match)
	83	(string (string-to-number (substring match 1)
	84	16)))
	85	string t t))
62f20204 GM	86
	87	(defun rfc2368-parse-mailto-url (mailto-url)
	88	"Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
	89	MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a
	90	key of 'Body' is a special case and is considered a header for this purpose.
	91	The returned alist is intended for use w/ the `compose-mail' interface.
	92	Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. & -> &), before
	93	calling this function."
	94	(let ((case-fold-search t)
	95	prequery query headers-alist)
	96
	97	(if (string-match rfc2368-mailto-regexp mailto-url)
	98	(progn
	99
	100	(setq prequery
	101	(match-string rfc2368-mailto-prequery-index mailto-url))
a1506d29	102
62f20204 GM	103	(setq query
	104	(match-string rfc2368-mailto-query-index mailto-url))
	105
	106	;; build alist of header name-value pairs
	107	(if (not (null query))
	108	(setq headers-alist
	109	(mapcar
	110	(lambda (x)
	111	(let* ((temp-list (split-string x "="))
	112	(header-name (car temp-list))
	113	(header-value (cadr temp-list)))
	114	;; return ("Header-Name" . "header-value")
	115	(cons
	116	(capitalize (rfc2368-unhexify-string header-name))
	117	(rfc2368-unhexify-string header-value))))
	118	(split-string query "&"))))
	119
	120	;; deal w/ multiple 'To' recipients
	121	(if prequery
	122	(progn
	123	(if (assoc "To" headers-alist)
	124	(let* ((our-cons-cell
	125	(assoc "To" headers-alist))
	126	(our-cdr
	127	(cdr our-cons-cell)))
	128	(setcdr our-cons-cell (concat our-cdr ", " prequery)))
	129	(setq headers-alist
	130	(cons (cons "To" prequery) headers-alist)))))
a1506d29	131
62f20204	132	headers-alist)
a1506d29	133
62f20204 GM	134	(error "Failed to match a mailto: url"))
	135	))
	136
	137	(provide 'rfc2368)
	138
ab5796a9	139	;;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95
62f20204	140	;;; rfc2368.el ends here