lisp/muse-mode.el

   1 ;;; muse-mode.el --- mode for editing Muse files; has font-lock support
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
   4
   5 ;; This file is part of Emacs Muse.  It is not part of GNU Emacs.
   6
   7 ;; Emacs Muse is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published
   9 ;; by the Free Software Foundation; either version 3, or (at your
  10 ;; option) any later version.
  11
  12 ;; Emacs Muse is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with Emacs Muse; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  20 ;; Boston, MA 02110-1301, USA.
  21
  22 ;;; Commentary:
  23
  24 ;; The Emacs Muse major mode is basically a hyped-up text-mode which
  25 ;; knows a lot more about the apparent structure of the document.
  26
  27 ;;; Contributors:
  28
  29 ;; Andrea Riciputi (ariciputi AT pito DOT com) gave an initial
  30 ;; implementation for tag completion by means of the `muse-insert-tag'
  31 ;; function.
  32
  33 ;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the
  34 ;; insertion of relative links and list items, backlink searching, and
  35 ;; other things as well.
  36
  37 ;; Stefan Schlee (stefan_schlee AT yahoo DOT com) fixed a bug in
  38 ;; muse-next-reference and muse-previous-reference involving links
  39 ;; that begin at point 1.
  40
  41 ;; Gregory Collins (greg AT gregorycollins DOT net) fixed a bug with
  42 ;; paragraph separation and headings when filling.
  43
  44 ;;; Code:
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 ;;
  48 ;; Emacs Muse Major Mode
  49 ;;
  50 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  51
  52 (provide 'muse-mode)
  53
  54 (require 'muse)
  55 (require 'muse-regexps)
  56 (require 'muse-project)
  57
  58 (autoload 'muse-use-font-lock "muse-colors")
  59 (autoload 'muse-publish-this-file "muse-publish")
  60 (autoload 'muse-publish-get-style "muse-publish")
  61 (autoload 'muse-publish-output-file "muse-publish")
  62
  63 (require 'derived)
  64 (eval-when-compile
  65   (condition-case nil
  66       (require 'pcomplete)              ; load if available
  67     (error nil)))
  68
  69 ;;; Options:
  70
  71 (defgroup muse-mode nil
  72   "Options controlling the behavior of the Muse editing Mode."
  73   :group 'muse)
  74
  75 (defcustom muse-mode-highlight-p t
  76   "If non-nil, highlight the content of Muse buffers."
  77   :type 'boolean
  78   :require 'muse-colors
  79   :group 'muse-mode)
  80
  81 (defcustom muse-mode-auto-p nil
  82   "If non-nil, automagically determine when Muse mode should be activated."
  83   :type 'boolean
  84   :set (function
  85         (lambda (sym value)
  86           (if value
  87               (add-hook 'find-file-hooks 'muse-mode-maybe)
  88             (remove-hook 'find-file-hooks 'muse-mode-maybe))
  89           (set sym value)))
  90   :group 'muse-mode)
  91
  92 (defun muse-mode-maybe-after-init ()
  93   (when muse-mode-auto-p
  94     (add-hook 'find-file-hooks 'muse-mode-maybe)))
  95
  96 ;; If the user sets this value in their init file, make sure that
  97 ;; it takes effect
  98 (add-hook 'after-init-hook 'muse-mode-maybe-after-init)
  99
 100 (defcustom muse-mode-intangible-links nil
 101   "If non-nil, use the intangible property on links.
 102 This can cause problems with flyspell (and potentially fill-mode),
 103 so only enable this if you don't use either of these."
 104   :type 'boolean
 105   :group 'muse-mode)
 106
 107 (defcustom muse-mode-hook nil
 108   "A hook that is run when Muse mode is entered."
 109   :type 'hook
 110   :options '(flyspell-mode footnote-mode turn-on-auto-fill
 111              highlight-changes-mode)
 112   :group 'muse-mode)
 113
 114 (defcustom muse-grep-command
 115   "find %D -type f ! -name '*~' | xargs -I {} echo \\\"{}\\\" | xargs egrep -n -e \"%W\""
 116   "The command to use when grepping for backlinks and other
 117 searches through the muse projects.  The string %D is replaced by
 118 the directories from muse-project-alist, space-separated.  The
 119 string %W is replaced with the name of the muse page or whatever
 120 else you are searching for.  This command has been modified to
 121 handle spaces in filenames, which were giving egrep a problem.
 122
 123 Note: We highly recommend using glimpse to search large projects.
 124 To use glimpse, install and edit a file called .glimpse_exclude
 125 in your home directory.  Put a list of glob patterns in that file
 126 to exclude Emacs backup files, etc.  Then, run the indexer using:
 127
 128   glimpseindex -o <list of Wiki directories>
 129
 130 Once that's completed, customize this variable to have the
 131 following value:
 132
 133   glimpse -nyi \"%W\"
 134
 135 Your searches will go much, much faster, especially for very
 136 large projects.  Don't forget to add a user cronjob to update the
 137 index at intervals."
 138   :type 'string
 139   :group 'muse-mode)
 140
 141 (defvar muse-insert-map
 142   (let ((map (make-sparse-keymap)))
 143     (define-key map "l" 'muse-insert-relative-link-to-file)
 144     (define-key map "t" 'muse-insert-tag)
 145     (define-key map "u" 'muse-insert-url)
 146
 147     map))
 148
 149 ;;; Muse mode
 150
 151 (defvar muse-mode-map
 152   (let ((map (make-sparse-keymap)))
 153     (define-key map [(control ?c) (control ?a)] 'muse-index)
 154     (define-key map [(control ?c) (control ?e)] 'muse-edit-link-at-point)
 155     (define-key map [(control ?c) (control ?l)] 'font-lock-mode)
 156     (define-key map [(control ?c) (control ?t)]
 157       'muse-project-publish-this-file)
 158     (define-key map [(control ?c) (control ?T)] 'muse-publish-this-file)
 159     (define-key map [(control ?c) (meta control ?t)] 'muse-publish-this-file)
 160     (define-key map [(control ?c) (control ?v)] 'muse-browse-result)
 161
 162     (define-key map [(control ?c) ?=]           'muse-what-changed)
 163
 164     (define-key map [tab] 'muse-next-reference)
 165     (define-key map [(control ?i)] 'muse-next-reference)
 166
 167     (if (featurep 'xemacs)
 168         (progn
 169           (define-key map [(button2)] 'muse-follow-name-at-mouse)
 170           (define-key map [(shift button2)]
 171             'muse-follow-name-at-mouse-other-window))
 172       (define-key map [(shift control ?m)]
 173         'muse-follow-name-at-point-other-window)
 174       (define-key map [mouse-2] 'muse-follow-name-at-mouse)
 175       (define-key map [(shift mouse-2)]
 176         'muse-follow-name-at-mouse-other-window))
 177
 178     (define-key map [(shift tab)] 'muse-previous-reference)
 179     (unless (featurep 'xemacs)
 180       (define-key map [(shift iso-lefttab)] 'muse-previous-reference)
 181       (define-key map [(shift control ?i)] 'muse-previous-reference))
 182
 183     (define-key map [(control ?c) (control ?f)] 'muse-project-find-file)
 184     (define-key map [(control ?c) (control ?p)] 'muse-project-publish)
 185
 186     (define-key map [(control ?c) (control ?i)] 'muse-insert-thing)
 187     (define-key map [(control ?c) tab] 'muse-insert-thing)
 188
 189     ;; Searching functions
 190     (define-key map [(control ?c) (control ?b)] 'muse-find-backlinks)
 191     (define-key map [(control ?c) (control ?s)] 'muse-search)
 192
 193     ;; Enhanced list functions
 194     (define-key map [(meta return)] 'muse-insert-list-item)
 195     (define-key map [(control ?>)] 'muse-increase-list-item-indentation)
 196     (define-key map [(control ?<)] 'muse-decrease-list-item-indentation)
 197
 198     (when (featurep 'pcomplete)
 199       (define-key map [(meta tab)] 'pcomplete)
 200       (define-key map [(meta control ?i)] 'pcomplete))
 201
 202     map)
 203   "Keymap used by Emacs Muse mode.")
 204
 205 ;;;###autoload
 206 (define-derived-mode muse-mode text-mode "Muse"
 207   "Muse is an Emacs mode for authoring and publishing documents.
 208 \\{muse-mode-map}"
 209   ;; Since we're not inheriting from normal-mode, we need to
 210   ;; explicitly run file variables.
 211   (condition-case err
 212       (hack-local-variables)
 213     (error (message "File local-variables error: %s"
 214                     (prin1-to-string err))))
 215   ;; Avoid lock-up caused by use of the 'intangible' text property
 216   ;; with flyspell.
 217   (unless muse-mode-intangible-links
 218     (set (make-local-variable 'inhibit-point-motion-hooks) t))
 219   (setq muse-current-project (muse-project-of-file))
 220   (muse-project-set-variables)
 221   ;; Make fill not split up links
 222   (when (boundp 'fill-nobreak-predicate)
 223     (make-local-variable 'fill-nobreak-predicate)
 224     ;; Work around annoying inconsistency in fill handling between
 225     ;; Emacs 21 and 22.
 226     (if (< emacs-major-version 22)
 227         (setq fill-nobreak-predicate 'muse-mode-fill-nobreak-p)
 228       (add-to-list 'fill-nobreak-predicate
 229                    'muse-mode-fill-nobreak-p)))
 230   ;; Make fill work nicely with item lists
 231   (let ((regexp (concat "\\s-+\\(-\\|[0-9]+\\.\\)\\s-+"
 232                         "\\|\\[[0-9]+\\]\\s-*"
 233                         "\\|.*\\s-*::\\s-+"
 234                         "\\|\\*+\\s-+")))
 235     (set (make-local-variable 'adaptive-fill-regexp)
 236          (concat regexp "\\|\\s-*"))
 237     (set (make-local-variable 'paragraph-start)
 238          (concat paragraph-start "\\|" regexp))
 239     (set (make-local-variable 'paragraph-separate)
 240          (concat paragraph-separate "\\|\\*+\\s-+")))
 241   (set (make-local-variable 'fill-paragraph-function)
 242        'muse-mode-fill-paragraph)
 243
 244   ;; Comment syntax is `; comment'
 245   (set (make-local-variable 'comment-start)
 246        "; ")
 247   (set (make-local-variable 'comment-start-skip)
 248        "^;\\s-+")
 249   (set (make-local-variable 'indent-line-function)
 250        #'ignore)
 251   ;; If we're using Emacs21, this makes flyspell work like it should
 252   (when (boundp 'flyspell-generic-check-word-p)
 253     (set (make-local-variable 'flyspell-generic-check-word-p)
 254          'muse-mode-flyspell-p))
 255   ;; If pcomplete is available, set it up
 256   (when (featurep 'pcomplete)
 257     (set (make-local-variable 'pcomplete-default-completion-function)
 258          'muse-mode-completions)
 259     (set (make-local-variable 'pcomplete-command-completion-function)
 260          'muse-mode-completions)
 261     (set (make-local-variable 'pcomplete-parse-arguments-function)
 262          'muse-mode-current-word))
 263   ;; Initialize any auto-generated variables
 264   (run-hooks 'muse-update-values-hook)
 265   (when muse-mode-highlight-p
 266     (muse-use-font-lock)))
 267
 268 (put 'muse-mode
 269      'flyspell-mode-predicate
 270      'muse-mode-flyspell-p)
 271
 272 (defun muse-mode-fill-nobreak-p ()
 273   "Return nil if we should allow a fill to occur at point.
 274 Otherwise return non-nil.
 275
 276 This is used to keep long explicit links from being mangled by
 277 fill mode."
 278   (save-excursion
 279     (save-match-data
 280       (and (re-search-backward "\\[\\[\\|\\]\\]"
 281                                (line-beginning-position) t)
 282            (string= (or (match-string 0) "")
 283                     "[[")))))
 284
 285 (defun muse-mode-fill-paragraph (arg)
 286   "If a definition list is at point, use special filling rules for it.
 287 Otherwise return nil to let the normal filling function take care
 288 of things.
 289
 290 ARG is passed to `fill-paragraph'."
 291   (let ((count 2))
 292     (and (not (muse-mode-fill-nobreak-p))
 293          (save-excursion
 294            (beginning-of-line)
 295            (and (looking-at muse-dl-term-regexp)
 296                 (prog1 t
 297                   ;; Take initial whitespace into account
 298                   (when (looking-at (concat "[" muse-regexp-blank "]+"))
 299                     (setq count (+ count (length (match-string 0))))))))
 300          (let ((fill-prefix (make-string count ?\ ))
 301                (fill-paragraph-function nil))
 302            (prog1 t
 303              (fill-paragraph arg))))))
 304
 305 (defun muse-mode-flyspell-p ()
 306   "Return non-nil if we should allow spell-checking to occur at point.
 307 Otherwise return nil.
 308
 309 This is used to keep links from being improperly colorized by flyspell."
 310   (and (not (get-text-property (if (bobp) (point) (1- (point)))
 311                                'muse-link))
 312        (save-match-data
 313          (null (muse-link-at-point)))))
 314
 315 ;;;###autoload
 316 (defun muse-mode-choose-mode ()
 317   "Turn the proper Emacs Muse related mode on for this file."
 318   (let ((project (muse-project-of-file)))
 319     (funcall (or (and project (muse-get-keyword :major-mode (cadr project) t))
 320                  'muse-mode))))
 321
 322 (defun muse-mode-maybe ()
 323   "Maybe turn Emacs Muse mode on for this file."
 324   (let ((project (muse-project-of-file)))
 325     (and project
 326          (funcall (or (muse-get-keyword :major-mode (cadr project) t)
 327                       'muse-mode)))))
 328
 329 ;;; Enhanced list editing
 330
 331 (defun muse-on-blank-line ()
 332   "See if point is on a blank line"
 333   (save-excursion
 334     (beginning-of-line)
 335     (looking-at (concat "[" muse-regexp-blank "]*$"))))
 336
 337 (defun muse-get-paragraph-start ()
 338   "Return the start of the current paragraph. This function will
 339 return nil if there are no prior paragraphs and the beginning of
 340 the line if point is on a blank line."
 341   (let ((para-start (concat "^[" muse-regexp-blank "]*$")))
 342     ;; search back to start of paragraph
 343     (save-excursion
 344       (save-match-data
 345         (if (not (muse-on-blank-line))
 346             (re-search-backward para-start nil t)
 347           (line-beginning-position))))))
 348
 349 (defun muse-insert-thing ()
 350   "Prompt for something to insert into the current buffer."
 351   (interactive)
 352   (message "Insert:\nl  link\nt  Muse tag\nu  URL")
 353   (let (key cmd)
 354     (let ((overriding-local-map muse-insert-map))
 355       (setq key (read-key-sequence nil)))
 356     (if (commandp (setq cmd (lookup-key muse-insert-map key)))
 357         (progn (message "")
 358                (call-interactively cmd))
 359       (message "Not inserting anything"))))
 360
 361 ;;;###autoload
 362 (defun muse-insert-list-item ()
 363   "Insert a list item at the current point, taking into account
 364 your current list type and indentation level."
 365   (interactive)
 366   (let ((newitem " - ")
 367         (itemno nil)
 368         (pstart (muse-get-paragraph-start))
 369         (list-item (format muse-list-item-regexp
 370                            (concat "[" muse-regexp-blank "]*"))))
 371     ;; search backwards for start of current item
 372     (save-excursion
 373       (when (re-search-backward list-item pstart t)
 374         ;; save the matching item
 375         (setq newitem (match-string 0))
 376         ;; see what type it is
 377         (if (string-match "::" (match-string 0))
 378             ;; is a definition, replace the term
 379             (setq newitem (concat " "
 380                                   (read-string "Term: ")
 381                                   " :: "))
 382           ;; see if it's a numbered list
 383           (when (string-match "[0-9]+" newitem)
 384             ;; is numbered, so increment
 385             (setq itemno (1+
 386                           (string-to-number
 387                            (match-string 0 newitem))))
 388             (setq newitem (replace-match
 389                            (number-to-string itemno)
 390                            nil nil newitem))))))
 391     ;; insert the new item
 392     (insert (concat "\n" newitem))))
 393
 394 (defun muse-alter-list-item-indentation (operation)
 395   "Alter the indentation of the current list item.
 396 Valid values of OPERATION are 'increase and 'decrease."
 397   (let ((pstart (muse-get-paragraph-start))
 398         (list-item (format muse-list-item-regexp
 399                            (concat "[" muse-regexp-blank "]*")))
 400         beg move-func indent)
 401     ;; search backwards until start of paragraph to see if we are on a
 402     ;; current item
 403     (save-excursion
 404       (if (or (progn (goto-char (muse-line-beginning-position))
 405                      ;; we are on an item
 406                      (looking-at list-item))
 407               ;; not on item, so search backwards
 408               (re-search-backward list-item pstart t))
 409           (let ((beg (point)))
 410             ;; we are on an item
 411             (setq indent (buffer-substring (match-beginning 0)
 412                                            (match-beginning 1)))
 413             (muse-forward-list-item (muse-list-item-type (match-string 1))
 414                                     (concat "[" muse-regexp-blank "]*")
 415                                     t)
 416             (save-restriction
 417               (narrow-to-region beg (point))
 418               (goto-char (point-min))
 419               (let ((halt nil))
 420                 (while (< (point) (point-max))
 421                   ;; increase or decrease the indentation
 422                   (unless halt
 423                     (cond ((eq operation 'increase)
 424                            (insert "  "))
 425                           ((eq operation 'decrease)
 426                            (if (looking-at "  ")
 427                                ;; we have enough space, so delete it
 428                                (delete-region (match-beginning 0)
 429                                               (match-end 0))
 430                              (setq halt t)))))
 431                   (forward-line 1)))))
 432         ;; we are not on an item, so warn
 433         (message "You are not on a list item.")))))
 434
 435 ;;;###autoload
 436 (defun muse-increase-list-item-indentation ()
 437   "Increase the indentation of the current list item."
 438   (interactive)
 439   (muse-alter-list-item-indentation 'increase))
 440
 441 ;;;###autoload
 442 (defun muse-decrease-list-item-indentation ()
 443   "Decrease the indentation of the current list item."
 444   (interactive)
 445   (muse-alter-list-item-indentation 'decrease))
 446
 447 ;;; Support page name completion using pcomplete
 448
 449 (defun muse-mode-completions ()
 450   "Return a list of possible completions names for this buffer."
 451   (let ((project (muse-project-of-file)))
 452     (if project
 453         (while (pcomplete-here
 454                 (mapcar 'car (muse-project-file-alist project)))))))
 455
 456 (defun muse-mode-current-word ()
 457   (let ((end (point)))
 458     (save-excursion
 459       (save-restriction
 460         (skip-chars-backward (concat "^\\[\n" muse-regexp-blank))
 461         (narrow-to-region (point) end))
 462       (pcomplete-parse-buffer-arguments))))
 463
 464 ;;; Navigate/visit links or URLs.  Use TAB, S-TAB and RET (or mouse-2).
 465
 466 (defun muse-link-at-point (&optional pos)
 467   "Return link text if a URL or link is at point."
 468   (let ((case-fold-search nil)
 469         (inhibit-point-motion-hooks t)
 470         (here (or pos (point))))
 471     ;; if we are using muse-colors, we can just use link properties to
 472     ;; determine whether we are on a link
 473     (if (featurep 'muse-colors)
 474         (when (get-text-property here 'muse-link)
 475           (save-excursion
 476             (when (and (not (bobp))
 477                        (get-text-property (1- here) 'muse-link))
 478               (goto-char (or (previous-single-property-change here 'muse-link)
 479                              (point-min))))
 480             (if (looking-at muse-explicit-link-regexp)
 481                 (progn
 482                   (goto-char (match-beginning 1))
 483                   (muse-handle-explicit-link))
 484               (muse-handle-implicit-link))))
 485       ;; use fallback method to find a link
 486       (when (or (null pos)
 487                 (and (char-after pos)
 488                      (not (eq (char-syntax (char-after pos)) ?\ ))))
 489         (save-excursion
 490           (goto-char here)
 491           ;; check for explicit link here or before point
 492           (if (or (looking-at muse-explicit-link-regexp)
 493                   (and
 494                    (re-search-backward "\\[\\[\\|\\]\\]"
 495                                        (muse-line-beginning-position)
 496                                        t)
 497                    (string= (or (match-string 0) "") "[[")
 498                    (looking-at muse-explicit-link-regexp)))
 499               (progn
 500                 (goto-char (match-beginning 1))
 501                 (muse-handle-explicit-link))
 502             (goto-char here)
 503             ;; check for bare URL or other link type
 504             (skip-chars-backward (concat "^'\"<>{}(\n" muse-regexp-blank))
 505             (and (looking-at muse-implicit-link-regexp)
 506                  (muse-handle-implicit-link))))))))
 507
 508 (defun muse-make-link (link &optional desc)
 509   "Return a link to LINK with DESC as the description."
 510   (when (string-match muse-explicit-link-regexp link)
 511     (unless desc (setq desc (muse-get-link-desc link)))
 512     (setq link (muse-get-link link)))
 513   (if (and desc
 514            link
 515            (not (string= desc ""))
 516            (not (string= link desc)))
 517       (concat "[[" (muse-link-escape link) "][" (muse-link-escape desc) "]]")
 518     (concat "[[" (or (muse-link-escape link) "") "]]")))
 519
 520 ;;;###autoload
 521 (defun muse-insert-relative-link-to-file ()
 522   "Insert a relative link to a file, with optional description, at point."
 523   ;; Perhaps the relative location should be configurable, so that the
 524   ;; file search would start in the publishing directory and then
 525   ;; insert the link relative to the publishing directory
 526   (interactive)
 527   (insert
 528    (muse-make-link (file-relative-name (read-file-name "Link: "))
 529                    (read-string "Text: "))))
 530
 531 (defcustom muse-insert-url-initial-input "http://"
 532   "The string to insert before reading a URL interactively.
 533 This is used by the `muse-insert-url' command."
 534   :type 'string
 535   :group 'muse-mode)
 536
 537 (defun muse-insert-url ()
 538   "Insert a URL, with optional description, at point."
 539   (interactive)
 540   (insert
 541    (muse-make-link (read-string "URL: " muse-insert-url-initial-input)
 542                    (read-string "Text: "))))
 543
 544 ;;;###autoload
 545 (defun muse-edit-link-at-point ()
 546   "Edit the current link.
 547 Do not rename the page originally referred to."
 548   (interactive)
 549   (if (muse-link-at-point)
 550       (let ((link (muse-link-unescape (muse-get-link)))
 551             (desc (muse-link-unescape (muse-get-link-desc))))
 552         (replace-match
 553          (save-match-data
 554            (muse-make-link
 555             (read-string "Link: " link)
 556             (read-string "Text: " desc)))
 557          t t))
 558     (error "There is no valid link at point")))
 559
 560 (defun muse-visit-link-default (link &optional other-window)
 561   "Visit the URL or link named by LINK.
 562 If ANCHOR is specified, search for it after opening LINK.
 563
 564 This is the default function to call when visiting links; it is
 565 used by `muse-visit-link' if you have not specified :visit-link
 566 in `muse-project-alist'."
 567   (if (string-match muse-url-regexp link)
 568       (muse-browse-url link)
 569     (let (anchor
 570           base-buffer)
 571       (when (string-match "#" link)
 572         (setq anchor (substring link (match-beginning 0))
 573               link (if (= (match-beginning 0) 0)
 574                        ;; If there is an anchor but no link, default
 575                        ;; to the current page.
 576                        nil
 577                      (substring link 0 (match-beginning 0)))))
 578       (when link
 579         (setq base-buffer (get-buffer link))
 580         (if (and base-buffer (not (buffer-file-name base-buffer)))
 581             ;; If file is temporary (no associated file), just switch to
 582             ;; the buffer
 583             (if other-window
 584                 (switch-to-buffer-other-window base-buffer)
 585               (switch-to-buffer base-buffer))
 586           (let ((project (muse-project-of-file)))
 587             (if project
 588                 (muse-project-find-file link project
 589                                         (and other-window
 590                                              'find-file-other-window))
 591               (if other-window
 592                   (find-file-other-window link)
 593                 (find-file link))))))
 594       (when anchor
 595         (let ((pos (point))
 596               (regexp (concat "^\\W*" (regexp-quote anchor) "\\b"))
 597               last)
 598           (goto-char (point-min))
 599           (while (and (setq last (re-search-forward regexp nil t))
 600                       (muse-link-at-point)))
 601           (unless last
 602             (goto-char pos)
 603             (message "Could not find anchor `%s'" anchor)))))))
 604
 605 (defun muse-visit-link (link &optional other-window)
 606   "Visit the URL or link named by LINK."
 607   (let ((visit-link-function
 608          (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t)))
 609     (if visit-link-function
 610         (funcall visit-link-function link other-window)
 611       (muse-visit-link-default link other-window))))
 612
 613 ;;;###autoload
 614 (defun muse-browse-result (style &optional other-window)
 615   "Visit the current page's published result."
 616   (interactive
 617    (list (muse-project-get-applicable-style buffer-file-name
 618                                             (cddr muse-current-project))
 619          current-prefix-arg))
 620   (setq style (muse-style style))
 621   (muse-project-publish-this-file nil style)
 622   (let* ((output-dir (muse-style-element :path style))
 623          (output-suffix (muse-style-element :osuffix style))
 624          (output-path (muse-publish-output-file buffer-file-name output-dir
 625                                                 style))
 626          (target (if output-suffix
 627                      (concat (muse-path-sans-extension output-path)
 628                              output-suffix)
 629                    output-path))
 630          (muse-current-output-style (list :base (car style)
 631                                           :path output-dir)))
 632     (if (not (file-readable-p target))
 633         (error "Cannot open output file '%s'" target)
 634       (if other-window
 635           (find-file-other-window target)
 636         (let ((func (muse-style-element :browser style t)))
 637           (if func
 638               (funcall func target)
 639             (message "The %s publishing style does not support browsing."
 640                      style)))))))
 641
 642 ;;;###autoload
 643 (defun muse-follow-name-at-point (&optional other-window)
 644   "Visit the link at point."
 645   (interactive "P")
 646   (let ((link (muse-link-at-point)))
 647     (if link
 648         (muse-visit-link link other-window)
 649       (error "There is no valid link at point"))))
 650
 651 ;;;###autoload
 652 (defun muse-follow-name-at-point-other-window ()
 653   "Visit the link at point in other window."
 654   (interactive)
 655   (muse-follow-name-at-point t))
 656
 657 (defun muse-follow-name-at-mouse (event &optional other-window)
 658   "Visit the link at point, or yank text if none is found."
 659   (interactive "eN")
 660   (unless
 661       (save-excursion
 662         (cond ((fboundp 'event-window)      ; XEmacs
 663                (set-buffer (window-buffer (event-window event)))
 664                (and (funcall (symbol-function 'event-point) event)
 665                     (goto-char (funcall (symbol-function 'event-point)
 666                                         event))))
 667               ((fboundp 'posn-window)       ; Emacs
 668                (set-buffer (window-buffer (posn-window (event-start event))))
 669                (goto-char (posn-point (event-start event)))))
 670         (let ((link (muse-link-at-point)))
 671           (when link
 672             (muse-visit-link link other-window)
 673             t)))
 674     ;; Fall back to normal binding for this event
 675     (call-interactively
 676      (lookup-key (current-global-map) (this-command-keys)))))
 677
 678 (defun muse-follow-name-at-mouse-other-window (event)
 679   "Visit the link at point"
 680   (interactive "e")
 681   ;; throw away the old window position, since other-window will
 682   ;; change it anyway
 683   (select-window (car (cadr event)))
 684   (muse-follow-name-at-mouse event t))
 685
 686 ;;;###autoload
 687 (defun muse-next-reference ()
 688   "Move forward to next Muse link or URL, cycling if necessary."
 689   (interactive)
 690   (let ((pos))
 691     (save-excursion
 692       (when (get-text-property (point) 'muse-link)
 693         (goto-char (or (next-single-property-change (point) 'muse-link)
 694                        (point-max))))
 695
 696       (setq pos (next-single-property-change (point) 'muse-link))
 697
 698       (when (not pos)
 699         (if (get-text-property (point-min) 'muse-link)
 700             (setq pos (point-min))
 701           (setq pos (next-single-property-change (point-min) 'muse-link)))))
 702
 703     (when pos
 704       (goto-char pos))))
 705
 706 ;;;###autoload
 707 (defun muse-previous-reference ()
 708   "Move backward to the next Muse link or URL, cycling if necessary.
 709 In case of Emacs x <= 21 and ignoring of intangible properties (see
 710 `muse-mode-intangible-links').
 711
 712 This function is not entirely accurate, but it's close enough."
 713   (interactive)
 714   (let ((pos))
 715     (save-excursion
 716
 717       ;; Hack: The user perceives the two cases of point ("|")
 718       ;; position (1) "|[[" and (2) "[[|" or "][|" as "point is at
 719       ;; start of link".  But in the sense of the function
 720       ;; "previous-single-property-change" these two cases are
 721       ;; different.  The following code aligns these two cases.  Emacs
 722       ;; 21: If the intangible property is ignored case (2) is more
 723       ;; complicate and this hack only solves the problem partially.
 724       ;;
 725       (when (and (get-text-property (point) 'muse-link)
 726                  (muse-looking-back "\\[\\|\\]"))
 727         (goto-char (or (previous-single-property-change (point) 'muse-link)
 728                        (point-min))))
 729
 730       (when (eq (point) (point-min))
 731         (goto-char (point-max)))
 732
 733       (setq pos (previous-single-property-change (point) 'muse-link))
 734
 735       (when (not pos)
 736         (if (get-text-property (point-min) 'muse-link)
 737             (setq pos (point-min))
 738           (setq pos (previous-single-property-change (point-max)
 739                                                      'muse-link)))))
 740
 741     (when pos
 742       (if (get-text-property pos 'muse-link)
 743           (goto-char pos)
 744         (goto-char (or (previous-single-property-change pos 'muse-link)
 745                        (point-min)))))))
 746
 747 ;;;###autoload
 748 (defun muse-what-changed ()
 749   "Show the unsaved changes that have been made to the current file."
 750   (interactive)
 751   (diff-backup buffer-file-name))
 752
 753
 754 ;;; Find text in project pages, or pages referring to the current page
 755
 756 (defvar muse-search-history nil)
 757
 758 (defun muse-grep (string &optional grep-command-no-shadow)
 759   "Grep for STRING in the project directories.
 760 GREP-COMMAND if passed will supplant `muse-grep-command'."
 761   ;; careful - grep-command leaks into compile, so we call it
 762   ;; -no-shadow instead
 763   (require 'compile)
 764   (let* ((str (or grep-command-no-shadow muse-grep-command))
 765          (muse-directories (mapcar
 766                             (lambda (thing)
 767                               (car (cadr thing)))
 768                             muse-project-alist))
 769          (dirs (mapconcat (lambda (dir)
 770                             (shell-quote-argument
 771                              (expand-file-name dir)))
 772                           muse-directories " ")))
 773     (if (string= dirs "")
 774         (muse-display-warning
 775          "No directories were found in the current project; aborting search")
 776       (while (string-match "%W" str)
 777         (setq str (replace-match string t t str)))
 778       (while (string-match "%D" str)
 779         (setq str (replace-match dirs t t str)))
 780       (if (fboundp 'compilation-start)
 781           (compilation-start str nil (lambda (&rest args) "*search*")
 782                              grep-regexp-alist)
 783         (and (fboundp 'compile-internal)
 784              (compile-internal str "No more search hits" "search"
 785                                nil grep-regexp-alist))))))
 786
 787 ;;;###autoload
 788 (defun muse-search-with-command (text)
 789   "Search for the given TEXT string in the project directories
 790 using the specified command."
 791   (interactive
 792    (list (let ((str (concat muse-grep-command)) pos)
 793            (when (string-match "%W" str)
 794              (setq pos (match-beginning 0))
 795              (unless (featurep 'xemacs)
 796                (setq pos (1+ pos)))
 797              (setq str (replace-match "" t t str)))
 798            (read-from-minibuffer "Search command: "
 799                                  (cons str pos) nil nil
 800                                  'muse-search-history))))
 801   (muse-grep nil text))
 802
 803 ;;;###autoload
 804 (defun muse-search ()
 805   "Search for the given TEXT using the default grep command."
 806   (interactive)
 807   (muse-grep (read-string "Search: ")))
 808
 809 ;;;###autoload
 810 (defun muse-find-backlinks ()
 811   "Grep for the current pagename in all the project directories."
 812   (interactive)
 813   (muse-grep (muse-page-name)))
 814
 815
 816 ;;; Generate an index of all known Muse pages
 817
 818 (defun muse-generate-index (&optional as-list exclude-private)
 819   "Generate an index of all Muse pages."
 820   (let ((index (muse-index-as-string as-list exclude-private)))
 821     (with-current-buffer (get-buffer-create "*Muse Index*")
 822       (erase-buffer)
 823       (insert index)
 824       (current-buffer))))
 825
 826 ;;;###autoload
 827 (defun muse-index ()
 828   "Display an index of all known Muse pages."
 829   (interactive)
 830   (message "Generating Muse index...")
 831   (let ((project (muse-project)))
 832     (with-current-buffer (muse-generate-index)
 833       (goto-char (point-min))
 834       (muse-mode)
 835       (setq muse-current-project project)
 836       (pop-to-buffer (current-buffer))))
 837   (message "Generating Muse index...done"))
 838
 839 (defun muse-index-as-string (&optional as-list exclude-private exclude-current)
 840   "Generate an index of all Muse pages.
 841 If AS-LIST is non-nil, insert a dash and spaces before each item.
 842 If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
 843 If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
 844   (let ((files (sort (copy-alist (muse-project-file-alist))
 845                      (function
 846                       (lambda (l r)
 847                         (string-lessp (car l) (car r)))))))
 848     (when (and exclude-current (muse-page-name))
 849       (setq files (delete (assoc (muse-page-name) files) files)))
 850     (with-temp-buffer
 851       (while files
 852         (unless (and exclude-private
 853                      (muse-project-private-p (cdar files)))
 854           (insert (if as-list " - " "") "[[" (caar files) "]]\n"))
 855         (setq files (cdr files)))
 856       (buffer-string))))
 857
 858 ;;; Insert tags interactively on C-c TAB t
 859
 860 (defvar muse-tag-history nil
 861   "List of recently-entered tags; used by `muse-insert-tag'.
 862 If you want a tag to start as the default, you may manually set
 863 this variable to a list.")
 864
 865 (defvar muse-custom-tags nil
 866   "Keep track of any new tags entered in `muse-insert-tag'.
 867 If there are (X)HTML tags that you use frequently with that
 868 function, you might want to set this manually.")
 869
 870 ;;;###autoload
 871 (defun muse-insert-tag (tag)
 872   "Insert a tag interactively with a blank line after it."
 873   (interactive
 874    (list
 875     (funcall
 876      muse-completing-read-function
 877      (concat "Tag: "
 878              (when muse-tag-history
 879                (concat "(default: " (car muse-tag-history) ") ")))
 880      (progn
 881        (require 'muse-publish)
 882        (mapcar 'list (nconc (mapcar 'car muse-publish-markup-tags)
 883                             muse-custom-tags)))
 884      nil nil nil 'muse-tag-history
 885      (car muse-tag-history))))
 886   (when (equal tag "")
 887     (setq tag (car muse-tag-history)))
 888   (unless (interactive-p)
 889     (require 'muse-publish))
 890   (let ((tag-entry (assoc tag muse-publish-markup-tags))
 891         (options ""))
 892     ;; Add to custom list if no entry exists
 893     (unless tag-entry
 894       (add-to-list 'muse-custom-tags tag))
 895     ;; Get option
 896     (when (nth 2 tag-entry)
 897       (setq options (read-string "Option: ")))
 898     (unless (equal options "")
 899       (setq options (concat " " options)))
 900     ;; Insert the tag, closing if necessary
 901     (when tag (insert (concat "<" tag options ">")))
 902     (when (nth 1 tag-entry)
 903       (insert (concat "\n\n</" tag ">\n"))
 904       (forward-line -2))))
 905
 906 ;;; Muse list edit minor mode
 907
 908 (defvar muse-list-edit-minor-mode-map
 909   (let ((map (make-sparse-keymap)))
 910     (define-key map [(meta return)] 'muse-l-e-m-m-insert-list-item)
 911     (define-key map [(control ?>)] 'muse-l-e-m-m-increase-list-item-indent)
 912     (define-key map [(control ?<)] 'muse-l-e-m-m-decrease-list-item-indent)
 913
 914     map)
 915   "Keymap used by Muse list edit minor mode.")
 916
 917 (defvar muse-l-e-m-m-list-item-regexp
 918   (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::"
 919           "\\(?:[" muse-regexp-blank "]+\\|$\\)"
 920           "\\|[" muse-regexp-blank "]?[-*+][" muse-regexp-blank "]*"
 921           "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)")
 922   "Regexp used to match the beginning of a list item.
 923 This is used by `muse-list-edit-minor-mode'.
 924 The '%s' will be replaced with a whitespace regexp when publishing.")
 925
 926 (defun muse-l-e-m-m-insert-list-item ()
 927   "Insert a list item at the current point, taking into account
 928 your current list type and indentation level."
 929   (interactive)
 930   (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
 931     (call-interactively 'muse-insert-list-item)))
 932
 933 (defun muse-l-e-m-m-increase-list-item-indent ()
 934   "Increase the indentation of the current list item."
 935   (interactive)
 936   (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
 937     (call-interactively 'muse-increase-list-item-indentation)))
 938
 939 (defun muse-l-e-m-m-decrease-list-item-indent ()
 940   "Decrease the indentation of the current list item."
 941   (interactive)
 942   (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
 943     (call-interactively 'muse-decrease-list-item-indentation)))
 944
 945 (defvar muse-l-e-m-m-data nil
 946   "A list of data that was changed by Muse list edit minor mode.")
 947 (make-variable-buffer-local 'muse-l-e-m-m-data)
 948
 949 ;;;###autoload
 950 (define-minor-mode muse-list-edit-minor-mode
 951   "This is a global minor mode for editing files with lists.
 952 It is meant to be used with other major modes, and not with Muse mode.
 953
 954 Interactively, with no prefix argument, toggle the mode.
 955 With universal prefix ARG turn mode on.
 956 With zero or negative ARG turn mode off.
 957
 958 This minor mode provides the Muse keybindings for editing lists,
 959 and support for filling lists properly.
 960
 961 It recognizes not only Muse-style lists, which use the \"-\"
 962 character or numbers, but also lists that use asterisks or plus
 963 signs.  This should make the minor mode generally useful.
 964
 965 Definition lists and footnotes are also recognized.
 966
 967 Note that list items may omit leading spaces, for compatibility
 968 with modes that set `left-margin', such as
 969 `debian-changelog-mode'.
 970
 971 \\{muse-list-edit-minor-mode-map}"
 972   :init-value nil
 973   :lighter ""
 974   :keymap muse-list-edit-minor-mode-map
 975   :global nil
 976   :group 'muse-mode
 977   (if (not muse-list-edit-minor-mode)
 978       ;; deactivate
 979       (when muse-l-e-m-m-data
 980         (setq adaptive-fill-regexp (cdr (assoc "a-f-r" muse-l-e-m-m-data))
 981               paragraph-start (cdr (assoc "p-s" muse-l-e-m-m-data))
 982               fill-prefix (cdr (assoc "f-p" muse-l-e-m-m-data)))
 983         (setq muse-l-e-m-m-data nil))
 984     ;; activate
 985     (unless muse-l-e-m-m-data
 986       ;; save previous fill-related data so we can restore it later
 987       (setq muse-l-e-m-m-data
 988             (list (cons "a-f-r" adaptive-fill-regexp)
 989                   (cons "p-s" paragraph-start)
 990                   (cons "f-p" fill-prefix))))
 991     ;; make fill work nicely with item lists
 992     (let ((regexp (concat "\\s-*\\([-*+]\\|[0-9]+\\.\\)\\s-+"
 993                           "\\|\\[[0-9]+\\]\\s-*"
 994                           "\\|.*\\s-*::\\s-+")))
 995       (set (make-local-variable 'adaptive-fill-regexp)
 996            (concat regexp "\\|\\s-*"))
 997       (set (make-local-variable 'paragraph-start)
 998            (concat paragraph-start "\\|" regexp)))
 999     ;; force fill-prefix to be nil, because if it is a string that has
1000     ;; initial spaces, it messes up fill-paragraph's algorithm
1001     (set (make-local-variable 'fill-prefix) nil)))
1002
1003 (defun turn-on-muse-list-edit-minor-mode ()
1004   "Unconditionally turn on Muse list edit minor mode."
1005   (muse-list-edit-minor-mode 1))
1006
1007 (defun turn-off-muse-list-edit-minor-mode ()
1008   "Unconditionally turn off Muse list edit minor mode."
1009   (muse-list-edit-minor-mode -1))
1010
1011 ;;; muse-mode.el ends here