;;; muse-mode.el --- mode for editing Muse files; has font-lock support

;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.

;; This file is part of Emacs Muse.  It is not part of GNU Emacs.

;; Emacs Muse is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 2, or (at your
;; option) any later version.

;; Emacs Muse is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with Emacs Muse; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; The Emacs Muse major mode is basically a hyped-up text-mode which
;; knows a lot more about the apparent structure of the document.

;;; Contributors:

;; Andrea Riciputi (ariciputi AT pito DOT com) gave an initial
;; implementation for tag completion by means of the `muse-insert-tag'
;; function.

;; Per B. Sederberg (per AT med DOT upenn DOT edu) contributed the
;; insertion of relative links and list items, backlink searching, and
;; other things as well.

;; Stefan Schlee (stefan_schlee AT yahoo DOT com) fixed a bug in
;; muse-next-reference and muse-previous-reference involving links
;; that begin at point 1.

;;; Code:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Emacs Muse Major Mode
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'muse-mode)

(require 'muse)
(require 'muse-regexps)
(require 'muse-project)

(autoload 'muse-use-font-lock "muse-colors")
(autoload 'muse-publish-this-file "muse-publish")
(autoload 'muse-publish-get-style "muse-publish")
(autoload 'muse-publish-output-file "muse-publish")

(require 'derived)
(eval-when-compile
  (condition-case nil
      (require 'pcomplete)              ; load if available
    (error nil)))

;;; Options:

(defgroup muse-mode nil
  "Options controlling the behavior of the Muse editing Mode."
  :group 'muse)

(defcustom muse-mode-highlight-p t
  "If non-nil, highlight the content of Muse buffers."
  :type 'boolean
  :require 'muse-colors
  :group 'muse-mode)

(defcustom muse-mode-auto-p nil
  "If non-nil, automagically determine when Muse mode should be activated."
  :type 'boolean
  :set (function
        (lambda (sym value)
          (if value
              (add-hook 'find-file-hooks 'muse-mode-maybe)
            (remove-hook 'find-file-hooks 'muse-mode-maybe))
          (set sym value)))
  :group 'muse-mode)

(defun muse-mode-maybe-after-init ()
  (when muse-mode-auto-p
    (add-hook 'find-file-hooks 'muse-mode-maybe)))

;; If the user sets this value in their init file, make sure that
;; it takes effect
(add-hook 'after-init-hook 'muse-mode-maybe-after-init)

(defcustom muse-mode-intangible-links nil
  "If non-nil, use the intangible property on links.
This can cause problems with flyspell (and potentially fill-mode),
so only enable this if you don't use either of these."
  :type 'boolean
  :group 'muse-mode)

(defcustom muse-mode-hook nil
  "A hook that is run when Muse mode is entered."
  :type 'hook
  :options '(flyspell-mode footnote-mode turn-on-auto-fill
             highlight-changes-mode)
  :group 'muse-mode)

(defcustom muse-grep-command
  "find %D -type f ! -name '*~' | xargs -I {} echo \\\"{}\\\" | xargs egrep -n -e \"%W\""
  "The command to use when grepping for backlinks and other
searches through the muse projects.  The string %D is replaced by
the directories from muse-project-alist, space-separated.  The
string %W is replaced with the name of the muse page or whatever
else you are searching for.  This command has been modified to
handle spaces in filenames, which were giving egrep a problem.

Note: We highly recommend using glimpse to search large projects.
To use glimpse, install and edit a file called .glimpse_exclude
in your home directory.  Put a list of glob patterns in that file
to exclude Emacs backup files, etc.  Then, run the indexer using:

  glimpseindex -o <list of Wiki directories>

Once that's completed, customize this variable to have the
following value:

  glimpse -nyi \"%W\"

Your searches will go much, much faster, especially for very
large projects.  Don't forget to add a user cronjob to update the
index at intervals."
  :type 'string
  :group 'muse-mode)

(defvar muse-insert-map
  (let ((map (make-sparse-keymap)))
    (define-key map "l" 'muse-insert-relative-link-to-file)
    (define-key map "t" 'muse-insert-tag)
    (define-key map "u" 'muse-insert-url)

    map))

(defvar muse-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [(control ?c) (control ?a)] 'muse-index)
    (define-key map [(control ?c) (control ?e)] 'muse-edit-link-at-point)
    (define-key map [(control ?c) (control ?l)] 'font-lock-mode)
    (define-key map [(control ?c) (control ?t)]
      'muse-project-publish-this-file)
    (define-key map [(control ?c) (control ?T)] 'muse-publish-this-file)
    (define-key map [(control ?c) (meta control ?t)] 'muse-publish-this-file)
    (define-key map [(control ?c) (control ?v)] 'muse-browse-result)

    (define-key map [(control ?c) ?=]           'muse-what-changed)

    (define-key map [tab] 'muse-next-reference)
    (define-key map [(control ?i)] 'muse-next-reference)

    (if (featurep 'xemacs)
        (progn
          (define-key map [(button2)] 'muse-follow-name-at-mouse)
          (define-key map [(shift button2)]
            'muse-follow-name-at-mouse-other-window))
      (define-key map [(shift control ?m)]
        'muse-follow-name-at-point-other-window)
      (define-key map [mouse-2] 'muse-follow-name-at-mouse)
      (define-key map [(shift mouse-2)]
        'muse-follow-name-at-mouse-other-window))

    (define-key map [(shift tab)] 'muse-previous-reference)
    (unless (featurep 'xemacs)
      (define-key map [(shift iso-lefttab)] 'muse-previous-reference)
      (define-key map [(shift control ?i)] 'muse-previous-reference))

    (define-key map [(control ?c) (control ?f)] 'muse-project-find-file)
    (define-key map [(control ?c) (control ?p)] 'muse-project-publish)

    (define-key map [(control ?c) (control ?i)] 'muse-insert-thing)
    (define-key map [(control ?c) tab] 'muse-insert-thing)

    ;; Searching functions
    (define-key map [(control ?c) (control ?b)] 'muse-find-backlinks)
    (define-key map [(control ?c) (control ?s)] 'muse-search)

    ;; Enhanced list functions
    (define-key map [(meta return)] 'muse-insert-list-item)
    (define-key map [(control ?>)] 'muse-increase-list-item-indentation)
    (define-key map [(control ?<)] 'muse-decrease-list-item-indentation)

    (when (featurep 'pcomplete)
      (define-key map [(meta tab)] 'pcomplete)
      (define-key map [(meta control ?i)] 'pcomplete))

    map)
  "Keymap used by Emacs Muse mode.")

;; Code:

;;;###autoload
(define-derived-mode muse-mode text-mode "Muse"
  "Muse is an Emacs mode for authoring and publishing documents.
\\{muse-mode-map}"
  ;; Since we're not inheriting from normal-mode, we need to
  ;; explicitly run file variables.
  (condition-case err
      (hack-local-variables)
    (error (message "File local-variables error: %s"
                    (prin1-to-string err))))
  ;; Avoid lock-up caused by use of the 'intangible' text property
  ;; with flyspell.
  (unless muse-mode-intangible-links
    (set (make-local-variable 'inhibit-point-motion-hooks) t))
  (setq muse-current-project (muse-project-of-file))
  (muse-project-set-variables)
  ;; Make fill not split up links
  (when (boundp 'fill-nobreak-predicate)
    (make-local-variable 'fill-nobreak-predicate)
    ;; Work around annoying inconsistency in fill handling between
    ;; Emacs 21 and 22.
    (if (< emacs-major-version 22)
        (setq fill-nobreak-predicate 'muse-mode-fill-nobreak-p)
      (add-to-list 'fill-nobreak-predicate
                   'muse-mode-fill-nobreak-p)))
  ;; Make fill work nicely with item lists
  (set (make-local-variable 'adaptive-fill-regexp)
       (concat "\\s-+\\(-\\|[0-9]+\\.\\)\\s-+\\|\\[[0-9]+\\]\\s-*"
               "\\|.*\\s-*::\\s-+\\|\\s-*"))
  (set (make-local-variable 'paragraph-start)
       (concat paragraph-start
               "\\|\\s-+\\(-\\|[0-9]+\\.\\)\\s-+\\|\\[[0-9]+\\]\\s-*"
               "\\|.*\\s-*::\\s-+"))
  ;; Comment syntax is `; comment'
  (set (make-local-variable 'comment-start)
       "; ")
  (set (make-local-variable 'comment-start-skip)
       "^;\\s-+")
  ;; If we're using Emacs21, this makes flyspell work like it should
  (when (boundp 'flyspell-generic-check-word-p)
    (set (make-local-variable 'flyspell-generic-check-word-p)
         'muse-mode-flyspell-p))
  ;; If pcomplete is available, set it up
  (when (featurep 'pcomplete)
    (set (make-local-variable 'pcomplete-default-completion-function)
         'muse-mode-completions)
    (set (make-local-variable 'pcomplete-command-completion-function)
         'muse-mode-completions)
    (set (make-local-variable 'pcomplete-parse-arguments-function)
         'muse-mode-current-word))
  ;; Initialize any auto-generated variables
  (run-hooks 'muse-update-values-hook)
  (when muse-mode-highlight-p
    (muse-use-font-lock)))

(put 'muse-mode
     'flyspell-mode-predicate
     'muse-mode-flyspell-p)

(defun muse-mode-fill-nobreak-p ()
  "Return nil if we should allow a fill to occur at point.
Otherwise return non-nil.

This is used to keep long explicit links from being mangled by
fill mode."
  (save-excursion
    (save-match-data
      (and (re-search-backward "\\[\\[\\|\\]\\]"
                               (line-beginning-position) t)
           (string= (or (match-string 0) "")
                    "[[")))))

(defun muse-mode-flyspell-p ()
  "Return non-nil if we should allow spell-checking to occur at point.
Otherwise return nil.

This is used to keep links from being improperly colorized by flyspell."
  (and (not (get-text-property (if (bobp) (point) (1- (point)))
                               'muse-link))
       (save-match-data
         (null (muse-link-at-point)))))

;;;###autoload
(defun muse-mode-choose-mode ()
  "Turn the proper Emacs Muse related mode on for this file."
  (let ((project (muse-project-of-file)))
    (funcall (or (and project (muse-get-keyword :major-mode (cadr project) t))
                 'muse-mode))))

(defun muse-mode-maybe ()
  "Maybe turn Emacs Muse mode on for this file."
  (let ((project (muse-project-of-file)))
    (and project
         (funcall (or (muse-get-keyword :major-mode (cadr project) t)
                      'muse-mode)))))

;;; Enhanced list editing

(defun muse-on-blank-line ()
  "See if point is on a blank line"
  (save-excursion
    (beginning-of-line)
    (looking-at (concat "[" muse-regexp-blank "]?[\n]+"))))

(defun muse-get-paragraph-start ()
  "Return the start of the current paragraph. This function will
return nil if there are no prior paragraphs and the beginning of
the line if point is on a blank line."
  (let ((para-start (concat "[\n]+[" muse-regexp-blank "]?[\n]+")))
    ;; search back to start of paragraph
    (save-excursion
      (save-match-data
        (if (not (muse-on-blank-line))
            (re-search-backward para-start nil t)
          (line-beginning-position))))))

(defun muse-insert-thing ()
  "Prompt for something to insert into the current buffer."
  (interactive)
  (message "Insert:\nl  link\nt  Muse tag\nu  URL")
  (let (key cmd)
    (let ((overriding-local-map muse-insert-map))
      (setq key (read-key-sequence nil)))
    (if (commandp (setq cmd (lookup-key muse-insert-map key)))
        (progn (message "")
               (call-interactively cmd))
      (message "Not inserting anything"))))

;;;###autoload
(defun muse-insert-list-item ()
  "Insert a list item at the current point, taking into account
your current list type and indentation level."
  (interactive)
  (let ((newitem " - ")
        (itemno nil)
        (pstart (muse-get-paragraph-start))
        (list-item (format muse-list-item-regexp
                           (concat "[" muse-regexp-blank "]*"))))
    ;; search backwards for start of current item
    (save-excursion
      (when (re-search-backward list-item pstart t)
        ;; save the matching item
        (setq newitem (match-string 0))
        ;; see what type it is
        (if (string-match "::" (match-string 0))
            ;; is a definition, replace the term
            (setq newitem (concat " "
                                  (read-string "Term: ")
                                  " :: "))
          ;; see if it's a numbered list
          (when (string-match "[0-9]+" newitem)
            ;; is numbered, so increment
            (setq itemno (1+
                          (string-to-number
                           (match-string 0 newitem))))
            (setq newitem (replace-match
                           (number-to-string itemno)
                           nil nil newitem))))))
    ;; insert the new item
    (insert (concat "\n" newitem))))

(defun muse-alter-list-item-indentation (operation)
  "Alter the indentation of the current list item.
Valid values of OPERATION are 'increase and 'decrease."
  (let ((pstart (muse-get-paragraph-start))
        (list-item (format muse-list-item-regexp
                           (concat "[" muse-regexp-blank "]*")))
        beg move-func indent)
    ;; search backwards until start of paragraph to see if we are on a
    ;; current item
    (save-excursion
      (if (or (progn (goto-char (muse-line-beginning-position))
                     ;; we are on an item
                     (looking-at list-item))
              ;; not on item, so search backwards
              (re-search-backward list-item pstart t))
          (let ((beg (point)))
            ;; we are on an item
            (setq indent (buffer-substring (match-beginning 0)
                                           (match-beginning 1)))
            (muse-forward-list-item (muse-list-item-type (match-string 1))
                                    (concat "[" muse-regexp-blank "]*")
                                    t)
            (save-restriction
              (narrow-to-region beg (point))
              (goto-char (point-min))
              (let ((halt nil))
                (while (< (point) (point-max))
                  ;; increase or decrease the indentation
                  (unless halt
                    (cond ((eq operation 'increase)
                           (insert "  "))
                          ((eq operation 'decrease)
                           (if (looking-at "  ")
                               ;; we have enough space, so delete it
                               (delete-region (match-beginning 0)
                                              (match-end 0))
                             (setq halt t)))))
                  (forward-line 1)))))
        ;; we are not on an item, so warn
        (message "You are not on a list item.")))))

;;;###autoload
(defun muse-increase-list-item-indentation ()
  "Increase the indentation of the current list item."
  (interactive)
  (muse-alter-list-item-indentation 'increase))

;;;###autoload
(defun muse-decrease-list-item-indentation ()
  "Decrease the indentation of the current list item."
  (interactive)
  (muse-alter-list-item-indentation 'decrease))

;;; Support page name completion using pcomplete

(defun muse-mode-completions ()
  "Return a list of possible completions names for this buffer."
  (let ((project (muse-project-of-file)))
    (if project
        (while (pcomplete-here
                (mapcar 'car (muse-project-file-alist project)))))))

(defun muse-mode-current-word ()
  (let ((end (point)))
    (save-excursion
      (save-restriction
        (skip-chars-backward (concat "^\\[\n" muse-regexp-blank))
        (narrow-to-region (point) end))
      (pcomplete-parse-buffer-arguments))))

;;; Navigate/visit links or URLs.  Use TAB, S-TAB and RET (or mouse-2).

(defun muse-link-at-point (&optional pos)
  "Return link text if a URL or link is at point."
  (let ((case-fold-search nil)
        (inhibit-point-motion-hooks t)
        (here (or pos (point))))
    ;; if we are using muse-colors, we can just use link properties to
    ;; determine whether we are on a link
    (if (featurep 'muse-colors)
        (when (get-text-property here 'muse-link)
          (save-excursion
            (when (and (not (bobp))
                       (get-text-property (1- here) 'muse-link))
              (goto-char (or (previous-single-property-change here 'muse-link)
                             (point-min))))
            (if (looking-at muse-explicit-link-regexp)
                (progn
                  (goto-char (match-beginning 1))
                  (muse-handle-explicit-link))
              (muse-handle-implicit-link))))
      ;; use fallback method to find a link
      (when (or (null pos)
                (and (char-after pos)
                     (not (eq (char-syntax (char-after pos)) ?\ ))))
        (save-excursion
          (goto-char here)
          ;; check for explicit link here or before point
          (if (or (looking-at muse-explicit-link-regexp)
                  (and
                   (re-search-backward "\\[\\[\\|\\]\\]"
                                       (muse-line-beginning-position)
                                       t)
                   (string= (or (match-string 0) "") "[[")
                   (looking-at muse-explicit-link-regexp)))
              (progn
                (goto-char (match-beginning 1))
                (muse-handle-explicit-link))
            (goto-char here)
            ;; check for bare URL or other link type
            (skip-chars-backward (concat "^'\"<>{}(\n" muse-regexp-blank))
            (and (looking-at muse-implicit-link-regexp)
                 (muse-handle-implicit-link))))))))

(defun muse-make-link (link &optional desc)
  "Return a link to LINK with DESC as the description."
  (when (string-match muse-explicit-link-regexp link)
    (unless desc (setq desc (muse-get-link-desc link)))
    (setq link (muse-get-link link)))
  (if (and desc
           link
           (not (string= desc ""))
           (not (string= link desc)))
      (concat "[[" (muse-link-escape link) "][" (muse-link-escape desc) "]]")
    (concat "[[" (or (muse-link-escape link) "") "]]")))

;;;###autoload
(defun muse-insert-relative-link-to-file ()
  "Insert a relative link to a file, with optional description, at point."
  ;; Perhaps the relative location should be configurable, so that the
  ;; file search would start in the publishing directory and then
  ;; insert the link relative to the publishing directory
  (interactive)
  (insert
   (muse-make-link (file-relative-name (read-file-name "Link: "))
                   (read-string "Text: "))))

(defun muse-insert-url ()
  "Insert a URL, with optional description, at point."
  (interactive)
  (insert
   (muse-make-link (read-string "URL: ")
                   (read-string "Text: "))))

;;;###autoload
(defun muse-edit-link-at-point ()
  "Edit the current link.
Do not rename the page originally referred to."
  (interactive)
  (if (muse-link-at-point)
      (let ((link (muse-link-unescape (muse-get-link)))
            (desc (muse-link-unescape (muse-get-link-desc))))
        (replace-match
         (save-match-data
           (muse-make-link
            (read-string "Link: " link)
            (read-string "Text: " desc)))
         t t))
    (error "There is no valid link at point")))

(defun muse-visit-link-default (link &optional other-window)
  "Visit the URL or link named by LINK.
If ANCHOR is specified, search for it after opening LINK.

This is the default function to call when visiting links; it is
used by `muse-visit-link' if you have not specified :visit-link
in `muse-project-alist'."
  (if (string-match muse-url-regexp link)
      (muse-browse-url link)
    (let (anchor
          base-buffer)
      (when (string-match "#" link)
        (setq anchor (substring link (match-beginning 0))
              link (if (= (match-beginning 0) 0)
                       ;; If there is an anchor but no link, default
                       ;; to the current page.
                       nil
                     (substring link 0 (match-beginning 0)))))
      (when link
        (setq base-buffer (get-buffer link))
        (if (and base-buffer (not (buffer-file-name base-buffer)))
            ;; If file is temporary (no associated file), just switch to
            ;; the buffer
            (if other-window
                (switch-to-buffer-other-window base-buffer)
              (switch-to-buffer base-buffer))
          (let ((project (muse-project-of-file)))
            (if project
                (muse-project-find-file link project
                                        (and other-window
                                             'find-file-other-window))
              (if other-window
                  (find-file-other-window link)
                (find-file link))))))
      (when anchor
        (let ((pos (point)))
          (goto-char (point-min))
          (unless (re-search-forward (concat "^\\W*" (regexp-quote anchor)
                                             "\\b")
                                     nil t)
            (goto-char pos)))))))

(defun muse-visit-link (link &optional other-window)
  "Visit the URL or link named by LINK."
  (let ((visit-link-function
         (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t)))
    (if visit-link-function
        (funcall visit-link-function link other-window)
      (muse-visit-link-default link other-window))))

;;;###autoload
(defun muse-browse-result (style &optional other-window)
  "Visit the current page's published result."
  (interactive
   (list (muse-project-get-applicable-style buffer-file-name
                                            (cddr muse-current-project))
         current-prefix-arg))
  (setq style (muse-style style))
  (let ((result-path
         (muse-publish-output-file buffer-file-name
                                   (muse-style-element :path style) style)))
    (if (not (file-readable-p result-path))
        (error "Cannot open output file '%s'" result-path)
      (if other-window
          (find-file-other-window result-path)
        (let ((func (muse-style-element :browser style t)))
          (if func
              (funcall func result-path)
            (message "The %s publishing style does not support browsing."
                     style)))))))

;;;###autoload
(defun muse-follow-name-at-point (&optional other-window)
  "Visit the link at point."
  (interactive "P")
  (let ((link (muse-link-at-point)))
    (if link
        (muse-visit-link link other-window)
      (error "There is no valid link at point"))))

;;;###autoload
(defun muse-follow-name-at-point-other-window ()
  "Visit the link at point in other window."
  (interactive)
  (muse-follow-name-at-point t))

(defun muse-follow-name-at-mouse (event &optional other-window)
  "Visit the link at point, or yank text if none is found."
  (interactive "eN")
  (unless
      (save-excursion
        (cond ((fboundp 'event-window)      ; XEmacs
               (set-buffer (window-buffer (event-window event)))
               (and (funcall (symbol-function 'event-point) event)
                    (goto-char (funcall (symbol-function 'event-point)
                                        event))))
              ((fboundp 'posn-window)       ; Emacs
               (set-buffer (window-buffer (posn-window (event-start event))))
               (goto-char (posn-point (event-start event)))))
        (let ((link (muse-link-at-point)))
          (when link
            (muse-visit-link link other-window)
            t)))
    ;; Fall back to normal binding for this event
    (call-interactively
     (lookup-key (current-global-map) (this-command-keys)))))

(defun muse-follow-name-at-mouse-other-window (event)
  "Visit the link at point"
  (interactive "e")
  ;; throw away the old window position, since other-window will
  ;; change it anyway
  (select-window (car (cadr event)))
  (muse-follow-name-at-mouse event t))

;;;###autoload
(defun muse-next-reference ()
  "Move forward to next Muse link or URL, cycling if necessary."
  (interactive)
  (let ((pos))
    (save-excursion
      (when (get-text-property (point) 'muse-link)
        (goto-char (or (next-single-property-change (point) 'muse-link)
                       (point-max))))

      (setq pos (next-single-property-change (point) 'muse-link))

      (when (not pos)
        (if (get-text-property (point-min) 'muse-link)
            (setq pos (point-min))
          (setq pos (next-single-property-change (point-min) 'muse-link)))))

    (when pos
      (goto-char pos))))

;;;###autoload
(defun muse-previous-reference ()
  "Move backward to the next Muse link or URL, cycling if necessary.
In case of Emacs x <= 21 and ignoring of intangible properties (see
`muse-mode-intangible-links').

This function is not entirely accurate, but it's close enough."
  (interactive)
  (let ((pos))
    (save-excursion

      ;; Hack: The user perceives the two cases of point ("|")
      ;; position (1) "|[[" and (2) "[[|" or "][|" as "point is at
      ;; start of link".  But in the sense of the function
      ;; "previous-single-property-change" these two cases are
      ;; different.  The following code aligns these two cases.  Emacs
      ;; 21: If the intangible property is ignored case (2) is more
      ;; complicate and this hack only solves the problem partially.
      ;;
      (when (and (get-text-property (point) 'muse-link)
                 (muse-looking-back "\\[\\|\\]"))
        (goto-char (or (previous-single-property-change (point) 'muse-link)
                       (point-min))))

      (when (eq (point) (point-min))
        (goto-char (point-max)))

      (setq pos (previous-single-property-change (point) 'muse-link))

      (when (not pos)
        (if (get-text-property (point-min) 'muse-link)
            (setq pos (point-min))
          (setq pos (previous-single-property-change (point-max)
                                                     'muse-link)))))

    (when pos
      (if (get-text-property pos 'muse-link)
          (goto-char pos)
        (goto-char (or (previous-single-property-change pos 'muse-link)
                       (point-min)))))))

;;;###autoload
(defun muse-what-changed ()
  "Show the unsaved changes that have been made to the current file."
  (interactive)
  (diff-backup buffer-file-name))


;;; Find text in project pages, or pages referring to the current page

(defvar muse-search-history nil)

(defun muse-grep (string &optional grep-command-no-shadow)
  "Grep for STRING in the project directories.
GREP-COMMAND if passed will supplant `muse-grep-command'."
  ;; careful - grep-command leaks into compile, so we call it
  ;; -no-shadow instead
  (require 'compile)
  (let* ((str (or grep-command-no-shadow muse-grep-command))
         (muse-directories (mapcar
                            (lambda (thing)
                              (car (cadr thing)))
                            muse-project-alist))
         (dirs (mapconcat (lambda (dir)
                            (shell-quote-argument
                             (expand-file-name dir)))
                          muse-directories " ")))
    (while (string-match "%W" str)
      (setq str (replace-match string t t str)))
    (while (string-match "%D" str)
      (setq str (replace-match dirs t t str)))
    (if (fboundp 'compilation-start)
        (compilation-start str nil (lambda (&rest args) "*search*")
                           grep-regexp-alist)
      (and (fboundp 'compile-internal)
           (compile-internal str "No more search hits" "search"
                             nil grep-regexp-alist)))))

;;;###autoload
(defun muse-search-with-command (text)
  "Search for the given TEXT string in the project directories
using the specified command."
  (interactive
   (list (let ((str (concat muse-grep-command)) pos)
           (when (string-match "%W" str)
             (setq pos (match-beginning 0))
             (unless (featurep 'xemacs)
               (setq pos (1+ pos)))
             (setq str (replace-match "" t t str)))
           (read-from-minibuffer "Search command: "
                                 (cons str pos) nil nil
                                 'muse-search-history))))
  (muse-grep nil text))

;;;###autoload
(defun muse-search ()
  "Search for the given TEXT using the default grep command."
  (interactive)
  (muse-grep (read-string "Search: ")))

;;;###autoload
(defun muse-find-backlinks ()
  "Grep for the current pagename in all the project directories."
  (interactive)
  (muse-grep (muse-page-name)))


;;; Generate an index of all known Muse pages

(defun muse-generate-index (&optional as-list exclude-private)
  "Generate an index of all Muse pages."
  (let ((index (muse-index-as-string as-list exclude-private)))
    (with-current-buffer (get-buffer-create "*Muse Index*")
      (erase-buffer)
      (insert index)
      (current-buffer))))

;;;###autoload
(defun muse-index ()
  "Display an index of all known Muse pages."
  (interactive)
  (message "Generating Muse index...")
  (let ((project (muse-project)))
    (with-current-buffer (muse-generate-index)
      (goto-char (point-min))
      (muse-mode)
      (setq muse-current-project project)
      (pop-to-buffer (current-buffer))))
  (message "Generating Muse index...done"))

(defun muse-index-as-string (&optional as-list exclude-private exclude-current)
  "Generate an index of all Muse pages.
If AS-LIST is non-nil, insert a dash and spaces before each item.
If EXCLUDE-PRIVATE is non-nil, exclude files that have private permissions.
If EXCLUDE-CURRENT is non-nil, exclude the current file from the output."
  (let ((files (sort (copy-alist (muse-project-file-alist))
                     (function
                      (lambda (l r)
                        (string-lessp (car l) (car r)))))))
    (when (and exclude-current (muse-page-name))
      (setq files (delete (assoc (muse-page-name) files) files)))
    (with-temp-buffer
      (while files
        (unless (and exclude-private
                     (muse-project-private-p (cdar files)))
          (insert (if as-list " - " "") "[[" (caar files) "]]\n"))
        (setq files (cdr files)))
      (buffer-string))))

;;; Insert tags interactively on C-c TAB t

(defvar muse-tag-history nil
  "List of recently-entered tags; used by `muse-insert-tag'.
If you want a tag to start as the default, you may manually set
this variable to a list.")

(defvar muse-custom-tags nil
  "Keep track of any new tags entered in `muse-insert-tag'.
If there are (X)HTML tags that you use frequently with that
function, you might want to set this manually.")

;;;###autoload
(defun muse-insert-tag (tag)
  "Insert a tag interactively with a blank line after it."
  (interactive
   (list
    (completing-read
     (concat "Tag: "
             (when muse-tag-history
               (concat "(default: " (car muse-tag-history) ") ")))
     (progn
       (require 'muse-publish)
       (mapcar 'list (nconc (mapcar 'car muse-publish-markup-tags)
                            muse-custom-tags)))
     nil nil nil 'muse-tag-history
     (car muse-tag-history))))
  (when (equal tag "")
    (setq tag (car muse-tag-history)))
  (unless (interactive-p)
    (require 'muse-publish))
  (let ((tag-entry (assoc tag muse-publish-markup-tags))
        (options ""))
    ;; Add to custom list if no entry exists
    (unless tag-entry
      (add-to-list 'muse-custom-tags tag))
    ;; Get option
    (when (nth 2 tag-entry)
      (setq options (read-string "Option: ")))
    (unless (equal options "")
      (setq options (concat " " options)))
    ;; Insert the tag, closing if necessary
    (when tag (insert (concat "<" tag options ">")))
    (when (nth 1 tag-entry)
      (insert (concat "\n\n</" tag ">\n"))
      (forward-line -2))))

;;; muse-mode.el ends here
