phillord pushed a commit to branch externals/pabbrev
in repository elpa.
commit dc546e6012d28079070083cdea0c117fc392d35d
Author: Phillip Lord <phillip.l...@newcastle.ac.uk>
Date: Tue Aug 14 09:12:32 2012 +0100
Initial checking to mercurial
---
centering.el | 92 ++++++++++++
greycite.el | 278 ++++++++++++++++++++++++++++++++++++
omn-mode.el | 223 +++++++++++++++++++++++++++++
tmmofl-x.el | 59 ++++++++
tmmofl.el | 436 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
wide-column.el | 367 +++++++++++++++++++++++++++++++++++++++++++++++
6 files changed, 1455 insertions(+), 0 deletions(-)
diff --git a/centering.el b/centering.el
new file mode 100644
index 0000000..58e53aa
--- /dev/null
+++ b/centering.el
@@ -0,0 +1,92 @@
+;;; centering.el -- Keep the cursor in the centre at all times.
+
+;; $Revision: 1.14 $
+;; $Date: 2004/12/11 16:48:14 $
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <p.l...@russet.org.uk>
+;; Maintainer: Phillip Lord <p.l...@russet.org.uk>
+;; Website: http://www.russet.org.uk
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This mode ensures that the cursor is always in the center of the
+;; display. This can be useful at times if, for example, you are
+;; trying to get lots of stuff onto one screen for a screenshot, or to
+;; read without using the keyboard.
+;;
+;; It has one major entry point which is `centering-mode' which turns
+;; on a minor mode.
+;;
+;; It currently works by recentering the display after the line
+;; position has changed. There is a delay before this happens or the
+;; constant redisplaying makes the emacs look horrible. Set
+;; `centering-timer-delay' to change the length of the delay. Setting
+;; it to 0 is permissible.
+
+
+
+;;; Todo
+;;
+;; Well it doesn't work. So fix the centering-recenter function. Also
+;; this should only use a single timer. When switching on, check for
+;; timer, start if not. When switching off check whether there are any
+;; centering buffers left open, if not kill it.
+;;
+;; The current logic is imperfect, because if the a key is
+;; autorepeated, then the system will not update when the up key is
+;; removed. Perhaps I should move back to the old delay system.
+
+
+(define-minor-mode centering-mode
+ "Keep the cursor in the center at all times"
+ nil
+ " Cr"
+ nil)
+
+(add-hook 'centering-mode-on-hook
+ 'centering-mode-on)
+(add-hook 'centering-mode-off-hook
+ 'centering-mode-off)
+
+(defun centering-mode-on()
+ (add-hook 'post-command-hook 'centering-post-command-hook nil t))
+
+(defun centering-mode-off()
+ (remove-hook 'post-command-hook 'centering-post-command-hook t))
+
+(defun centering-post-command-hook()
+ (when centering-timer
+ (cancel-timer centering-timer))
+ (run-with-timer centering-delay nil
+ 'centering-recenter))
+
+(defun centering-recenter()
+ (unless (= centering-position
+ (line-beginning-position))
+ (setq centering-position (line-beginning-position))
+ (recenter)))
+
+
+(defvar centering-delay 0.1)
+(defvar centering-timer nil)
+(defvar centering-position 1)
+(make-variable-buffer-local 'centering-position)
\ No newline at end of file
diff --git a/greycite.el b/greycite.el
new file mode 100644
index 0000000..410db4e
--- /dev/null
+++ b/greycite.el
@@ -0,0 +1,278 @@
+;; greycite.el --- integrate referencing with the Greycite service
+
+;; Version: 0.1
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <phillip.l...@newcastle.ac.uk>
+;; Maintainer: Phillip Lord <phillip.l...@newcastle.ac.uk>
+;; Website: http://www.russet.org.uk
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This code in it's early stages. The greycite service aims to make the web
+;; citable by searching and storing basic metadata about articles on the web.
+;; This package helps to integrate Emacs' own referencing capabilities (reftex,
+;; bibtex and the like) with greycite.
+
+;;
+;; There are two main pieces of functionality. First you can use greycite.el
+;; to resolve DOIs or URLs into an equivalent piece of bibtex. This is useful
+;; because it provides the metadata for inserting references, which you can do
+;; using the reftex package which this file modifies to insert citations in
+;; the correct format.
+;;
+;; The main entry points for the bibtex functionality are
+;; `greycite-bibtex-url' which transforms a URL into a bibtex record, or
+;; `greycite-bibtex-update' which updates it. `greycite-bibtex-update' is
+;; currently somewhat destructive of updates that have been made manually, so
+;; you should be careful if this is the case. `greycite-bibtex-doi' and
+;; `greycite-bibtex-doi-update' do similar jobs for DOIs.
+;;
+;; Reftex support is added automatically to adoc-mode. If you prefer to use
+;; someother mode than adoc, `greycite-asciidoc-reftex-support' will turn this
+;; on.
+;;
+
+;;; Code:
+
+;;
+;;
+;; reftex support for asciidoc mode
+;;
+
+(add-hook 'adoc-mode-hook
+ 'greycite-asciidoc-reftex-support)
+
+(defvar greycite-reftex-citation-override nil)
+(defvar greycite-adoc-kblog-cite-format
+ '(
+ (?\C-m . "kurl:")
+ (?h . "http:")
+ (?j . "http:[]"))
+ )
+
+(defvar greycite-default-bibliographies
+ '("~/documents/bibtex/phil_lord_refs.bib"
+ "~/documents/bibtex/phil_lord/journal_papers.bib"
+ "~/documents/bibtex/phil_lord/conference_papers.bib"
+ "~/documents/bibtex/urls.bib"
+ "~/documents/bibtex/russet.bib"
+ ))
+
+
+(defun greycite-asciidoc-reftex-support()
+ (interactive)
+ (reftex-mode 1)
+ (make-local-variable 'greycite-reftex-citation-override)
+ (setq greycite-reftex-citation-override t)
+ (make-local-variable 'reftex-default-bibliography)
+ (make-local-variable 'reftex-cite-format)
+ (setq reftex-cite-format
+ greycite-adoc-kblog-cite-format)
+ (setq reftex-default-bibliography greycite-default-bibliographies))
+
+(defadvice reftex-format-citation (around greycite-asciidoc-around activate)
+ "Alter citation style for kcite"
+ (if greycite-reftex-citation-override
+ (progn
+ (setq ad-return-value (greycite-reftex-format-citation entry format)))
+ ad-do-it))
+
+;; we can't just use reftex-format-citation -- it has will template with most
+;; keys, but not DOI or URL. So just override it.
+(defun greycite-reftex-format-citation( entry format )
+ (cond
+ ;; the template strings are duplicated in phil-kblog-cite-format
+ ((string= format "kurl:")
+ (or
+ (greycite-reftex-or-false
+ entry "doi" "kurl:dx.doi.org/")
+ (greycite-reftex-or-false
+ entry "url" "kurl:"
+ (lambda(url)
+ (substring url 7))
+ )))
+ ((string= format "http:")
+ (reftex-get-bib-field "url" entry))
+ ((string= format "http:[]")
+ (concat (reftex-get-bib-field "url" entry) "[]"))
+ ))
+
+
+(defun greycite-reftex-or-false(entry field prefix &optional transform)
+ (let ((field-val
+ (reftex-get-bib-field field entry)))
+ (if (not (string= field-val ""))
+ (format " %s%s[]" prefix
+ (if transform
+ (funcall transform field-val)
+ field-val))
+ nil)))
+
+(defadvice reftex-format-bib-entry (around greycite-asciidoc-format-bib
activate)
+ (setq ad-return-value (greycite-reftex-entry-display entry ad-do-it)))
+
+(defun greycite-reftex-entry-display(entry formatted)
+ (let*
+ ((url (reftex-get-bib-field "url" entry))
+ (doi (reftex-get-bib-field "doi" entry))
+ (id
+ ;; DOI if we have it, or URL
+ (if (not (string= doi ""))
+ doi
+ url)))
+ (put-text-property 0 (length id) 'face reftex-bib-extra-face id)
+ ;; chop of last new line
+ (concat (substring formatted 0 -1)
+ " " id "\n\n")))
+
+
+
+;; bibtex stuff
+(defun greycite-bibtex-from-greycite(url)
+ (save-excursion
+ (set-buffer
+ (url-retrieve-synchronously
+ (concat
+ "http://greycite.knowledgeblog.org/bib?uri=";
+ url)))
+ (goto-char (point-min))
+ (delete-region
+ (point-min)
+ (search-forward "\n\n"))
+ ;; if there isn't a title, then use the URL or nothing appears in reftex.
+ (let ((entry
+ (bibtex-parse-entry)))
+ (when (not
+ (assoc "title" entry))
+ (search-forward ",")
+ (insert "title =")
+ (insert (cdr
+ (assoc "url" entry)))
+ (insert ",")))
+ (buffer-string)))
+
+
+(defun greycite-bibtex-url()
+ (interactive)
+ (let* ((url (thing-at-point 'url))
+ (bounds (bounds-of-thing-at-point 'url))
+ (bibtex (greycite-bibtex-from-greycite
+ url)))
+ (delete-region (car bounds) (cdr bounds))
+ (insert bibtex)
+ (bibtex-clean-entry)
+ (bibtex-fill-entry)))
+
+(defun greycite-bibtex-update()
+ (interactive)
+ (save-restriction
+ (bibtex-narrow-to-entry)
+ (goto-char (point-min))
+ (let* ((entry (bibtex-parse-entry))
+ (url
+ (substring
+ (cdr (assoc "url" entry)) 1 -1))
+ (key (cdr (assoc "=key=" entry)))
+ (update (greycite-bibtex-from-greycite url)))
+ (delete-region (point-min) (point-max))
+ (insert update)
+ ;; fix the key in case it has changed
+ (goto-char (point-min))
+ (search-forward "{")
+ (zap-to-char 1 ?,)
+ (insert (concat key ","))
+
+ (bibtex-clean-entry)
+ (bibtex-fill-entry))))
+
+
+;; I can't get url-retrieve-synchronously to do content negotiation, so give
+;; up and doi it in PHP instead
+(defun greycite-bibtex-from-doi(doi)
+ (save-excursion
+ (set-buffer
+ (url-retrieve-synchronously
+ (concat
+ "http://greycite.knowledgeblog.org/resolve/";
+ doi)))
+ (goto-char (point-min))
+ (delete-region
+ (point-min)
+ (search-forward "\n\n"))
+ (buffer-string)))
+
+
+(defun greycite-bibtex-doi()
+ (interactive)
+ ;; thing at point URL is about right, but stuffs "http:" on the beginning.
+ ;; hence substring
+ (let* ((doi (thing-at-point 'line))
+ (bounds (bounds-of-thing-at-point 'line))
+ (bibtex (greycite-bibtex-from-doi doi)))
+ (delete-region (car bounds)
+ (cdr bounds))
+ (insert bibtex)
+ (bibtex-clean-entry)
+ (bibtex-fill-entry)))
+
+;; (nearly) identical to phil-bibtex-update
+(defun greycite-bibtex-doi-update()
+ (interactive)
+ (save-restriction
+ (bibtex-narrow-to-entry)
+ (goto-char (point-min))
+ (let* ((entry (bibtex-parse-entry))
+ (doi
+ (substring
+ (cdr (assoc "DOI" entry)) 1 -1))
+ (key (cdr (assoc "=key=" entry)))
+ (update (greycite-bibtex-from-doi doi)))
+ (delete-region (point-min) (point-max))
+ (insert update)
+ ;; fix the key in case it has changed
+ (goto-char (point-min))
+ (search-forward "{")
+ (zap-to-char 1 ?,)
+ (insert (concat key ","))
+
+ (bibtex-clean-entry)
+ (bibtex-fill-entry))))
+
+
+(defun greycite-bibtex-region-from-greycite(start end)
+ (interactive "r")
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-max))
+ (while (> (point) (point-min))
+ (progn
+ (save-excursion
+ (greycite-bibtex-url))
+ (forward-line -1)
+ (sit-for 0.1)))))
+
+(defun greycite-bibtex-buffer-from-greycite()
+ (interactive)
+ (greycite-bibtex-region-from-greycite
+ (point-min) (point-max)))
+
+(provide 'greycite)
\ No newline at end of file
diff --git a/omn-mode.el b/omn-mode.el
new file mode 100644
index 0000000..94b1d81
--- /dev/null
+++ b/omn-mode.el
@@ -0,0 +1,223 @@
+;; $Revision: 1.16 $
+;; $Date: 2005/02/04 11:15:13 $
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <p.l...@russet.org.uk>
+;; Maintainer: Phillip Lord <p.l...@russet.org.uk>
+;; Website: http://www.russet.org.uk
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; Defines a major mode for editing the Manchester OWL syntax
+;; Basically, this is just a bit of font locking.
+
+
+
+
+(defvar omn-imenu-generic-expression
+ '(
+ ("Class" "Class: \\([a-zA-Z:_]+\\)" 1)
+ ("ObjectProperty" "ObjectProperty: \\([a-zA-Z:_]+\\)" 1)
+ ("Individual" "Individual: \\([a-zA-Z:_]+\\)" 1)
+ )
+
+ "Add support for imenu in omn
+
+See `imenu-generic-expression' for details")
+
+;; not sure if this bit is working yet!
+;; (defvar omn-mode-syntax-table
+;; (let ((st (make-syntax-table)))
+;; ;; underscores are valid separators in "words"
+;; (modify-syntax-entry ?\_ "w" st)
+;; ;; for name space prefixs
+;; (modify-syntax-entry ?\: "w" st)
+;; st)
+;; "Syntax table for `omn-mode'.")
+
+(defun omn-setup()
+ (make-local-variable 'indent-line-function)
+ (make-local-variable 'tab-to-tab-stop)
+ (make-local-variable 'comment-start)
+ (make-local-variable 'comment-end)
+ (setq comment-start "#")
+ (setq comment-end "")
+
+ (let ((st (syntax-table)))
+ ;; underscores are valid separators in "words"
+ (modify-syntax-entry ?\_ "w" st)
+ ;; for name space prefixs
+ (modify-syntax-entry ?\: "w" st))
+
+ (setq imenu-generic-expression omn-imenu-generic-expression)
+ (setq indent-line-function 'omn-ident-line)
+ (setq tab-stop-list '(4 8 12 16 20 24)))
+
+;; indentation engine
+(defun omn-ident-line()
+ (indent-line-to
+ (omn-determine-line-indent)))
+
+(defun omn-determine-line-indent()
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ ;; check the first word
+ (re-search-forward "\\w+" (line-end-position) t)
+ (let ((word (match-string 0))
+ (start (match-beginning 0)))
+ (cond
+ ((not word)
+ (progn
+ (if (not (forward-line -1))
+ (omn-determine-line-indent)
+ 0)))
+
+ ;; basing this on font-lock isn't ideal, because only the bits of the
+ ;; buffer that we have seen have been font locked. This is not a
+ ;; problem for interactive use, but causes a problem when indenting
+ ;; the entire buffer.
+
+ ;; if it is string, ident should be 0.
+ ((eq (get-text-property start 'face)
+ font-lock-string-face)
+ 0)
+
+ ;; if it is a comment
+ ((eq (get-text-property start 'face)
+ font-lock-comment-face)
+ ;; if there is a next line, indent the same as that
+ (cond
+ ((eq 0 (forward-line 1))
+ (omn-determine-line-indent))
+ ;; if there isn't return the same as the line before
+ ((eq 0 (forward-line -1))
+ (omn-determine-line-indent))
+ ;; who knows?
+ (t 0)))
+
+ ;; if it is one of Class:, Prefix: or so on, then indent should be 0
+ ((member word omn-mode-entity-keywords)
+ 0)
+ ;; if it is Annotations:, SubClassOf: or so on, then indent should be
4
+ ((member word omn-mode-property-keywords)
+ 4)
+
+ ;; if it is something else, then 8
+ (t 8))))))
+
+
+
+
+
+
+
+
+(defvar omn-mode-entity-keywords
+ '(
+ "Ontology:"
+ "Namespace:"
+ "Class:"
+ "Individual:"
+ "ObjectProperty:"
+ "Import:"
+ "Datatype:"
+ "AnnotationProperty:"
+ "DisjointClasses:"
+ "Prefix:"
+ "Alias:"
+ "owl:Thing"))
+
+(defvar omn-mode-property-keywords
+ '(
+ "EquivalentTo:"
+ "SubClassOf:"
+ "Annotations:"
+ "Characteristics:"
+ "DisjointUnion:"
+ "DisjointWith:"
+ "Domain:"
+ "Range:"
+ "InverseOf:"
+ "SubPropertyOf:"
+ "Types:"
+ "Facts:"
+ ))
+
+
+
+;; we should move this to derived mode now, since this is far from generic
+(define-generic-mode 'omn-mode
+ '(("# " . nil))
+
+ ;; keywords
+ omn-mode-entity-keywords
+ ;; a list of additional font lock info
+ `(
+ (
+ ,(mapconcat
+ (lambda(x) x)
+ '("\\<some\\>"
+ "\\<only\\>"
+ "\\<and\\>"
+ "\\<or\\>"
+ "\\<exactly\\>"
+ "Transitive"
+ )
+ "\\|")
+ . font-lock-type-face)
+
+ (
+ ,(mapconcat
+ (lambda(x) x)
+ omn-mode-property-keywords
+ "\\|")
+ . font-lock-builtin-face)
+
+
+ ("\\w+:\\w+" . font-lock-function-name-face)
+
+ )
+
+
+
+ ;; file spec
+ (list "\\.omn$")
+ ;; hooks
+ '(omn-setup))
+
+
+(add-to-list 'auto-mode-alist
+ '("\\.pomn$" . omn-mode))
+
+
+
+(provide 'omn-mode)
+
+;; interaction with a reasoner.....
+;; Define a struct using CL, which defines a command. Then send this to the
command line
+;; program as a single key-value pair line.
+;;
+;; Write a parser for this in Java.
+;; Write a "command" interface, use annotation to mark each of the command
setMethods.
+;;
+;; Have the command interface return results between tags as lisp. We can eval
+;; this, and get the result in that way.
\ No newline at end of file
diff --git a/tmmofl-x.el b/tmmofl-x.el
new file mode 100644
index 0000000..f6a164c
--- /dev/null
+++ b/tmmofl-x.el
@@ -0,0 +1,59 @@
+;; tmmofl-x.el - major mode library for tmmofl
+;; $Revision: 1.3 $
+;; $Date: 2000/06/19 22:03:27 $
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord<p.l...@hgmp.mrc.ac.uk>
+;; Maintainer: Phillip Lord
+;; Keywords: minor mode, font lock, toggling, tmmofl,
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;;
+;; Commentary
+;;
+;; All documentation for this file is available in the tmmofl.el file
+
+
+
+(provide 'tmmofl-x)
+
+(defvar tmmofl-jde-mode-actions
+ '((font-lock-comment-face
+ (lambda()
+ (progn
+ (abbrev-mode 0)
+ (auto-fill-mode 1)))
+ (lambda()
+ (progn
+ (abbrev-mode 1)
+ (auto-fill-mode 0))))
+
+ (font-lock-string-face
+ (lambda()
+ (abbrev-mode 0))
+ (lambda()
+ (abbrev-mode 1)))))
+
+
+
+
+
+
diff --git a/tmmofl.el b/tmmofl.el
new file mode 100644
index 0000000..7600989
--- /dev/null
+++ b/tmmofl.el
@@ -0,0 +1,436 @@
+;;; tmmofl.el --- Calls functions dependant on font lock highlighting at point
+;; $Revision: 1.9 $
+;; $Date: 2000/06/19 22:05:07 $
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <p.l...@hgmp.mrc.ac.uk>
+;; Maintainer: Phillip Lord <p.l...@hgmp.mrc.ac.uk>
+;; Keywords: minor mode, font lock, toggling.
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 2, or (at your option)
+;; any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;; Status:
+;;
+;; This seems to work at the moment. It is an extension of the
+;; jde-auto-abbrev.el which I wrote a while back. I wanted to use this
+;; in many other modes as well, so I have written it more
+;; generically. The name by the way stands for "toggle minor mode (based)
+;; on font lock" or "tuh-mof-l". It has recently been re-written
+;; totally. All the macros have gone west, which should make life a
+;; little bit easier. Effectively its entire core has been re-written
+;; and only the peripheral functions really remain the same. It seems
+;; to work for me but it needs more testing...
+;;
+
+;;; Limitations:
+;;
+;; 1) The code looks right, but Im not convinced that the make mode
+;; local hook thing is actually working.
+;; 2) At the moment using tmmofl as a minor mode will conflict with it
+;; being installed as part of the normal function of a mode.
+;; 3) Only works on GnuEmacs at the moment, due to the use of
+;; easy-mmode. It shouldnt take to much effort to remove this requirement
+
+;;; Commentary:
+;;
+;; This code is used to run to functions depending on whether the
+;; current font-lock font is at point. As font-lock is usually
+;; syntactically meaningful this means that you can for instance
+;; toggle minor modes on and off depending on the current syntax.
+;;
+;; To install this software place this file and the tmmofl-x.el file
+;; into your load path and place
+;;
+;; (require 'tmmofl)
+;;
+;; if your .emacs.
+;;
+;; To switch on this minor mode use the command tmmofl-mode. The mode
+;; line will indicate that the mode is switched on. What this actually
+;; does will depend on what the main mode of the current buffer
+;; is. The default behaviour is to switch `auto-fill' mode on when
+;; point is within comments, and off when its in anything else.
+;;
+
+;;; Notes for developers:
+;;~/src/ht/home_website/
+;; There are actually two ways to use this mode, firstly as a minor
+;; mode. Default behaviour is to toggle auto-fill on and off, but you
+;; might want additional behaviour. To do this you define a variable called
+;; `tmmofl-MODENAME-actions' where mode name is the name for mode as
+;; returned by the `major-mode' variable. This variable is as
+;; follows...
+;;
+;;(defvar tmmofl-jde-mode-actions
+;; '(
+;; (font-lock-comment-face
+;; (lambda()
+;; (progn
+;; (abbrev-mode 0)
+;; (auto-fill-mode 1)))
+;; (lambda()
+;; (progn
+;; (abbrev-mode 1)
+;; (auto-fill-mode 0))))
+;;
+;; (font-lock-string-face
+;; (lambda()
+;; (abbrev-mode 0))
+;; (lambda()
+;; (abbrev-mode 1)))))
+;;
+;; This is a list each element of which is a list defining the
+;; font-lock-symbol to be acted on, the on function, and the off
+;; function. If tmmofl can not find this variable the default of...
+;;
+;;(defvar tmmofl-default-actions
+;; '(
+;; (font-lock-comment-face
+;; (lambda()
+;; (auto-fill-mode 1))
+;; (lambda()
+;; (auto-fill-mode 0)))))
+;;
+;; can be used instead, which toggles auto fill on and off when on of
+;; off comments. There are some sample action variables defined in
+;; tmmofl-x.el which you may load if you wish.
+;;
+;; The second way to use this mode is outside of the tmmofl minor
+;; mode. For instance say you wanted emacs to display the fully
+;; referenced name of a class every time you moved point on top of a
+;; Type declaration in Java code. If you had a function called
+;; `java-show-full-class-name' (which I dont before you ask) you might
+;; want to use tmmofl to call this function. To do this you would use
+;; the `tmmofl-install-for-mode' function like so...
+;;
+;;(tmmofl-install-for-mode
+;; java-mode-hook
+;; font-lock-type-face
+;; (lambda()
+;; (java-show-full-class-name))
+;; (lambda()
+;; ()))
+;;
+;; where the first argument is the install hook. This would work
+;; without showing the tmmofl mode information in the mode line. I am
+;; fairly sure that this should work independantely of `tmmofl-mode'.
+
+;; The software was designed, written and tested on win 95, using
+;; NTEmacs. It has since been rewritten on a Gnu/Linux system. Please
+;; let me know if it works elsewhere. The current version should be
+;; available at http://www.bioinf.man.ac.uk/~lord
+;;
+
+;;; Acknowledgements:
+;;
+;; This code has grown up over about a year. It originally started off
+;; as jde-auto-abbrev. I would like to thank Joakim Verona
+;; (joa...@verona.se) who sent me the code which did part of what
+;; tmmofl does (toggled abbrev mode!). He used `defadvice' on
+;; `put-text-property'. I got the idea for using `post-command-hook'
+;; from Gerd Neugebauer's multi-mode.el.
+;; Finally Stefan Monnier who gave me lots of good advice about both
+;; the overall structure of the file, and some specific problems I
+;; had. Thanks a lot. Much appreciated.
+
+;; TODO
+;;
+;; More stuff in tmmofl-x.el, but at the moment its working quite
+;; nicely.
+;;
+
+;;; History:
+;;
+;; $Log: tmmofl.el,v $
+;; Revision 1.9 2000/06/19 22:05:07 phil
+;; Total rewrite
+;;
+;; Revision 1.8 2000/04/11 19:15:16 phil
+;; Updated documentation
+;;
+;; Revision 1.7 2000/01/25 14:24:18 lord
+;; Now requires easy-mmode, which it needs.
+;; Documentation changes
+;;
+;; Revision 1.6 1999-12-21 17:09:03+00 phillip2
+;; Applied Eric Ludlam's checkdoc to buffer
+;;
+;;
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(require 'cl)
+(require 'font-lock)
+(require 'easy-mmode)
+
+(defvar tmmofl-default-actions
+ '((font-lock-comment-face
+ (lambda()
+ (auto-fill-mode 1))
+ (lambda()
+ (auto-fill-mode 0))))
+ "Standard actions when mode specific actions are not provided.")
+
+
+(defvar tmmofl-actions nil
+ "An list which stores the functions to be run for a given face.
+Each element of the list is off form (face on-function off-function)")
+
+(make-variable-buffer-local 'tmmofl-actions)
+
+(defvar tmmofl-font-lock-symbols-cache nil
+ "Internal cache so we know where we were.")
+
+(make-variable-buffer-local 'tmmofl-font-lock-symbols-cache)
+
+(defun tmmofl-post-command-hook-function()
+ "Run on the post command hook"
+ (interactive)
+ (condition-case err
+ (let ((faces-at-point (get-text-property (point) 'face)))
+ ;;run the on and off functions
+ (tmmofl-run-off-functions faces-at-point)
+ (tmmofl-run-on-functions faces-at-point)
+ ;;and remember these for next time
+ (setq tmmofl-font-lock-symbols-cache faces-at-point))
+ (error
+ ;;if there is a problem in the called functions show the error message
+ ;;and then bomb out. If we dont do this emacs will empty
post-command-hook for
+ ;;us silently which makes things difficult to debug, and may also
+ ;;other packages which use post-command-hook.
+ (progn (message "Error caught by tmmofl: %s" (error-message-string err))
+ (remove-hook 'post-command-hook
'tmmofl-post-command-hook-function)))))
+
+(defun tmmofl-run-on-functions-for-face ( current-face )
+ "Run the on functions defined for CURRENT-FACE."
+ (interactive)
+ (dolist (face-and-action tmmofl-actions)
+ (if (eq (car face-and-action) current-face)
+ (funcall (nth 1 face-and-action)))))
+
+(defun tmmofl-run-on-functions (faces-at-point)
+ "Run the on functions.
+Those faces in FACES-AT-POINT that are not also in
+`tmmofl-font-lock-symbols-cache' have just been moved onto,
+so we should run the on-functions"
+ (tmmofl-iterate-and-run-functions 'tmmofl-run-on-functions-for-face
+ faces-at-point
+ tmmofl-font-lock-symbols-cache))
+
+(defun tmmofl-run-off-functions-for-face( face )
+ "Runs the off functions for this face"
+ (interactive)
+ (dolist (face-and-action tmmofl-actions)
+ (if (eq (car face-and-action) face)
+ (funcall (nth 2 face-and-action)))))
+
+
+(defun tmmofl-run-off-functions( faces-at-point )
+ "Runs the off functions.
+Those faces in `tmmofl-font-lock-symbols-cache' that are not also in
`faces-at-point'
+have just been moved off, so we should run the off-functions"
+ (tmmofl-iterate-and-run-functions 'tmmofl-run-off-functions-for-face
+ tmmofl-font-lock-symbols-cache
+ faces-at-point))
+
+(defun tmmofl-iterate-and-run-functions( function-to-call faces-to-interate
faces-cache )
+ "Calls functions depending on changes in faces.
+If a face is in `faces-to-iterate' but not in `faces-cache', then call
+`function-to-call' with that face as an argument"
+ (let ((remaining-faces faces-to-interate))
+ ;;iterate through all of faces in the cache
+ (while remaining-faces
+ (let ((current-face
+ (if (listp remaining-faces)
+ (car remaining-faces)
+ remaining-faces)))
+ ;;is the current face also at point.If not run the off-function
+ ;;if its theres a nil cache do it
+ (if (not faces-cache)
+ (funcall function-to-call current-face)
+ ;;else if its a list and it DOES not contain it
+ (if (and (listp faces-cache)
+ (not (memq current-face faces-cache)))
+ (funcall function-to-call current-face)
+ ;;else if it is not equal. There must be a better way of doing this
+ (if (not (eq current-face faces-cache))
+ (funcall function-to-call current-face))))
+ (setq remaining-faces (cdr-safe remaining-faces))))))
+
+(defun tmmofl-ensure-buffer-tmmofl-ready()
+ "Ensure that the `tmmofl-post-command-hook-function' is on the
+post-command-hook and that this hook is local"
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'tmmofl-post-command-hook-function nil t))
+
+(defun tmmofl-possibly-remove-tmmofl-readiness()
+ "Remove the `tmmofl-post-command-hook-function' from the
+post-command-hook, if `tmmofl-actions' is empty. "
+ ;;if both of these two are empty
+ (if (not tmmofl-actions)
+ ;;then we can make this non-local. Cant really make it no longer
+ ;;local as we dont know that something else hasnt already make
+ ;;it so
+ (remove-hook 'post-command-hook
+ 'tmmofl-post-command-hook-function t)))
+
+(defun tmmofl-install-in-buffer
+ ( face on-function off-function )
+ "Install the functions to be run for a given face.
+On moving onto a part of the buffer fontified by FACE run
+ON-FUNCTION. When moving of this run OFF-FUNCTION."
+ ;;make sure all the hooks are in the right place
+ (tmmofl-ensure-buffer-tmmofl-ready)
+ ;;now add to the on-actions. We should really check here that we have not
already got
+ ;;an identical component on the list but at the moment I can be bothered
+ (push (list face on-function off-function) tmmofl-actions))
+
+(defun tmmofl-deinstall-from-buffer
+ ( face on-function off-function )
+ "Deinstall the following functions from tmmofl.
+This works by removing them from `tmmofl-actions'. Should also remove
+`tmmofl-post-command-hook-function' from `post-command-hook' if
+appropriate.
+Argument FACE the face affected.
+Argument ON-FUNCTION the function to run when moving on.
+Argument OFF-FUNCTION the function to run on moving off."
+ ;;on actions first
+ (setq tmmofl-actions
+ (delete
+ (list face on-function off-function)
+ tmmofl-actions))
+ ;;and if there is nothing left remove the hooks
+ (tmmofl-possibly-remove-tmmofl-readiness))
+
+(defun tmmofl-blitz-from-buffer()
+ "Remove all tmmofl-actions from current buffer, under all circumstances.
+This is an emergency function to be used in case of tmmofl related disasters.
It
+may leave tmmofl-minor-mode in an inconsistant state"
+ (interactive)
+ ;;kill the hook
+ (remove-hook 'post-command-hook
+ 'tmmofl-post-command-hook-function
+ t)
+ ;;kill the action variables
+ (setq tmmofl-actions nil))
+
+(defun tmmofl-blitz-from-buffer-for-symbol (symbol)
+ "Remove all the `tmmofl-actions' from the current buffer for `SYMBOL'.
+This is an emergency function to be used in case of tmmofl related disasters.
+It removes all actions for a given font-lock-symbol regardless of the function.
+Like `tmmofl-blitz-from-buffer' it may leave tmmofl-minor-mode in a
+inconsistant state."
+ (interactive "MSymbol to untmmofl: ")
+ (setq tmmofl-actions
+ (remove* (intern symbol) tmmofl-actions :key 'car)))
+
+(defun tmmofl-install-for-mode (install-hook face on-function off-function)
+ "Install tmmofl on any buffer running the hook INSTALL-HOOK.
+Functions added in this way operate independantly of tmmofl-minor-mode
+Argument FACE the face affected.
+Argument ON-FUNCTION function to run moving onto FACE.
+Argument OFF-FUNCTION function to run moving off FACE."
+ (interactive)
+ (add-hook install-hook
+ (lambda()
+ "This function was auto-coded by `tmmofl-install-for-mode'"
+ (tmmofl-install-in-buffer
+ face
+ on-function
+ off-function))))
+
+(defun tmmofl-install-action(command)
+ "Install tmmofl `action' in the current buffer.
+The action should consist of a font-lock-symbol, and function to run on moving
+onto this face, and another to run on moving off this symbol. Actually it does
+need to be a font-lock-face, but if it isnt the functions will never be
called."
+ (let ((face (nth 0 command))
+ (on-function (nth 1 command))
+ (off-function (nth 2 command)))
+ (tmmofl-install-in-buffer face
+ on-function
+ off-function)))
+
+(defun tmmofl-deinstall-action(command)
+ "Deinstall `action' in the current buffer.
+See `tmmofl-install-action' which is the complementary function."
+ (let ((face (nth 0 command))
+ (on-function (nth 1 command))
+ (off-function (nth 2 command)))
+ (tmmofl-deinstall-from-buffer face
+ on-function
+ off-function)))
+
+(defun tmmofl-install-mode-actions()
+ "Add all of the actions defined as appropriate for this mode"
+ (let ((list (tmmofl-get-actions-for-mode)))
+ (while list
+ (let ((cur (car list)))
+ (progn
+ (tmmofl-install-action cur)
+ (setq list (cdr list)))))))
+
+(defun tmmofl-deinstall-mode-actions()
+ "Remove all of the actions defined as appropriate for this mode"
+ (interactive)
+ (let ((list (tmmofl-get-actions-for-mode)))
+ (while list
+ (let ((cur (car list)))
+ (progn
+ (tmmofl-deinstall-action cur)
+ (setq list (cdr list)))))))
+
+(defun tmmofl-get-actions-for-mode()
+ "Get the actions defined as appropriate for this mode"
+ (let((mode-variable (intern (concat "tmmofl-" (symbol-name major-mode)
"-actions"))))
+ (if (boundp mode-variable)
+ (eval mode-variable)
+ tmmofl-default-actions)))
+
+;;we also want to define a minor mode which allows others to define
+;;tmmofl additions to their own major odes.
+(easy-mmode-define-minor-mode tmmofl-mode
+"Toggle tmmofl minor mode.
+With no arguments, this command toggles the mode.
+Non-null prefix argument turns on the mode.
+Null prefix argument turns off the mode.
+
+When tmmofl mode is enabled various other minor
+modes are turned on or off, depending on the fontification
+scheme at point. This is useful for instance for turning on
+ whilst in comments, and turning it off whilst
+in code.
+
+tmmofl minor mode provides a default minor mode toggle
+(which is auto-filling as described above). This may be altered in a
+mode specific way by defining function foo-tmmofl-install for
+foo-mode."
+;;the initial value
+nil
+;;the mode line indicator
+" Tmmofl" nil)
+
+(add-hook 'tmmofl-mode-on-hook 'tmmofl-install-mode-actions)
+(add-hook 'tmmofl-mode-off-hook 'tmmofl-deinstall-mode-actions)
+
+(provide 'tmmofl)
+
+;;; tmmofl.el ends here
+
diff --git a/wide-column.el b/wide-column.el
new file mode 100644
index 0000000..e75c2e0
--- /dev/null
+++ b/wide-column.el
@@ -0,0 +1,367 @@
+;;; wide-column.el --- Calls functions dependant on column position.
+;; $Revision: 1.4 $
+;; $Date: 2002/04/05 09:28:09 $
+
+;; This file is not part of Emacs
+
+;; Copyright (c) 2002 Phillip Lord
+
+;; Author: Phillip Lord <p.l...@russet.org.uk>
+;; Maintainer: Phillip Lord <p.l...@russet.org.uk>
+;; Keywords: minor mode, cursor colour, column width
+
+;; COPYRIGHT NOTICE
+;;
+;; This program 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 Foundationl; either version 2 or (at
+;; your option) any later version.
+
+;; This program 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 this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Status:
+;;
+;; This has been released for quite a while now, and works well for
+;; me. There are few issues with it, which are mentioned in issues.
+;; It's pretty much ready, but I haven't put custom support in yet
+;; which would be nice.
+
+
+;;; Commentary:
+;;
+;; This package is designed to run functions depending on the column
+;; that the cursor is in. My initial idea with it, is just to have it
+;; change the cursor colour, lightening it as you go over the fill
+;; column length.
+;;
+;; The point of this is that monitor sizes have in recent years got
+;; plain silly, and its now relatively easy to buy one the size of a
+;; small wardrobe. Combined with the other wise wonderful
+;; `dabbrev-expand' which makes it feasible to use very explantory,
+;; and very long variable, and function names, source code has a habit
+;; of becoming stupidly wide. Now of course this wouldn't matter very
+;; much, if we all had wide screens. However in recent years, flat
+;; screen monitors have become widely prevelant, and these generally
+;; have lower resolutions, and smaller screen sizes, unless you are
+;; very rich. This raises the nasty possibility of a split therefore
+;; in behaviour between those using LCD, and CRT based monitors.
+;; Coming, as I do, from the left of the political spectrum, naturally
+;; I find such divisiveness worrying. This, therefore, is my
+;; contribution to preventing it.
+;;
+;; This package functions as a normal minor mode, so
+;; `wide-column-mode' toggles it on and off. There is also a global
+;; minor mode which you can access with `global-wide-column-mode'
+;; (Emacs 21 only). There is a problem with the getting the default
+;; cursor colour; this happens when wide-column is loaded, and I can't
+;; get around it without a hook in `set-cursor-color'. Set the
+;; variable `wide-column-default-cursor-colour' which will solve this
+;; problem.
+;;
+
+;;; Similar Packages:
+;;
+;; Sandip Chitale (sandip.chit...@blazesoft.com) highlight-beyond-fill
+
+;;; Installation
+;;
+;; Place this file in your Emacs load path. Put (require 'wide-column)
+;; into your .emacs or equivalent file. This operates as a normal
+;; minor mode, so `wide-column-mode' will toggle it on and off.
+;;
+;; The code was developed on Gnu Emacs 21. Emacs 20 support has now
+;; been removed because it required code duplication horribleness.
+;;
+;; It may work on XEmacs, but I don't have one around to try. You will
+;; certainly need the fsf compatibility packages if you do.
+
+;;; Issues;
+;;
+;; 1) I'm not sure about the error handling. I think things are
+;; working quite well. However if the affector function crashes out,
+;; it will appear to the user that wide-column mode is on, but
+;; actually, it will be disabled. I can solve this easily, by
+;; switching the mode off on errors, but easy-mmode produces
+;; mini-buffer messages, which hide my own attempts to provide error
+;; reporting. I think this way is better. If a crash happens the
+;; system will be inconsistent, but the alternative will be to have
+;; the minor-mode switch itself off.
+;;
+;; 2) The colour list is poor. I would like to improve things here,
+;; but I am not sure how. See the comments near the definition of
+;; `wide-column-colour-list'
+;;
+;; 3) Custom support would be good, and no doubt will be added at some
+;; time.
+;;
+;; 4) It's not going to work if people use lots of different default
+;; cursor colours. Seems like a daft thing to do to me! Something to
+;; work on anyway. Maybe I could solve this by advicing
+;; `set-cursor-colour', but this would fail if someone uses
+;; `modify-frame-parameters' directly, and I really don't want to
+;; advice this function anyway.
+
+(require 'easy-mmode)
+
+;;; Code:
+
+;; Basic variables. Defcustom these later.
+(defvar wide-column-start-width nil
+ "The column beyond which the `wide-column-affector-function' is called.
+If this variable is set to nil then the value of `fill-column' is
+used instead.")
+
+(make-variable-buffer-local 'wide-column-start-width)
+
+(defvar wide-column-affector-function 'wide-column-warning-colour
+ "This defines the main affector function.
+This function is called when the cursor is at a position greater than
+`wide-column-start-width'. If this affector function fails for some
+reason then errors are reported to the mini-buffer. The system will
+try to do its best to return things to normal, but obviously this is a
+programming error somewhere, so there are no guarentees.
+
+The affector function must have the following properties:-
+
+It should take a single parameter.
+
+If this parameter is positive then it is the amount that the cursor
+position is in excess of the maximum. The function will be called
+after every command while the cursor is beyond the maximum allowable
+value, so don't make it too heavy weight, or it will make editing
+slow.
+
+If the parameter is negative, or zero then its still the amount that
+the cursor is in excess of the maximum (i.e. the cursor is lower than
+or equal to the maximum). The function will be called with these
+values however only when moving from over the maximum to below it
+once, as an optimisation.
+
+If the parameter is the symbol `on', then it mean that the function is
+being called for the first time in this buffer, and it should do what
+ever is necessary.
+
+If the parameter is the symbol `off', then it means that the mode is
+being switched off, in the current buffer.
+
+If the parameter is the symbol `reset' then it means that the cursor
+has moved out of the old buffer and into a new one, and a reset should
+happen. Its important to realise here that when this reset happens
+the `current-buffer' may or may not be using the option
+`wide-column-mode'. The function only needs to do something
+therefore, if it affects a global property, like for instance the
+cursor colour. If it affects a buffer local property, then IT WILL BE
+IN THE WRONG BUFFER
+
+And finally it shouldn't do anything daft, like leaving the current
+buffer changed, probably it shouldn't move point. Deleting all of the
+text in excess of the wide column would be amusing, but still perhaps
+not a good idea.")
+
+(make-variable-buffer-local 'wide-column-affector-function)
+
+;;; This section provides the basic functionality of the mode.
+(defvar wide-column-last-command-over-width-p nil
+ "The last command executed beyond the maximum width.")
+(make-variable-buffer-local 'wide-column-last-command-over-width-p)
+
+(defvar wide-column-buffer-affector-last-called-in nil
+ "The last buffer an affector was called in.
+This is the last buffer that any `wide-column-affector-function' was
+called in. This information is recorded so that things can be reset,
+when the buffer is moved out of.")
+
+(defvar wide-column-affector-function-last-called nil
+ "This is the last affector function that was called.")
+
+(defun wide-column-post-command-hook-function()
+ "This calls the function specified by `wide-column-affector-function'
+when the cursor is beyond the column `wide-column-start-width' if it
+is set, or `fill-column' if it is not. See the documentation of
+`wide-column-affector-function' for full details."
+ (interactive)
+ (condition-case err
+ (progn
+ (let ((buffer (current-buffer)))
+ (if (not (eq wide-column-buffer-affector-last-called-in buffer))
+ ;; we have moved out of the a wide column buffer,
+ ;; therefore we need to reset the affector from the last
+ ;; buffer
+ (if wide-column-affector-function-last-called
+ (funcall wide-column-affector-function-last-called 'reset))))
+ ;; now only actually do anything if wide-column-mode is on
+ (if wide-column-mode
+ (let ((column-position (current-column))
+ (start-width
+ (or wide-column-start-width
+ fill-column)))
+ (if (> column-position start-width)
+ (progn
+ (wide-column-call-affector)
+ (setq wide-column-last-command-over-width-p t))
+ (if wide-column-last-command-over-width-p
+ (progn (wide-column-call-affector)
+ (setq wide-column-last-command-over-width-p
nil)))))))
+ (error
+ ;; this catches errors in this function, or in the affector
+ ;; function. If I don't do this then emacs just empties
+ ;; post-command-hook, which makes things a pain in the ass to
+ ;; debug, and will affect other packages using this hook
+ (progn
+ ;; Switch the mode off. This will leave the system in an
+ ;; inconsistent state, as the minor mode will still appear to
+ ;; be on. I am not sure what to do with this. I've tried just
+ ;; switching the mode off, but the informative message from
+ ;; easy-mmode covers up the error report.
+ (wide-column-mode-emergency-off)
+ (backtrace)
+ (message "Error from `wide-column-affector-function' caught: %s"
+ (error-message-string err))))))
+
+(defun wide-column-call-affector ()
+ "Call the affector with the column position."
+ ;; sing hey diddle dey, for dynamic scoping
+ (funcall wide-column-affector-function (- column-position start-width))
+ ;; record this stuff so that we can reset correctly.
+ (setq wide-column-affector-function-last-called
wide-column-affector-function)
+ (setq wide-column-buffer-affector-last-called-in (current-buffer)))
+
+(define-minor-mode wide-column-mode
+ "Toggle wide-column mode.
+With no argument, this command toggles this mode.
+Non-null prefix arguments turns on the mode,
+Null prefix argument turns it off.
+
+When wide-column mode is enabled, the function defined in
+`wide-column-affector-function' is called, when your cursor has gone
+beyond `wide-column-start-width' if it's set, or `fill-column' it
+its not.
+
+By default the practical upshot of this is that cursor colour changes,
+when your lines get too long."
+ :group 'wide-column
+ :lighter " Wc"
+ (if wide-column-mode
+ (progn
+ ;; add hook if we need to.
+ (wide-column-mode-reset)
+ (funcall wide-column-affector-function 'on))
+ (funcall wide-column-affector-function 'off)))
+
+
+;; define global-minor-mode
+(define-global-minor-mode global-wide-column-mode
+ wide-column-mode wide-column-turn-on)
+
+;; (add-hook
+;; 'global-wide-column-mode-hook
+;; 'global-wide-column-hook)))
+
+;; (defun global-wide-column-hook()
+;; "Help to switch off global mode"
+;; (interactive)
+;; (if (not global-wide-column-mode)
+;; (funcall wide-column-affector-function 'off)))
+
+(defun wide-column-turn-on()
+ (wide-column-mode 1))
+
+(defun wide-column-mode-emergency-off()
+ "Get out of `wide-column-mode'. Calling this function disabled this mode
+totally, and irrespective of whether its actually switched on or
+not. It's an emergency function, in case of crashes, and should not
+normally be called. `wide-column-mode-reset' turns it back on again. "
+ (interactive)
+ ;; switch mode off
+ (remove-hook 'post-command-hook
+ 'wide-column-post-command-hook-function))
+
+;; I can't find any leaving or entering buffer hooks. So I have to use
+;; a global post-command hook. I don't really like this, but what can
+;; you do?
+
+(defun wide-column-mode-reset()
+ "This function resets` wide-column mode' if its been switched off due to
errors"
+ (interactive)
+ (add-hook 'post-command-hook
+ 'wide-column-post-command-hook-function))
+
+
+;; This is the bit which provides the colour switching code, which is
+;; the default behaviour of this package.
+
+
+;; with faces you can set colours depending on whether the background
+;; is dark or light. I don't know how to do this with colour
+;; names. Also the colour list that I am using here is fine for me,
+;; but its based on my usual cursor colour. What I would really like
+;; to do is lighten the colour each time I move further from the
+;; fill-column. So it would be nice to be able to get from one colour
+;; to the next automatically, without just specifying a list.
+(defvar wide-column-colour-list
+ '("orange" "yellow" "white"))
+
+(setq wide-column-warning-colour-quotient 5)
+
+(defvar wide-column-default-cursor-colour
+ (frame-parameter (selected-frame) 'cursor-color)
+ "Place to store the default cursor colour.")
+
+(defun wide-column-warning-colour (current-excess-column)
+ "Set the cursor colour depending on the column position"
+ ;; first we need to test for a flag condition, mostly to
+ ;; reset or store the current cursor colour.
+ (cond
+ ((or (eq 'reset current-excess-column)
+ (eq 'off current-excess-column))
+ (set-cursor-color wide-column-default-cursor-colour))
+ ;; switched on the first time.
+ ((eq 'on current-excess-column)
+ nil)
+ ;;(setq wide-column-default-cursor-colour
+ ;; (frame-parameter (selected-frame) 'cursor-color)))
+ ;; now we need to actually do the cursor colour change. Change it
+ ;; back to default.
+ ((>= 0 current-excess-column)
+ (set-cursor-color wide-column-default-cursor-colour))
+ ;; change it toggles something else.
+ (t
+ (let* ((max-colour-index
+ (- (length wide-column-colour-list) 1))
+ (suggested-colour-number
+ (/ current-excess-column wide-column-warning-colour-quotient))
+ (actual-colour-number
+ (if (> suggested-colour-number max-colour-index)
+ max-colour-index
+ suggested-colour-number)))
+ (set-cursor-color (nth actual-colour-number
wide-column-colour-list))))))
+
+;; Some test code
+(defun wide-column-warning-colour-test()
+ (interactive)
+ (wide-column-warning-colour
+ (- (current-column) 20)))
+
+(defun wide-column-shout-about-affector()
+ (interactive)
+ (setq wide-column-affector-function
+ (lambda(current-excess-column)
+ (message "Wide Column Affector called with column %s"
current-excess-column))))
+
+(defun wide-column-restore-default-affector()
+ (interactive)
+ (setq wide-column-affector-function
+ 'wide-column-warning-colour))
+ ;(default-value wide-column-affector-function)))
+
+(provide 'wide-column)
+
+;;; wide-column.el ends here
