lisp/muse.el

   1 ;;; muse.el --- An authoring and publishing tool for Emacs.
   2
   3 ;; Copyright (C) 2004 Free Software Foundation, Inc.
   4
   5 ;; Emacs Lisp Archive Entry
   6 ;; Filename: muse.el
   7 ;; Version: 3.01
   8 ;; Date: Thu 15-Jun-2005
   9 ;; Keywords: hypermedia
  10 ;; Author: John Wiegley (johnw AT gnu DOT org)
  11 ;; Maintainer: Michael Olson (mwolson AT gnu DOT org)
  12 ;; Description: An authoring and publishing tool for Emacs
  13 ;; URL: http://www.mwolson.org/projects/MuseMode.html
  14 ;; Compatibility: Emacs21
  15
  16 ;; This file is not part of GNU Emacs.
  17
  18 ;; This is free software; you can redistribute it and/or modify it under
  19 ;; the terms of the GNU General Public License as published by the Free
  20 ;; Software Foundation; either version 2, or (at your option) any later
  21 ;; version.
  22 ;;
  23 ;; This is distributed in the hope that it will be useful, but WITHOUT
  24 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  25 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  26 ;; for more details.
  27 ;;
  28 ;; You should have received a copy of the GNU General Public License
  29 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  30 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  31 ;; Boston, MA 02110-1301, USA.
  32
  33 ;;; Commentary:
  34
  35 ;; Muse is a tool for easily authoring and publishing documents.  It
  36 ;; allows for rapid prototyping of hyperlinked text, which may then be
  37 ;; exported to multiple output formats -- such as HTML, LaTeX,
  38 ;; Texinfo, etc.
  39
  40 ;; The markup rules used by Muse are intended to be very friendly to
  41 ;; people familiar with Emacs.  See the included QuickStart file in
  42 ;; the `examples' directory for more information.
  43
  44 ;;; Contributors:
  45
  46 ;;; Code:
  47
  48 (defvar muse-version "3.01"
  49   "The version of Muse currently loaded")
  50
  51 (defun muse-version ()
  52   "Display the version of Muse that is currently loaded."
  53   (interactive)
  54   (message muse-version))
  55
  56 (defgroup muse nil
  57   "Options controlling the behavior of Muse.
  58 The markup used by Muse is intended to be very friendly to people
  59 familiar with Emacs."
  60   :group 'hypermedia)
  61
  62 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
  63
  64 (require 'muse-regexps)
  65
  66 (defvar muse-current-file nil
  67   "File currently being published.")
  68 (make-variable-buffer-local 'muse-current-file)
  69
  70 ;;; Return an list of known wiki names and the files they represent.
  71
  72 (defsubst muse-delete-file-if-exists (file)
  73   (when (file-exists-p file)
  74     (delete-file file)
  75     (message "Removed %s" file)))
  76
  77 (defsubst muse-time-less-p (t1 t2)
  78   "Say whether time T1 is less than time T2."
  79   (or (< (car t1) (car t2))
  80       (and (= (car t1) (car t2))
  81            (< (nth 1 t1) (nth 1 t2)))))
  82
  83 (defun muse-page-name (&optional name)
  84   "Return the canonical form of a Muse page name.
  85 All this means is that certain extensions, like .gz, are removed."
  86   (save-match-data
  87     (unless name
  88       (setq name (or muse-current-file buffer-file-name)))
  89     (if name
  90         (let ((page (file-name-nondirectory name)))
  91           (if (string-match muse-ignored-extensions-regexp page)
  92               (replace-match "" t t page)
  93             page)))))
  94
  95 (defun muse-eval-lisp (form)
  96   "Evaluate the given form and return the result as a string."
  97   (require 'pp)
  98   (save-match-data
  99     (let ((object (eval (read form))))
 100       (cond
 101        ((stringp object) object)
 102        ((and (listp object)
 103              (not (eq object nil)))
 104         (let ((string (pp-to-string object)))
 105           (substring string 0 (1- (length string)))))
 106        ((numberp object)
 107         (number-to-string object))
 108        ((eq object nil) "")
 109        (t
 110         (pp-to-string object))))))
 111
 112 ;; The following code was extracted from cl
 113
 114 (defun muse-const-expr-p (x)
 115   (cond ((consp x)
 116          (or (eq (car x) 'quote)
 117              (and (memq (car x) '(function function*))
 118                   (or (symbolp (nth 1 x))
 119                       (and (eq (and (consp (nth 1 x))
 120                                     (car (nth 1 x))) 'lambda) 'func)))))
 121         ((symbolp x) (and (memq x '(nil t)) t))
 122         (t t)))
 123
 124 (put 'muse-assertion-failed 'error-conditions '(error))
 125 (put 'muse-assertion-failed 'error-message "Assertion failed")
 126
 127 (defun muse-list* (arg &rest rest)
 128   "Return a new list with specified args as elements, cons'd to last arg.
 129 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
 130 `(cons A (cons B (cons C D)))'."
 131   (cond ((not rest) arg)
 132         ((not (cdr rest)) (cons arg (car rest)))
 133         (t (let* ((n (length rest))
 134                   (copy (copy-sequence rest))
 135                   (last (nthcdr (- n 2) copy)))
 136              (setcdr last (car (cdr last)))
 137              (cons arg copy)))))
 138
 139 (defmacro muse-assert (form &optional show-args string &rest args)
 140   "Verify that FORM returns non-nil; signal an error if not.
 141 Second arg SHOW-ARGS means to include arguments of FORM in message.
 142 Other args STRING and ARGS... are arguments to be passed to `error'.
 143 They are not evaluated unless the assertion fails.  If STRING is
 144 omitted, a default message listing FORM itself is used."
 145   (let ((sargs
 146          (and show-args
 147               (delq nil (mapcar
 148                          (function
 149                           (lambda (x)
 150                             (and (not (muse-const-expr-p x)) x)))
 151                          (cdr form))))))
 152     (list 'progn
 153           (list 'or form
 154                 (if string
 155                     (muse-list* 'error string (append sargs args))
 156                   (list 'signal '(quote muse-assertion-failed)
 157                         (muse-list* 'list (list 'quote form) sargs))))
 158           nil)))
 159
 160 ;; Compatibility functions
 161
 162 (defun muse-looking-back (regexp &optional limit)
 163   (if (fboundp 'looking-back)
 164       (looking-back regexp limit)
 165     (save-excursion
 166       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 167
 168 (defun muse-line-end-position (&optional n)
 169   (if (fboundp 'line-end-position)
 170       (line-end-position n)
 171     (save-excursion (end-of-line n) (point))))
 172
 173 (defun muse-line-beginning-position (&optional n)
 174   (if (fboundp 'line-beginning-position)
 175       (line-beginning-position n)
 176     (save-excursion (beginning-of-line n) (point))))
 177
 178 (defun muse-match-string-no-properties (num &optional string)
 179   (if (fboundp 'match-string-no-properties)
 180       (match-string-no-properties num string)
 181     (match-string num string)))
 182
 183 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
 184   "Replace REGEXP with REPLACEMENT in TEXT.
 185 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
 186 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
 187   (cond
 188    ((fboundp 'replace-regexp-in-string)
 189     (replace-regexp-in-string regexp replacement text fixedcase literal))
 190    ((fboundp 'replace-in-string)
 191     (replace-in-string text regexp replacement literal))
 192    (t (while (string-match regexp text)
 193         (setq text (replace-match replacement fixedcase literal text)))
 194       text)))
 195
 196 (defun muse-add-to-invisibility-spec (element)
 197   "Add ELEMENT to `buffer-invisibility-spec'.
 198 See documentation for `buffer-invisibility-spec' for the kind of elements
 199 that can be added."
 200   (if (fboundp 'add-to-invisibility-spec)
 201       (add-to-invisibility-spec element)
 202     (if (eq buffer-invisibility-spec t)
 203         (setq buffer-invisibility-spec (list t)))
 204     (setq buffer-invisibility-spec
 205           (cons element buffer-invisibility-spec))))
 206
 207 (defun muse-assoc-string (key list)
 208   "Like `assoc' but specifically for strings."
 209   (if (fboundp 'assoc-string)
 210       (assoc-string key list)
 211     (catch 'found
 212       (dolist (el list)
 213         (when (string= key el)
 214           (throw 'found el))))))
 215
 216 ;; Link-handling functions and variables
 217
 218 (defun muse-handle-url (&optional string)
 219   "If STRING or point has a URL, match and return it."
 220   (if (if string (string-match muse-url-regexp string)
 221         (looking-at muse-url-regexp))
 222       (match-string 0 string)))
 223
 224 (defcustom muse-implicit-link-functions '(muse-handle-url)
 225   "A list of functions to handle an implicit link.
 226 An implicit link is one that is not surrounded by brackets.
 227
 228 By default, Muse handles URLs only.
 229 If you want to handle WikiWords, load muse-wiki.el."
 230   :type '(repeat function)
 231   :group 'muse)
 232
 233 (defun muse-handle-implicit-link (&optional link)
 234   "Handle implicit links.  If LINK is not specified, look at point.
 235 An implicit link is one that is not surrounded by brackets.
 236 By default, Muse handles URLs only.
 237 If you want to handle WikiWords, load muse-wiki.el.
 238
 239 This function modifies the match data so that match 1 is the
 240 link.  Match 2 will usually be nil, unless the description is
 241 embedded in the text of the buffer.
 242
 243 The match data is restored after each unsuccessful handler
 244 function call.  If LINK is specified, only restore at very end.
 245
 246 This behavior is needed because the part of the buffer that
 247 `muse-implicit-link-regexp' matches must be narrowed to the part
 248 that is an accepted link."
 249   (let ((funcs muse-implicit-link-functions)
 250         (res nil)
 251         (data (match-data t)))
 252     (while funcs
 253       (setq res (funcall (car funcs) link))
 254       (if res
 255           (setq funcs nil)
 256         (unless link (set-match-data data))
 257         (setq funcs (cdr funcs))))
 258     (when link (set-match-data data))
 259     res))
 260
 261 (defcustom muse-explicit-link-functions nil
 262   "A list of functions to handle an explicit link.
 263 An explicit link is one [[like][this]] or [[this]]."
 264   :type '(repeat function)
 265   :group 'muse)
 266
 267 (defun muse-handle-explicit-link (&optional link)
 268   "Handle explicit links.  If LINK is not specified, look at point.
 269 An explicit link is one that looks [[like][this]] or [[this]].
 270
 271 This function modifies the match data so that match 1 is the link
 272 and match 2 is the description.  Perhaps someday match 3 might be
 273 the text to use for the alt element of an <a> or <img> tag.
 274
 275 The match data is saved.  If no handlers are able to process
 276 LINK, return LINK (if specified) or the 1st match string.  If
 277 LINK is not specified, it is assumed that Muse has matched
 278 against `muse-explicit-link-regexp' before calling this
 279 function."
 280   (let ((funcs muse-explicit-link-functions)
 281         (res nil))
 282     (save-match-data
 283       (while funcs
 284         (setq res (funcall (car funcs) link))
 285         (if res
 286             (setq funcs nil)
 287           (setq funcs (cdr funcs)))))
 288     (if res
 289         res
 290       (or link (match-string 1)))))
 291
 292 (provide 'muse)
 293
 294 ;;; muse.el ends here