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