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   (let* ((output-dir (muse-style-element :path style))
 622          (result-path (muse-publish-output-file buffer-file-name output-dir
 623                                                 style))
 624          (muse-current-output-style (list :base (car style)
 625                                           :path output-dir)))
 626     (if (not (file-readable-p result-path))
 627         (error "Cannot open output file '%s'" result-path)
 628       (if other-window
 629           (find-file-other-window result-path)
 630         (let ((func (muse-style-element :browser style t)))
 631           (if func
 632               (funcall func result-path)
 633             (message "The %s publishing style does not support browsing."
 634                      style)))))))
 635
 636 ;;;###autoload
 637 (defun muse-follow-name-at-point (&optional other-window)
 638   "Visit the link at point."
 639   (interactive "P")
 640   (let ((link (muse-link-at-point)))
 641     (if link
 642         (muse-visit-link link other-window)
 643       (error "There is no valid link at point"))))
 644
 645 ;;;###autoload
 646 (defun muse-follow-name-at-point-other-window ()
 647   "Visit the link at point in other window."
 648   (interactive)
 649   (muse-follow-name-at-point t))
 650
 651 (defun muse-follow-name-at-mouse (event &optional other-window)
 652   "Visit the link at point, or yank text if none is found."
 653   (interactive "eN")
 654   (unless
 655       (save-excursion
 656         (cond ((fboundp 'event-window)      ; XEmacs
 657                (set-buffer (window-buffer (event-window event)))
 658                (and (funcall (symbol-function 'event-point) event)
 659                     (goto-char (funcall (symbol-function 'event-point)
 660                                         event))))
 661               ((fboundp 'posn-window)       ; Emacs
 662                (set-buffer (window-buffer (posn-window (event-start event))))
 663                (goto-char (posn-point (event-start event)))))
 664         (let ((link (muse-link-at-point)))
 665           (when link
 666             (muse-visit-link link other-window)
 667             t)))
 668     ;; Fall back to normal binding for this event
 669     (call-interactively
 670      (lookup-key (current-global-map) (this-command-keys)))))
 671
 672 (defun muse-follow-name-at-mouse-other-window (event)
 673   "Visit the link at point"
 674   (interactive "e")
 675   ;; throw away the old window position, since other-window will
 676   ;; change it anyway
 677   (select-window (car (cadr event)))
 678   (muse-follow-name-at-mouse event t))
 679
 680 ;;;###autoload
 681 (defun muse-next-reference ()
 682   "Move forward to next Muse link or URL, cycling if necessary."
 683   (interactive)
 684   (let ((pos))
 685     (save-excursion
 686       (when (get-text-property (point) 'muse-link)
 687         (goto-char (or (next-single-property-change (point) 'muse-link)
 688                        (point-max))))
 689
 690       (setq pos (next-single-property-change (point) 'muse-link))
 691
 692       (when (not pos)
 693         (if (get-text-property (point-min) 'muse-link)
 694             (setq pos (point-min))
 695           (setq pos (next-single-property-change (point-min) 'muse-link)))))
 696
 697     (when pos
 698       (goto-char pos))))
 699
 700 ;;;###autoload
 701 (defun muse-previous-reference ()
 702   "Move backward to the next Muse link or URL, cycling if necessary.
 703 In case of Emacs x <= 21 and ignoring of intangible properties (see
 704 `muse-mode-intangible-links').
 705
 706 This function is not entirely accurate, but it's close enough."
 707   (interactive)
 708   (let ((pos))
 709     (save-excursion
 710
 711       ;; Hack: The user perceives the two cases of point ("|")
 712       ;; position (1) "|[[" and (2) "[[|" or "][|" as "point is at
 713       ;; start of link".  But in the sense of the function
 714       ;; "previous-single-property-change" these two cases are
 715       ;; different.  The following code aligns these two cases.  Emacs
 716       ;; 21: If the intangible property is ignored case (2) is more
 717       ;; complicate and this hack only solves the problem partially.
 718       ;;
 719       (when (and (get-text-property (point) 'muse-link)
 720                  (muse-looking-back "\\[\\|\\]"))
 721         (goto-char (or (previous-single-property-change (point) 'muse-link)
 722                        (point-min))))
 723
 724       (when (eq (point) (point-min))
 725         (goto-char (point-max)))
 726
 727       (setq pos (previous-single-property-change (point) 'muse-link))
 728
 729       (when (not pos)
 730         (if (get-text-property (point-min) 'muse-link)
 731             (setq pos (point-min))
 732           (setq pos (previous-single-property-change (point-max)
 733                                                      'muse-link)))))
 734
 735     (when pos
 736       (if (get-text-property pos 'muse-link)
 737           (goto-char pos)
 738         (goto-char (or (previous-single-property-change pos 'muse-link)
 739                        (point-min)))))))
 740
 741 ;;;###autoload
 742 (defun muse-what-changed ()
 743   "Show the unsaved changes that have been made to the current file."
 744   (interactive)
 745   (diff-backup buffer-file-name))
 746
 747
 748 ;;; Find text in project pages, or pages referring to the current page
 749
 750 (defvar muse-search-history nil)
 751
 752 (defun muse-grep (string &optional grep-command-no-shadow)
 753   "Grep for STRING in the project directories.
 754 GREP-COMMAND if passed will supplant `muse-grep-command'."
 755   ;; careful - grep-command leaks into compile, so we call it
 756   ;; -no-shadow instead
 757   (require 'compile)
 758   (let* ((str (or grep-command-no-shadow muse-grep-command))
 759          (muse-directories (mapcar
 760                             (lambda (thing)
 761                               (car (cadr thing)))
 762                             muse-project-alist))
 763          (dirs (mapconcat (lambda (dir)
 764                             (shell-quote-argument
 765                              (expand-file-name dir)))
 766                           muse-directories " ")))
 767     (if (string= dirs "")
 768         (muse-display-warning
 769          "No directories were found in the current project; aborting search")
 770       (while (string-match "%W" str)
 771         (setq str (replace-match string t t str)))
 772       (while (string-match "%D" str)
 773         (setq str (replace-match dirs t t str)))
 774       (if (fboundp 'compilation-start)
 775           (compilation-start str nil (lambda (&rest args) "*search*")
 776                              grep-regexp-alist)
 777         (and (fboundp 'compile-internal)
 778              (compile-internal str "No more search hits" "search"
 779                                nil grep-regexp-alist))))))
 780
 781 ;;;###autoload
 782 (defun muse-search-with-command (text)
 783   "Search for the given TEXT string in the project directories
 784 using the specified command."
 785   (interactive
 786    (list (let ((str (concat muse-grep-command)) pos)
 787            (when (string-match "%W" str)
 788              (setq pos (match-beginning 0))
 789              (unless (featurep 'xemacs)
 790                (setq pos (1+ pos)))
 791              (setq str (replace-match "" t t str)))
 792            (read-from-minibuffer "Search command: "
 793                                  (cons str pos) nil nil
 794                                  'muse-search-history))))
 795   (muse-grep nil text))
 796
 797 ;;;###autoload
 798 (defun muse-search ()
 799   "Search for the given TEXT using the default grep command."
 800   (interactive)
 801   (muse-grep (read-string "Search: ")))
 802
 803 ;;;###autoload
 804 (defun muse-find-backlinks ()
 805   "Grep for the current pagename in all the project directories."
 806   (interactive)
 807   (muse-grep (muse-page-name)))
 808
 809
 810 ;;; Generate an index of all known Muse pages
 811
 812 (defun muse-generate-index (&optional as-list exclude-private)
 813   "Generate an index of all Muse pages."
 814   (let ((index (muse-index-as-string as-list exclude-private)))
 815     (with-current-buffer (get-buffer-create "*Muse Index*")
 816       (erase-buffer)
 817       (insert index)
 818       (current-buffer))))
 819
 820 ;;;###autoload
 821 (defun muse-index ()
 822   "Display an index of all known Muse pages."
 823   (interactive)
 824   (message "Generating Muse index...")
 825   (let ((project (muse-project)))
 826     (with-current-buffer (muse-generate-index)
 827       (goto-char (point-min))
 828       (muse-mode)
 829       (setq muse-current-project project)
 830       (pop-to-buffer (current-buffer))))
 831   (message "Generating Muse index...done"))
 832
 833 (defun muse-index-as-string (&optional as-list exclude-private exclude-current)
 834   "Generate an index of all Muse pages.
 835 If AS-LIST is non-nil, insert a dash and spaces before each item.
 836 If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
 837 If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
 838   (let ((files (sort (copy-alist (muse-project-file-alist))
 839                      (function
 840                       (lambda (l r)
 841                         (string-lessp (car l) (car r)))))))
 842     (when (and exclude-current (muse-page-name))
 843       (setq files (delete (assoc (muse-page-name) files) files)))
 844     (with-temp-buffer
 845       (while files
 846         (unless (and exclude-private
 847                      (muse-project-private-p (cdar files)))
 848           (insert (if as-list " - " "") "[[" (caar files) "]]\n"))
 849         (setq files (cdr files)))
 850       (buffer-string))))
 851
 852 ;;; Insert tags interactively on C-c TAB t
 853
 854 (defvar muse-tag-history nil
 855   "List of recently-entered tags; used by `muse-insert-tag'.
 856 If you want a tag to start as the default, you may manually set
 857 this variable to a list.")
 858
 859 (defvar muse-custom-tags nil
 860   "Keep track of any new tags entered in `muse-insert-tag'.
 861 If there are (X)HTML tags that you use frequently with that
 862 function, you might want to set this manually.")
 863
 864 ;;;###autoload
 865 (defun muse-insert-tag (tag)
 866   "Insert a tag interactively with a blank line after it."
 867   (interactive
 868    (list
 869     (funcall
 870      muse-completing-read-function
 871      (concat "Tag: "
 872              (when muse-tag-history
 873                (concat "(default: " (car muse-tag-history) ") ")))
 874      (progn
 875        (require 'muse-publish)
 876        (mapcar 'list (nconc (mapcar 'car muse-publish-markup-tags)
 877                             muse-custom-tags)))
 878      nil nil nil 'muse-tag-history
 879      (car muse-tag-history))))
 880   (when (equal tag "")
 881     (setq tag (car muse-tag-history)))
 882   (unless (interactive-p)
 883     (require 'muse-publish))
 884   (let ((tag-entry (assoc tag muse-publish-markup-tags))
 885         (options ""))
 886     ;; Add to custom list if no entry exists
 887     (unless tag-entry
 888       (add-to-list 'muse-custom-tags tag))
 889     ;; Get option
 890     (when (nth 2 tag-entry)
 891       (setq options (read-string "Option: ")))
 892     (unless (equal options "")
 893       (setq options (concat " " options)))
 894     ;; Insert the tag, closing if necessary
 895     (when tag (insert (concat "<" tag options ">")))
 896     (when (nth 1 tag-entry)
 897       (insert (concat "\n\n</" tag ">\n"))
 898       (forward-line -2))))
 899
 900 ;;; Muse list edit minor mode
 901
 902 (defvar muse-list-edit-minor-mode-map
 903   (let ((map (make-sparse-keymap)))
 904     (define-key map [(meta return)] 'muse-l-e-m-m-insert-list-item)
 905     (define-key map [(control ?>)] 'muse-l-e-m-m-increase-list-item-indent)
 906     (define-key map [(control ?<)] 'muse-l-e-m-m-decrease-list-item-indent)
 907
 908     map)
 909   "Keymap used by Muse list edit minor mode.")
 910
 911 (defvar muse-l-e-m-m-list-item-regexp
 912   (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::"
 913           "\\(?:[" muse-regexp-blank "]+\\|$\\)"
 914           "\\|[" muse-regexp-blank "]?[-*+][" muse-regexp-blank "]*"
 915           "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)")
 916   "Regexp used to match the beginning of a list item.
 917 This is used by `muse-list-edit-minor-mode'.
 918 The '%s' will be replaced with a whitespace regexp when publishing.")
 919
 920 (defun muse-l-e-m-m-insert-list-item ()
 921   "Insert a list item at the current point, taking into account
 922 your current list type and indentation level."
 923   (interactive)
 924   (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
 925     (call-interactively 'muse-insert-list-item)))
 926
 927 (defun muse-l-e-m-m-increase-list-item-indent ()
 928   "Increase the indentation of the current list item."
 929   (interactive)
 930   (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp))
 931     (call-interactively 'muse-increase-list-item-indentation)))
 932
 933 (defun muse-l-e-m-m-decrease-list-item-indent ()
 934   "Decrease 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-decrease-list-item-indentation)))
 938
 939 (defvar muse-l-e-m-m-data nil
 940   "A list of data that was changed by Muse list edit minor mode.")
 941 (make-variable-buffer-local 'muse-l-e-m-m-data)
 942
 943 ;;;###autoload
 944 (define-minor-mode muse-list-edit-minor-mode
 945   "This is a global minor mode for editing files with lists.
 946 It is meant to be used with other major modes, and not with Muse mode.
 947
 948 Interactively, with no prefix argument, toggle the mode.
 949 With universal prefix ARG turn mode on.
 950 With zero or negative ARG turn mode off.
 951
 952 This minor mode provides the Muse keybindings for editing lists,
 953 and support for filling lists properly.
 954
 955 It recognizes not only Muse-style lists, which use the \"-\"
 956 character or numbers, but also lists that use asterisks or plus
 957 signs.  This should make the minor mode generally useful.
 958
 959 Definition lists and footnotes are also recognized.
 960
 961 Note that list items may omit leading spaces, for compatibility
 962 with modes that set `left-margin', such as
 963 `debian-changelog-mode'.
 964
 965 \\{muse-list-edit-minor-mode-map}"
 966   :init-value nil
 967   :lighter ""
 968   :keymap muse-list-edit-minor-mode-map
 969   :global nil
 970   :group 'muse-mode
 971   (if (not muse-list-edit-minor-mode)
 972       ;; deactivate
 973       (when muse-l-e-m-m-data
 974         (setq adaptive-fill-regexp (cdr (assoc "a-f-r" muse-l-e-m-m-data))
 975               paragraph-start (cdr (assoc "p-s" muse-l-e-m-m-data))
 976               fill-prefix (cdr (assoc "f-p" muse-l-e-m-m-data)))
 977         (setq muse-l-e-m-m-data nil))
 978     ;; activate
 979     (unless muse-l-e-m-m-data
 980       ;; save previous fill-related data so we can restore it later
 981       (setq muse-l-e-m-m-data
 982             (list (cons "a-f-r" adaptive-fill-regexp)
 983                   (cons "p-s" paragraph-start)
 984                   (cons "f-p" fill-prefix))))
 985     ;; make fill work nicely with item lists
 986     (let ((regexp (concat "\\s-*\\([-*+]\\|[0-9]+\\.\\)\\s-+"
 987                           "\\|\\[[0-9]+\\]\\s-*"
 988                           "\\|.*\\s-*::\\s-+")))
 989       (set (make-local-variable 'adaptive-fill-regexp)
 990            (concat regexp "\\|\\s-*"))
 991       (set (make-local-variable 'paragraph-start)
 992            (concat paragraph-start "\\|" regexp)))
 993     ;; force fill-prefix to be nil, because if it is a string that has
 994     ;; initial spaces, it messes up fill-paragraph's algorithm
 995     (set (make-local-variable 'fill-prefix) nil)))
 996
 997 (defun turn-on-muse-list-edit-minor-mode ()
 998   "Unconditionally turn on Muse list edit minor mode."
 999   (muse-list-edit-minor-mode 1))
1000
1001 (defun turn-off-muse-list-edit-minor-mode ()
1002   "Unconditionally turn off Muse list edit minor mode."
1003   (muse-list-edit-minor-mode -1))
1004
1005 ;;; muse-mode.el ends here