phillord pushed a commit to branch externals/pabbrev
in repository elpa.
commit 90a83e5c733e35eb9bb98ac244a6a44e4ed94c2e
Author: Phillip Lord <phillip.l...@newcastle.ac.uk>
Date: Tue Aug 14 09:09:06 2012 +0100
Initial checkin to Mercurial
---
pabbrev.el | 1754 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 1754 insertions(+), 0 deletions(-)
diff --git a/pabbrev.el b/pabbrev.el
new file mode 100644
index 0000000..98b19b4
--- /dev/null
+++ b/pabbrev.el
@@ -0,0 +1,1754 @@
+;; pabbrev.el --- Predictive abbreviation expansion
+
+;; Version: 3.0
+
+;; This file is not part of Emacs
+
+;; Author: Phillip Lord <p.l...@russet.org.uk>
+;; Maintainer: Phillip Lord <p.l...@russet.org.uk>
+;; Maintainer (XEmacs): Martin Kuehl (martin.ku...@gmail.com)
+;; 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:
+;;
+;; The code provides a abbreviation expansion for Emacs. Its fairly
+;; similar to "dabbrev" expansion, which works based on the contents
+;; of the current buffer (or other buffers).
+;;
+;; Predictive abbreviation expansion works based on the previously
+;; written text. Unlike dynamic abbreviation, the text is analysed
+;; during idle time, while Emacs is doing nothing else. `pabbrev-mode'
+;; tells you when this is happening. If this irritates you unset
+;; `pabbrev-idle-timer-verbose'. The advantage of this is that its
+;; very quick to look up potential abbreviations, which means that the
+;; can be constantly displayed, without interfering with the user as
+;; they type. Certainly it works for me, on an old laptop, typing as
+;; fast as I can (which is fast, since I learnt to type with four
+;; fingers).
+;;
+;; pabbrev's main entry point is through the minor mode
+;; `pabbrev-mode'. There is also a global minor mode, called
+;; `global-pabbrev-mode', which does the same in all appropriate
+;; buffers.
+;;
+;; The current user interface looks like so...
+;;
+;; p[oint]
+;; pr[ogn]
+;; pre[-command-hook]
+;; pred[ictive]
+;;
+;; As the user types the system narrows down the possibilities. The
+;; narrowing is based on how many times the words have been used
+;; previously. By hitting [tab] at any point the user can complete the
+;; word. The [tab] key is normally bound to `indent-line'.
+;; `pabbrev-mode' preserves access to this command (or whatever else
+;; [tab] was bound to), if there is no current expansion.
+;;
+;; Sometimes you do not want to select the most commonly occurring
+;; word, but a less frequently occurring word. You can access this
+;; functionality by hitting [tab] for a second time. This takes you
+;; into a special suggestions buffer, from where you can select
+;; secondary selections. See `pabbrev-select-mode' for more
+;; details. There is also an option `pabbrev-minimal-expansion-p'
+;; which results in the shortest substring option being offered as the
+;; first replacement.
+;;
+;; But is this actually of any use? Well having use the system for a
+;; while now, I can say that it is sometimes. I originally thought
+;; that it would be good for text, but in general its not so
+;; useful. By the time you have realised that you have an expansion
+;; that you can use, hit tab, and checked that its done the right
+;; thing, you could have just typed the word directly in. It's much
+;; nicer in code containing buffers, where there tend to be lots of
+;; long words, which is obviously where an abbreviation expansion
+;; mechanism is most useful.
+;;
+;; Currently pabbrev builds up a dictionary on a per major-mode basis.
+;; While pabbrev builds up this dictionary automatically, you can also
+;; explicitly add a buffer, or a region to the dictionary with
+;; `pabbrev-scavenge-buffer', or `pabbrev-scavenge-region'. There is
+;; also a command `pabbrev-scavenge-some' which adds some words from
+;; around point. pabbrev remembers the word that it has seen already,
+;; so run these commands as many times as you wish.
+;;
+;; Although the main data structures are efficient during typing, the
+;; pay off cost is that they can take a reasonable amount of time, and
+;; processor power to gather up the words from the buffer. There are
+;; two main settings of interest to reduce this, which are
+;; `pabbrev-scavenge-some-chunk-size' and
+;; `pabbrev-scavenge-on-large-move'. `pabbrev-mode' gathers text from
+;; around point when point has moved a long way. This means symbols
+;; within the current context should be in the dictionary, but it can
+;; make Emacs choppy, in handling. Either reduce
+;; `pabbrev-scavenge-some-chunk-size' to a smaller value, or
+;; `pabbrev-scavenge-on-large-move' to nil to reduce the effects of
+;; this.
+;;
+;; NOTE: There are a set of standard conventions for Emacs minor
+;; modes, particularly with respect to standard key bindings, which
+;; pabbrev somewhat abuses. The justification for this is that the
+;; whole point of pabbrev mode is to speed up typing. Access to its
+;; main function has to be on a very easy to use keybinding. The tab
+;; seems to be a good choice for this. By preserving access to the
+;; original tab binding when there is no expansion, pabbrev mostly
+;; "does what I mean", at least in my hands.
+
+;;; Installation:
+;;
+;; To install this file place in your `load-path', and add
+;;
+;; (require 'pabbrev)
+;;
+;; to your .emacs
+
+;;; Status:
+;;
+;; At the moment this seems to be working mostly, although
+;; occasionally it seems to leave an expansion in the buffer.
+;; I wrote this on an Emacs 21.0 prerelease, that I haven't upgraded
+;; yet, running under RedHat 7.x. I've also tried this out on NT
+;; Emacs (21.1), where it seems to byte compile, and work. But it has not
+;; been tried out extensively. It will NOT work on Emacs' older than
+;; 21.
+;;
+;; This package now has an XEmacs maintainer (Martin Kuehl). He
+;; appears to have isolated the last few problems with pabbrev on
+;; XEmacs, and it is running stably there now. It has been tested on
+;; XEmacs 21.4, running on Debian and Ubuntu Linux.
+
+;;; Package Support:
+;;
+;; Some packages need extra support for pabbrev to work with. There are two
+;; plists properties which package developers can use.
+;;
+;; (put 'command-name 'pabbrev-expand-after-command t)
+;;
+;; means that the following the named command (in this case command-name),
+;; expansion will be offered. `self-insert-command' and a few others is
+;; normally fine, but not always.
+;;
+;; (put mode-name 'pabbrev-global-mode-excluded-modes t)
+;;
+;; will mean that any buffer with this major mode will not have
+;; global-pabbrev-mode activated.
+;;
+
+;;; Bugs;
+;;
+;; This package had an occasional bug which has historically been hard
+;; to track down and reproduce. Basically I end up with a load of
+;; offering expansions in the buffer. It looks something like this....
+;; pabbrev[-mode][v][ev][rev][brev][bbrev][abbrev] which is amusing
+;; the first time, but more or less totally useless.
+;;
+;; Thanks to the efforts of Martin Kuehl, I think we have tracked the
+;; cause of the problem now (the old version depended on
+;; pre-command-hook and post-command-hook being called
+;; consecutively. But sometimes they get called twice). Please let us
+;; know if you see this problem.
+
+;;; Limitations:
+;;
+;; pabbrev mode has a number of common limitations.
+;;
+;; 1) I think it would be nice to save the dictionaries, or offer
+;; facilities for doing so, before Emacs is killed. This would clearly
+;; depend on point 3 also. I'm not sure whether this is possible in a
+;; reasonable length of time. `pabbrev-debug-print-hashes' is
+;; certainly pretty slow.
+;;
+;; 2) I think that the scavenge functions are more computationally
+;; intensive than they need to be. They generally run in the idle
+;; cycle so its not a disaster. However more efficiency would mean the
+;; buffer could be gathered more quickly. This has the disadvantage
+;; that I would have to start to think about...
+;;
+;; 3) There are current no facilities at all, for removing words from
+;; the dictionaries. The original data structures, and in particular
+;; the usage hash, were partly designed to support this. One way I
+;; would do this is, for example, by just decreasing the number of
+;; usages by a given amount, and then deleting (probably after the
+;; sort during the scavenge), any cons cells with less than one
+;; usage. I'm not sure this is a problem though. The number of words
+;; in the dictionaries only increases slowly, then don't seem to grow
+;; that quickly, and they don't take up that much memory.
+
+
+;;; Bug Reporting
+;;
+;; Bug reports are more than welcome. However one particular problem
+;; with this mode is that it makes heavy use of
+;; `post-command-hook'. This is a very useful hook, but makes the
+;; package difficult to debug. If you want to send in a bug report it
+;; will help a lot if you can get a repeatable set of keypresses, that
+;; always causes the problem.
+
+;;; Implementation notes:
+;;
+;; The core data structures are two hashes. The first of which looks
+;; like this...
+;; "the" -> ("the" . 5)
+;; "there" -> ("there" . 3)
+;;
+;; I call this the usage hash, as it stores the total number of times
+;; each word has been seen.
+;;
+;; The second hash which is called the prefix hash. It stores
+;; prefixes, and usages...
+;;
+;; "t"->
+;; (("the" . 64)
+;; ("to" . 28)
+;; ("t" . 22)
+;; ("this" . 17))
+;;
+;; "th"->
+;; (("the" . 64)
+;; ("this" . 17)
+;; ("that" . 7))
+;;
+;; "the"->
+;; (("the" . 64)
+;; ("there" . 6)
+;; ("then" . 3)
+;; ("these" . 1))
+;;
+;; The alist cons cells in the first hash are conserved in the second,
+;; but the alists are not. The alist in the second hash is always
+;; sorted, on the basis of word usage.
+;;
+;; The point with this data structure is that I can find word usage
+;; in constant time, from the first hash, and completions for a given
+;; prefix, also in constant time. As access to completions happens as
+;; the user types speed is more important here, than during
+;; update, which is why the prefix hash maintains sorted alists. This
+;; is probably at the cost of slower updating of words.
+
+;;; Acknowledgements;
+;;
+;; Many thanks to Martin Kuehl for tracking down the last bug which
+;; stood between this being an "official" full release.
+;;
+;; Once again I need to thank Stefan Monnier, for his comments on my
+;; code base. Once day I will write a minor mode which Stefan Monnier
+;; does not offer me advice on, but it would appear that this day has not
+;; yet arrived!
+;;
+;; I should also thank Kim F. Storm (and in turn Stephen Eglen), as
+;; the user interface for this mode has been heavily influenced by
+;; ido.el, a wonderful package which I use every day.
+;;
+;; Carsten Dominik suggested I add the package suppport rather than the
+;; existing defcustom which was not as good I think.
+;;
+;; Scott Vokes added a nice patch, adding the single/multiple expansion, the
+;; universal argument support and some bug fixes.
+
+;;; Code:
+(eval-when-compile (require 'cl))
+(require 'thingatpt)
+
+
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (progn
+ (require 'overlay)
+ (unless (fboundp 'line-beginning-position)
+ (defalias 'line-beginning-position 'point-at-bol))
+ (unless (fboundp 'line-end-position)
+ (defalias 'line-end-position 'point-at-eol))
+ (unless (fboundp 'cancel-timer)
+ (defalias 'cancel-timer 'delete-itimer))
+ )))
+
+(defconst pabbrev-xemacs-p (string-match "XEmacs" (emacs-version))
+ "Non-nil if we are running in the XEmacs environment.")
+
+(defgroup pabbrev nil
+ "Predicative abbreviation expansion."
+ :tag "Predictive Abbreviations."
+ :group 'abbrev
+ :group 'convenience)
+
+(defcustom pabbrev-global-mode-not-buffer-names '("*Messages*")
+ "*Will not activate function `global-pabbrev-mode' if buffers have this
name."
+ :type '(repeat (string :tag "Buffer name"))
+ :group 'pabbrev)
+
+(defcustom pabbrev-global-mode-buffer-size-limit nil
+ "*Will not activate function `global-pabbrev-mode' if buffers are over this
size (in bytes) (when non-nil)."
+ :type 'integer
+ :group 'pabbrev)
+
+(defcustom pabbrev-marker-distance-before-scavenge 2000
+ "Minimal distance moved before we wish to scavenge."
+ :type 'integer
+ :group 'pabbrev)
+
+
+;;(setq pabbrev-scavenge-on-large-move nil)
+(defcustom pabbrev-scavenge-on-large-move t
+ "*If non NIL, scavenge when a large buffer move has occured.
+This can make Emacs' handling a little bumpy. See also
+`pabbrev-scavenge-some-chunk-size', as reducing this, or increasing
+`pabbrev-marker-distance-before-scavenge' is an alternative
+to setting this to nil"
+ :type 'boolean
+ :group 'pabbrev)
+
+(defcustom pabbrev-thing-at-point-constituent 'symbol
+ "Symbol defining THING which function `pabbrev-mode' works on.
+This symbol should be understandable by
+`bounds-of-thing-at-point'. This symbol defines what function `pabbrev-mode'
+considers to be the basic unit of expansion. If if it set to `symbol',
+for example, \"pabbrev-mode\" would be offered as an expansion, while
+if it is set to `word' \"pabbrev\" and \"mode\" would be offered.
+You could also set it to `whitespace' which would be really daft,
+or `page' which would be silly in a different way."
+ :group 'pabbrev
+ :type 'symbol
+ :options '(symbol word))
+
+(defcustom pabbrev-scavenge-some-chunk-size 40
+ "Number of words that `pabbrev-scavenge-words' gathers.
+This also affects the speed with which pabbrev will scan through
+the buffer during idle, so decrease this if too much processor
+is being used, increase it if you want more. It's set quite
+conservatively. If you get choppy performance when moving
+around the buffer you should also consider
+`pabbrev-scavenge-on-large-move' to nil."
+ :type 'integer
+ :group 'pabbrev)
+
+(defcustom pabbrev-idle-timer-verbose t
+ "If non NIL, print messages while scavenging on idle timer.
+
+At the moment this is set to t by default. The idle timer function,
+`pabbrev-idle-timer-function' uses quite a bit of processor power, and
+I want the users to known what is eating their CPU. I may change
+this at a later date."
+ :type 'boolean
+ :group 'pabbrev)
+
+(defcustom pabbrev-read-only-error t
+ "If non NIL, signal an error when in a read only buffer.
+
+`pabbrev-mode' works by alterating the local buffer, so it's pointless
+within a read only buffer. So, normally, it signals an error when an
+attempt is made to use it in this way. But this is a pain if you toggle
+buffers read only a lot. Set this to NIL, and pabbrev-mode will disable
+it's functionality in read only buffers silently."
+ :type 'boolean
+ :group 'pabbrev)
+
+
+;; variable in progress
+(defcustom pabbrev-minimal-expansion-p nil
+ "If t offer minimal expansion.
+
+pabbrev can select the optimal expansion in two different ways. The
+normal way is to offer the expansion which occurs most frequently in
+the words which pabbrev has scavenged (in any buffer in the same
+mode). The other method is to take the minimal occuring substring
+present in any potential expansion; this is a lot more like standard
+completion seen on a command line.
+
+I'm not telling you which version, I prefer."
+ :type 'boolean
+ :group 'pabbrev
+)
+;;(setq pabbrev-minimal-expansion-p t)
+
+;; stolen from font-lock!
+(if pabbrev-xemacs-p
+ (progn
+ (defface pabbrev-suggestions-face
+ '((((class color) (background dark)) (:foreground "tan"))
+ (((class color) (background light)) (:foreground "green4"))
+ (((class grayscale) (background light)) (:foreground "DimGray"
:italic t))
+ (((class grayscale) (background dark)) (:foreground "LightGray"
:italic t))
+ (t (:bold t)))
+ "Face for displaying suggestions."
+ :group 'pabbrev)
+ (defface pabbrev-single-suggestion-face
+ '((((class color) (background dark)) (:foreground "tan"))
+ (((class color) (background light)) (:foreground "green4"))
+ (((class grayscale) (background light)) (:foreground "DimGray"
:italic t))
+ (((class grayscale) (background dark)) (:foreground "LightGray"
:italic t))
+ (t (:bold t)))
+ "Face for displaying one suggestion."
+ :group 'pabbrev)
+ (defface pabbrev-suggestions-label-face
+ nil "Font lock mode face used to highlight suggestions"
+ :group 'pabbrev))
+ (progn ; GNU Emacs
+ (defface pabbrev-suggestions-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "Gray90" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
+ (((class color) (background light)) (:foreground "ForestGreen"))
+ (((class color) (background dark)) (:foreground "Red"))
+ (t (:bold t :underline t)))
+ "Face for displaying suggestions."
+ :group 'pabbrev)
+ (defface pabbrev-single-suggestion-face
+ '((((type tty) (class color)) (:foreground "green"))
+ (((class grayscale) (background light)) (:foreground "Gray70" :bold t))
+ (((class grayscale) (background dark)) (:foreground "DarkSlateGray"
:bold t))
+ (((class color) (background light)) (:foreground "OliveDrab"))
+ (((class color) (background dark)) (:foreground "PaleGreen"))
+ (t (:bold t :underline t)))
+ "Face for displaying one suggestion."
+ :group 'pabbrev)
+ (defface pabbrev-suggestions-label-face
+ '((t
+ :inverse-video t))
+ "Font Lock mode face used to highlight suggestions"
+ :group 'pabbrev)))
+
+
+;;;; End user Customizable variables.
+
+
+;;;; Begin Package Support.
+
+
+;; mark commands after which expansion should be offered
+(mapc
+ (lambda(x)
+ (put x 'pabbrev-expand-after-command t))
+ '(self-insert-command mouse-set-point delete-char
+ backward-delete-char-untabify pabbrev-expand-maybe
+ pabbrev-expand-maybe-minimal pabbrev-expand-maybe-full
+ universal-argument universal-argument-other-key))
+
+;; mark modes in which to not activate pabbrev with global mode.
+(mapc
+ (lambda(x)
+ (put x 'pabbrev-global-mode-excluded-modes t))
+ '(shell-mode
+ Custom-mode
+ custom-mode
+ telnet-mode
+ term-mode
+ dired-mode
+ eshell-mode
+ ;; gnus article mode is read-only so should be missed anyway,
+ ;; but it does something wierd so that it's not
+ gnus-article-mode
+ ))
+
+
+;;;; End Package Support
+
+;;; Start data structures
+(defvar pabbrev-usage-hash-modes nil
+ "List of modes with associated usage dictionaries.")
+
+(defvar pabbrev-prefix-hash-modes nil
+ "List of modes with associated prefix dictionaries.")
+
+(defmacro pabbrev-save-buffer-modified-p (&rest body)
+ "Eval BODY without affected buffer modification status"
+ `(let ((buffer-modified (buffer-modified-p))
+ (buffer-undo-list t))
+ ,@body
+ (set-buffer-modified-p buffer-modified)))
+
+(defun pabbrev-get-usage-hash()
+ "Returns the usage hash for this buffer."
+ (let((hash (get major-mode 'pabbrev-usage-hash)))
+ (unless hash
+ (put major-mode 'pabbrev-usage-hash
+ (setq hash
+ (make-hash-table :test 'equal)))
+ (push major-mode pabbrev-usage-hash-modes))
+ hash))
+
+(defun pabbrev-get-usage-dictionary-size()
+ "Returns the size of the usage hash."
+ (hash-table-count (pabbrev-get-usage-hash)))
+
+(defun pabbrev-get-total-usages-dictionary()
+ "Returns the total number of usages from the usage hash"
+ (interactive)
+ (let ((size 0))
+ (maphash
+ (lambda(key value)
+ (setq size (+ size (cdr value))))
+ (pabbrev-get-usage-hash))
+ size))
+
+(defun pabbrev-get-prefix-hash()
+ "Returns the prefix hash for the current buffer."
+ (let((hash (get major-mode 'pabbrev-prefix-hash)))
+ (unless hash
+ (put major-mode 'pabbrev-prefix-hash
+ (setq hash
+ (make-hash-table :test 'equal)))
+ (push major-mode pabbrev-prefix-hash-modes))
+ hash))
+
+(defun pabbrev-add-word-usage (word)
+ "Add a WORD to the usage hash.
+This is a function internal to the data structures. The
+`pabbrev-add-word' is the main entry point to this functionality."
+ (let ((value
+ (gethash
+ ;; look for word usage cons we need a cons, but the last
+ ;; value is irrelevant.
+ word
+ (pabbrev-get-usage-hash))))
+ ;; so now we have cons, or nil
+ (if value
+ ;; increment occurences
+ (setcdr
+ value (+ 1 (cdr value)))
+ ;; we have no so make is
+ (setq value
+ (cons word 1)))
+ ;; so now we the cons cell for sure
+ ;; possible we should do this above, as I think it only needs
+ ;; doing for a new cons.
+ (puthash word value (pabbrev-get-usage-hash))
+ value))
+
+
+(defun pabbrev-add-word-cons-with-prefix (prefix conscell)
+ "Add a word usage, and a PREFIX.
+This function is internal to the data structures, and should normally
+only be called, by `pabbrev-add-word'. CONSCELL should be cons
+returned from `pabbrev-add-word-usage', while PREFIX should be a
+prefix of the from the cons cell."
+ (let
+ ;; this should be an alist or nil
+ ((value (gethash prefix
+ (pabbrev-get-prefix-hash))))
+ (if value
+ ;; so we have an alist. Has our word been added to this alist
+ ;; before? If not, do so. If it has been added, then it will
+ ;; have been updated with the addition of the word
+ (if (not
+ (member conscell value))
+ (setq value (cons conscell value)))
+ ;; nothing in there, so create an alist with
+ ;; a single element
+ (setq value (list conscell)))
+ ;; so we now have the value alist...sort it and store it back in
+ ;; the hash
+ (puthash prefix
+ (pabbrev-sort-alist value conscell)
+ (pabbrev-get-prefix-hash))))
+
+
+(defun pabbrev-sort-alist(alist cons)
+ ;; this sort is bit poor. It should be possible to do this in less
+ ;; than linear time, rather than n(log-n) as now. I think most of
+ ;; the time is spent entering the lambda function. The irony is that
+ ;; the sort is more or less sorted from the start, so a bubble sort
+ ;; would work in linear time. I've tried replacing with a linear
+ ;; sort, that is just placing the cons in the correct place, but in
+ ;; my hands, it's three or four times slower, on this buffer which
+ ;; has a lot of common prefixes, and so should take a while,
+ ;; probably because too much has to be done in lisp rather than with
+ ;; builtin's.
+ ;;
+ ;; Possibly the sort could be done on removing the value from the
+ ;; hash, which would reduce the amount of sorting that needs to be
+ ;; done. But it would then be in the command cycle rather than the
+ ;; idle loop, which seems like a really bad idea to me.
+ ;;
+ ;; When I wrote the data structures this was a bit of a worry as
+ ;; emacs spent most of its time in this loop, but now I've bolted
+ ;; on a user interface, its not so much of a problem, as plenty of
+ ;; time is spent in placing on the "been here" overlays....
+ (sort alist
+ ;;'pabbrev-comparitor-function))
+ (lambda(a b)
+ (> (cdr a) (cdr b)))))
+
+(defun pabbrev-comparitor-function(a b)
+ (> (cdr a) (cdr b)))
+
+
+(defun pabbrev-add-word (word)
+ "Add the usage of a WORD to the current dictionary."
+ (let ((conscell
+ (pabbrev-add-word-usage word)))
+ (dotimes (i (- (length word) 1))
+ (pabbrev-add-word-cons-with-prefix
+ (substring word 0 (1+ i))
+ conscell))))
+
+(defun pabbrev-fetch-all-suggestions-for-prefix(prefix)
+ "Returns the suggestions for a given PREFIX.
+Results are an alist, with cons with car of the word, and cdr of the
+number of usages seen so far. This alist should NOT be altered, its
+it's ordering is part of the core data structures"
+ (gethash prefix (pabbrev-get-prefix-hash)))
+;; Which completes the core data structures.
+
+
+
+;; This code provides the minor mode which displays, and accepts
+;; abbreviations.
+(defvar pabbrev-mode-map (make-keymap)
+ "Keymap for pabbrev-minor-mode.")
+
+;; I don't understand this. I thought that this were equivalent. But
+;; modes which define [tab] get used in preference to \t. So I define
+;; both. Don't change these without also changing the definition of
+;; pabbrev-expand-maybe.
+(define-key pabbrev-mode-map "\t" 'pabbrev-expand-maybe)
+(define-key pabbrev-mode-map [tab] 'pabbrev-expand-maybe)
+
+
+;; xemacs has synced to newest easy-mmode now
+;;(if (not pabbrev-xemacs-p)
+(define-minor-mode pabbrev-mode
+ "Toggle pabbrev mode.
+With arg, turn on Predicative Abbreviation mode if and only if arg is
+positive.
+
+This mode is another abbreviation expansion mode somewhat like
+`dabbrev-expand', in that it looks through the current buffer for
+symbols that can complete the current symbol. Unlike `dabbrev-expand',
+it does this by discovering the words during the Emacs idle time, and
+places the results into data structures which enable very rapid
+extraction of expansions. The upshot of this is that it can offer
+suggestions as you type, without causing an unacceptable slow down.
+
+There is an associated `global-pabbrev-mode' which turns on the mode
+on in all buffers.
+"
+ nil
+ " Pabbrev"
+ pabbrev-mode-map
+ (when (and pabbrev-mode-map
+ buffer-read-only)
+ (if pabbrev-read-only-error
+ (error "Can not use pabbrev-mode in read only buffer"))))
+
+;; (easy-mmode-define-minor-mode pabbrev-mode
+;; "Toggle pabbrev mode.
+;; This mode is an abbreviation expansion mode. It looks through the
+;; current buffer, and offers expansions based on the words already
+;; there.
+
+;; I have only just recently ported this to XEmacs, and I don't
+;; personally use XEmacs, so it has received little or no testing."
+;; nil
+;; " Pabbrev"
+;; pabbrev-mode-map))
+
+(if (fboundp 'easy-mmode-define-global-mode)
+ (easy-mmode-define-global-mode global-pabbrev-mode
+ pabbrev-mode pabbrev-global-mode))
+
+(defun pabbrev-global-mode()
+ "Switch on `pabbrev-mode' in current buffer if appropriate.
+Currently appropriate means, if the buffer is not read only, and is
+not a minibuffer."
+ (unless (or buffer-read-only
+ pabbrev-mode
+ (get major-mode 'pabbrev-global-mode-excluded-modes)
+ ;; don't turn on in non listable buffers
+ (equal (substring (buffer-name) 0 1) " ")
+ (when pabbrev-global-mode-buffer-size-limit
+ (> (buffer-size) pabbrev-global-mode-buffer-size-limit))
+ (member (buffer-name) pabbrev-global-mode-not-buffer-names)
+ (window-minibuffer-p (selected-window)))
+ (let
+ ;; set the chunk size low, or the global mode takes for ever
+ ;; to switch on
+ ((pabbrev-scavenge-some-chunk-size 0))
+ (pabbrev-mode))))
+
+;; hooks for switching on and off.
+(add-hook 'pabbrev-mode-on-hook
+ 'pabbrev-mode-on)
+(add-hook 'pabbrev-mode-off-hook
+ 'pabbrev-mode-off)
+
+(defvar pabbrev-marker nil
+ "Location of current insertion, or nil.
+This variable is not actually a marker, but a cons of
+start and end positions")
+(make-variable-buffer-local 'pabbrev-marker)
+
+(defvar pabbrev-expansion nil
+ "Currently displayed expansion, or nil.")
+(make-variable-buffer-local 'pabbrev-expansion)
+
+(defvar pabbrev-expansion-suggestions nil
+ "Current expansion suggestions, or nil.")
+(make-variable-buffer-local 'pabbrev-expansion-suggestions)
+
+(defvar pabbrev-marker-last-expansion nil
+ "Marks where the last possible expansion was.")
+(make-variable-buffer-local 'pabbrev-marker-last-expansion)
+
+(defun pabbrev-mode-on()
+ "Turn `pabbrev-mode' on."
+ (add-hook 'pre-command-hook 'pabbrev-pre-command-hook nil t)
+ (add-hook 'post-command-hook 'pabbrev-post-command-hook nil t))
+
+(defun pabbrev-mode-off()
+ "Turn `pabbrev-mode' off."
+ ;; we have to remove the binding for tab. Other wise next time we
+ ;; switch the mode on, this binding will be found, and set for
+ ;; pabbrev-tab-previously-defined
+ (remove-hook 'pre-command-hook 'pabbrev-pre-command-hook t)
+ (remove-hook 'post-command-hook 'pabbrev-post-command-hook t))
+
+;;(defun test()(interactive)(let ((last-command
'self-insert-command))(pabbrev-post-command-hook)))
+
+
+
+;;(defun test()
+;; (interactive)
+;; (pabbrev-insert-suggestion
+;; (pabbrev-thing-at-point)
+;; (cdr (pabbrev-bounds-of-thing-at-point))
+;; (pabbrev-fetch-all-suggestions-for-prefix
+;; (pabbrev-thing-at-point))))
+
+
+(defun pabbrev-post-command-hook()
+ "Offer expansion if appropriate.
+This function is normally run off the `post-command-hook'."
+ (condition-case err
+ ;; pabbrev will not switch on in a read only buffer. But the
+ ;; buffer may have become read only between the time that it was
+ ;; switched on, and now. So we need to check this anyway.
+ (unless (or buffer-read-only
+ ;; This seems to be an issue in xemacs, so check for
+ ;; this as well.
+ (window-minibuffer-p (selected-window)))
+ (save-excursion
+ ;; ensure that any suggestion is deleted.
+ (when pabbrev-marker
+ (pabbrev-delete-last-suggestion))
+ (let ((word (pabbrev-thing-at-point))
+ (bounds (pabbrev-bounds-of-thing-at-point))
+ (suggestions))
+ (if (and
+ ;; last command was a symbol
+ ;; PWL last-command to this-command
+ (symbolp this-command)
+ ;; we have just had an appropriate command
+ ;; PWL commented out and testing change suggestd by Ye Wenbin
+ ;;(get last-command 'pabbrev-expand-after-command)
+ (get this-command 'pabbrev-expand-after-command)
+ ;; is word at point
+ word
+ ;; we are at the end of it.
+ (= (point) (cdr bounds))
+ ;; and we have some suggestions.
+ (setq suggestions (pabbrev-fetch-all-suggestions-for-prefix
word)))
+ (progn
+ (pabbrev-insert-suggestion word (cdr bounds) suggestions)
+ (pabbrev-post-command-check-movement))))))
+ (error
+ (pabbrev-command-hook-fail err "post" ))))
+
+
+(defun pabbrev-delete-last-suggestion()
+ "Remove previously inserted suggestions."
+ (pabbrev-save-buffer-modified-p
+ ;; I don't think we need to check for buffer-read-only
+ ;; here, because pabbrev-marker will always be nil in a
+ ;; read only buffer. I could be wrong about this of
+ ;; course.
+ (pabbrev-delete-overlay)
+ (delete-region (car pabbrev-marker) (cdr pabbrev-marker))
+ (setq pabbrev-marker nil)))
+
+
+(defun pabbrev-pre-command-hook()
+ "Remove offering expansion from the buffer, if present.
+This function is normally run off the `pre-command-hook'"
+ (condition-case err
+ (progn
+ (unless (memq this-command
+ pabbrev-expand-commands)
+ (setq pabbrev-expansion nil
+ pabbrev-expansion-suggestions nil))
+ (when pabbrev-marker
+ (pabbrev-delete-last-suggestion)))
+ ;;catch the error
+ (error
+ (pabbrev-command-hook-fail err "pre"))))
+
+(defun pabbrev-command-hook-fail(err hook)
+ "Advise user of a failure command-hooks.
+This function should only run as the result of a bug.
+A message is sent, as we can do little else safely,
+on the `post-command-hook', or `pre-command-hook'."
+ (message "pabbrev mode has failed on %s hook: %s "
+ hook (error-message-string err))
+ (remove-hook 'pre-command-hook 'pabbrev-pre-command-hook t)
+ (remove-hook 'post-command-hook 'pabbrev-post-command-hook t)
+ (with-output-to-temp-buffer "*pabbrev-fail*"
+ (princ "There has been an error in pabbrev-mode. This mode normally
+makes use of \"post-command-hook\", which runs after every command. If this
+error continued Emacs could be made unusable, so pabbrev-mode has attempted
+to disable itself. So although it will appear to still be on, it won't do
+anything. Toggling it off, and then on again will usually restore
functionality.\n")
+ (princ "The following is debugging information\n\n")
+ (princ (error-message-string err))
+ (princ "\n\nBacktrace is: \n" )
+ (let ((standard-output (get-buffer "*pabbrev-fail*" )))
+ (backtrace)))
+ (select-window (get-buffer-window "*pabbrev-fail*"))
+ (error "Error in pabbrev-mode"))
+
+(defun pabbrev-marker-last-expansion()
+ "Fetch marker for last offered expansion."
+ (unless
+ pabbrev-marker-last-expansion
+ (setq pabbrev-marker-last-expansion
+ (set-marker (make-marker)
+ (point) (current-buffer))))
+ pabbrev-marker-last-expansion)
+
+(defun pabbrev-update-marker()
+ (set-marker (pabbrev-marker-last-expansion)
+ (point) (current-buffer)))
+
+(defun pabbrev-post-command-check-movement()
+ (let ((distance
+ (abs (- (point) (marker-position
+ (pabbrev-marker-last-expansion))))))
+ (if (> distance pabbrev-marker-distance-before-scavenge)
+ ;; we have moved a lot in the buffer
+ (progn
+ (pabbrev-debug-message "Scavenge due to buffer marker")
+ (pabbrev-scavenge-some)
+ (pabbrev-update-marker)))))
+
+(defvar pabbrev-overlay nil
+ "Overlay for offered completion.")
+(make-variable-buffer-local 'pabbrev-overlay)
+
+(defun pabbrev-set-overlay(start end count)
+ "Move overlay to START END location."
+ (unless pabbrev-overlay
+ (setq pabbrev-overlay
+ ;; set an overlay at 1 1. Originally this used to be a 0 0 but
+ ;; it crashes xemacs...well I never....
+ (make-overlay 1 1)))
+ ;; for when we are not in font-lock-mode
+ (overlay-put pabbrev-overlay 'face
+ (if (> count 1) 'pabbrev-suggestions-face
+ 'pabbrev-single-suggestion-face))
+ ;; for when we are. If we just set face, font-lock tends to reset the face
+ ;; immediately. This isn't working for me. font-lock still just blithely
+ ;; resets the properties we have so carefully just placed
+ (overlay-put pabbrev-overlay 'font-lock-face
+ (if (> count 1) 'pabbrev-suggestions-face
+ 'pabbrev-single-suggestion-face))
+ (move-overlay pabbrev-overlay start end (current-buffer)))
+
+(defun pabbrev-set-overlay(start end count)
+ "Move overlay to START END location."
+ (unless pabbrev-overlay
+ (setq pabbrev-overlay
+ ;; set an overlay at 1 1. Originally this used to be a 0 0 but
+ ;; it crashes xemacs...well I never....
+ (make-overlay 1 1)))
+ (overlay-put pabbrev-overlay 'face
+ (if (> count 1) 'pabbrev-suggestions-face
+ 'pabbrev-single-suggestion-face))
+ (move-overlay pabbrev-overlay start end (current-buffer)))
+
+(defun pabbrev-delete-overlay()
+ "Make overlay invisible."
+ (if pabbrev-overlay
+ (delete-overlay pabbrev-overlay)))
+
+
+
+
+(defun pabbrev-insert-suggestion(prefix end suggestions)
+ "Insert a suggestion into the buffer.
+The suggestion should start with PREFIX, and be entered
+at buffer position END."
+ (interactive)
+ (let* ((suggestion
+ (if (not pabbrev-minimal-expansion-p)
+ (car (car suggestions))
+ (try-completion "" suggestions))))
+ (let ((expansion
+ (if suggestion
+ (substring suggestion
+ (length prefix))
+ "")))
+ (save-excursion
+ (if (< 0 (length expansion))
+ ;; add the abbreviation to the buffer
+ (pabbrev-save-buffer-modified-p
+ (insert
+ "[" expansion "]" )
+ ;; store everything. Most importantly the pabbrev-marker!
+ (setq
+ pabbrev-expansion expansion
+ pabbrev-expansion-suggestions suggestions
+ pabbrev-marker
+ (cons end (point)))
+ (let ((point-1 (- (point) 1)))
+ (pabbrev-set-overlay
+ (- point-1 (length expansion)) point-1
+ (length suggestions)))))))))
+
+
+
+(defvar pabbrev-last-expansion-suggestions nil
+ "Cached alternative suggestions from the last expansion.")
+
+
+;; patch from Trey Jackson to fix problem with python (which uses tab to cycle
+;; through indentation levels
+(defun pabbrev-call-previous-tab-binding ()
+ "Call the function normally associated with [tab]."
+ (let ((prev-binding (pabbrev-get-previous-binding)))
+ (if (and (fboundp prev-binding)
+ (not (eq prev-binding 'pabbrev-expand-maybe)))
+ (let ((last-command (if (eq last-command this-command)
+ prev-binding
+ last-command))
+ (this-command prev-binding))
+ (funcall prev-binding)))))
+
+
+;; (defun pabbrev-call-previous-tab-binding ()
+;; "Call the function normally associated with [tab]."
+;; (let ((prev-binding (pabbrev-get-previous-binding)))
+;; (if (and (fboundp prev-binding)
+;; (not (eq prev-binding 'pabbrev-expand-maybe)))
+;; (funcall prev-binding))))
+
+
+(defun pabbrev-expand-maybe(uarg)
+ "Call appropriate expansion command based on whether
+minimal or full expansion is desired. If there is no expansion the command
returned by
+`pabbrev-get-previous-binding' will be run instead."
+ (interactive "p")
+ (if pabbrev-minimal-expansion-p
+ (pabbrev-expand-maybe-minimal uarg)
+ (pabbrev-expand-maybe-full uarg)))
+
+
+(defun pabbrev-expand-maybe-minimal (uarg)
+ "Expand the minimal common prefix at point.
+With prefix argument, bring up the menu of all full expansions."
+ (if (= uarg 4)
+ (if (> (length pabbrev-expansion-suggestions) 1)
+ (pabbrev-suggestions-goto-buffer pabbrev-expansion-suggestions)
+ (pabbrev-call-previous-tab-binding))
+ (if pabbrev-expansion
+ (pabbrev-expand)
+ (pabbrev-call-previous-tab-binding))))
+
+
+(defun pabbrev-expand-maybe-full (uarg)
+ "Expand fully to the most common abbreviation at point.
+With prefix argument, bring up a menu of all full expansions."
+ (cond
+ ((= uarg 4)
+ (if (> (length pabbrev-expansion-suggestions) 1)
+ (pabbrev-suggestions-goto-buffer pabbrev-expansion-suggestions)
+ (pabbrev-call-previous-tab-binding)))
+ ((eq last-command 'pabbrev-expand-maybe)
+ (if (and (> (length pabbrev-expansion-suggestions) 1)
+ (> (length pabbrev-last-expansion-suggestions) 1))
+ (pabbrev-suggestions-goto-buffer pabbrev-last-expansion-suggestions)
+ (pabbrev-call-previous-tab-binding)))
+ (pabbrev-expansion
+ (progn
+ (setq pabbrev-last-expansion-suggestions pabbrev-expansion-suggestions)
+ (pabbrev-expand)))
+ (t (pabbrev-call-previous-tab-binding))))
+
+;; (setq pabbrev-minimal-expansion-p nil)
+
+
+(defun pabbrev-show-previous-binding ()
+ (interactive)
+ (message "Previous binding is: %s"
+ (pabbrev-get-previous-binding)))
+
+(defun pabbrev-get-previous-binding ()
+ "Show the binding of tab if pabbrev were not active.
+The command `pabbrev-show-previous-binding' prints this out."
+ (let ((pabbrev-mode nil))
+ ;; This is the original and satisfying solution
+ ;;(key-binding (char-to-string last-command-event)))))
+
+ ;; This is the new and unsatisfying one. The
+ ;; keybindings are hard coded here, because I defined
+ ;; [tab] and \t earlier. Both are tab, but the former
+ ;; gets used in preference to the later.
+ (or (key-binding [tab])
+ (key-binding "\t"))))
+
+;; ;; I think that I have this worked out now.
+;; (if (eq prev-binding 'pabbrev-expand-maybe)
+;; (message "pabbrev known bug! Avoiding recursive tab")
+;; (funcall prev-binding))))))
+
+;; (define-key pabbrev-mode-map "\t" nil)
+;; (let ((tunneled-keybinding (key-binding "\t")))
+;; (if (and (fboundp tunneled-keybinding)
+;; (not (eq tunneled-keybinding 'pabbrev-expand-maybe)))
+;; (funcall tunneled-keybinding)))
+;; (define-key pabbrev-mode-map "\t" 'pabbrev-expand-maybe)))
+
+(defvar pabbrev-expand-previous-word nil)
+(defun pabbrev-expand()
+ "Expand abbreviation"
+ (setq pabbrev-expand-previous-word (pabbrev-thing-at-point))
+ (if pabbrev-expansion
+ (insert pabbrev-expansion)
+ (message "No expansion"))
+ (setq pabbrev-expansion nil))
+
+
+(defvar pabbrev-expand-commands
+ '(pabbrev-expand-maybe pabbrev-expand
+ pabbrev-expand-maybe-minimal
pabbrev-expand-maybe-full)
+ "List of commands which will be used expand.
+We need to know this, or the possible expansions are deleted
+before the command gets run.")
+
+;; suggestions buffer
+;; (defvar pabbrev-suggestions-buffer-enable nil)
+;; (defun pabbrev-suggestions-toggle()
+;; "NOT FULLY FUNCTIONAL. Enable interactive suggestions window.
+;; This is just a test function at the moment. The idea is that you will
+;; be able to see alternate suggestions as you type. This will be most
+;; useful in a programming buffer. At the moment there is no way of
+;; actually selecting these abbreviations. But it appears that the core
+;; data structures are quick enough to work."
+;; (interactive)
+;; (if pabbrev-suggestions-buffer-enable
+;; (progn
+;; (setq pabbrev-suggestions-buffer-enable nil)
+;; (remove-hook 'post-command-hook
+;; 'pabbrev-suggestions-delete-window)
+;; (delete-window (get-buffer-window " *pabbrev suggestions*"))
+;; (message "pabbrev suggestions off"))
+;; (setq pabbrev-suggestions-buffer-enable t)
+;; (add-hook 'post-command-hook
+;; 'pabbrev-suggestions-delete-window)
+;; (message "pabbrev suggestions on")))
+
+(defun pabbrev-suggestions-delete-window()
+ "Delete the suggestions window."
+ (interactive)
+ (unless
+ (or pabbrev-mode
+ (eq (buffer-name) " *pabbrev suggestions*"))
+ (delete-window (get-buffer-window " *pabbrev suggestions*"))
+ (set-window-configuration pabbrev-window-configuration)))
+
+;; (defun pabbrev-post-command-delete-suggestions()
+;; (interactive)
+;; (if pabbrev-suggestions-buffer-enable
+;; (progn
+;; ;; this isn't perfect. The window pops up in a fairly random place.
+;; (with-output-to-temp-buffer " *pabbrev suggestions*")
+;; (shrink-window-if-larger-than-buffer (get-buffer-window " *pabbrev
suggestions*")))))
+
+;; (defun pabbrev-post-command-show-suggestions(suggestions prefix)
+;; (if pabbrev-suggestions-buffer-enable
+;; (pabbrev-suggestions-buffer suggestions prefix)))
+
+
+(defvar pabbrev-window-configuration nil
+ "Stores the window configuration before presence of a window buffer")
+
+
+(defun pabbrev-suggestions-goto-buffer(suggestion-list)
+ "Jump into the suggestions buffer."
+ ;; (if pabbrev-suggestions-buffer-enable
+ ;; (pabbrev-suggestions-delete-window))
+ (setq pabbrev-window-configuration (current-window-configuration))
+ (pabbrev-suggestions-buffer suggestion-list "")
+ (shrink-window-if-larger-than-buffer
+ (select-window (get-buffer-window " *pabbrev suggestions*"))))
+
+(defvar pabbrev-suggestions-from-buffer nil)
+(defvar pabbrev-suggestions-done-suggestions nil)
+(defvar pabbrev-suggestions-best-suggestion nil)
+
+(defun pabbrev-suggestions-buffer(suggestions prefix)
+ "Form the suggestions buffer."
+ (with-output-to-temp-buffer " *pabbrev suggestions*"
+ (setq pabbrev-suggestions-from-buffer (current-buffer))
+ (setq pabbrev-suggestions-best-suggestion
+ (car suggestions))
+ (setq pabbrev-suggestions-done-suggestions
+ (pabbrev-suggestions-limit-alpha-sort suggestions))
+ (setq suggestions pabbrev-suggestions-done-suggestions)
+ (let
+ ((window-width (- (window-width) 1)))
+ (save-excursion
+ (set-buffer (get-buffer " *pabbrev suggestions*"))
+ (pabbrev-suggestions-setup)`
+ (princ
+ (concat;;"Current Word: " prefix " "
+ "Max Substring: " (try-completion "" suggestions)
+ "\n"))
+ (princ
+ (concat
+ "Best Match: " (car pabbrev-suggestions-best-suggestion)
+ "\n"))
+ (if suggestions
+ (loop for i from 0 to 9 do
+ ;; are we less than the suggestions
+ (if (< i (length suggestions))
+ (progn
+ (goto-char (point-max))
+ ;; insert all the suggestions
+ (let ((next-suggestion
+ (concat
+ (number-to-string i)
+ ") "
+ (car (nth i suggestions)) " " ))
+ (line-length
+ (- (line-end-position) (line-beginning-position))))
+ ;; if well. are not on the first suggestion,
+ (if (and (> i 0)
+ ;; and the line will be too long
+ (< window-width
+ (+ line-length (length next-suggestion))))
+ ;; add a new line.
+ (princ "\n"))
+ (princ next-suggestion)
+ (let ((start (- (point) (length next-suggestion))))
+ (overlay-put
+ (make-overlay start (+ 2 start))
+ 'face 'pabbrev-suggestions-label-face))))))))))
+ (shrink-window-if-larger-than-buffer (get-buffer-window " *pabbrev
suggestions*")))
+
+(defun pabbrev-suggestions-limit-alpha-sort(suggestions)
+ "Limit suggestions and sort."
+ (delq nil
+ (sort (pabbrev-suggestions-subseq suggestions 0 10)
+ (lambda(a b)
+ (string< (car a) (car b))))))
+
+(defun pabbrev-suggestions-subseq(sequence from to)
+ "Return subsequence from seq.
+FROM starting here
+TO finishing here.
+Amazing though it seems the implementation of this differs between Emacs,
+and XEmacs. Irritating or what!
+The Emacs version copes with numbers past the end, and backs with nil
+values. XEmacs uses its own builtin rather than the one in the CL package.
+It crashes under the same circumstances. Yeech."
+ (if pabbrev-xemacs-p
+ (subseq sequence from
+ (min to
+ (length sequence)))
+ (subseq sequence from to)))
+
+(defun pabbrev-suggestions-setup()
+ "Set up suggestions major mode."
+ (unless (fboundp 'pabbrev-select-mode)
+ ;; define pabbrev select mode
+ (define-derived-mode pabbrev-select-mode fundamental-mode
+ "Pabbrev Select"
+ "Major mode for selecting `pabbrev-mode' expansions.
+The number keys selects the various possible expansions.
\\[pabbrev-suggestions-delete]
+removes the previously added expansion, \\[pabbrev-suggestions-minimum]
selects the minimum
+matching substring, while \\[pabbrev-suggestions-delete-window] just deletes
the window
+\\{pabbrev-select-mode-map}")
+ (setq pabbrev-select-mode-map (make-sparse-keymap))
+ (loop for i from 33 to 126 do
+ (define-key pabbrev-select-mode-map (char-to-string i) 'pabbrev-noop))
+ (define-key pabbrev-select-mode-map "\t"
'pabbrev-suggestions-select-default)
+ (define-key pabbrev-select-mode-map [delete] 'pabbrev-suggestions-delete)
+ (define-key pabbrev-select-mode-map [backspace]
'pabbrev-suggestions-delete)
+ (define-key pabbrev-select-mode-map "\C-m" 'pabbrev-suggestions-minimum)
+ (define-key pabbrev-select-mode-map " " 'pabbrev-suggestions-delete-window)
+ (define-key pabbrev-select-mode-map "q" 'pabbrev-suggestions-delete-window)
+ ;; define all the standard insert commands
+ (loop for i from 0 to 9 do
+ (define-key pabbrev-select-mode-map
+ (number-to-string i) 'pabbrev-suggestions-select)))
+ (pabbrev-select-mode))
+
+(defun pabbrev-noop()
+ "Do absolutely nothing.
+This command is used to nobble the suggestions buffer
+self inserting commands."
+ (interactive))
+
+(defun pabbrev-suggestions-select-default()
+ "Select the most commonly occuring string."
+ (interactive)
+ (if pabbrev-suggestions-best-suggestion
+ (pabbrev-suggestions-insert
+ (car pabbrev-suggestions-best-suggestion))))
+
+(defun pabbrev-suggestions-delete()
+ "Delete the last suggestion."
+ (interactive)
+ (pabbrev-suggestions-insert
+ pabbrev-expand-previous-word))
+
+(defun pabbrev-suggestions-minimum()
+ "Select the maximally occuring substring."
+ (interactive)
+ (pabbrev-suggestions-insert
+ ;;(try-completion "" pabbrev-suggestions-done-suggestions)))
+ (try-completion "" (pabbrev-suggestions-subseq
pabbrev-suggestions-done-suggestions 0 10))))
+
+(defun pabbrev-suggestions-insert(insertion)
+ "Actually insert the suggestion."
+ (let ((point))
+ (save-excursion
+ (set-buffer pabbrev-suggestions-from-buffer)
+ (let ((bounds (pabbrev-bounds-of-thing-at-point)))
+ (progn
+ (delete-region (car bounds) (cdr bounds))
+ (insert insertion)
+ (setq point (point)))))
+ (pabbrev-suggestions-delete-window)
+ (if point
+ (goto-char point))))
+
+(defun pabbrev-suggestions-select(&optional index)
+ "Select one of the numbered suggestions."
+ (interactive)
+ (let ((insert-index
+ (or index
+ (string-to-number
+ (char-to-string last-command-event)))))
+ (if (< insert-index
+ (length pabbrev-suggestions-done-suggestions))
+ (pabbrev-suggestions-insert
+ (car
+ (nth insert-index pabbrev-suggestions-done-suggestions))))))
+
+
+;; These functions define movement around the buffer, which
+;; determines what pabbrev considers to be a "word"
+(defun pabbrev-forward-thing(&optional number)
+ "Move forward a pabbrev word. Or backwards if number -1"
+ (interactive)
+ (forward-thing pabbrev-thing-at-point-constituent number))
+
+(defun pabbrev-thing-at-point()
+ "Get thing at point."
+ (let ((bounds (pabbrev-bounds-of-thing-at-point)))
+ (if bounds
+ (buffer-substring-no-properties
+ (car bounds) (cdr bounds)))))
+
+(defun pabbrev-bounds-of-thing-at-point()
+ "Get the bounds of the thing at point"
+ (bounds-of-thing-at-point
+ pabbrev-thing-at-point-constituent))
+
+
+;; These functions deal with scavenging word usage from the buffer,
+;; which are then added to the dictionary.
+(defun pabbrev-bounds-marked-p (start end)
+ "Return t if anywhere between START and END is marked."
+ (save-excursion
+ (let ((retn))
+ (do ((i start (1+ i)))
+ ((> i end))
+ (if
+ (setq retn
+ (get-text-property i 'pabbrev-added))
+ (setq i end)))
+ retn)))
+
+(defun pabbrev-mark-add-word (bounds)
+ "Add word in BOUNDS as abbreviation, and mark the buffer."
+ (if bounds
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (unless
+ ;; is this word or part of it already added?
+ (pabbrev-bounds-marked-p start end)
+ ;; mark the word visibly as well.
+ (pabbrev-debug-display start end)
+ ;; set a property so that we know what we have done.
+ (pabbrev-save-buffer-modified-p
+ (add-text-properties start end
+ '(pabbrev-added t)))
+ ;; and add the word to the system.
+ (pabbrev-add-word
+ (buffer-substring-no-properties start end))))))
+
+(defun pabbrev-scavenge-some()
+ "Gather some words up from around point"
+ (interactive)
+ (save-excursion
+ ;; move somewhat away from point, as this is likely to not contain
+ ;; complete words.
+ (pabbrev-forward-thing -2)
+ (pabbrev-scavenge-words -1
+ (* 2 pabbrev-scavenge-some-chunk-size))
+ (save-excursion
+ (pabbrev-forward-thing 2)
+ (pabbrev-scavenge-words 1 pabbrev-scavenge-some-chunk-size))))
+
+(defun pabbrev-scavenge-region()
+ (interactive)
+ (narrow-to-region (region-beginning) (region-end))
+ (pabbrev-scavenge-buffer))
+
+
+(defun pabbrev-scavenge-buffer-fast()
+ (interactive)
+ (message "pabbrev fast scavenging buffer...")
+ (save-excursion
+ (goto-char (point-min))
+ (while (pabbrev-forward-thing)
+
+ (let* ((bounds (pabbrev-bounds-of-thing-at-point))
+ (start (car bounds))
+ (stop (cdr bounds)))
+ (unless
+ (pabbrev-bounds-marked-p start stop)
+ (pabbrev-add-word
+ (buffer-substring-no-properties start stop)))))
+
+ (pabbrev-debug-message "Dictionary size %s total usage %s"
+ (pabbrev-get-usage-dictionary-size))
+ (pabbrev-save-buffer-modified-p
+ (add-text-properties (point-min) (point-max)
+ '(pabbrev-added t)))
+ (message "pabbrev fast scavenging buffer...done.")))
+
+
+(defun pabbrev-scavenge-buffer()
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+
+ (working-status-forms "pabbrev scavenging buffer" "done"
+ (while (pabbrev-forward-thing)
+ (working-status (/ (* 100 (point)) (point-max)))
+ ;;(message "pabbrev scavenging (buffer %s words %s line %s done %s
%%)..."
+ ;; (current-buffer)
+ ;; (pabbrev-get-usage-dictionary-size)
+ ;; current-line
+ ;; (/ (* 100 current-line) total-line))
+ ;;(message "pabbrev scavenging buffer...On line %s"
+ ;; (count-lines (point-min) (point)))
+ (pabbrev-mark-add-word
+ (pabbrev-bounds-of-thing-at-point)))
+ (working-status t))
+
+ (pabbrev-debug-message "Dictionary size %s total usage %s"
+ (pabbrev-get-usage-dictionary-size))
+ (message "pabbrev scavenging buffer...done.")))
+
+
+(defun pabbrev-scavenge-words(&optional direction number)
+ "Scavenge words from current buffer, starting from point.
+DIRECTION is in which direction we should work,
+NUMBER is how many words we should try to scavenge"
+ (if (not direction)
+ (setq direction 1))
+ (if (not number)
+ (setq number 20))
+ (save-excursion
+ (dotimes (i number)
+ (pabbrev-forward-thing direction)
+ (pabbrev-mark-add-word
+ (pabbrev-bounds-of-thing-at-point)))
+ (point)))
+
+;; switch on the idle timer if required when the mode is switched on.
+(add-hook 'pabbrev-mode-on-hook
+ 'pabbrev-ensure-idle-timer)
+;; also run the idle timer function, to put some works in the
+;; dictionary.
+(add-hook 'pabbrev-mode-on-hook
+ 'pabbrev-scavenge-some)
+
+(defvar pabbrev-long-idle-timer nil
+ "Timer which adds whole buffer.
+There are two idle timers which run for function `pabbrev-mode'. This
+one doesn't start for a while, but once it has will work its way
+through the whole buffer. In prints out a message to say what its
+doing, and stops on user input. The variable
+`pabbrev-short-idle-timer' is the other.
+The idea here is that the short timer will pick up most of the recent
+changes, and will not bother the user. The long timer will slowly
+gather up the whole buffer, telling the user what it is doing, in case
+it takes up too much processor. If this happened after a second it
+would be irritating in the extreme.")
+
+(defvar pabbrev-short-idle-timer nil
+ "Timer which adds a few words.
+See `pabbrev-long-idle-timer'.")
+
+(defun pabbrev-ensure-idle-timer()
+ (unless nil
+ (if (not (and pabbrev-short-idle-timer
+ pabbrev-long-idle-timer))
+ (pabbrev-start-idle-timer))))
+
+(defun pabbrev-start-idle-timer()
+ (setq pabbrev-long-idle-timer
+ (run-with-idle-timer 5 t 'pabbrev-idle-timer-function))
+ (setq pabbrev-short-idle-timer
+ (run-with-idle-timer 1 t 'pabbrev-short-idle-timer)))
+
+;;(setq pabbrev-disable-timers t)
+(defvar pabbrev-disable-timers nil)
+;; I don't understand why this is necessary but it seems to help the
+;; slow idle timer work in the correct buffer. I suspect someother
+;; timer is screwing up with the current buffer...
+(defvar pabbrev-timer-buffer nil)
+
+(defun pabbrev-short-idle-timer(&optional buffer)
+ "Add a few words to the dictionary."
+ (save-excursion
+ (set-buffer (or buffer (current-buffer)))
+ ;; remember which buffer we have just looked at.
+ (setq pabbrev-timer-buffer (current-buffer))
+ (if (and pabbrev-mode (not pabbrev-disable-timers))
+ (progn
+ (pabbrev-debug-message "running short idle timer")
+ ;;(message "Running short timer in %s" (current-buffer))
+ (pabbrev-scavenge-some)
+ (pabbrev-debug-message "Dictionary size %s total usage %s"
+ (pabbrev-get-usage-dictionary-size)
+ (pabbrev-get-total-usages-dictionary))))))
+
+(defun pabbrev-idle-timer-function(&optional buffer)
+ ;; so this only works on the current buffer. Might want to scavenge
+ ;; over other buffers
+ (save-excursion
+ (set-buffer (or buffer pabbrev-timer-buffer (current-buffer)))
+ (if (and pabbrev-mode (not pabbrev-disable-timers))
+ (pabbrev-idle-timer-function-0)
+ (pabbrev-debug-message "idle running in non pabbrev-mode"))))
+
+;; for some reason that I do not understand yet, this sometimes
+;; appears to work in the wrong buffer. I really have not got any idea
+;; why this is the case.
+(defun pabbrev-idle-timer-function-0()
+ "Add all words to the buffer.
+`pabbrev-scavenge-buffer' does this more efficiently interactively.
+If this takes up too much processor power, see
`pabbrev-scavenge-some-chunk-size'."
+ (let ((forward-marker (point))
+ (backward-marker (point))
+ (forward-complete nil)
+ (backward-complete nil)
+ (repeat t))
+ (if pabbrev-idle-timer-verbose
+ (message "pabbrev scavenging..."))
+ (pabbrev-debug-message "running idle timer at %s" (point))
+ (while
+ (and repeat
+ (not (and forward-complete backward-complete)))
+ (save-excursion
+ (unless backward-complete
+ (goto-char backward-marker)
+ (setq backward-marker
+ (pabbrev-scavenge-words -1
+ (* 2 pabbrev-scavenge-some-chunk-size)))
+ (setq backward-complete
+ (eq (point-min) backward-marker))
+ (pabbrev-debug-message "searching backward to %s complete %s"
+ backward-marker backward-complete))
+ (unless forward-complete
+ (goto-char forward-marker)
+ (setq forward-marker
+ (pabbrev-scavenge-words 1 pabbrev-scavenge-some-chunk-size))
+ (setq forward-complete
+ (eq (point-max) forward-marker))
+ (pabbrev-debug-message "searching forward to %s complete %s"
+ forward-marker forward-complete)))
+ (pabbrev-debug-message "Dictionary size %s total usage %s"
+ (pabbrev-get-usage-dictionary-size)
+ (pabbrev-get-total-usages-dictionary))
+
+ (if pabbrev-idle-timer-verbose
+ (message "pabbrev scavenging (%s words %s buffer)..."
(pabbrev-get-usage-dictionary-size)
+ (buffer-name (current-buffer))))
+ (setq repeat (sit-for 0.1)))
+ (if pabbrev-idle-timer-verbose
+ (progn
+ (message "pabbrev scavenging...done")
+ (sit-for 2)
+ (message nil)))))
+
+(defun pabbrev-shut-up()
+ "Switch off verbose messages..."
+ (interactive)
+ (message "Swiching off pabbrev messages" )
+ (setq pabbrev-idle-timer-verbose nil))
+
+;;; The following are debug functions.
+(defvar pabbrev-debug-buffer nil)
+
+;;(setq pabbrev-debug-enabled t)
+(defvar pabbrev-debug-enabled nil)
+
+(defun pabbrev-debug-get-buffer()
+ (get-buffer-create "*pabbrev-debug"))
+
+(defmacro pabbrev-debug-message(&rest body)
+ `(if pabbrev-debug-enabled
+ (let ((insert
+ (concat (format ,@body) "\n")))
+ (save-excursion
+ (set-buffer
+ (pabbrev-debug-get-buffer))
+ (goto-char (point-max))
+ (insert insert)
+ (pabbrev-debug-frame-scroll)))))
+
+(defun pabbrev-debug()
+ (interactive)
+ (pabbrev-debug-frame)
+ (setq pabbrev-debug-enabled t))
+
+(defvar pabbrev-debug-frame nil)
+(defun pabbrev-debug-frame()
+ (interactive)
+ (if (not pabbrev-debug-frame)
+ (progn
+ (setq pabbrev-debug-frame
+ (make-frame '((width . 30)
+ (height . 30))))
+ (select-frame pabbrev-debug-frame)
+ (switch-to-buffer (pabbrev-debug-get-buffer)))))
+
+(defun pabbrev-debug-frame-scroll()
+ (save-excursion
+ (if pabbrev-debug-frame
+ (progn
+ (select-frame pabbrev-debug-frame)
+ (switch-to-buffer (pabbrev-debug-get-buffer))
+ (goto-char (point-max))))))
+
+;;(setq pabbrev-debug-display t)
+(defvar pabbrev-debug-display nil
+ "If t visible mark the progress of function `pabbrev-mode' through the
buffer.
+This looks very ugly. Note that this only shows newly added words. Use
+`pabbrev-debug-remove-properties' to clear this invisible markers. Use
+`pabbrev-debug-show-all-properties' to show existing markers.")
+
+(defun pabbrev-debug-display(start end)
+ (if pabbrev-debug-display
+ (overlay-put
+ (make-overlay start end)
+ 'face 'pabbrev-debug-display-label-face)))
+
+(defface pabbrev-debug-display-label-face
+ '((t
+ (:underline "navy")))
+ "Font Lock mode face used to highlight suggestions"
+ :group 'pabbrev)
+
+
+(defun pabbrev-debug-erase-all-overlays()
+ "Kill all visible overlays from the current buffer. "
+ (interactive)
+ (pabbrev-debug-remove-properties)
+ (mapcar
+ (lambda(overlay)
+ (if
+ (eq 'pabbrev-debug-display-label-face
+ (overlay-get overlay 'face))
+ (delete-overlay overlay)))
+ (overlays-in
+ (point-min) (point-max))))
+
+(defun pabbrev-debug-show-all-properties()
+ "Show all existing markers.
+This can be rather slow."
+ (interactive)
+ (goto-char (point-min))
+ (let ((on-mark-state nil)
+ (on-mark))
+ (while t
+ (progn
+ (setq on-mark (get-text-property (point) 'pabbrev-added))
+ (message "On line %s"
+ (count-lines (point-min) (point)))
+ (cond
+ ;; just moved onto marked area
+ ((and on-mark (not on-mark-state))
+ (setq on-mark-state (point)))
+ ;; just moved off a marked area
+ ((and on-mark-state (not on-mark))
+ (progn
+ (overlay-put
+ (make-overlay on-mark-state (point))
+ 'face 'underline)
+ (setq on-mark-state nil)))))
+ (forward-char))))
+
+(defun pabbrev-debug-restart-idle-timer()
+ "Kill and restart the idle timers."
+ (interactive)
+ (pabbrev-debug-kill-idle-timer)
+ (pabbrev-ensure-idle-timer))
+
+(defun pabbrev-debug-kill-idle-timer()
+ "Kill the idle timers.
+Toggling `pabbrev-mode' will tend to turn them on again, as
+will `pabbrev-debug-restart-idle-timer'."
+ (interactive)
+ (if pabbrev-short-idle-timer
+ (progn
+ (cancel-timer pabbrev-short-idle-timer)
+ (setq pabbrev-short-idle-timer nil)))
+ (if pabbrev-long-idle-timer
+ (progn
+ (cancel-timer pabbrev-long-idle-timer)
+ (setq pabbrev-long-idle-timer nil))))
+
+(defun pabbrev-debug-clear()
+ (pabbrev-debug-clear-all-hashes)
+ (pabbrev-debug-remove-properties))
+
+(defun pabbrev-debug-remove-properties()
+ "Remove all the `pabbrev-added' properties from the buffer.
+This means all the words in the buffer will be open for addition
+to the dictionary."
+ (interactive)
+ (remove-text-properties
+ (point-min)
+ (point-max)
+ '(pabbrev-added)))
+
+(defun pabbrev-debug-clear-hashes(&optional mode)
+ "Clear the dictionary for major mode MODE, or the current mode."
+ (interactive)
+ (if (not mode)
+ (setq mode major-mode))
+ (setq pabbrev-prefix-hash-modes
+ (delq mode pabbrev-prefix-hash-modes))
+ (setq pabbrev-usage-hash-modes
+ (delq mode pabbrev-usage-hash-modes))
+ ;; help the GC a bit..
+ (if (pabbrev-get-usage-hash)
+ (progn
+ (clrhash (pabbrev-get-usage-hash))
+ (put mode 'pabbrev-usage-hash nil)))
+ (if (pabbrev-get-prefix-hash)
+ (progn
+ (clrhash (pabbrev-get-prefix-hash))
+ (put mode 'pabbrev-get-prefix-hash nil))))
+
+(defun pabbrev-debug-clear-all-hashes()
+ "Clear all hashes for all modes."
+ (interactive)
+ (mapcar 'pabbrev-debug-clear-hashes pabbrev-prefix-hash-modes))
+
+(defun pabbrev-debug-print-hashes()
+ "Print the hashes for the current mode."
+ (interactive)
+ (let ((usage (pabbrev-get-usage-hash))
+ (prefix (pabbrev-get-prefix-hash)))
+ (switch-to-buffer
+ (get-buffer-create "*pabbrev hash*"))
+ (erase-buffer)
+ (if (not usage)
+ (insert "Usage hash nil"))
+ (insert "Usage hash size "
+ (number-to-string
+ (hash-table-count usage)) "\n")
+ (if (not prefix)
+ (insert "Prefix hash nil")
+ (insert "Prefix hash size "
+ (number-to-string
+ (hash-table-count prefix)) "\n"))
+ (insert "Usage hash:\n")
+ (pabbrev-debug-print-hash usage)
+ (insert "Prefix hash:\n")
+ (pabbrev-debug-print-hash prefix)))
+
+(defun pabbrev-debug-print-hash(hash)
+ "Pretty print a hash."
+ (if hash
+ (progn
+ (pp hash (current-buffer))
+ (insert "\n")
+ (insert (hash-table-count hash))
+ (insert "\n")
+ (maphash
+ (lambda(key value)
+ (insert (concat "KEY: " key "\n"))
+ (pp value (current-buffer)))
+ hash))))
+
+
+;; nobble pabbrev -- useful for profiling.
+;;
+;; nobble core data structures...
+;;(defun pabbrev-add-word(word))
+;;
+;; nobble text properties...
+;; (defun pabbrev-mark-add-word (bounds))
+
+
+
+;; Working.el hack. Use working.el if it's around, or don't if it's
+;; not.
+(eval-and-compile
+ (condition-case nil
+ (require 'working)
+ (error
+ (progn
+ (defmacro working-status-forms (message donestr &rest forms)
+ "Contain a block of code during which a working status is shown."
+ (list 'let (list (list 'msg message) (list 'dstr donestr)
+ '(ref1 0))
+ (cons 'progn forms)))
+
+ (defun working-status (&optional percent &rest args)
+ "Called within the macro `working-status-forms', show the status."
+ (message "%s%s" (apply 'format msg args)
+ (if (eq percent t) (concat "... " dstr)
+ (format "... %3d%%"
+ (or percent
+ (floor (* 100.0 (/ (float (point))
+ (point-max)))))))))
+
+ (defun working-dynamic-status (&optional number &rest args)
+ "Called within the macro `working-status-forms', show the status."
+ (message "%s%s" (apply 'format msg args)
+ (format "... %c" (aref [ ?- ?/ ?| ?\\ ] (% ref1 4))))
+ (setq ref1 (1+ ref1)))
+
+ (put 'working-status-forms 'lisp-indent-function 2)))))
+
+
+
+
+(provide 'pabbrev)
+;;; pabbrev.el ends here
