lisp/muse-ikiwiki.el

   1 ;;; muse-ikiwiki.el --- integrate with Ikiwiki
   2
   3 ;; Copyright (C) 2008, 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 3, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; 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 ;;; Contributors:
  25
  26 ;;; Code:
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;
  30 ;; Muse Ikiwiki Integration
  31 ;;
  32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33
  34 (require 'muse)
  35 (require 'muse-html)
  36 (require 'muse-publish)
  37
  38 (eval-when-compile
  39   (require 'muse-colors))
  40
  41 (defgroup muse-ikiwiki nil
  42   "Options controlling the behavior of Muse integration with Ikiwiki."
  43   :group 'muse-publish)
  44
  45 (defcustom muse-ikiwiki-header ""
  46   "Header used for publishing Ikiwiki output files.
  47 This may be text or a filename."
  48   :type 'string
  49   :group 'muse-ikiwiki)
  50
  51 (defcustom muse-ikiwiki-footer ""
  52   "Footer used for publishing Ikiwiki output files.
  53 This may be text or a filename."
  54   :type 'string
  55   :group 'muse-ikiwiki)
  56
  57 (defcustom muse-ikiwiki-markup-regexps
  58   `(;; Ikiwiki directives
  59     (1350 ,(concat "\\(\\\\?\\)\\[\\[!""\\(?:-\\|\\w\\)+"
  60                    "\\([" muse-regexp-blank "\n]+"
  61                    "\\(?:\\(?:\\(?:-\\|\\w\\)+=\\)?"
  62                    "\\(?:\"\"\".*?\"\"\"\\|\"[^\"]+\""
  63                    "\\|[^]" muse-regexp-blank "\n]+\\)"
  64                    "[" muse-regexp-blank "\n]*\\)*\\)?\\]\\]")
  65           0 muse-ikiwiki-markup-directive))
  66   "List of markup rules for publishing Ikiwiki markup on Muse pages.
  67 For more on the structure of this list, see `muse-publish-markup-regexps'."
  68   :type '(repeat (choice
  69                   (list :tag "Markup rule"
  70                         integer
  71                         (choice regexp symbol)
  72                         integer
  73                         (choice string function symbol))
  74                   function))
  75   :group 'muse-ikiwiki)
  76
  77 ;;; Publishing
  78
  79 (defun muse-ikiwiki-markup-directive ()
  80   "Handle publishing of an Ikiwiki directive."
  81   (unless (get-text-property (match-beginning 0) 'read-only)
  82     (add-text-properties (match-beginning 0) (match-end 0)
  83                          '(muse-no-paragraph t))
  84     (muse-publish-mark-read-only (match-beginning 0) (match-end 0))))
  85
  86 (defun muse-ikiwiki-publish-buffer (name title &optional style)
  87   "Publish a buffer for Ikiwki.
  88 The name of the corresponding file is NAME.
  89 The name of the style is given by STYLE.  It defaults to \"ikiwiki\"."
  90   (unless style (setq style "ikiwiki"))
  91   (unless title (setq title (muse-page-name name)))
  92   (let ((muse-batch-publishing-p t)
  93         (muse-publishing-current-file name)
  94         (muse-publishing-current-output-path file)
  95         (muse-publishing-current-style style)
  96         (font-lock-verbose nil)
  97         (vc-handled-backends nil)) ; don't activate VC when publishing files
  98     (run-hooks 'muse-before-publish-hook)
  99     (let ((muse-inhibit-before-publish-hook t))
 100       (muse-publish-markup-buffer title style))))
 101
 102 (defun muse-ikiwiki-publish-file (file name &optional style)
 103   "Publish a single file for Ikiwiki.
 104 The name of the real file is NAME, and the name of the temporary
 105 file containing the content is FILE.
 106 The name of the style is given by STYLE.  It defaults to \"ikiwiki\"."
 107   (if (not (stringp file))
 108       (message "Error: No file given to publish")
 109     (unless style
 110       (setq style "ikiwiki"))
 111     (let ((output-path file)
 112           (target file)
 113           (vc-handled-backends nil) ; don't activate VC when publishing files
 114           auto-mode-alist
 115           muse-current-output-style)
 116       (setq auto-mode-alist
 117             (delete (cons (concat "\\." muse-file-extension "\\'")
 118                           'muse-mode-choose-mode)
 119                     auto-mode-alist))
 120       (setq muse-current-output-style (list :base style :path file))
 121       (muse-with-temp-buffer
 122         (muse-insert-file-contents file)
 123         (muse-ikiwiki-publish-buffer name nil nil style)
 124         (when (muse-write-file output-path t)
 125           (muse-style-run-hooks :final style file output-path target))))))
 126
 127 (defun muse-ikiwiki-start-server (port)
 128   "Start Muse IPC server, initializing with the client on PORT."
 129   (muse-ipc-start "foo" #'muse-ikiwiki-publish-buffer port))
 130
 131 ;;; Colors
 132
 133 (defface muse-ikiwiki-directive
 134   '((((class color) (background light))
 135      (:foreground "dark green"))
 136     (((class color) (background dark))
 137      (:foreground "green")))
 138   "Face for Ikiwiki directives."
 139   :group 'muse-ikiwiki)
 140
 141 (defun muse-colors-ikiwiki-directive ()
 142   "Color ikiwiki directives."
 143   (let ((start (match-beginning 0)))
 144     (unless (or (eq (get-text-property start 'invisible) 'muse)
 145                 (get-text-property start 'muse-comment)
 146                 (get-text-property start 'muse-directive))
 147       ;; beginning of line or space or symbol
 148       (save-excursion
 149         (and
 150          (catch 'valid
 151            (while t
 152              (skip-chars-forward "^\"]" muse-colors-region-end)
 153              (cond ((eq (point) (point-max))
 154                     (throw 'valid nil))
 155                    ((> (point) muse-colors-region-end)
 156                     (throw 'valid nil))
 157                    ((eq (char-after) ?\")
 158                     (if (and (< (1+ (point)) muse-colors-region-end)
 159                              (eq (char-after (1+ (point))) ?\"))
 160                         (if (and (< (+ 2 (point)) muse-colors-region-end)
 161                                  (eq (char-after (+ 2 (point))) ?\"))
 162                             ;; triple-quote
 163                             (progn
 164                               (forward-char 3)
 165                               (or (and (looking-at "\"\"\"")
 166                                        (goto-char (match-end 0)))
 167                                   (re-search-forward
 168                                    "\"\"\"" muse-colors-region-end t)
 169                                   (throw 'valid nil)))
 170                           ;; empty quotes (""), which are invalid
 171                           (throw 'valid nil))
 172                       ;; quote with content
 173                       (forward-char 1)
 174                       (skip-chars-forward "^\"" muse-colors-region-end)
 175                       (when (eq (char-after) ?\")
 176                         (forward-char 1))))
 177                    ((eq (char-after) ?\])
 178                     (forward-char 1)
 179                     (when (and (< (point) muse-colors-region-end)
 180                                (eq (char-after (point)) ?\]))
 181                       (forward-char 1)
 182                       (throw 'valid t)))
 183                    (t (throw 'valid nil)))))
 184          ;; found a valid directive
 185          (let ((end (point)))
 186            ;; remove flyspell overlays
 187            (when (fboundp 'flyspell-unhighlight-at)
 188              (let ((cur start))
 189                (while (> end cur)
 190                  (flyspell-unhighlight-at cur)
 191                  (setq cur (1+ cur)))))
 192            (add-text-properties start end
 193                                 '(face muse-ikiwiki-directive
 194                                   muse-directive t muse-no-flyspell t))
 195            (when (progn
 196                    (goto-char start)
 197                    (skip-chars-forward "^\n" end)
 198                    (and (eq (char-after) ?\n)
 199                         (not (= (point) end))))
 200              (add-text-properties start end
 201                                   '(font-lock-multiline t)))))))))
 202
 203 (defun muse-ikiwiki-insinuate-colors ()
 204   (add-to-list 'muse-colors-markup
 205                '("\\[\\[!" ?\[ muse-colors-ikiwiki-directive)
 206                nil))
 207
 208 (eval-after-load "muse-colors" '(muse-ikiwiki-insinuate-colors))
 209
 210 ;; Styles
 211 (muse-derive-style "ikiwiki" "xhtml"
 212                    :header  'muse-ikiwiki-header
 213                    :footer  'muse-ikiwiki-footer
 214                    :regexps 'muse-ikiwiki-markup-regexps)
 215
 216 (provide 'muse-ikiwiki)
 217
 218 ;;; muse-ikiwiki.el ends here