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.91 (3.02 RC2)
   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.91 (3.02 RC2)"
  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 'wid-edit)
  65 (require 'muse-regexps)
  66
  67 ;; Default file extension
  68
  69 (eval-when-compile
  70   (defvar muse-ignored-extensions))
  71
  72 (defvar muse-ignored-extensions-regexp nil
  73   "A regexp of extensions to omit from the ending of a Muse page name.
  74 This is autogenerated from `muse-ignored-extensions'.")
  75
  76 (defun muse-update-file-extension (sym val)
  77   "Update the value of `muse-file-extension'."
  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
  94 (defcustom muse-file-extension nil
  95   "File extension of Muse files.  Omit the period at the beginning."
  96   :type '(choice
  97           (const :tag "None" nil)
  98           (string))
  99   :set 'muse-update-file-extension
 100   :group 'muse)
 101
 102 (defun muse-update-ignored-extensions-regexp (sym val)
 103   "Update the value of `muse-ignored-extensions-regexp'."
 104   (set sym val)
 105   (if val
 106       (setq muse-ignored-extensions-regexp
 107             (concat "\\.\\("
 108                     (regexp-quote (or muse-file-extension "")) "\\|"
 109                     (mapconcat 'identity val "\\|")
 110                     "\\)\\'"))
 111     (setq muse-ignored-extensions-regexp
 112           (if muse-file-extension
 113               (concat "\\.\\(" muse-file-extension "\\)\\'")
 114             nil))))
 115
 116 (defcustom muse-ignored-extensions '("bz2" "gz" "[Zz]")
 117   "A list of extensions to omit from the ending of a Muse page name.
 118 These are regexps.
 119
 120 Don't put a period at the beginning of each extension unless you
 121 understand that it is part of a regexp."
 122   :type '(repeat (regexp :tag "Extension"))
 123   :set 'muse-update-ignored-extensions-regexp
 124   :group 'muse)
 125
 126 ;;; Return an list of known wiki names and the files they represent.
 127
 128 (defsubst muse-delete-file-if-exists (file)
 129   (when (file-exists-p file)
 130     (delete-file file)
 131     (message "Removed %s" file)))
 132
 133 (defsubst muse-time-less-p (t1 t2)
 134   "Say whether time T1 is less than time T2."
 135   (or (< (car t1) (car t2))
 136       (and (= (car t1) (car t2))
 137            (< (nth 1 t1) (nth 1 t2)))))
 138
 139 (eval-when-compile
 140   (defvar muse-publishing-current-file nil))
 141
 142 (defun muse-current-file ()
 143   "Return the name of the currently visited or published file."
 144   (or (and (boundp 'muse-publishing-current-file)
 145            muse-publishing-current-file)
 146       (buffer-file-name)
 147       (concat default-directory (buffer-name))))
 148
 149 (defun muse-page-name (&optional name)
 150   "Return the canonical form of a Muse page name.
 151 All this means is that certain extensions, like .gz, are removed."
 152   (save-match-data
 153     (unless (and name (not (string= name "")))
 154       (setq name (muse-current-file)))
 155     (if name
 156         (let ((page (file-name-nondirectory name)))
 157           (if (and muse-ignored-extensions-regexp
 158                    (string-match muse-ignored-extensions-regexp page))
 159               (replace-match "" t t page)
 160             page)))))
 161
 162 (defun muse-eval-lisp (form)
 163   "Evaluate the given form and return the result as a string."
 164   (require 'pp)
 165   (save-match-data
 166     (condition-case err
 167         (let ((object (eval (read form))))
 168           (cond
 169            ((stringp object) object)
 170            ((and (listp object)
 171                  (not (eq object nil)))
 172             (let ((string (pp-to-string object)))
 173               (substring string 0 (1- (length string)))))
 174            ((numberp object)
 175             (number-to-string object))
 176            ((eq object nil) "")
 177            (t
 178             (pp-to-string object))))
 179       (error
 180        (if (fboundp 'display-warning)
 181            (display-warning 'muse
 182                             (format "%s: Error evaluating %s: %s"
 183                                     (muse-page-name) form err)
 184                             (if (featurep 'xemacs)
 185                                 'warning
 186                               :warning))
 187          (message "%s: Error evaluating %s: %s"
 188                   (muse-page-name) form err))
 189        "<!--INVALID LISP CODE-->"))))
 190
 191 (defmacro muse-with-temp-buffer (&rest body)
 192   "Create a temporary buffer, and evaluate BODY there like `progn'.
 193 See also `with-temp-file' and `with-output-to-string'.
 194 Unlike `with-temp-buffer', this will never attempt to save the temp buffer."
 195   (let ((temp-buffer (make-symbol "temp-buffer")))
 196     `(let ((,temp-buffer (generate-new-buffer " *muse-temp*")))
 197        (unwind-protect
 198            (if debug-on-error
 199                (with-current-buffer ,temp-buffer
 200                  ,@body)
 201              (condition-case err
 202                  (with-current-buffer ,temp-buffer
 203                    ,@body)
 204                (error
 205                 (if (and (boundp 'muse-batch-publishing-p)
 206                          muse-batch-publishing-p)
 207                     (progn
 208                       (message "%s: Error occured: %s"
 209                                (muse-page-name) err)
 210                       (backtrace))
 211                   (if (fboundp 'display-warning)
 212                       (display-warning 'muse
 213                                        (format "%s: Error occurred: %s\n\n%s"
 214                                                (muse-page-name) err
 215                                                (pp (quote ,body)))
 216                                        (if (featurep 'xemacs)
 217                                            'warning
 218                                          :warning))
 219                     (message "%s: Error occured: %s\n\n%s"
 220                              (muse-page-name) err (pp (quote ,body))))))))
 221          (when (buffer-live-p ,temp-buffer)
 222            (with-current-buffer ,temp-buffer
 223              (set-buffer-modified-p nil))
 224            (unless debug-on-error (kill-buffer ,temp-buffer)))))))
 225 (put 'muse-with-temp-buffer 'lisp-indent-function 0)
 226 (put 'muse-with-temp-buffer 'edebug-form-spec '(body))
 227
 228 ;; The following code was extracted from cl
 229
 230 (defun muse-const-expr-p (x)
 231   (cond ((consp x)
 232          (or (eq (car x) 'quote)
 233              (and (memq (car x) '(function function*))
 234                   (or (symbolp (nth 1 x))
 235                       (and (eq (and (consp (nth 1 x))
 236                                     (car (nth 1 x))) 'lambda) 'func)))))
 237         ((symbolp x) (and (memq x '(nil t)) t))
 238         (t t)))
 239
 240 (put 'muse-assertion-failed 'error-conditions '(error))
 241 (put 'muse-assertion-failed 'error-message "Assertion failed")
 242
 243 (defun muse-list* (arg &rest rest)
 244   "Return a new list with specified args as elements, cons'd to last arg.
 245 Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
 246 `(cons A (cons B (cons C D)))'."
 247   (cond ((not rest) arg)
 248         ((not (cdr rest)) (cons arg (car rest)))
 249         (t (let* ((n (length rest))
 250                   (copy (copy-sequence rest))
 251                   (last (nthcdr (- n 2) copy)))
 252              (setcdr last (car (cdr last)))
 253              (cons arg copy)))))
 254
 255 (defmacro muse-assert (form &optional show-args string &rest args)
 256   "Verify that FORM returns non-nil; signal an error if not.
 257 Second arg SHOW-ARGS means to include arguments of FORM in message.
 258 Other args STRING and ARGS... are arguments to be passed to `error'.
 259 They are not evaluated unless the assertion fails.  If STRING is
 260 omitted, a default message listing FORM itself is used."
 261   (let ((sargs
 262          (and show-args
 263               (delq nil (mapcar
 264                          (function
 265                           (lambda (x)
 266                             (and (not (muse-const-expr-p x)) x)))
 267                          (cdr form))))))
 268     (list 'progn
 269           (list 'or form
 270                 (if string
 271                     (muse-list* 'error string (append sargs args))
 272                   (list 'signal '(quote muse-assertion-failed)
 273                         (muse-list* 'list (list 'quote form) sargs))))
 274           nil)))
 275
 276 ;; Compatibility functions
 277
 278 (defun muse-looking-back (regexp &optional limit)
 279   (if (fboundp 'looking-back)
 280       (looking-back regexp limit)
 281     (save-excursion
 282       (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))
 283
 284 (defun muse-line-end-position (&optional n)
 285   (if (fboundp 'line-end-position)
 286       (line-end-position n)
 287     (save-excursion (end-of-line n) (point))))
 288
 289 (defun muse-line-beginning-position (&optional n)
 290   (if (fboundp 'line-beginning-position)
 291       (line-beginning-position n)
 292     (save-excursion (beginning-of-line n) (point))))
 293
 294 (defun muse-match-string-no-properties (num &optional string)
 295   (if (fboundp 'match-string-no-properties)
 296       (match-string-no-properties num string)
 297     (match-string num string)))
 298
 299 (defun muse-replace-regexp-in-string (regexp replacement text &optional fixedcase literal)
 300   "Replace REGEXP with REPLACEMENT in TEXT.
 301 If fourth arg FIXEDCASE is non-nil, do not alter case of replacement text.
 302 If fifth arg LITERAL is non-nil, insert REPLACEMENT literally."
 303   (cond
 304    ((fboundp 'replace-regexp-in-string)
 305     (replace-regexp-in-string regexp replacement text fixedcase literal))
 306    ((fboundp 'replace-in-string)
 307     (replace-in-string text regexp replacement literal))
 308    (t (while (string-match regexp text)
 309         (setq text (replace-match replacement fixedcase literal text)))
 310       text)))
 311
 312 (defun muse-add-to-invisibility-spec (element)
 313   "Add ELEMENT to `buffer-invisibility-spec'.
 314 See documentation for `buffer-invisibility-spec' for the kind of elements
 315 that can be added."
 316   (if (fboundp 'add-to-invisibility-spec)
 317       (add-to-invisibility-spec element)
 318     (if (eq buffer-invisibility-spec t)
 319         (setq buffer-invisibility-spec (list t)))
 320     (setq buffer-invisibility-spec
 321           (cons element buffer-invisibility-spec))))
 322
 323 ;; Widget compatibility functions
 324
 325 (defun muse-widget-type-value-create (widget)
 326   "Convert and instantiate the value of the :type attribute of WIDGET.
 327 Store the newly created widget in the :children attribute.
 328
 329 The value of the :type attribute should be an unconverted widget type."
 330   (let ((value (widget-get widget :value))
 331         (type (widget-get widget :type)))
 332     (widget-put widget :children
 333                 (list (widget-create-child-value widget
 334                                                  (widget-convert type)
 335                                                  value)))))
 336
 337 (defun muse-widget-child-value-get (widget)
 338   "Get the value of the first member of :children in WIDGET."
 339   (widget-value (car (widget-get widget :children))))
 340
 341 (defun muse-widget-type-match (widget value)
 342   "Non-nil if the :type value of WIDGET matches VALUE.
 343
 344 The value of the :type attribute should be an unconverted widget type."
 345   (widget-apply (widget-convert (widget-get widget :type)) :match value))
 346
 347 ;; Link-handling functions and variables
 348
 349 (defun muse-handle-url (&optional string)
 350   "If STRING or point has a URL, match and return it."
 351   (if (if string (string-match muse-url-regexp string)
 352         (looking-at muse-url-regexp))
 353       (match-string 0 string)))
 354
 355 (defcustom muse-implicit-link-functions '(muse-handle-url)
 356   "A list of functions to handle an implicit link.
 357 An implicit link is one that is not surrounded by brackets.
 358
 359 By default, Muse handles URLs only.
 360 If you want to handle WikiWords, load muse-wiki.el."
 361   :type 'hook
 362   :options '(muse-handle-url)
 363   :group 'muse)
 364
 365 (defun muse-handle-implicit-link (&optional link)
 366   "Handle implicit links.  If LINK is not specified, look at point.
 367 An implicit link is one that is not surrounded by brackets.
 368 By default, Muse handles URLs only.
 369 If you want to handle WikiWords, load muse-wiki.el.
 370
 371 This function modifies the match data so that match 1 is the
 372 link.  Match 2 will usually be nil, unless the description is
 373 embedded in the text of the buffer.
 374
 375 The match data is restored after each unsuccessful handler
 376 function call.  If LINK is specified, only restore at very end.
 377
 378 This behavior is needed because the part of the buffer that
 379 `muse-implicit-link-regexp' matches must be narrowed to the part
 380 that is an accepted link."
 381   (let ((funcs muse-implicit-link-functions)
 382         (res nil)
 383         (data (match-data t)))
 384     (while funcs
 385       (setq res (funcall (car funcs) link))
 386       (if res
 387           (setq funcs nil)
 388         (unless link (set-match-data data))
 389         (setq funcs (cdr funcs))))
 390     (when link (set-match-data data))
 391     res))
 392
 393 (defcustom muse-explicit-link-functions nil
 394   "A list of functions to handle an explicit link.
 395 An explicit link is one [[like][this]] or [[this]]."
 396   :type 'hook
 397   :group 'muse)
 398
 399 (defun muse-handle-explicit-link (&optional link)
 400   "Handle explicit links.  If LINK is not specified, look at point.
 401 An explicit link is one that looks [[like][this]] or [[this]].
 402
 403 This function modifies the match data so that match 1 is the link
 404 and match 2 is the description.  Perhaps someday match 3 might be
 405 the text to use for the alt element of an <a> or <img> tag.
 406
 407 The match data is saved.  If no handlers are able to process
 408 LINK, return LINK (if specified) or the 1st match string.  If
 409 LINK is not specified, it is assumed that Muse has matched
 410 against `muse-explicit-link-regexp' before calling this
 411 function."
 412   (let ((funcs muse-explicit-link-functions)
 413         (res nil))
 414     (save-match-data
 415       (while funcs
 416         (setq res (funcall (car funcs) link))
 417         (if res
 418             (setq funcs nil)
 419           (setq funcs (cdr funcs)))))
 420     (if res
 421         res
 422       (or link (match-string 1)))))
 423
 424 (provide 'muse)
 425
 426 ;;; muse.el ends here