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