experimental/muse-message.el

   1 ;;; muse-message.el --- publish a file as an email message
   2
   3 ;; Copyright (C) 2004, 2005  Free Software Foundation, Inc.
   4
   5 ;; This file is not part of GNU Emacs.
   6
   7 ;; This is free software; you can redistribute it and/or modify it under
   8 ;; the terms of the GNU General Public License as published by the Free
   9 ;; Software Foundation; either version 2, or (at your option) any later
  10 ;; version.
  11 ;;
  12 ;; This is distributed in the hope that it will be useful, but WITHOUT
  13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 ;; for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; This file is in experimental status due to unimplemented features.
  25 ;;
  26 ;; To make use of this file, put (require 'muse-message) in your .emacs.
  27 ;;
  28 ;; By default, the way to mark up an email message is to do the
  29 ;; following.
  30 ;;
  31 ;;  - Enter Message mode.  This is usually done automatically when you
  32 ;;    compose an email message using your Emacs mail client of choice.
  33 ;;
  34 ;;  - Use standard Muse markup instead of plain text for your message.
  35 ;;
  36 ;;  - When you are ready to see what the email message will look like,
  37 ;;    do `M-x muse-message-markup'.  This will make two versions of
  38 ;;    your message: plaintext and HTML.
  39 ;;
  40 ;;  - If you want to do further editing, simply undo your changes,
  41 ;;    edit some more, and run `muse-message-markup' when you're ready
  42 ;;    to send.
  43 ;;
  44 ;;  - Send the message.
  45 ;;
  46 ;; If you wish the markup to be automatic at the time of sending you
  47 ;; message (a risky proposition), just add `muse-message-markup' to
  48 ;; `message-send-hook'.
  49
  50 ;;; Contributors:
  51
  52 ;;; Code:
  53
  54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  55 ;;
  56 ;; Muse E-Mail Publishing (via alternative/html)
  57 ;;
  58 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59
  60 (require 'message)
  61 (require 'footnote)
  62
  63 (require 'muse-publish)
  64 (require 'muse-html)
  65
  66 (defgroup muse-message nil
  67   "Options controlling the behavior of Emacs Wiki Mail Markup."
  68   :group 'hypermedia
  69   :group 'muse-publish)
  70
  71 (defcustom muse-message-publishing-style "message"
  72   "Style used for publishing the alternative/text section of a message."
  73   :type 'string
  74   :group 'muse-message)
  75
  76 (defcustom muse-message-html-publishing-style "message-html"
  77   "Style used for publishing the alternative/html section of a message."
  78   :type 'string
  79   :group 'muse-message)
  80
  81 (defcustom muse-message-indent "  "
  82   "String used to pad indentend text."
  83   :type 'string
  84   :group 'muse-message)
  85
  86 (defcustom muse-message-style-sheet
  87   "body {
  88   background: white; color: black;
  89   margin-left: 3%; margin-right: 7%;
  90 }
  91
  92 p { margin-top: 1% }
  93 p.verse { margin-left: 3% }
  94
  95 .example { margin-left: 3% }
  96
  97 h2 {
  98   margin-top: 25px;
  99   margin-bottom: 0px;
 100 }
 101 h3 { margin-bottom: 0px; }"
 102   "Text to prepend to a Muse mail message being published.
 103 This text may contain <lisp> markup tags."
 104   :type 'string
 105   :group 'muse-message)
 106
 107 (defcustom muse-message-html-header
 108   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">
 109 <html>
 110   <head>
 111     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
 112     <meta name=\"generator\" content=\"muse-message.el\">
 113     <link rev=\"made\" href=\"<lisp>user-mail-address</lisp>\">
 114     <style type=\"text/css\">
 115       <lisp>muse-message-style-sheet</lisp>
 116     </style>
 117   </head>
 118   <body>
 119     <!-- Mail published by Emacs Muse begins here -->\n"
 120   "Text to prepend to a Muse mail message being published.
 121 This text may contain <lisp> markup tags."
 122   :type 'string
 123   :group 'muse-message)
 124
 125 (defcustom muse-message-html-footer
 126   "\n    <!-- Mail published by Emacs Muse ends here -->
 127   </body>
 128 </html>\n"
 129   "Text to append to a Muse mail message being published.
 130 This text may contain <lisp> markup tags."
 131   :type 'string
 132   :group 'muse-message)
 133
 134 (defcustom muse-message-markup-functions
 135   '((link . muse-message-markup-link))
 136   "An alist of style types to custom functions for that kind of text.
 137 For more on the structure of this list, see
 138 `muse-publish-markup-functions'."
 139   :type '(alist :key-type symbol :value-type function)
 140   :group 'muse-message)
 141
 142 (defcustom muse-message-markup-strings
 143   '((rule            . "                               * * * *")
 144     (begin-verse     . "  ")
 145     (end-verse-line  . "\n  ")
 146     (verse-space     . "  ")
 147     (end-verse       . "")
 148     (begin-underline . "_")
 149     (end-underline   . "_")
 150     (begin-literal   . "`")
 151     (end-literal     . "'")
 152     (begin-emph      . "/")
 153     (end-emph        . "/")
 154     (begin-more-emph . "*")
 155     (end-more-emph   . "*")
 156     (begin-most-emph . "*/")
 157     (end-most-emph   . "/*"))
 158   "Strings used for marking up message text."
 159   :type '(alist :key-type symbol :value-type string)
 160   :group 'muse-message)
 161
 162 (defcustom muse-message-markup-tags
 163   '(("example"  t   nil muse-message-example-tag)
 164     ("contents" nil t   muse-message-contents-tag))
 165   "A list of tag specifications, for specially marking up text.
 166 See the documentation for `muse-publish-markup-tags'."
 167   :type '(repeat (list (string :tag "Markup tag")
 168                        (boolean :tag "Expect closing tag" :value t)
 169                        (boolean :tag "Parse attributes" :value nil)
 170                        function))
 171   :group 'muse-message)
 172
 173 (defcustom muse-message-markup-specials nil
 174   "A table of characters which must be represented specially."
 175   :type '(alist :key-type character :value-type string)
 176   :group 'muse-message)
 177
 178 (defun muse-message-markup-link ()
 179   (let ((desc (match-string 2))
 180         (url (match-string 1)))
 181     (save-match-data
 182       (delete-region (match-beginning 0) (match-end 0))
 183       (when desc (insert desc))
 184       (save-excursion
 185         (Footnote-add-footnote)
 186         (insert url))
 187       "")))
 188
 189 (defun muse-message-example-tag (beg end)
 190   "Mark up example and code by simply indenting them."
 191   (muse-publish-escape-specials beg end)
 192   (kill-line 1)
 193   (goto-char end)
 194   (kill-line -1)
 195   (string-rectangle beg (point) muse-message-indent)
 196   (muse-publish-mark-read-only beg (point)))
 197
 198 ;; Copied from `muse-publish-contents-tag'.
 199 ;; FIXME: Make this do something worthwhile.
 200 (defun muse-message-contents-tag (beg end attrs)
 201   (set (make-local-variable 'muse-publish-generate-contents)
 202        (cons (copy-marker (point) t)
 203              (let ((depth (cdr (assoc "depth" attrs))))
 204                (or (and depth (string-to-number depth)) 2)))))
 205
 206 ;;;###autoload
 207 (defun muse-message-markup ()
 208   "Markup a wiki-ish e-mail message as HTML alternative e-mail.
 209 This step is manual by default, to give the author a chance to review
 210 the results and ensure they are appropriate.
 211 If you wish it to be automatic (a risky proposition), just add this
 212 function to `message-send-hook'."
 213   (interactive)
 214   (save-excursion
 215     (message-goto-body)
 216     (let ((text (buffer-substring-no-properties (point) (point-max)))
 217           (subject (message-fetch-field "subject"))
 218           (encoding (muse-html-encoding)))
 219       (delete-region (point) (point-max))
 220       (insert
 221        "<#multipart type=alternative>\n"
 222        "<#part type=text/plain charset=\"" encoding "\" nofile=yes>\n"
 223        (with-temp-buffer
 224          (insert text)
 225          (muse-publish-markup-buffer
 226           subject muse-message-publishing-style)
 227          (buffer-substring-no-properties (point-min) (point-max)))
 228        "\n<#part type=text/html charset=\"" encoding "\" nofile=yes>\n"
 229        (with-temp-buffer
 230          (insert text)
 231          (muse-publish-markup-buffer
 232           subject muse-message-html-publishing-style)
 233          (buffer-substring-no-properties (point-min) (point-max)))
 234        "<#/multipart>\n"))))
 235
 236 (unless (assoc "message" muse-publishing-styles)
 237   (muse-define-style "message"
 238                      :functions 'muse-message-markup-functions
 239                      :strings   'muse-message-markup-strings
 240                      :tags      'muse-message-markup-tags)
 241
 242   (muse-derive-style "message-html" "html"
 243                      :header 'muse-message-html-header
 244                      :footer 'muse-message-html-footer)
 245
 246   (muse-derive-style "message-xhtml" "xhtml"
 247                      :header 'muse-message-html-header
 248                      :footer 'muse-message-html-footer))
 249
 250 (provide 'muse-message)
 251
 252 ;;; muse-message.el ends here