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