emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 02/39: Initial checking to mercurial


From: Phillip Lord
Subject: [elpa] 02/39: Initial checking to mercurial
Date: Mon, 20 Oct 2014 08:22:29 +0000

phillord pushed a commit to branch externals/pabbrev
in repository elpa.

commit dc546e6012d28079070083cdea0c117fc392d35d
Author: Phillip Lord <address@hidden>
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 <address@hidden>
+;; Maintainer: Phillip Lord <address@hidden>
+;; 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 <address@hidden>
+;; Maintainer: Phillip Lord <address@hidden>
+;; 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 <address@hidden>
+;; Maintainer: Phillip Lord <address@hidden>
+;; 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<address@hidden>
+;; 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 <address@hidden>
+;; Maintainer: Phillip Lord <address@hidden>
+;; 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
+;; (address@hidden) 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 <address@hidden>
+;; Maintainer: Phillip Lord <address@hidden>
+;; 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 (address@hidden) 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]