1 ;;; muse-mode.el --- Mode for editing Muse files; has font-lock support.
3 ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
5 ;; This file is not part of GNU Emacs.
7 ;; This is free software; you can redistribute it and/or modify it under
8 ;; the terms of the GNU General Public License as published by the Free
9 ;; Software Foundation; either version 2, or (at your option) any later
12 ;; This is distributed in the hope that it will be useful, but WITHOUT
13 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; 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.
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.
29 ;; Andrea Riciputi (ariciputi AT pito DOT com) gave an initial
30 ;; implementation for tag completion by means of the
31 ;; `muse-insert-tag' function.
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;; Emacs Muse Major Mode
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
42 (require 'muse-regexps
)
43 (require 'muse-project
)
44 (require 'muse-publish
)
46 (autoload 'muse-use-font-lock
"muse-colors")
51 (require 'pcomplete
) ; load if available
56 (defgroup muse-mode nil
57 "Options controlling the behavior of the Muse editing Mode.
58 See `muse-publish' for more information."
61 (defcustom muse-mode-highlight-p t
62 "If non-nil, highlight the content of Muse buffers."
67 (defcustom muse-mode-auto-p t
68 "If non-nil, automagically determine when Muse mode should be activated."
73 (add-hook 'find-file-hooks
'muse-mode-maybe
)
74 (remove-hook 'find-file-hooks
'muse-mode-maybe
))
78 (defcustom muse-mode-hook nil
79 "A hook that is run when Muse mode is entered."
81 :options
'(flyspell-mode footnote-mode turn-on-auto-fill
82 highlight-changes-mode
)
86 (let ((map (make-sparse-keymap)))
87 (define-key map
[(control ?c
) (control ?a
)] 'muse-index
)
88 (define-key map
[(control ?c
) (control ?b
)] 'muse-browse-result
)
89 (define-key map
[(control ?c
) (control ?c
)] 'muse-follow-name-at-point
)
90 (define-key map
[(control ?c
) (control ?e
)] 'muse-edit-link-at-point
)
91 (define-key map
[(control ?c
) (control ?t
)] 'muse-publish-this-file
)
92 (define-key map
[(control ?c
) (control ?v
)] 'muse-follow-name-at-point
)
94 (define-key map
[(control ?c
) (control ?l
)] 'font-lock-mode
)
96 (define-key map
[(control ?c
) ?
=] 'muse-what-changed
)
98 (define-key map
[tab] 'muse-next-reference)
99 (define-key map [(control ?i)] 'muse-next-reference)
101 (if (featurep 'xemacs)
103 (define-key map [(button2)] 'muse-follow-name-at-mouse)
104 (define-key map [(shift button2)]
105 'muse-follow-name-at-mouse-other-window))
106 (define-key map [(shift control ?m)]
107 'muse-follow-name-at-point-other-window)
108 (define-key map [mouse-2] 'muse-follow-name-at-mouse)
109 (define-key map [(shift mouse-2)]
110 'muse-follow-name-at-mouse-other-window))
112 (if (featurep 'xemacs)
113 (define-key map [(shift tab)] 'muse-previous-reference)
114 (define-key map [(shift iso-lefttab)] 'muse-previous-reference)
115 (define-key map [(shift control ?i)] 'muse-previous-reference))
117 (define-key map [(control ?c) (control ?f)] 'muse-project-find-file)
118 (define-key map [(control ?c) (control ?p)] 'muse-project-publish)
120 (define-key map [(control ?c) tab] 'muse-insert-tag)
121 (define-key map [(control ?c) (control ?i)] 'muse-insert-tag)
123 (when (featurep 'pcomplete)
124 (define-key map [(meta tab)] 'pcomplete)
125 (define-key map [(meta control ?i)] 'pcomplete))
128 "Keymap used by Emacs Muse mode.")
133 (define-derived-mode muse-mode text-mode "Muse"
134 "Muse is an Emacs mode for authoring and publishing documents.
136 ;; because we're not inheriting from normal-mode, we need to
137 ;; explicitly run file variables if the user wants to
139 (hack-local-variables)
140 (error (message "File local-variables error: %s"
141 (prin1-to-string err))))
142 (if muse-mode-highlight-p
143 (muse-use-font-lock))
144 (setq muse-current-project (muse-project-of-file))
145 (muse-project-set-variables)
146 (when (featurep 'pcomplete)
147 ;; if pcomplete is available, set it up!
148 (set (make-variable-buffer-local 'pcomplete-default-completion-function)
149 'muse-mode-completions)
150 (set (make-variable-buffer-local 'pcomplete-command-completion-function)
151 'muse-mode-completions)
152 (set (make-variable-buffer-local 'pcomplete-parse-arguments-function)
153 'muse-mode-current-word)))
155 (defun muse-mode-maybe ()
156 "Maybe turn Emacs Muse mode on for this file."
157 (let ((project (muse-project-of-file)))
159 (funcall (or (muse-get-keyword :major-mode (cadr project) t)
162 ;;; Support page name completion using pcomplete
164 (defun muse-completions ()
165 "Return a list of possible completions names for this buffer."
166 (let ((project (muse-project-of-file)))
168 (while (pcomplete-here
169 (mapcar 'car (muse-project-file-alist project)))))))
171 (defun muse-current-word ()
175 (skip-chars-backward (concat "^\\["
177 (narrow-to-region (point) end))
178 (pcomplete-parse-buffer-arguments))))
180 ;;; Navigate/visit links or URLs. Use TAB, S-TAB and RET (or mouse-2).
182 (defun muse-link-at-point (&optional pos)
183 "Return link text if a URL or Muse link name is at point."
184 (let ((case-fold-search nil)
185 (here (or pos (point))))
187 (and (char-after pos)
188 (not (eq (char-syntax (char-after pos)) ?\ ))))
191 (skip-chars-backward (concat "^'\"<>{}("
193 (or (and (looking-at muse-url-regexp)
195 (and (or (looking-at muse-link-regexp)
196 (and (search-backward "[[" (line-beginning-position) t)
197 (looking-at muse-link-regexp)))
198 (<= here (match-end 0))
199 (match-string 1)))))))
201 (defun muse-make-link (link &optional name)
202 "Return a link to LINK with NAME as the text."
205 (not (string= name ""))
206 (not (string= link name)))
207 (concat "[[" (or link "") "][" name "]]")
208 (concat "[[" (or link "") "]]")))
210 (defun muse-edit-link-at-point ()
211 "Edit the current link.
212 Do not rename the page originally referred to."
215 (if (muse-link-at-point)
218 (read-string "Link: "
219 (match-string-no-properties 1))
220 (read-string "Text: "
221 (match-string-no-properties 2)))
223 (error "There is no valid link at point"))))
225 (defun muse-visit-link (link &optional other-window)
226 "Visit the URL or link named by LINK-NAME."
227 (let ((visit-link-function
228 (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t)))
229 (if visit-link-function
230 (funcall visit-link-function link other-window)
231 (if (string-match muse-url-regexp link)
234 (if (string-match "#" link)
235 (setq anchor (substring link (match-beginning 0))
236 link (substring link 0 (match-beginning 0))))
237 (let ((project (muse-project-of-file)))
239 (muse-project-find-file link project
241 'find-file-other-window))
243 (find-file-other-window link)
246 (search-forward anchor nil t)))))))
248 (defun muse-browse-result (style &optional other-window)
249 "Visit the current page's published result."
250 (interactive (list (muse-publish-get-style) current-prefix-arg))
251 (setq style (muse-style style))
253 (muse-publish-output-file buffer-file-name
254 (muse-style-element :path style) style)))
255 (if (not (file-readable-p result-path))
256 (error "Cannot open output file '%s" result-path)
258 (find-file-other-window result-path)
259 (let ((func (muse-style-element :browser style t)))
261 (funcall func result-path)
262 (message "The publishing style %s does not support browsing."
265 (defun muse-follow-name-at-point (&optional other-window)
266 "Visit the link at point, or insert a newline if none."
268 (let ((link (muse-link-at-point)))
270 (muse-visit-link link other-window)
271 (error "There is no valid link at point"))))
273 (defun muse-follow-name-at-point-other-window ()
274 "Visit the link at point in other window."
276 (muse-follow-name-at-point t))
278 (defun muse-follow-name-at-mouse (event &optional other-window)
279 "Visit the link at point, or yank text if none."
282 (cond ((fboundp 'event-window) ; XEmacs
283 (set-buffer (window-buffer (event-window event)))
284 (and (funcall (symbol-function 'event-point) event)
285 (goto-char (funcall (symbol-function 'event-point) event))))
286 ((fboundp 'posn-window) ; Emacs
287 (set-buffer (window-buffer (posn-window (event-start event))))
288 (goto-char (posn-point (event-start event)))))
289 (muse-follow-name-at-point other-window)))
291 (defun muse-follow-name-at-mouse-other-window (event)
292 "Visit the link at point"
294 ;; throw away the old window position, since other-window will
296 (select-window (car (cadr event)))
297 (muse-follow-name-at-mouse event t))
299 (defun muse-next-reference ()
300 "Move forward to next Muse link or URL, cycling if necessary."
302 (let ((case-fold-search nil)
305 (if (muse-link-at-point)
306 (goto-char (match-end 0)))
308 (if (re-search-forward
309 (concat "\\(" muse-link-regexp "\\|"
310 muse-url-regexp "\\)") nil t)
311 (setq pos (match-beginning 0)
313 (goto-char (point-min))
314 (setq cycled (1+ cycled)))))
318 (defun muse-previous-reference ()
319 "Move backward to the next Muse link or URL, cycling if necessary.
320 This function is not entirely accurate, but it's close enough."
322 (let ((case-fold-search nil)
326 (if (re-search-backward
327 (concat "\\(" muse-link-regexp "\\|"
328 muse-url-regexp "\\)") nil t)
331 (goto-char (point-max))
332 (setq cycled (1+ cycled)))))
336 (defun muse-what-changed ()
337 "Show the unsaved changes that have been made to the current file."
339 (diff-backup buffer-file-name))
341 ;;; Generate an index of all known Muse pages
343 (defun muse-generate-index (&optional as-list exclude-private)
344 "Generate an index of all Muse pages."
345 (let ((files (sort (copy-alist (muse-project-file-alist))
348 (string-lessp (car l) (car r))))))
350 (with-current-buffer (get-buffer-create "*Muse Index*")
353 (unless (and exclude-private
354 (muse-project-private-p (cdar files)))
355 (insert (if as-list "- " "") "[[" (caar files) "]]\n"))
356 (setq files (cdr files)))
360 "Display an index of all known Muse pages."
362 (message "Generating Muse index...")
363 (let ((project (muse-project)))
364 (with-current-buffer (muse-generate-index)
365 (goto-char (point-min))
367 (setq muse-current-project project)
368 (pop-to-buffer (current-buffer))))
369 (message "Generating Muse index...done"))
371 ;;; Insert tags interactively on C-c TAB
373 (defvar muse-tag-history nil
374 "List of recently-entered tags; used by `muse-insert-tag'.
375 If you want a tag to start as the default, you may manually set
376 this variable to a list.")
378 (defvar muse-custom-tags nil
379 "Keep track of any new tags entered in `muse-insert-tag'.
380 If there are (X)HTML tags that you use frequently with that
381 function, you might want to set this manually.")
383 (defun muse-insert-tag (tag)
384 "Insert a tag interactively with a blank line after it."
389 (when muse-tag-history
390 (concat "(default: " (car muse-tag-history) ") ")))
391 (nconc (mapcar 'car muse-publish-markup-tags)
393 nil nil nil 'muse-tag-history
394 (car muse-tag-history))))
396 (setq tag (car muse-tag-history)))
397 (let ((tag-entry (assoc tag muse-publish-markup-tags))
399 ;; Add to custom list if no entry exists
401 (add-to-list 'muse-custom-tags tag))
403 (when (nth 2 tag-entry)
404 (setq options (read-string "Option: ")))
405 (unless (equal options "")
406 (setq options (concat " " options)))
407 ;; Insert the tag, closing if necessary
408 (when tag (insert (concat "<" tag options ">")))
409 (when (nth 1 tag-entry)
410 (insert (concat "\n\n</" tag ">\n"))
415 ;;; muse-mode.el ends here