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 ;; Default file extension
  67
  68 (defvar muse-ignored-extensions-regexp nil
  69   "A regexp of extensions to omit from the ending of a Muse page name.
  70 This is autogenerated from `muse-ignored-extensions'.")
  71
  72 (defcustom muse-file-extension nil
  73   "File extension of Muse files.  Omit the period at the beginning."
  74   :type '(choice
  75           (const :tag "None" nil)
  76           (string))
  77   :set #'(lambda (sym val)
  78            (when (and (boundp sym) (symbol-value sym))
  79              ;; remove old auto-mode-alist association
  80              (setq auto-mode-alist
  81                    (delete (cons (concat "\\." (symbol-value sym) "\\'")
  82                                  'muse-mode-choose-mode)
  83                            auto-mode-alist)))
  84            (set sym val)
  85            ;; associate .muse with muse-mode
  86            (when val
  87              (add-to-list 'auto-mode-alist
  88                           (cons (concat "\\." val "\\'")
  89                                 'muse-mode-choose-mode)))
  90            (when (fboundp 'muse-update-ignored-extensions-regexp)
  91              (muse-update-ignored-extensions-regexp
  92               'muse-ignored-extensions muse-ignored-extensions)))
  93   :group 'muse)
  94
  95 (defun muse-update-ignored-extensions-regexp (sym val)
  96   "Update the value of `muse-ignored-extensions-regexp'."
  97   (set sym val)
  98   (if val
  99       (setq muse-ignored-extensions-regexp
 100             (concat "\\.\\("
 101                     (regexp-quote (or muse-file-extension "")) "\\|"
 102                     (mapconcat 'identity val "\\|")
 103                     "\\)\\'"))
 104     (setq muse-ignored-extensions-regexp
 105           (if muse-file-extension
 106               (concat "\\.\\(" muse-file-extension "\\)\\'")
 107             nil))))
 108
 109 (defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
 110   "A list of extensions to omit from the ending of a Muse page name.
 111 These are regexps.
 112
 113 Don't put a period at the beginning of each extension unless you
 114 understand that it is part of a regexp."
 115   :type '(repeat (regexp :tag "Extension"))
 116   :set 'muse-update-ignored-extensions-regexp
 117   :group 'muse)
 118
 119 ;;; Return an list of known wiki names and the files they represent.
 120
 121 (defsubst muse-delete-file-if-exists (file)
 122   (when (file-exists-p file)
 123     (delete-file file)
 124     (message "Removed %s" file)))
 125
 126 (defsubst muse-time-less-p (t1 t2)
 127   "Say whether time T1 is less than time T2."
 128   (or (< (car t1) (car t2))
 129       (and (= (car t1) (car t2))
 130            (< (nth 1 t1) (nth 1 t2)))))
 131
 132 (eval-when-compile
 133   (defvar muse-publishing-current-file nil))
 134
 135 (defun muse-page-name (&optional name)
 136   "Return the canonical form of a Muse page name.
 137 All this means is that certain extensions, like .gz, are removed."
 138   (save-match-data
 139     (unless name
 140       (setq name (or (and (boundp 'muse-publishing-current-file)
 141                           muse-publishing-current-file)
 142                      buffer-file-name)))
 143     (if name
 144         (let ((page (file-name-nondirectory name)))
 145           (if (and muse-ignored-extensions-regexp
 146                    (string-match muse-ignored-extensions-regexp page))
 147               (replace-match "" t t page)
 148             page)))))
 149
 150 (defun muse-eval-lisp (form)
 151   "Evaluate the given form and return the result as a string."
 152   (require 'pp)
 153   (save-match-data
 154     (let ((object (eval (read form))))
 155       (cond
 156        ((stringp object) object)
 157        ((and (listp object)
 158              (not (eq object nil)))
 159         (let ((string (pp-to-string object)))
 160           (substring string 0 (1- (length string)))))
 161        ((numberp object)
 162         (number-to-string object))
 163        ((eq object nil) "")
 164        (t
 165         (pp-to-string object))))))
 166
 167 ;; The following code was extracted from cl
 168
 169 (defun muse-const-expr-p (x)
 170   (cond ((consp x)
 171          (or (eq (car x) 'quote)
 172              (and (memq (car x) '(function function*))
 173                   (or (symbolp (nth 1 x))
 174                       (and (eq (and (consp (nth 1 x))
 175                                     (car (nth 1 x))) 'lambda) 'func)))))
 176         ((symbolp x) (and (memq x '(nil t)) t))
 177         (t t)))
 178
 179 (put 'muse-assertion-failed 'error-conditions '(error))
 180 (put 'muse-assertion-failed 'error-message "Assertion failed")
 181
 182 (defun muse-list* (arg &rest rest)
 183   "Return a new list with specified args as elements, cons'd to last arg.
 184 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
 185 `(cons A (cons B (cons C D)))'."
 186   (cond ((not rest) arg)
 187         ((not (cdr rest)) (cons arg (car rest)))
 188         (t (let* ((n (length rest))
 189                   (copy (copy-sequence rest))
 190                   (last (nthcdr (- n 2) copy)))
 191              (setcdr last (car (cdr last)))
 192              (cons arg copy)))))
 193
 194 (defmacro muse-assert (form &optional show-args string &rest args)
 195   "Verify that FORM returns non-nil; signal an error if not.
 196 Second arg SHOW-ARGS means to include arguments of FORM in message.
 197 Other args STRING and ARGS... are arguments to be passed to `error'.
 198 They are not evaluated unless the assertion fails.  If STRING is
 199 omitted, a default message listing FORM itself is used."
 200   (let ((sargs
 201          (and show-args
 202               (delq nil (mapcar
 203                          (function
 204                           (lambda (x)
 205                             (and (not (muse-const-expr-p x)) x)))
 206                          (cdr form))))))
 207     (list 'progn
 208           (list 'or form
 209                 (if string
 210                     (muse-list* 'error string (append sargs args))
 211                   (list 'signal '(quote muse-assertion-failed)
 212                         (muse-list* 'list (list 'quote form) sargs))))
 213           nil)))
 214
 215 ;; Compatibility functions
 216
 217 (defun muse-looking-back (regexp &optional limit)
 218   (if (fboundp 'looking-back)
 219       (looking-back regexp limit)
 220     (save-excursion
 221       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 222
 223 (defun muse-line-end-position (&optional n)
 224   (if (fboundp 'line-end-position)
 225       (line-end-position n)
 226     (save-excursion (end-of-line n) (point))))
 227
 228 (defun muse-line-beginning-position (&optional n)
 229   (if (fboundp 'line-beginning-position)
 230       (line-beginning-position n)
 231     (save-excursion (beginning-of-line n) (point))))
 232
 233 (defun muse-match-string-no-properties (num &optional string)
 234   (if (fboundp 'match-string-no-properties)
 235       (match-string-no-properties num string)
 236     (match-string num string)))
 237
 238 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
 239   "Replace REGEXP with REPLACEMENT in TEXT.
 240 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
 241 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
 242   (cond
 243    ((fboundp 'replace-regexp-in-string)
 244     (replace-regexp-in-string regexp replacement text fixedcase literal))
 245    ((fboundp 'replace-in-string)
 246     (replace-in-string text regexp replacement literal))
 247    (t (while (string-match regexp text)
 248         (setq text (replace-match replacement fixedcase literal text)))
 249       text)))
 250
 251 (defun muse-add-to-invisibility-spec (element)
 252   "Add ELEMENT to `buffer-invisibility-spec'.
 253 See documentation for `buffer-invisibility-spec' for the kind of elements
 254 that can be added."
 255   (if (fboundp 'add-to-invisibility-spec)
 256       (add-to-invisibility-spec element)
 257     (if (eq buffer-invisibility-spec t)
 258         (setq buffer-invisibility-spec (list t)))
 259     (setq buffer-invisibility-spec
 260           (cons element buffer-invisibility-spec))))
 261
 262 ;; Link-handling functions and variables
 263
 264 (defun muse-handle-url (&optional string)
 265   "If STRING or point has a URL, match and return it."
 266   (if (if string (string-match muse-url-regexp string)
 267         (looking-at muse-url-regexp))
 268       (match-string 0 string)))
 269
 270 (defcustom muse-implicit-link-functions '(muse-handle-url)
 271   "A list of functions to handle an implicit link.
 272 An implicit link is one that is not surrounded by brackets.
 273
 274 By default, Muse handles URLs only.
 275 If you want to handle WikiWords, load muse-wiki.el."
 276   :type '(repeat function)
 277   :options '(muse-handle-url
 278              muse-wiki-handle-interwiki
 279              muse-wiki-handle-wikiword)
 280   :group 'muse)
 281
 282 (defun muse-handle-implicit-link (&optional link)
 283   "Handle implicit links.  If LINK is not specified, look at point.
 284 An implicit link is one that is not surrounded by brackets.
 285 By default, Muse handles URLs only.
 286 If you want to handle WikiWords, load muse-wiki.el.
 287
 288 This function modifies the match data so that match 1 is the
 289 link.  Match 2 will usually be nil, unless the description is
 290 embedded in the text of the buffer.
 291
 292 The match data is restored after each unsuccessful handler
 293 function call.  If LINK is specified, only restore at very end.
 294
 295 This behavior is needed because the part of the buffer that
 296 `muse-implicit-link-regexp' matches must be narrowed to the part
 297 that is an accepted link."
 298   (let ((funcs muse-implicit-link-functions)
 299         (res nil)
 300         (data (match-data t)))
 301     (while funcs
 302       (setq res (funcall (car funcs) link))
 303       (if res
 304           (setq funcs nil)
 305         (unless link (set-match-data data))
 306         (setq funcs (cdr funcs))))
 307     (when link (set-match-data data))
 308     res))
 309
 310 (defcustom muse-explicit-link-functions nil
 311   "A list of functions to handle an explicit link.
 312 An explicit link is one [[like][this]] or [[this]]."
 313   :type '(repeat function)
 314   :options '(muse-wiki-handle-interwiki)
 315   :group 'muse)
 316
 317 (defun muse-handle-explicit-link (&optional link)
 318   "Handle explicit links.  If LINK is not specified, look at point.
 319 An explicit link is one that looks [[like][this]] or [[this]].
 320
 321 This function modifies the match data so that match 1 is the link
 322 and match 2 is the description.  Perhaps someday match 3 might be
 323 the text to use for the alt element of an <a> or <img> tag.
 324
 325 The match data is saved.  If no handlers are able to process
 326 LINK, return LINK (if specified) or the 1st match string.  If
 327 LINK is not specified, it is assumed that Muse has matched
 328 against `muse-explicit-link-regexp' before calling this
 329 function."
 330   (let ((funcs muse-explicit-link-functions)
 331         (res nil))
 332     (save-match-data
 333       (while funcs
 334         (setq res (funcall (car funcs) link))
 335         (if res
 336             (setq funcs nil)
 337           (setq funcs (cdr funcs)))))
 338     (if res
 339         res
 340       (or link (match-string 1)))))
 341
 342 (provide 'muse)
 343
 344 ;;; muse.el ends here