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 (defvar muse-version "3.00 ALPHA"
  47   "The version of Muse currently loaded")
  48
  49 (defun muse-version ()
  50   "Display the version of Muse that is currently loaded."
  51   (interactive)
  52   (message muse-version))
  53
  54 (defgroup muse nil
  55   "Options controlling the behaviour of Muse.
  56 The markup used by Muse is intended to be very friendly to people
  57 familiar with Emacs."
  58   :group 'hypermedia)
  59
  60 (defvar muse-under-windows-p (memq system-type '(ms-dos windows-nt)))
  61
  62 (require 'muse-regexps)
  63
  64 ;;; Return an list of known wiki names and the files they represent.
  65
  66 (defsubst muse-delete-file-if-exists (file)
  67   (when (file-exists-p file)
  68     (delete-file file)
  69     (message "Removed %s" file)))
  70
  71 (defsubst muse-time-less-p (t1 t2)
  72   "Say whether time T1 is less than time T2."
  73   (or (< (car t1) (car t2))
  74       (and (= (car t1) (car t2))
  75            (< (nth 1 t1) (nth 1 t2)))))
  76
  77 (defun muse-page-name (&optional name)
  78   "Return the canonical form of a Muse page name.
  79 All this means is that certain extensions, like .gz, are removed."
  80   (save-match-data
  81     (unless name
  82       (setq name buffer-file-name))
  83     (if name
  84         (let ((page (file-name-nondirectory name)))
  85           (if (string-match muse-ignored-extensions-regexp page)
  86               (replace-match "" t t page)
  87             page)))))
  88
  89 (defun muse-eval-lisp (form)
  90   "Evaluate the given form and return the result as a string."
  91   (require 'pp)
  92   (save-match-data
  93     (let ((object (eval (read form))))
  94       (cond
  95        ((stringp object) object)
  96        ((and (listp object)
  97              (not (eq object nil)))
  98         (let ((string (pp-to-string object)))
  99           (substring string 0 (1- (length string)))))
 100        ((numberp object)
 101         (number-to-string object))
 102        ((eq object nil) "")
 103        (t
 104         (pp-to-string object))))))
 105
 106 ;; The following code was extracted from cl
 107
 108 (defun muse-const-expr-p (x)
 109   (cond ((consp x)
 110          (or (eq (car x) 'quote)
 111              (and (memq (car x) '(function function*))
 112                   (or (symbolp (nth 1 x))
 113                       (and (eq (and (consp (nth 1 x))
 114                                     (car (nth 1 x))) 'lambda) 'func)))))
 115         ((symbolp x) (and (memq x '(nil t)) t))
 116         (t t)))
 117
 118 (put 'muse-assertion-failed 'error-conditions '(error))
 119 (put 'muse-assertion-failed 'error-message "Assertion failed")
 120
 121 (defun muse-list* (arg &rest rest)
 122   "Return a new list with specified args as elements, cons'd to last arg.
 123 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
 124 `(cons A (cons B (cons C D)))'."
 125   (cond ((not rest) arg)
 126         ((not (cdr rest)) (cons arg (car rest)))
 127         (t (let* ((n (length rest))
 128                   (copy (copy-sequence rest))
 129                   (last (nthcdr (- n 2) copy)))
 130              (setcdr last (car (cdr last)))
 131              (cons arg copy)))))
 132
 133 (defmacro muse-assert (form &optional show-args string &rest args)
 134   "Verify that FORM returns non-nil; signal an error if not.
 135 Second arg SHOW-ARGS means to include arguments of FORM in message.
 136 Other args STRING and ARGS... are arguments to be passed to `error'.
 137 They are not evaluated unless the assertion fails.  If STRING is
 138 omitted, a default message listing FORM itself is used."
 139   (let ((sargs
 140          (and show-args
 141               (delq nil (mapcar
 142                          (function
 143                           (lambda (x)
 144                             (and (not (muse-const-expr-p x)) x)))
 145                          (cdr form))))))
 146     (list 'progn
 147           (list 'or form
 148                 (if string
 149                     (muse-list* 'error string (append sargs args))
 150                   (list 'signal '(quote muse-assertion-failed)
 151                         (muse-list* 'list (list 'quote form) sargs))))
 152           nil)))
 153
 154 ;; Compatibility functions
 155
 156 (defun muse-looking-back (regexp &optional limit)
 157   (if (fboundp 'looking-back)
 158       (looking-back regexp limit)
 159     (save-excursion
 160       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 161
 162 (provide 'muse)
 163
 164 ;;; muse.el ends here