utils/rfc2368.el

   1 ;;; rfc2368.el --- support for rfc 2368
   2
   3 ;;; Copyright 1999 Sen Nagata <sen@eccosys.com>
   4
   5 ;; Author: Sen Nagata <sen@eccosys.com>
   6 ;; Version: 0.3
   7 ;; Keywords: rfc 2368, mailto, mail
   8 ;; License: GPL 2
   9
  10 ;; This file is not a part of GNU Emacs.
  11
  12 ;;; Commentary:
  13 ;;
  14 ;; notes:
  15 ;;
  16 ;;   -repeat after me: "the colon is not part of the header name..."
  17 ;;   -if w3 becomes part of Emacs, then it may make sense to have this
  18 ;;    file depend on w3 -- the maintainer of w3 says merging w/ emacs
  19 ;;    is planned!
  20 ;;
  21 ;; historical note:
  22 ;;
  23 ;;   this is intended as a replacement for mailto.el
  24 ;;
  25 ;; acknowledgements:
  26 ;;
  27 ;;   the functions that deal w/ unhexifying in this file were basically
  28 ;; taken from w3 -- i hope to replace them w/ something else soon OR
  29 ;; perhaps if w3 becomes a part of Emacs soon, use the functions from w3.
  30
  31 ;;; History:
  32 ;;
  33 ;; 0.3:
  34 ;;
  35 ;;  added the constant rfc2368-version
  36 ;;  implemented first potential fix for a bug in rfc2368-mailto-regexp
  37 ;;  implemented first potential fix for a bug in rfc2368-parse-mailto
  38 ;;  (both bugs reported by Kenichi OKADA)
  39 ;;
  40 ;; 0.2:
  41 ;;
  42 ;;  started to use checkdoc
  43 ;;
  44 ;; 0.1:
  45 ;;
  46 ;;  initial implementation
  47
  48 ;;; Code:
  49 (defconst rfc2368-version "rfc2368.el 0.3")
  50
  51 ;; only an approximation?
  52 ;; see rfc 1738
  53 (defconst rfc2368-mailto-regexp
  54   "^\\(mailto:\\)\\([^?]+\\)*\\(\\?\\(.*\\)\\)*"
  55   "Regular expression to match and aid in parsing a mailto url.")
  56
  57 ;; describes 'mailto:'
  58 (defconst rfc2368-mailto-scheme-index 1
  59   "Describes the 'mailto:' portion of the url.")
  60 ;; i'm going to call this part the 'prequery'
  61 (defconst rfc2368-mailto-prequery-index 2
  62   "Describes the portion of the url between 'mailto:' and '?'.")
  63 ;; i'm going to call this part the 'query'
  64 (defconst rfc2368-mailto-query-index 4
  65   "Describes the portion of the url after '?'.")
  66
  67 ;; for dealing w/ unhexifying strings, my preferred approach is to use
  68 ;; a 'string-replace-match-using-function' which can perform a
  69 ;; string-replace-match and compute the replacement text based on a
  70 ;; passed function -- however, emacs doesn't seem to have such a
  71 ;; function yet :-(
  72
  73 ;; for the moment a rip-off of url-unhex (w3/url.el)
  74 (defun rfc2368-unhexify-char (char)
  75   "Unhexify CHAR -- e.g. %20 -> <SPC>."
  76   (if (> char ?9)
  77       (if (>= char ?a)
  78           (+ 10 (- char ?a))
  79         (+ 10 (- char ?A)))
  80     (- char ?0)))
  81
  82 ;; for the moment a rip-off of url-unhex-string (w3/url.el) (slightly modified)
  83 (defun rfc2368-unhexify-string (string)
  84   "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
  85   (let ((case-fold-search t)
  86         (result ""))
  87     (while (string-match "%[0-9a-f][0-9a-f]" string)
  88       (let* ((start (match-beginning 0))
  89              (hex-code (+ (* 16
  90                              (rfc2368-unhexify-char (elt string (+ start 1))))
  91                           (rfc2368-unhexify-char (elt string (+ start 2))))))
  92         (setq result (concat
  93                       result (substring string 0 start)
  94                       (char-to-string hex-code))
  95               string (substring string (match-end 0)))))
  96     ;; it seems clearer to do things this way than to just return:
  97     ;; (concat result string)
  98     (setq result (concat result string))
  99     result))
 100
 101 (defun rfc2368-parse-mailto-url (mailto-url)
 102   "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
 103 MAILTO-URL should be a RFC 2368 (mailto) compliant url.  A cons cell w/ a
 104 key of 'Body' is a special case and is considered a header for this purpose.
 105 The returned alist is intended for use w/ the `compose-mail' interface.
 106 Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. &amp; -> &), before
 107 calling this function."
 108   (let ((case-fold-search t)
 109         prequery query headers-alist)
 110
 111     (if (string-match rfc2368-mailto-regexp mailto-url)
 112         (progn
 113
 114           (setq prequery
 115                 (match-string rfc2368-mailto-prequery-index mailto-url))
 116
 117           (setq query
 118                 (match-string rfc2368-mailto-query-index mailto-url))
 119
 120           ;; build alist of header name-value pairs
 121           (if (not (null query))
 122               (setq headers-alist
 123                     (mapcar
 124                      (lambda (x)
 125                        (let* ((temp-list (split-string x "="))
 126                               (header-name (car temp-list))
 127                               (header-value (cadr temp-list)))
 128                          ;; return ("Header-Name" . "header-value")
 129                          (cons
 130                           (capitalize (rfc2368-unhexify-string header-name))
 131                           (rfc2368-unhexify-string header-value))))
 132                      (split-string query "&"))))
 133
 134           ;; deal w/ multiple 'To' recipients
 135           (if prequery
 136               (progn
 137                 (if (assoc "To" headers-alist)
 138                     (let* ((our-cons-cell
 139                             (assoc "To" headers-alist))
 140                            (our-cdr
 141                             (cdr our-cons-cell)))
 142                       (setcdr our-cons-cell (concat our-cdr ", " prequery)))
 143                   (setq headers-alist
 144                         (cons (cons "To" prequery) headers-alist)))))
 145
 146           headers-alist)
 147
 148       (error "Failed to match a mailto: url"))
 149     ))
 150
 151 (provide 'rfc2368)
 152
 153 ;;; rfc2368.el ends here