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