diff options
author | Tom Willemsen | 2011-03-17 11:36:56 +0100 |
---|---|---|
committer | Tom Willemsen | 2011-03-17 11:37:07 +0100 |
commit | 82b8ca280905ea284730f228ae082c42c348e818 (patch) | |
tree | 0c60d42c717905632c32ad80d83397d59c7d5036 /emacs.d/elisp/muse/muse-mode.el | |
parent | 04b349e8e00c2720fed4b14b7a1e0616db27ad2f (diff) | |
download | dotfiles-82b8ca280905ea284730f228ae082c42c348e818.tar.gz dotfiles-82b8ca280905ea284730f228ae082c42c348e818.zip |
Big emacs cleanup, must be lighter
Diffstat (limited to 'emacs.d/elisp/muse/muse-mode.el')
-rw-r--r-- | emacs.d/elisp/muse/muse-mode.el | 1013 |
1 files changed, 0 insertions, 1013 deletions
diff --git a/emacs.d/elisp/muse/muse-mode.el b/emacs.d/elisp/muse/muse-mode.el deleted file mode 100644 index 9659843..0000000 --- a/emacs.d/elisp/muse/muse-mode.el +++ /dev/null @@ -1,1013 +0,0 @@ -;;; muse-mode.el --- mode for editing Muse files; has font-lock support - -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; 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 3, 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. - -;; Gregory Collins (greg AT gregorycollins DOT net) fixed a bug with -;; paragraph separation and headings when filling. - -;;; 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)) - -;;; Muse mode - -(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.") - -;;;###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 - (let ((regexp (concat "\\s-+\\(-\\|[0-9]+\\.\\)\\s-+" - "\\|\\[[0-9]+\\]\\s-*" - "\\|.*\\s-*::\\s-+" - "\\|\\*+\\s-+"))) - (set (make-local-variable 'adaptive-fill-regexp) - (concat regexp "\\|\\s-*")) - (set (make-local-variable 'paragraph-start) - (concat paragraph-start "\\|" regexp)) - (set (make-local-variable 'paragraph-separate) - (concat paragraph-separate "\\|\\*+\\s-+"))) - (set (make-local-variable 'fill-paragraph-function) - 'muse-mode-fill-paragraph) - - ;; Comment syntax is `; comment' - (set (make-local-variable 'comment-start) - "; ") - (set (make-local-variable 'comment-start-skip) - "^;\\s-+") - (set (make-local-variable 'indent-line-function) - #'ignore) - ;; 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-fill-paragraph (arg) - "If a definition list is at point, use special filling rules for it. -Otherwise return nil to let the normal filling function take care -of things. - -ARG is passed to `fill-paragraph'." - (let ((count 2)) - (and (not (muse-mode-fill-nobreak-p)) - (save-excursion - (beginning-of-line) - (and (looking-at muse-dl-term-regexp) - (prog1 t - ;; Take initial whitespace into account - (when (looking-at (concat "[" muse-regexp-blank "]+")) - (setq count (+ count (length (match-string 0)))))))) - (let ((fill-prefix (make-string count ?\ )) - (fill-paragraph-function nil)) - (prog1 t - (fill-paragraph arg)))))) - -(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." - (let ((pos (if (bobp) (point) (1- (point))))) - (and (not (get-text-property pos 'muse-no-flyspell)) - (not (get-text-property pos '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 "]*$")))) - -(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 "^[" muse-regexp-blank "]*$"))) - ;; 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: ")))) - -(defcustom muse-insert-url-initial-input "http://" - "The string to insert before reading a URL interactively. -This is used by the `muse-insert-url' command." - :type 'string - :group 'muse-mode) - -(defun muse-insert-url () - "Insert a URL, with optional description, at point." - (interactive) - (insert - (muse-make-link (read-string "URL: " muse-insert-url-initial-input) - (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)) - (regexp (concat "^\\W*" (regexp-quote anchor) "\\b")) - last) - (goto-char (point-min)) - (while (and (setq last (re-search-forward regexp nil t)) - (muse-link-at-point))) - (unless last - (goto-char pos) - (message "Could not find anchor `%s'" anchor))))))) - -(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)) - (muse-project-publish-this-file nil style) - (let* ((output-dir (muse-style-element :path style)) - (output-suffix (muse-style-element :osuffix style)) - (output-path (muse-publish-output-file buffer-file-name output-dir - style)) - (target (if output-suffix - (concat (muse-path-sans-extension output-path) - output-suffix) - output-path)) - (muse-current-output-style (list :base (car style) - :path output-dir))) - (if (not (file-readable-p target)) - (error "Cannot open output file '%s'" target) - (if other-window - (find-file-other-window target) - (let ((func (muse-style-element :browser style t))) - (if func - (funcall func target) - (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 " "))) - (if (string= dirs "") - (muse-display-warning - "No directories were found in the current project; aborting search") - (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 - (funcall - muse-completing-read-function - (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 list edit minor mode - -(defvar muse-list-edit-minor-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(meta return)] 'muse-l-e-m-m-insert-list-item) - (define-key map [(control ?>)] 'muse-l-e-m-m-increase-list-item-indent) - (define-key map [(control ?<)] 'muse-l-e-m-m-decrease-list-item-indent) - - map) - "Keymap used by Muse list edit minor mode.") - -(defvar muse-l-e-m-m-list-item-regexp - (concat "^%s\\(\\([^\n" muse-regexp-blank "].*?\\)?::" - "\\(?:[" muse-regexp-blank "]+\\|$\\)" - "\\|[" muse-regexp-blank "]?[-*+][" muse-regexp-blank "]*" - "\\|[" muse-regexp-blank "][0-9]+\\.[" muse-regexp-blank "]*\\)") - "Regexp used to match the beginning of a list item. -This is used by `muse-list-edit-minor-mode'. -The '%s' will be replaced with a whitespace regexp when publishing.") - -(defun muse-l-e-m-m-insert-list-item () - "Insert a list item at the current point, taking into account -your current list type and indentation level." - (interactive) - (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) - (call-interactively 'muse-insert-list-item))) - -(defun muse-l-e-m-m-increase-list-item-indent () - "Increase the indentation of the current list item." - (interactive) - (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) - (call-interactively 'muse-increase-list-item-indentation))) - -(defun muse-l-e-m-m-decrease-list-item-indent () - "Decrease the indentation of the current list item." - (interactive) - (let ((muse-list-item-regexp muse-l-e-m-m-list-item-regexp)) - (call-interactively 'muse-decrease-list-item-indentation))) - -(defvar muse-l-e-m-m-data nil - "A list of data that was changed by Muse list edit minor mode.") -(make-variable-buffer-local 'muse-l-e-m-m-data) - -;;;###autoload -(define-minor-mode muse-list-edit-minor-mode - "This is a global minor mode for editing files with lists. -It is meant to be used with other major modes, and not with Muse mode. - -Interactively, with no prefix argument, toggle the mode. -With universal prefix ARG turn mode on. -With zero or negative ARG turn mode off. - -This minor mode provides the Muse keybindings for editing lists, -and support for filling lists properly. - -It recognizes not only Muse-style lists, which use the \"-\" -character or numbers, but also lists that use asterisks or plus -signs. This should make the minor mode generally useful. - -Definition lists and footnotes are also recognized. - -Note that list items may omit leading spaces, for compatibility -with modes that set `left-margin', such as -`debian-changelog-mode'. - -\\{muse-list-edit-minor-mode-map}" - :init-value nil - :lighter "" - :keymap muse-list-edit-minor-mode-map - :global nil - :group 'muse-mode - (if (not muse-list-edit-minor-mode) - ;; deactivate - (when muse-l-e-m-m-data - (setq adaptive-fill-regexp (cdr (assoc "a-f-r" muse-l-e-m-m-data)) - paragraph-start (cdr (assoc "p-s" muse-l-e-m-m-data)) - fill-prefix (cdr (assoc "f-p" muse-l-e-m-m-data))) - (setq muse-l-e-m-m-data nil)) - ;; activate - (unless muse-l-e-m-m-data - ;; save previous fill-related data so we can restore it later - (setq muse-l-e-m-m-data - (list (cons "a-f-r" adaptive-fill-regexp) - (cons "p-s" paragraph-start) - (cons "f-p" fill-prefix)))) - ;; make fill work nicely with item lists - (let ((regexp (concat "\\s-*\\([-*+]\\|[0-9]+\\.\\)\\s-+" - "\\|\\[[0-9]+\\]\\s-*" - "\\|.*\\s-*::\\s-+"))) - (set (make-local-variable 'adaptive-fill-regexp) - (concat regexp "\\|\\s-*")) - (set (make-local-variable 'paragraph-start) - (concat paragraph-start "\\|" regexp))) - ;; force fill-prefix to be nil, because if it is a string that has - ;; initial spaces, it messes up fill-paragraph's algorithm - (set (make-local-variable 'fill-prefix) nil))) - -(defun turn-on-muse-list-edit-minor-mode () - "Unconditionally turn on Muse list edit minor mode." - (muse-list-edit-minor-mode 1)) - -(defun turn-off-muse-list-edit-minor-mode () - "Unconditionally turn off Muse list edit minor mode." - (muse-list-edit-minor-mode -1)) - -;;; muse-mode.el ends here |