;;; muse-html.el --- publish to HTML and XHTML ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2014 ;; Free Software Foundation, Inc. ;; This file is part of Emacs Muse. It is not part of GNU Emacs. ;; Emacs Muse 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 3, or (at your ;; option) any later version. ;; Emacs Muse 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 Emacs Muse; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; Contributors: ;; Zhiqiang Ye (yezq AT mail DOT cbi DOT pku DOT edu DOT cn) suggested ;; appending an 'encoding="..."' fragment to the first line of the ;; sample publishing header so that when editing the resulting XHTML ;; file, Emacs would use the proper encoding. ;; Sun Jiyang (sunyijiang AT gmail DOT com) came up with the idea for ;; the tag and provided an implementation for emacs-wiki. ;; Charles Wang (wcy123 AT gmail DOT com) provided an initial ;; implementation of the tag for Muse. ;; Clinton Ebadi (clinton AT unknownlamer DOT org) provided further ;; ideas for the implementation of the tag. ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Muse HTML Publishing ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'muse-publish) (require 'muse-regexps) (require 'muse-xml-common) (defgroup muse-html nil "Options controlling the behavior of Muse HTML publishing." :group 'muse-publish) (defcustom muse-html-extension ".html" "Default file extension for publishing HTML files." :type 'string :group 'muse-html) (defcustom muse-xhtml-extension ".html" "Default file extension for publishing XHTML files." :type 'string :group 'muse-html) (defcustom muse-html-style-sheet "" "Store your stylesheet definitions here. This is used in `muse-html-header'. You can put raw CSS in here or a tag to an external stylesheet. This text may contain markup tags. An example of using is as follows. " :type 'string :group 'muse-html) (defcustom muse-xhtml-style-sheet "" "Store your stylesheet definitions here. This is used in `muse-xhtml-header'. You can put raw CSS in here or a tag to an external stylesheet. This text may contain markup tags. An example of using is as follows. " :type 'string :group 'muse-html) (defcustom muse-html-header " <lisp> (concat (muse-publishing-directive \"title\") (let ((author (muse-publishing-directive \"author\"))) (if (not (string= author (user-full-name))) (concat \" (by \" author \")\"))))</lisp> muse-html-meta-http-equiv\" content=\"muse-html-meta-content-type\"> (let ((maintainer (muse-style-element :maintainer))) (when maintainer (concat \"\"))) (muse-style-element :style-sheet muse-publishing-current-style)

(concat (muse-publishing-directive \"title\") (let ((author (muse-publishing-directive \"author\"))) (if (not (string= author (user-full-name))) (concat \" (by \" author \")\"))))

\n" "Header used for publishing HTML files. This may be text or a filename." :type 'string :group 'muse-html) (defcustom muse-html-footer " \n" "Footer used for publishing HTML files. This may be text or a filename." :type 'string :group 'muse-html) (defcustom muse-xhtml-header " (muse-html-encoding)\"?> <lisp> (concat (muse-publishing-directive \"title\") (let ((author (muse-publishing-directive \"author\"))) (if (not (string= author (user-full-name))) (concat \" (by \" author \")\"))))</lisp> muse-html-meta-http-equiv\" content=\"muse-html-meta-content-type\" /> (let ((maintainer (muse-style-element :maintainer))) (when maintainer (concat \"\"))) (muse-style-element :style-sheet muse-publishing-current-style)

(concat (muse-publishing-directive \"title\") (let ((author (muse-publishing-directive \"author\"))) (if (not (string= author (user-full-name))) (concat \" (by \" author \")\"))))

\n" "Header used for publishing XHTML files. This may be text or a filename." :type 'string :group 'muse-html) (defcustom muse-xhtml-footer " \n" "Footer used for publishing XHTML files. This may be text or a filename." :type 'string :group 'muse-html) (defcustom muse-html-anchor-on-word nil "When true, anchors surround the closest word. This allows you to select them in a browser (i.e. for pasting), but has the side-effect of marking up headers in multiple colors if your header style is different from your link style." :type 'boolean :group 'muse-html) (defcustom muse-html-table-attributes " class=\"muse-table\" border=\"2\" cellpadding=\"5\"" "The attribute to be used with HTML tags. Note that Muse supports insertion of raw HTML tags, as long as you wrap the region in ." :type 'string :group 'muse-html) (defcustom muse-html-markup-regexps `(;; Beginning of doc, end of doc, or plain paragraph separator (10000 ,(concat "\\(\\(\n\\(?:[" muse-regexp-blank "]*\n\\)*" "\\([" muse-regexp-blank "]*\n\\)\\)" "\\|\\`\\s-*\\|\\s-*\\'\\)") ;; this is somewhat repetitive because we only require the ;; line just before the paragraph beginning to be not ;; read-only 3 muse-html-markup-paragraph)) "List of markup rules for publishing a Muse page to HTML. For more on the structure of this list, see `muse-publish-markup-regexps'." :type '(repeat (choice (list :tag "Markup rule" integer (choice regexp symbol) integer (choice string function symbol)) function)) :group 'muse-html) (defcustom muse-html-markup-functions '((anchor . muse-html-markup-anchor) (table . muse-html-markup-table) (footnote . muse-html-markup-footnote)) "An alist of style types to custom functions for that kind of text. For more on the structure of this list, see `muse-publish-markup-functions'." :type '(alist :key-type symbol :value-type function) :group 'muse-html) (defcustom muse-html-markup-strings '((image-with-desc . "
\"%3%\"
%3%
") (image . "\"\"") (image-link . " ") (anchor-ref . "%s") (url . "%s") (link . "%s") (link-and-anchor . "%s") (email-addr . "%s") (anchor . "") (emdash . "%s—%s") (comment-begin . "") (rule . "
") (fn-sep . "
\n") (no-break-space . " ") (line-break . "
") (enddots . "....") (dots . "...") (section . "

") (section-end . "

") (subsection . "

") (subsection-end . "

") (subsubsection . "

") (subsubsection-end . "

") (section-other . "
") (section-other-end . "
") (begin-underline . "") (end-underline . "") (begin-literal . "") (end-literal . "") (begin-cite . "") (begin-cite-author . "") (begin-cite-year . "") (end-cite . "") (begin-emph . "") (end-emph . "") (begin-more-emph . "") (end-more-emph . "") (begin-most-emph . "") (end-most-emph . "") (begin-verse . "

\n") (verse-space . "  ") (end-verse-line . "
") (end-last-stanza-line . "
") (empty-verse-line . "
") (end-verse . "

") (begin-example . "
")
    (end-example     . "
") (begin-center . "
\n

") (end-center . "

\n
") (begin-quote . "
\n") (end-quote . "\n
") (begin-quote-item . "

") (end-quote-item . "

") (begin-uli . "
    \n") (end-uli . "\n
") (begin-uli-item . "
  • ") (end-uli-item . "
    • ") (begin-oli . "
      \n") (end-oli . "\n
    ") (begin-oli-item . "
  • ") (end-oli-item . "
    • ") (begin-dl . "
    \n") (end-dl . "\n
    ") (begin-ddt . "
    ") (end-ddt . "
    ") (begin-dde . "
    ") (end-dde . "
    ") (begin-table . "\n") (end-table . "") (begin-table-row . " \n") (end-table-row . " \n") (begin-table-entry . " <%s>") (end-table-entry . "\n")) "Strings used for marking up text as HTML. These cover the most basic kinds of markup, the handling of which differs little between the various styles." :type '(alist :key-type symbol :value-type string) :group 'muse-html) (defcustom muse-xhtml-markup-strings '((image-with-desc . "
    \"%3%\"
    %3%
    ") (image . "\"\"") (image-link . "     \"\"") (rule . "
    ") (fn-sep . "
    \n") (line-break . "
    ") (begin-underline . "") (end-underline . "") (begin-center . "

    \n") (end-center . "\n

    ") (end-verse-line . "
    ") (end-last-stanza-line . "
    ") (empty-verse-line . "
    ")) "Strings used for marking up text as XHTML. These cover the most basic kinds of markup, the handling of which differs little between the various styles. If a markup rule is not found here, `muse-html-markup-strings' is searched." :type '(alist :key-type symbol :value-type string) :group 'muse-html) (defcustom muse-xhtml1.1-markup-strings '((anchor . "")) "Strings used for marking up text as XHTML 1.1. These cover the most basic kinds of markup, the handling of which differs little between the various styles. If a markup rule is not found here, `muse-xhtml-markup-strings' and `muse-html-markup-strings' are searched." :type '(alist :key-type symbol :value-type string) :group 'muse-html) (defcustom muse-html-markup-tags '(("class" t t t muse-html-class-tag) ("div" t t t muse-html-div-tag) ("src" t t nil muse-html-src-tag)) "A list of tag specifications, for specially marking up HTML." :type '(repeat (list (string :tag "Markup tag") (boolean :tag "Expect closing tag" :value t) (boolean :tag "Parse attributes" :value nil) (boolean :tag "Nestable" :value nil) function)) :group 'muse-html) (defcustom muse-html-meta-http-equiv "Content-Type" "The http-equiv attribute used for the HTML tag." :type 'string :group 'muse-html) (defcustom muse-html-meta-content-type "text/html" "The content type used for the HTML tag. If you are striving for XHTML 1.1 compliance, you may want to change this to \"application/xhtml+xml\"." :type 'string :group 'muse-html) (defcustom muse-html-meta-content-encoding (if (featurep 'mule) 'detect "iso-8859-1") "The charset to append to the HTML tag. If set to the symbol `detect', use `muse-html-encoding-map' to try and determine the HTML charset from emacs's coding. If set to a string, this string will be used to force a particular charset" :type '(choice string symbol) :group 'muse-html) (defcustom muse-html-encoding-default 'iso-8859-1 "The default Emacs buffer encoding to use in published files. This will be used if no special characters are found." :type 'symbol :group 'muse-html) (defcustom muse-html-charset-default "iso-8859-1" "The default HTML meta charset to use if no translation is found in `muse-html-encoding-map'." :type 'string :group 'muse-html) (defcustom muse-html-src-allowed-modes t "Modes that we allow the tag to colorize. If t, permit the tag to colorize any mode. If a list of mode names, such as (\"html\" \"latex\"), and the lang argument to is not in the list, then use fundamental mode instead." :type '(choice (const :tag "Any" t) (repeat (string :tag "Mode"))) :group 'muse-html) (defun muse-html-insert-anchor (anchor) "Insert an anchor, either around the word at point, or within a tag." (skip-chars-forward (concat muse-regexp-blank "\n")) (if (looking-at (concat "<\\([^" muse-regexp-blank "/>\n]+\\)>")) (let ((tag (match-string 1))) (goto-char (match-end 0)) (muse-insert-markup (muse-markup-text 'anchor anchor)) (when muse-html-anchor-on-word (or (and (search-forward (format "" tag) (muse-line-end-position) t) (goto-char (match-beginning 0))) (forward-word 1))) (muse-insert-markup "")) (muse-insert-markup (muse-markup-text 'anchor anchor)) (when muse-html-anchor-on-word (forward-word 1)) (muse-insert-markup "\n"))) (defun muse-html-markup-anchor () (unless (get-text-property (match-end 1) 'muse-link) (save-match-data (muse-html-insert-anchor (match-string 2))) (match-string 1))) (defun muse-html-markup-paragraph () (let ((end (copy-marker (match-end 0) t))) (goto-char (match-beginning 0)) (when (save-excursion (save-match-data (and (not (get-text-property (max (point-min) (1- (point))) 'muse-no-paragraph)) (re-search-backward "<\\(/?\\)p[ >]" nil t) (not (string-equal (match-string 1) "/"))))) (when (get-text-property (1- (point)) 'muse-end-list) (goto-char (previous-single-property-change (1- (point)) 'muse-end-list))) (muse-insert-markup "

    ")) (goto-char end)) (cond ((eobp) (unless (bolp) (insert "\n"))) ((get-text-property (point) 'muse-no-paragraph) (forward-char 1) nil) ((eq (char-after) ?\<) (cond ((looking-at "<\\(em\\|strong\\|code\\|span\\)[ >]") (muse-insert-markup "

    ")) ((looking-at "\n]+>") (muse-insert-markup "

    "))) ((looking-at "]") (muse-insert-markup "

    ")) (t (forward-char 1) nil))) ((muse-looking-back "\\(\\|

    \\)\n\n") (muse-insert-markup "

    ")) (t (muse-insert-markup "

    ")))) (defun muse-html-markup-footnote () (cond ((get-text-property (match-beginning 0) 'muse-link) nil) ((= (muse-line-beginning-position) (match-beginning 0)) (prog1 (let ((text (match-string 1))) (muse-insert-markup (concat "

    " "" text "."))) (save-excursion (save-match-data (let* ((beg (goto-char (match-end 0))) (end (and (search-forward "\n\n" nil t) (prog1 (copy-marker (match-beginning 0)) (goto-char beg))))) (while (re-search-forward (concat "^[" muse-regexp-blank "]+\\([^\n]\\)") end t) (replace-match "\\1" t))))) (replace-match ""))) (t (let ((text (match-string 1))) (muse-insert-markup (concat "" text ""))) (replace-match "")))) (defun muse-html-markup-table () (muse-xml-markup-table muse-html-table-attributes)) ;; Handling of tags for HTML (defun muse-html-strip-links (string) "Remove all HTML links from STRING." (muse-replace-regexp-in-string "\\(\\|\\)" "" string nil t)) (defun muse-html-insert-contents (depth) "Scan the current document and generate a table of contents at point. DEPTH indicates how many levels of headings to include. The default is 2." (let ((max-depth (or depth 2)) (index 1) base contents l end) (save-excursion (goto-char (point-min)) (search-forward "Page published by Emacs Muse begins here" nil t) (catch 'done (while (re-search-forward "\\(.+?\\)$" nil t) (unless (and (get-text-property (point) 'read-only) (not (get-text-property (match-beginning 0) 'muse-contents))) (remove-text-properties (match-beginning 0) (match-end 0) '(muse-contents nil)) (setq l (1- (string-to-number (match-string 1)))) (if (null base) (setq base l) (if (< l base) (throw 'done t))) (when (<= l max-depth) ;; escape specials now before copying the text, so that we ;; can deal sanely with both emphasis in titles and ;; special characters (goto-char (match-end 2)) (setq end (point-marker)) (muse-publish-escape-specials (match-beginning 2) end nil 'document) (muse-publish-mark-read-only (match-beginning 2) end) (setq contents (cons (cons l (buffer-substring-no-properties (match-beginning 2) end)) contents)) (set-marker end nil) (goto-char (match-beginning 2)) (muse-html-insert-anchor (concat "sec" (int-to-string index))) (setq index (1+ index))))))) (setq index 1 contents (nreverse contents)) (let ((depth 1) (sub-open 0) (p (point))) (muse-insert-markup "

    \n
    \n") (while contents (muse-insert-markup "
    \n" "" (muse-html-strip-links (cdar contents)) "\n" "
    \n") (setq index (1+ index) depth (caar contents) contents (cdr contents)) (when contents (cond ((< (caar contents) depth) (let ((idx (caar contents))) (while (< idx depth) (muse-insert-markup "
    \n\n") (setq sub-open (1- sub-open) idx (1+ idx))))) ((> (caar contents) depth) ; can't jump more than one ahead (muse-insert-markup "
    \n
    \n") (setq sub-open (1+ sub-open)))))) (while (> sub-open 0) (muse-insert-markup "
    \n
    \n") (setq sub-open (1- sub-open))) (muse-insert-markup "\n
    \n") (muse-publish-mark-read-only p (point))))) (defun muse-html-denote-headings () "Place a text property on any headings in the current buffer. This allows the headings to be picked up later on if publishing a table of contents." (save-excursion (goto-char (point-min)) (search-forward "Page published by Emacs Muse begins here" nil t) (while (re-search-forward "\\(.+?\\)$" nil t) (unless (get-text-property (point) 'read-only) (add-text-properties (match-beginning 0) (match-end 0) '(muse-contents t)))))) (defun muse-html-class-tag (beg end attrs) (let ((name (cdr (assoc "name" attrs)))) (when name (goto-char beg) (muse-insert-markup "") (save-excursion (goto-char end) (muse-insert-markup ""))))) (defun muse-html-div-tag (beg end attrs) "Publish a
    tag for HTML." (let ((id (cdr (assoc "id" attrs))) (style (cdr (assoc "style" attrs)))) (when (or id style) (goto-char beg) (if (null id) (muse-insert-markup "
    ") (muse-insert-markup "
    ")) (save-excursion (goto-char end) (muse-insert-markup "
    "))))) (defun muse-html-src-tag (beg end attrs) "Publish the region using htmlize. The language to use may be specified by the \"lang\" attribute. Muse will look for a function named LANG-mode, where LANG is the value of the \"lang\" attribute. This tag requires htmlize 1.34 or later in order to work." (if (condition-case nil (progn (require 'htmlize) (if (fboundp 'htmlize-region-for-paste) nil (muse-display-warning (concat "The `htmlize-region-for-paste' function was not" " found.\nThis is available in htmlize.el 1.34" " or later.")) t)) (error nil t)) ;; if htmlize.el was not found, treat this like an example tag (muse-publish-example-tag beg end) (muse-publish-ensure-block beg end) (let* ((lang (cdr (assoc "lang" attrs))) (mode (or (and (not (eq muse-html-src-allowed-modes t)) (not (member lang muse-html-src-allowed-modes)) 'fundamental-mode) (intern-soft (concat lang "-mode")))) (text (muse-delete-and-extract-region beg end)) (htmltext (with-temp-buffer (insert text) (if (functionp mode) (funcall mode) (fundamental-mode)) (if (fboundp 'font-lock-ensure) (font-lock-ensure) (font-lock-fontify-buffer)) ;; silence the byte-compiler (when (fboundp 'htmlize-region-for-paste) ;; transform the region to HTML (htmlize-region-for-paste (point-min) (point-max)))))) (save-restriction (narrow-to-region (point) (point)) (insert htmltext) (goto-char (point-min)) (re-search-forward "]*\\)>\n?" nil t) (replace-match "
    ")
        (goto-char (point-max))
        (muse-publish-mark-read-only (point-min) (point-max))))))

;; Register the Muse HTML Publisher

(defun muse-html-browse-file (file)
  (browse-url (concat "file:" file)))

(defun muse-html-encoding ()
  (if (stringp muse-html-meta-content-encoding)
      muse-html-meta-content-encoding
    (muse-xml-transform-content-type
     (or (and (boundp 'buffer-file-coding-system)
              buffer-file-coding-system)
         muse-html-encoding-default)
     muse-html-charset-default)))

(defun muse-html-prepare-buffer ()
  (make-local-variable 'muse-html-meta-http-equiv)
  (set (make-local-variable 'muse-html-meta-content-type)
       (if (save-match-data
             (string-match "charset=" muse-html-meta-content-type))
           muse-html-meta-content-type
         (concat muse-html-meta-content-type "; charset="
                 (muse-html-encoding)))))

(defun muse-html-munge-buffer ()
  (if muse-publish-generate-contents
      (progn
        (goto-char (car muse-publish-generate-contents))
        (muse-html-insert-contents (cdr muse-publish-generate-contents))
        (setq muse-publish-generate-contents nil))
    (muse-html-denote-headings)))

(defun muse-html-finalize-buffer ()
  (when (and (boundp 'buffer-file-coding-system)
             (memq buffer-file-coding-system '(no-conversion undecided-unix)))
    ;; make it agree with the default charset
    (setq buffer-file-coding-system muse-html-encoding-default)))

;;; Register the Muse HTML and XHTML Publishers

(muse-define-style "html"
                   :suffix    'muse-html-extension
                   :regexps   'muse-html-markup-regexps
                   :functions 'muse-html-markup-functions
                   :strings   'muse-html-markup-strings
                   :tags      'muse-html-markup-tags
                   :specials  'muse-xml-decide-specials
                   :before    'muse-html-prepare-buffer
                   :before-end 'muse-html-munge-buffer
                   :after     'muse-html-finalize-buffer
                   :header    'muse-html-header
                   :footer    'muse-html-footer
                   :style-sheet 'muse-html-style-sheet
                   :browser   'muse-html-browse-file)

(muse-derive-style "xhtml" "html"
                   :suffix    'muse-xhtml-extension
                   :strings   'muse-xhtml-markup-strings
                   :header    'muse-xhtml-header
                   :footer    'muse-xhtml-footer
                   :style-sheet 'muse-xhtml-style-sheet)

;; xhtml1.0 is an alias for xhtml
(muse-derive-style "xhtml1.0" "xhtml")

;; xhtml1.1 has some quirks that need attention from us
(muse-derive-style "xhtml1.1" "xhtml"
                   :strings   'muse-xhtml1.1-markup-strings)

(provide 'muse-html)

;;; muse-html.el ends here