From 57366f385a2f1f35bbe741d7542096db81368c72 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Thu, 17 Mar 2011 11:23:07 +0100 Subject: Big changes, last one before I wipe it all. * Added muse * Added graphviz-dot-mode * Remove all trailing whitespace on save. This is the last commit I'm going to do before throwing it all away again. --- emacs.d/elisp/muse/muse-backlink.el | 327 ++++++++++++++++++++++++++++++++++++ 1 file changed, 327 insertions(+) create mode 100644 emacs.d/elisp/muse/muse-backlink.el (limited to 'emacs.d/elisp/muse/muse-backlink.el') diff --git a/emacs.d/elisp/muse/muse-backlink.el b/emacs.d/elisp/muse/muse-backlink.el new file mode 100644 index 0000000..bc21ddd --- /dev/null +++ b/emacs.d/elisp/muse/muse-backlink.el @@ -0,0 +1,327 @@ +;;; muse-backlink.el --- backlinks for Muse + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. + +;; Author: Jim Ottaway +;; 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 -- cgit v1.2.3-54-g00ecf