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.00 ALPHA
   8 ;; Date: Thu 11-Mar-2004
   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., 59 Temple Place - Suite 330, Boston,
  31 ;; MA 02111-1307, 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 README file for more
  42 ;; information.
  43
  44 ;;; Code:
  45
  46 (require 'muse-regexps)
  47
  48 (defvar muse-version "3.00 ALPHA"
  49   "The version of Muse currently loaded")
  50
  51 (defgroup muse nil
  52   "Options controlling the behaviour of Muse.
  53 The markup used by Muse is intended to be very friendly to people
  54 familiar with Emacs."
  55   :group 'hypermedia)
  56
  57 (defcustom muse-tag-regexp
  58   (concat "<\\([^/" muse-regexp-space "][^" muse-regexp-space
  59           "</>]*\\)\\(\\s-+[^<>]+[^</>]\\)?\\(/\\)?>")
  60   "A regexp used to find XML-style tags within a buffer when publishing.
  61 Group 1 should be the tag name, group 2 the properties, and group
  62 3 the optional immediate ending slash."
  63   :type 'regexp
  64   :group 'muse)
  65
  66 (defcustom muse-link-regexp
  67   "\\[\\[\\([^][\t\n]+\\)\\]\\(?:\\[\\([^][\n]+\\)\\]\\)?\\]"
  68   "Regexp used to match [[target][description]] links.
  69 Paren group 1 must match the URL, and paren group 2 the description."
  70   :type 'regexp
  71   :group 'muse)
  72
  73 (defcustom muse-url-regexp
  74   (concat "\\<\\(?:https?:/?/?\\|ftp:/?/?\\|gopher://\\|"
  75           "telnet://\\|wais://\\|file:/\\|s?news:\\|"
  76           "mailto:\\)"
  77           "[^]  \n \"'()<>[^`{}]*[^]    \n \"'()<>[^`{}.,;]+")
  78   "A regexp used to match URLs within a Muse page."
  79   :type 'regexp
  80   :group 'muse)
  81
  82 (defcustom muse-file-regexp
  83   "[/?]\\|\\.\\(html?\\|pdf\\|mp3\\|el\\|zip\\|txt\\|tar\\)\\(\\.\\(gz\\|bz2\\)\\)?\\'"
  84   "A link matching this regexp will be regarded as a link to a file."
  85   :type 'regexp
  86   :group 'muse-publish)
  87
  88 (defcustom muse-image-regexp
  89   "\\.\\(eps\\|gif\\|jp\\(e?g\\)\\|p\\(bm\\|ng\\)\\|tiff\\|x\\([bp]m\\)\\)\\'"
  90   "A link matching this regexp will be published inline as an image.
  91 For example:
  92
  93   [[./wife.jpg][A picture of my wife]]
  94
  95 If you omit the description, the alt tag of the resulting HTML
  96 buffer will be the name of the file."
  97   :type 'regexp
  98   :group 'muse-publish)
  99
 100 (defcustom muse-ignored-extensions-regexp
 101   "\\.\\(bz2\\|gz\\|[Zz]\\)\\'"
 102   "A regexp of extensions to omit from the ending of a Muse page name."
 103   :type 'string
 104   :group 'muse)
 105
 106 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
 107
 108 ;;; Return an list of known wiki names and the files they represent.
 109
 110 (defsubst muse-delete-file-if-exists (file)
 111   (when (file-exists-p file)
 112     (delete-file file)
 113     (message "Removed %s" file)))
 114
 115 (defsubst muse-time-less-p (t1 t2)
 116   "Say whether time T1 is less than time T2."
 117   (or (< (car t1) (car t2))
 118       (and (= (car t1) (car t2))
 119            (< (nth 1 t1) (nth 1 t2)))))
 120
 121 (defun muse-page-name (&optional name)
 122   "Return the canonical form of a Muse page name.
 123 All this means is that certain extensions, like .gz, are removed."
 124   (save-match-data
 125     (unless name
 126       (setq name buffer-file-name))
 127     (if name
 128         (let ((page (file-name-nondirectory name)))
 129           (if (string-match muse-ignored-extensions-regexp page)
 130               (replace-match "" t t page)
 131             page)))))
 132
 133 (defun muse-eval-lisp (form)
 134   "Evaluate the given form and return the result as a string."
 135   (require 'pp)
 136   (save-match-data
 137     (let ((object (eval (read form))))
 138       (cond
 139        ((stringp object) object)
 140        ((and (listp object)
 141              (not (eq object nil)))
 142         (let ((string (pp-to-string object)))
 143           (substring string 0 (1- (length string)))))
 144        ((numberp object)
 145         (number-to-string object))
 146        ((eq object nil) "")
 147        (t
 148         (pp-to-string object))))))
 149
 150 ;; The following code was extracted from cl
 151
 152 (defun muse-const-expr-p (x)
 153   (cond ((consp x)
 154          (or (eq (car x) 'quote)
 155              (and (memq (car x) '(function function*))
 156                   (or (symbolp (nth 1 x))
 157                       (and (eq (and (consp (nth 1 x))
 158                                     (car (nth 1 x))) 'lambda) 'func)))))
 159         ((symbolp x) (and (memq x '(nil t)) t))
 160         (t t)))
 161
 162 (put 'muse-assertion-failed 'error-conditions '(error))
 163 (put 'muse-assertion-failed 'error-message "Assertion failed")
 164
 165 (defun muse-list* (arg &rest rest)
 166   "Return a new list with specified args as elements, cons'd to last arg.
 167 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
 168 `(cons A (cons B (cons C D)))'."
 169   (cond ((not rest) arg)
 170         ((not (cdr rest)) (cons arg (car rest)))
 171         (t (let* ((n (length rest))
 172                   (copy (copy-sequence rest))
 173                   (last (nthcdr (- n 2) copy)))
 174              (setcdr last (car (cdr last)))
 175              (cons arg copy)))))
 176
 177 (defmacro muse-assert (form &optional show-args string &rest args)
 178   "Verify that FORM returns non-nil; signal an error if not.
 179 Second arg SHOW-ARGS means to include arguments of FORM in message.
 180 Other args STRING and ARGS... are arguments to be passed to `error'.
 181 They are not evaluated unless the assertion fails.  If STRING is
 182 omitted, a default message listing FORM itself is used."
 183   (let ((sargs
 184          (and show-args
 185               (delq nil (mapcar
 186                          (function
 187                           (lambda (x)
 188                             (and (not (muse-const-expr-p x)) x)))
 189                          (cdr form))))))
 190     (list 'progn
 191           (list 'or form
 192                 (if string
 193                     (muse-list* 'error string (append sargs args))
 194                   (list 'signal '(quote muse-assertion-failed)
 195                         (muse-list* 'list (list 'quote form) sargs))))
 196           nil)))
 197
 198 (provide 'muse)
 199
 200 ;;; muse.el ends here