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