muse-message.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Muse E-Mail Publishing (via alternative/html)
   4 ;;
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 (require 'message)
   8 (require 'footnote)
   9
  10 (require 'muse-publish)
  11 (require 'muse-html)
  12
  13 (defgroup muse-message nil
  14   "Options controlling the behaviour of Emacs Wiki Mail Markup."
  15   :group 'hypermedia
  16   :group 'muse-publish)
  17
  18 (defcustom muse-message-publishing-style "message"
  19   "Style used for publishing the alternative/text section of a message."
  20   :type 'string
  21   :group 'muse-message)
  22
  23 (defcustom muse-message-html-publishing-style "message-html"
  24   "Style used for publishing the alternative/html section of a message."
  25   :type 'string
  26   :group 'muse-message)
  27
  28 (defcustom muse-message-indent "  "
  29   "String used to pad indentend text."
  30   :type 'string
  31   :group 'muse-message)
  32
  33 (defcustom muse-message-style-sheet
  34   "body {
  35   background: white; color: black;
  36   margin-left: 3%; margin-right: 7%;
  37 }
  38
  39 p { margin-top: 1% }
  40 p.verse { margin-left: 3% }
  41
  42 .example { margin-left: 3% }
  43
  44 h2 {
  45   margin-top: 25px;
  46   margin-bottom: 0px;
  47 }
  48 h3 { margin-bottom: 0px; }"
  49   "Text to prepend to a Muse mail message being published.
  50 This text may contain <lisp> markup tags."
  51   :type 'string
  52   :group 'muse-message)
  53
  54 (defcustom muse-message-html-header
  55   "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\">
  56 <html>
  57   <head>
  58     <title><lisp>(muse-publishing-directive \"title\")</lisp></title>
  59     <meta name=\"generator\" content=\"muse-message.el\">
  60     <link rev=\"made\" href=\"<lisp>user-mail-address</lisp>\">
  61     <style type=\"text/css\">
  62       <lisp>muse-message-style-sheet</lisp>
  63     </style>
  64   </head>
  65   <body>
  66     <!-- Mail published by Emacs Muse begins here -->\n"
  67   "Text to prepend to a Muse mail message being published.
  68 This text may contain <lisp> markup tags."
  69   :type 'string
  70   :group 'muse-message)
  71
  72 (defcustom muse-message-html-footer
  73   "\n    <!-- Mail published by Emacs Muse ends here -->
  74   </body>
  75 </html>\n"
  76   "Text to append to a Muse mail message being published.
  77 This text may contain <lisp> markup tags."
  78   :type 'string
  79   :group 'muse-message)
  80
  81 (defcustom muse-message-markup-functions
  82   '((link . muse-message-markup-link))
  83   "An alist of style types to custom functions for that kind of text.
  84 For more on the structure of this list, see
  85 `muse-publish-markup-functions'."
  86   :type '(alist :key-type symbol :value-type function)
  87   :group 'muse-message)
  88
  89 (defcustom muse-message-markup-strings
  90   '((rule            . "                               * * * *")
  91     (begin-verse     . "  ")
  92     (end-verse-line  . "\n  ")
  93     (verse-space     . "  ")
  94     (end-verse       . "")
  95     (begin-underline . "_")
  96     (end-underline   . "_")
  97     (begin-literal   . "`")
  98     (end-literal     . "'")
  99     (begin-emph      . "/")
 100     (end-emph        . "/")
 101     (begin-more-emph . "*")
 102     (end-more-emph   . "*")
 103     (begin-most-emph . "*/")
 104     (end-most-emph   . "/*"))
 105   "Strings used for marking up message text."
 106   :type '(alist :key-type symbol :value-type string)
 107   :group 'muse-message)
 108
 109 (defcustom muse-message-markup-tags
 110   '(("example"  t   nil muse-message-example-tag)
 111     ("contents" nil t   muse-message-contents-tag))
 112   "A list of tag specifications, for specially marking up text.
 113 See the documentation for `muse-publish-markup-tags'."
 114   :type '(repeat (list (string :tag "Markup tag")
 115                        (boolean :tag "Expect closing tag" :value t)
 116                        (boolean :tag "Parse attributes" :value nil)
 117                        function))
 118   :group 'muse-message)
 119
 120 (defcustom muse-message-markup-specials nil
 121   "A table of characters which must be represented specially."
 122   :type '(alist :key-type character :value-type string)
 123   :group 'muse-message)
 124
 125 (defun muse-message-markup-link ()
 126   (let ((desc (match-string 2))
 127         (url (match-string 1)))
 128     (save-match-data
 129       (delete-region (match-beginning 0) (match-end 0))
 130       (insert desc)
 131       (save-excursion
 132         (Footnote-add-footnote)
 133         (insert url))
 134       "")))
 135
 136 (defun muse-message-example-tag (beg end attrs highlight-p)
 137   "Mark up example and code by simply indenting them."
 138   (muse-publish-escape-specials beg end)
 139   (kill-line 1)
 140   (goto-char end)
 141   (kill-line -1)
 142   (string-rectangle beg (point) muse-message-indent)
 143   (muse-publish-mark-read-only beg (point)))
 144
 145 ;;;###autoload
 146 (defun muse-message-markup ()
 147   "Markup a wiki-ish e-mail message as HTML alternative e-mail.
 148 This step is manual by default, to give the author a chance to review
 149 the results and ensure they are appropriate.
 150 If you wish it to be automatic (a risky proposition), just add this
 151 function to `message-send-hook'."
 152   (interactive)
 153   (save-excursion
 154     (message-goto-body)
 155     (let ((text (buffer-substring-no-properties (point) (point-max)))
 156           (subject (message-fetch-field "subject"))
 157           (encoding (muse-html-encoding)))
 158       (delete-region (point) (point-max))
 159       (insert
 160        "<#multipart type=alternative>\n"
 161        "<#part type=text/plain charset=\"" encoding "\" nofile=yes>\n"
 162        (with-temp-buffer
 163          (insert text)
 164          (muse-publish-markup-buffer
 165           subject muse-message-publishing-style)
 166          (buffer-substring-no-properties (point-min) (point-max)))
 167        "\n<#part type=text/html charset=\"" encoding "\" nofile=yes>\n"
 168        (with-temp-buffer
 169          (insert text)
 170          (muse-publish-markup-buffer
 171           subject muse-message-html-publishing-style)
 172          (buffer-substring-no-properties (point-min) (point-max)))
 173        "<#/multipart>\n"))))
 174
 175 (unless (assoc "message" muse-publishing-styles)
 176   (muse-define-style "message"
 177                      :functions 'muse-message-markup-functions
 178                      :strings   'muse-message-markup-strings
 179                      :tags      'muse-message-markup-tags)
 180
 181   (muse-derive-style "message-html" "html"
 182                      :header 'muse-message-html-header
 183                      :footer 'muse-message-html-footer))
 184
 185 (provide 'muse-message)
 186
 187 ;;; muse-message.el ends here