diff options
Diffstat (limited to 'emacs.d/elisp/muse/muse-backlink.el')
| -rw-r--r-- | emacs.d/elisp/muse/muse-backlink.el | 327 |
1 files changed, 0 insertions, 327 deletions
diff --git a/emacs.d/elisp/muse/muse-backlink.el b/emacs.d/elisp/muse/muse-backlink.el deleted file mode 100644 index bc21ddd..0000000 --- a/emacs.d/elisp/muse/muse-backlink.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; muse-backlink.el --- backlinks for Muse - -;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. - -;; Author: Jim Ottaway <j.ottaway@lse.ac.uk> -;; Keywords: - -;; 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: - -;; Hierarchical backlink insertion into new muse pages. -;; -;; To add: -;; -;; (require 'muse-backlink) -;; (muse-backlink-install) -;; -;; To control what gets backlinked, modify -;; `muse-backlink-exclude-backlink-regexp' and -;; `muse-backlink-exclude-backlink-parent-regexp'. -;; -;; To stop backlinking temporarily: -;; (setq muse-backlink-create-backlinks nil) -;; -;; To remove the backlink functionality completely: -;; -;; (muse-backlink-remove) - -;;; Contributors: - -;;; Code: - -(require 'muse) -(require 'muse-project) - -(eval-when-compile (require 'muse-mode)) - -(eval-and-compile - (if (< emacs-major-version 22) - (progn - ;; Swiped from Emacs 22.0.50.4 - (defvar muse-backlink-split-string-default-separators "[ \f\t\n\r\v]+" - "The default value of separators for `split-string'. - -A regexp matching strings of whitespace. May be locale-dependent -\(as yet unimplemented). Should not match non-breaking spaces. - -Warning: binding this to a different value and using it as default is -likely to have undesired semantics.") - - (defun muse-backlink-split-string (string &optional separators omit-nulls) - "Split STRING into substrings bounded by matches for SEPARATORS. - -The beginning and end of STRING, and each match for SEPARATORS, are -splitting points. The substrings matching SEPARATORS are removed, and -the substrings between the splitting points are collected as a list, -which is returned. - -If SEPARATORS is non-nil, it should be a regular expression matching text -which separates, but is not part of, the substrings. If nil it defaults to -`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and -OMIT-NULLS is forced to t. - -If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so -that for the default value of SEPARATORS leading and trailing whitespace -are effectively trimmed). If nil, all zero-length substrings are retained, -which correctly parses CSV format, for example. - -Note that the effect of `(split-string STRING)' is the same as -`(split-string STRING split-string-default-separators t)'). In the rare -case that you wish to retain zero-length substrings when splitting on -whitespace, use `(split-string STRING split-string-default-separators)'. - -Modifies the match data; use `save-match-data' if necessary." - (let ((keep-nulls (not (if separators omit-nulls t))) - (rexp (or separators muse-backlink-split-string-default-separators)) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< start (length string))) - (setq notfirst t) - (if (or keep-nulls (< start (match-beginning 0))) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (if (or keep-nulls (< start (length string))) - (setq list - (cons (substring string start) - list))) - (nreverse list)))) - (defalias 'muse-backlink-split-string 'split-string))) - -(defgroup muse-backlink nil - "Hierarchical backlinking for Muse." - :group 'muse) - -(defcustom muse-backlink-create-backlinks t - "When non-nil, create hierarchical backlinks in new Muse pages. -For control over which pages will receive backlinks, see -`muse-backlink-exclude-backlink-parent-regexp' and -`muse-backlink-exclude-backlink-regexp'." - :type 'boolean - :group 'muse-backlink) - -(defcustom muse-backlink-avoid-bad-links t - "When non-nil, avoid bad links when backlinking." - :type 'boolean - :group 'muse-backlink) - -;; The default for exclusion stops backlinks from being added to and -;; from planner day pages. -(defcustom muse-backlink-exclude-backlink-parent-regexp - "^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$" - "Regular expression matching pages whose children should not have backlinks." - :type 'regexp - :group 'muse-backlink) - -(defcustom muse-backlink-exclude-backlink-regexp - "^[0-9][0-9][0-9][0-9]\\.[0-9][0-9]\\.[0-9][0-9]$" - "Regular expression matching pages that should not have backlinks." - :type 'regexp - :group 'muse-backlink) - -(defcustom muse-backlink-separator "/" - "String that separates backlinks. -Should be something that will not appear as a substring in an explicit -link that has no description." - :type 'string - :group 'muse-backlink) - -(defcustom muse-backlink-before-string "backlinks: " - "String to come before the backlink list." - :type 'string - :group 'muse-backlink) - -(defcustom muse-backlink-after-string "" - "String to come after the backlink list." - :type 'string - :group 'muse-backlink) - -(defcustom muse-backlink-separator "/" - "String that separates backlinks. -Should be something that will not appear as a substring in an explicit -link that has no description." - :type 'string - :group 'muse-backlink) - -(defcustom muse-backlink-regexp - (concat "^" - (regexp-quote muse-backlink-before-string) - "\\(" - (regexp-quote muse-backlink-separator) - ".+\\)" - (regexp-quote muse-backlink-after-string)) - ;; Really, I want something like this, but I can't make it work: - ;; (concat "^\\(" - ;; (regexp-quote muse-backlink-separator) - ;; "\\(?:" - ;; muse-explicit-link-regexp - ;; "\\)\\)+") - "Regular expression to match backlinks in a buffer. -Match 1 is the list of backlinks without `muse-backlink-before-string' -and `muse-backlink-after-string'." - :type 'regexp - :group 'muse-backlink) - -(defun muse-backlink-goto-insertion-point () - "Find the right place to add backlinks." - (goto-char (point-min)) - (when (looking-at "\\(?:^#.+[ \t]*\n\\)+") - (goto-char (match-end 0)))) - -(defun muse-backlink-get-current () - "Return a list of backlinks in the current buffer." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward muse-backlink-regexp nil t) - (muse-backlink-split-string - (match-string 1) - (regexp-quote muse-backlink-separator) t)))) - -(defun muse-backlink-format-link-list (links) - "Format the list of LINKS as backlinks." - (concat muse-backlink-separator - (mapconcat #'identity links muse-backlink-separator))) - -(defun muse-backlink-insert-links (links) - "Insert backlinks to LINKS into the current page. -LINKS is a list of links ordered by ancestry, with the parent as the -last element." - (muse-backlink-goto-insertion-point) - (insert muse-backlink-before-string - (muse-backlink-format-link-list links) - muse-backlink-after-string - ;; Could have this in the after string, but they might get - ;; deleted. - "\n\n")) - -(defun muse-backlink-unsaved-page-p (page project) - "Return non-nil if PAGE is in PROJECT but has not been saved." - (member - page - (mapcar - #'(lambda (b) - (with-current-buffer b - (and (derived-mode-p 'muse-mode) - (equal muse-current-project project) - (not (muse-project-page-file - (muse-page-name) - muse-current-project)) - (muse-page-name)))) - (buffer-list)))) - -(defvar muse-backlink-links nil - "Internal variable. -The links to insert in the forthcomingly visited muse page.") - -(defvar muse-backlink-pending nil - "Internal variable.") - -(defvar muse-backlink-parent-buffer nil - "Internal variable. -The parent buffer of the forthcomingly visited muse page.") - - -;;; Attach hook to the derived mode hook, to avoid problems such as -;;; planner-prepare-file thinking that the buffer needs no template. -(defun muse-backlink-get-mode-hook () - (derived-mode-hook-name major-mode)) - -(defun muse-backlink-insert-hook-func () - "Insert backlinks into the current buffer and clean up." - (when (and muse-backlink-links - muse-backlink-pending - (string= (car muse-backlink-links) (muse-page-name))) - (muse-backlink-insert-links (cdr muse-backlink-links)) - (when muse-backlink-avoid-bad-links - (save-buffer) - (when muse-backlink-parent-buffer - (with-current-buffer muse-backlink-parent-buffer - (font-lock-fontify-buffer)))) - (setq muse-backlink-links nil - muse-backlink-parent-buffer nil - muse-backlink-pending nil) - (remove-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func))) - -(defun muse-backlink-handle-link (link) - "When appropriate, arrange for backlinks on visiting LINK." - (when (and muse-backlink-create-backlinks - (not muse-backlink-pending) - (memq this-command - '(muse-follow-name-at-point muse-follow-name-at-mouse)) - (not muse-publishing-p) - (not (and (boundp 'muse-colors-fontifying-p) - muse-colors-fontifying-p))) - (require 'muse-mode) - (setq - muse-backlink-links - (save-match-data - (let* ((orig-link (or link (match-string 1))) - (link (if (string-match "#" orig-link) - (substring orig-link 0 (match-beginning 0)) - orig-link))) - (unless - (or (not muse-current-project) - (string-match muse-url-regexp orig-link) - (string-match muse-image-regexp orig-link) - (and (boundp 'muse-wiki-interwiki-regexp) - (string-match muse-wiki-interwiki-regexp - orig-link)) - ;; Don't add a backlink if the page already - ;; exists, whether it has been saved or not. - (or (muse-project-page-file link muse-current-project) - (muse-backlink-unsaved-page-p link muse-current-project)) - (string-match muse-backlink-exclude-backlink-parent-regexp - (muse-page-name)) - (string-match muse-backlink-exclude-backlink-regexp link)) - ;; todo: Hmm. This will only work if the child page is the - ;; same mode as the parent page. - (add-hook (muse-backlink-get-mode-hook) #'muse-backlink-insert-hook-func) - (setq muse-backlink-pending t) - (when muse-backlink-avoid-bad-links - (setq muse-backlink-parent-buffer (current-buffer)) - (unless (muse-project-page-file - (muse-page-name) muse-current-project) - ;; It must be modified... - (save-buffer))) - (cons link - (append (muse-backlink-get-current) - (list (muse-make-link (muse-page-name)))))))))) - ;; Make sure we always return nil - nil) - -(defun muse-backlink-install () - "Add backlinking functionality to muse-mode." - (add-to-list 'muse-explicit-link-functions #'muse-backlink-handle-link)) - -(defun muse-backlink-remove () - "Remove backlinking functionality from muse-mode." - (setq muse-explicit-link-functions - (delq #'muse-backlink-handle-link muse-explicit-link-functions))) - -(provide 'muse-backlink) -;;; muse-backlink.el ends here |