muse-mode.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Emacs Muse Major Mode
   4 ;;
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 ;; The Emacs Muse major mode is basically a hyped-up text-mode which
   8 ;; knows a lot more about the apparent structure of the document.
   9
  10 (require 'muse)
  11 (require 'muse-regexps)
  12 (require 'muse-project)
  13
  14 (autoload 'muse-use-font-lock "muse-colors")
  15
  16 (require 'derived)
  17 (condition-case nil
  18     (require 'pcomplete)                ; load if available
  19   (error nil))
  20
  21 ;;; Options:
  22
  23 (defgroup muse-mode nil
  24   "Options controlling the behaviour of the Muse editing Mode.
  25 See `muse-publish' for more information."
  26   :group 'muse)
  27
  28 (defcustom muse-mode-highlight-p t
  29   "If non-nil, highlight the content of Muse buffers."
  30   :type 'boolean
  31   :require 'muse-colors
  32   :group 'muse-mode)
  33
  34 (defcustom muse-mode-auto-p t
  35   "If non-nil, automagically determine when Muse mode should be activated."
  36   :type 'boolean
  37   :set (function
  38         (lambda (sym value)
  39           (if value
  40               (add-hook 'find-file-hooks 'muse-mode-maybe)
  41             (remove-hook 'find-file-hooks 'muse-mode-maybe))
  42           (set sym value)))
  43   :group 'muse-mode)
  44
  45 (defcustom muse-mode-hook nil
  46   "A hook that is run when Muse mode is entered."
  47   :type 'hook
  48   :options '(flyspell-mode footnote-mode turn-on-auto-fill
  49              highlight-changes-mode)
  50   :group 'muse-mode)
  51
  52 (defvar muse-mode-map
  53   (let ((map (make-sparse-keymap)))
  54     (define-key map [(control ?c) (control ?a)] 'muse-index)
  55     (define-key map [(control ?c) (control ?b)] 'muse-browse-result)
  56     (define-key map [(control ?c) (control ?c)] 'muse-follow-name-at-point)
  57     (define-key map [(control ?c) (control ?e)] 'muse-edit-link-at-point)
  58     (define-key map [(control ?c) (control ?t)] 'muse-publish-this-file)
  59     (define-key map [(control ?c) (control ?v)] 'muse-follow-name-at-point)
  60
  61     (define-key map [(control ?c) (control ?l)] 'font-lock-mode)
  62
  63     (define-key map [(control ?c) ?=]           'muse-what-changed)
  64
  65     (define-key map [tab] 'muse-next-reference)
  66     (define-key map [(control ?i)] 'muse-next-reference)
  67
  68     (if (featurep 'xemacs)
  69         (progn
  70           (define-key map [(button2)] 'muse-follow-name-at-mouse)
  71           (define-key map [(shift button2)]
  72             'muse-follow-name-at-mouse-other-window))
  73       (define-key map [(shift control ?m)]
  74         'muse-follow-name-at-point-other-window)
  75       (define-key map [mouse-2] 'muse-follow-name-at-mouse)
  76       (define-key map [(shift mouse-2)]
  77         'muse-follow-name-at-mouse-other-window))
  78
  79     (if (featurep 'xemacs)
  80         (define-key map [(shift tab)] 'muse-previous-reference)
  81       (define-key map [(shift iso-lefttab)] 'muse-previous-reference)
  82       (define-key map [(shift control ?i)] 'muse-previous-reference))
  83
  84     (define-key map [(control ?c) (control ?f)] 'muse-project-find-file)
  85     (define-key map [(control ?c) (control ?p)] 'muse-project-publish)
  86
  87     (when (featurep 'pcomplete)
  88       (define-key map [(meta tab)] 'pcomplete)
  89       (define-key map [(meta control ?i)] 'pcomplete))
  90
  91     map)
  92   "Keymap used by Emacs Muse mode.")
  93
  94 ;; Code:
  95
  96 ;;;###autoload
  97 (define-derived-mode muse-mode text-mode "Muse"
  98   "Muse is an Emacs mode for authoring and publishing documents.
  99 \\{muse-mode-map}"
 100   ;; because we're not inheriting from normal-mode, we need to
 101   ;; explicitly run file variables if the user wants to
 102   (condition-case err
 103       (hack-local-variables)
 104     (error (message "File local-variables error: %s"
 105                     (prin1-to-string err))))
 106   (if muse-mode-highlight-p
 107       (muse-use-font-lock))
 108   (setq muse-current-project (muse-project-of-file))
 109   (muse-project-set-variables)
 110   (when (featurep 'pcomplete)
 111     ;; if pcomplete is available, set it up!
 112     (set (make-variable-buffer-local 'pcomplete-default-completion-function)
 113          'muse-mode-completions)
 114     (set (make-variable-buffer-local 'pcomplete-command-completion-function)
 115          'muse-mode-completions)
 116     (set (make-variable-buffer-local 'pcomplete-parse-arguments-function)
 117          'muse-mode-current-word)))
 118
 119 (defun muse-mode-maybe ()
 120   "Maybe turn Emacs Muse mode on for this file."
 121   (let ((project (muse-project-of-file)))
 122     (and project
 123          (funcall (or (muse-get-keyword :major-mode (cadr project) t)
 124                       'muse-mode)))))
 125
 126 ;;; Support page name completion using pcomplete
 127
 128 (defun muse-completions ()
 129   "Return a list of possible completions names for this buffer."
 130   (let ((project (muse-project-of-file)))
 131     (if project
 132         (while (pcomplete-here
 133                 (mapcar 'car (muse-project-file-alist project)))))))
 134
 135 (defun muse-current-word ()
 136   (let ((end (point)))
 137     (save-restriction
 138       (save-excursion
 139         (skip-chars-backward (concat "^\\["
 140                                      muse-regexp-space))
 141         (narrow-to-region (point) end))
 142       (pcomplete-parse-buffer-arguments))))
 143
 144 ;;; Navigate/visit links or URLs.  Use TAB, S-TAB and RET (or mouse-2).
 145
 146 (defun muse-link-at-point (&optional pos)
 147   "Return link text if a URL or Muse link name is at point."
 148   (let ((case-fold-search nil)
 149         (here (or pos (point))))
 150     (when (or (null pos)
 151               (and (char-after pos)
 152                    (not (eq (char-syntax (char-after pos)) ?\ ))))
 153       (save-excursion
 154         (goto-char here)
 155         (skip-chars-backward (concat "^'\"<>{}("
 156                                      muse-regexp-space))
 157         (or (and (looking-at muse-url-regexp)
 158                  (match-string 0))
 159             (and (or (looking-at muse-link-regexp)
 160                      (and (search-backward "[[" (line-beginning-position) t)
 161                           (looking-at muse-link-regexp)))
 162                  (<= here (match-end 0))
 163                  (match-string 1)))))))
 164
 165 (defun muse-make-link (link &optional name)
 166   "Return a link to LINK with NAME as the text."
 167   (if (and name
 168            link
 169            (not (string= name ""))
 170            (not (string= link name)))
 171       (concat "[[" (or link "") "][" name "]]")
 172     (concat "[[" (or link "") "]]")))
 173
 174 (defun muse-edit-link-at-point ()
 175   "Edit the current link.
 176 Do not rename the page originally referred to."
 177   (interactive)
 178   (let (old-name)
 179     (if (muse-link-at-point)
 180         (replace-match
 181          (muse-make-link
 182           (read-string "Link: "
 183                        (match-string-no-properties 1))
 184           (read-string "Text: "
 185                        (match-string-no-properties 2)))
 186          t t)
 187       (error "There is no valid link at point"))))
 188
 189 (defun muse-visit-link (link &optional other-window)
 190   "Visit the URL or link named by LINK-NAME."
 191   (let ((visit-link-function
 192          (muse-get-keyword :visit-link (cadr (muse-project-of-file)) t)))
 193     (if visit-link-function
 194         (funcall visit-link-function link other-window)
 195       (if (string-match muse-url-regexp link)
 196           (browse-url link)
 197         (let (anchor)
 198           (if (string-match "#" link)
 199               (setq anchor (substring link (match-beginning 0))
 200                     link (substring link 0 (match-beginning 0))))
 201           (let ((project (muse-project-of-file)))
 202             (if project
 203                 (muse-project-find-file link project
 204                                         (and other-window
 205                                              'find-file-other-window))
 206               (if other-window
 207                   (find-file-other-window link)
 208                 (find-file link))))
 209           (if anchor
 210               (search-forward anchor nil t)))))))
 211
 212 (defun muse-browse-result (style &optional other-window)
 213   "Visit the current page's published result."
 214   (interactive (list (muse-publish-get-style) current-prefix-arg))
 215   (setq style (muse-style style))
 216   (let ((result-path
 217          (muse-publish-output-file buffer-file-name
 218                                    (muse-style-element :path style) style)))
 219     (if (not (file-readable-p result-path))
 220         (error "Cannot open output file '%s" result-path)
 221       (if other-window
 222           (find-file-other-window result-path)
 223         (let ((func (muse-style-element :browser style t)))
 224           (if func
 225               (funcall func result-path)
 226             (message "The publishing style %s does not support browsing."
 227                      style)))))))
 228
 229 (defun muse-follow-name-at-point (&optional other-window)
 230   "Visit the link at point, or insert a newline if none."
 231   (interactive "P")
 232   (let ((link (muse-link-at-point)))
 233     (if link
 234         (muse-visit-link link other-window)
 235       (error "There is no valid link at point"))))
 236
 237 (defun muse-follow-name-at-point-other-window ()
 238   "Visit the link at point in other window."
 239   (interactive)
 240   (muse-follow-name-at-point t))
 241
 242 (defun muse-follow-name-at-mouse (event &optional other-window)
 243   "Visit the link at point, or yank text if none."
 244   (interactive "eN")
 245   (save-excursion
 246     (cond ((fboundp 'event-window)      ; XEmacs
 247            (set-buffer (window-buffer (event-window event)))
 248            (and (funcall (symbol-function 'event-point) event)
 249                 (goto-char (funcall (symbol-function 'event-point) event))))
 250           ((fboundp 'posn-window)       ; Emacs
 251            (set-buffer (window-buffer (posn-window (event-start event))))
 252            (goto-char (posn-point (event-start event)))))
 253     (muse-follow-name-at-point other-window)))
 254
 255 (defun muse-follow-name-at-mouse-other-window (event)
 256   "Visit the link at point"
 257   (interactive "e")
 258   ;; throw away the old window position, since other-window will
 259   ;; change it anyway
 260   (select-window (car (cadr event)))
 261   (muse-follow-name-at-mouse event t))
 262
 263 (defun muse-next-reference ()
 264   "Move forward to next Muse link or URL, cycling if necessary."
 265   (interactive)
 266   (let ((case-fold-search nil)
 267         (cycled 0) pos)
 268     (save-excursion
 269       (if (muse-link-at-point)
 270           (goto-char (match-end 0)))
 271       (while (< cycled 2)
 272         (if (re-search-forward
 273              (concat "\\(" muse-link-regexp "\\|"
 274                      muse-url-regexp "\\)") nil t)
 275             (setq pos (match-beginning 0)
 276                   cycled 2)
 277           (goto-char (point-min))
 278           (setq cycled (1+ cycled)))))
 279     (if pos
 280         (goto-char pos))))
 281
 282 (defun muse-previous-reference ()
 283   "Move backward to the next Muse link or URL, cycling if necessary.
 284 This function is not entirely accurate, but it's close enough."
 285   (interactive)
 286   (let ((case-fold-search nil)
 287         (cycled 0) pos)
 288     (save-excursion
 289       (while (< cycled 2)
 290         (if (re-search-backward
 291              (concat "\\(" muse-link-regexp "\\|"
 292                      muse-url-regexp "\\)") nil t)
 293             (setq pos (point)
 294                   cycled 2)
 295           (goto-char (point-max))
 296           (setq cycled (1+ cycled)))))
 297     (if pos
 298         (goto-char pos))))
 299
 300 (defun muse-what-changed ()
 301   "Show the unsaved changes that have been made to the current file."
 302   (interactive)
 303   (diff-backup buffer-file-name))
 304
 305 ;;; Generate an index of all known Muse pages
 306
 307 (defun muse-generate-index (&optional as-list exclude-private)
 308   "Generate an index of all Muse pages."
 309   (let ((files (sort (copy-alist (muse-project-file-alist))
 310                      (function
 311                       (lambda (l r)
 312                         (string-lessp (car l) (car r))))))
 313         file)
 314     (with-current-buffer (get-buffer-create "*Muse Index*")
 315       (erase-buffer)
 316       (while files
 317         (unless (and exclude-private
 318                      (muse-project-private-p (cdar files)))
 319           (insert (if as-list "- " "") "[[" (caar files) "]]\n"))
 320         (setq files (cdr files)))
 321       (current-buffer))))
 322
 323 (defun muse-index ()
 324   "Display an index of all known Muse pages."
 325   (interactive)
 326   (message "Generating Muse index...")
 327   (let ((project (muse-project)))
 328     (with-current-buffer (muse-generate-index)
 329       (goto-char (point-min))
 330       (muse-mode)
 331       (setq muse-current-project project)
 332       (pop-to-buffer (current-buffer))))
 333   (message "Generating Muse index...done"))
 334
 335 (provide 'muse-mode)
 336
 337 ;;; muse-mode.el ends here