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