;;; expand-a-word.el --- expand-a-word
;;
;; Copyright (C) 2000,2001,2004,2005,2006 Peter Milliken
;;
;; Author: Peter Milliken peterm@resmed.com.au
;;                        peter.milliken@exemail.com.au
;;
;; $Date: 2007-07-02 07:41:09 +1000 (Mon, 02 Jul 2007) $
;; $Revision: 295 $
;; Keywords: word expansion completion
;;
;;
;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;; These functions will find the next, or previous occurrence of the word
;; that the cursor is currently positioned over.
;;
;; Find the beginning of the word, then search forward for the end of the
;; word, extract the word to 'target-string' then search forward for the
;; next occurrence of 'target-string'.
;;
;;; Installation
;; 1. Copy anywhere into your load path. Add the following to your .emacs file:
;;
;; (require 'expand-a-word)
;;
;; 2. Bind the command 'expand-a-word to some convenient key sequence
;;    i.e. I use <F2> on my keyboard.
;;
;; Usage: Invoke 'expand-a-word after typing some text, if there is a
;; single possible completion that will be done, if there are more
;; than one possibility, then the possibilities will be displayed in a
;; buffer and point positioned at the first possible choice. Navigate
;; up and down using the arrow keys (point wraps when it hits the top
;; or bottom), select the word at point using either the 's' key or
;; invoking the 'expand-a-word command again (convenient when you
;; don't want to move one hand in the process :-)).
;;
;; Use 'q' to quit from the command without making any completion.
;;
;;; Change Log:

;;; Code:

(defvar expand-menu-mode-map nil "")

(defvar expand-selected-text nil
  "This is the string selected by the user when multiple choices in the Expand
   word function are available")

;;
;; Make sure that all key-bindings that bind to the expansion command are
;; echoed in the menu selection keymap ie the user doesn't have to move his
;; fingers from the command that caused a menu pick list to be displayed.
;;
(defun enable-dups (command-to-search-out replacement-command)
  (let (abc)
    (setq abc (where-is-internal command-to-search-out))
    (while abc
      (progn
        (define-key expand-menu-mode-map (car abc) replacement-command)
        (setq abc (cdr abc))))))
;;
;; Block out forward and backward char motion.
;;
(defun expand-menu-block-movement ()
;;  [Documentation]
  (interactive)
  (let ()))

;;
;; Next line in the menu, wraps when moving past last line
;;
(defun expand-menu-previous-line ()
;;  [Documentation]
  (interactive)
  (let ((here (point)))
    (progn
      (if (not (= (point) (point-min)))
          (progn
            (backward-char)
            (beginning-of-line))
        (progn
          (goto-char (1- (point-max)))
          (beginning-of-line))))))

;;
;; Quit the menu pick list processing.
;;
(defun expand-menu-quit ()
  "Quit from the menu pick list."
  (interactive)
  (let ()
    (setq expand-selected-text nil)
    (exit-recursive-edit)))

;;
;; Next line in the menu, wraps when moving past last line
;;
(defun expand-menu-next-line ()
;;  [Documentation]
  (interactive)
  (let ((here (point)))
    (progn
      (end-of-line)
      (if (not (= (point) (1- (point-max))))
          (forward-char)
        (goto-char (point-min))))))


(defun expand-menu-select ()
  (interactive)
  (let (my-position)
    (end-of-line)
    (setq my-position (point))
    (beginning-of-line)
    (setq expand-selected-text (buffer-substring (point) my-position))
    (exit-recursive-edit)))

;
; This routine displays the list of possible matches for the expand-a-word
; function, it is not called unless there is more than one possible match
;
(defun expand-display (possible-matches)
  (let (my-buffer
        (oldbuf (current-buffer))
        (upper-window (selected-window))
        current-element
        lower-window
        temp-list)
    (save-window-excursion
      (save-excursion
        (setq expand-selected-text nil)
        (setq my-buffer (get-buffer-create "*Expand List*"))
        (set-buffer my-buffer)
        (erase-buffer)
        (setq possible-matches (sort possible-matches 'string<))
        (setq current-element (car possible-matches))
        (insert current-element)
        (newline)
        (setq temp-list possible-matches)
        (while (setq temp-list (cdr temp-list))
          (progn
            (insert (car temp-list))
            (newline)))
        (goto-char (point-min))
        ;; The call to split-window results in a return value which is the lower
        ;; of the two windows. Want to display the menu in the "upper" window,
        ;; so use variables appropriately.
        (setq lower-window (split-window (selected-window)))
        (set-window-buffer upper-window my-buffer)
        (shrink-window-if-larger-than-buffer upper-window)
        (select-window upper-window)
        (setq major-mode 'expand-display)
        (if (not expand-menu-mode-map)
            (expand-create-menu-keymap))
        (use-local-map expand-menu-mode-map)
        (setq mode-name "Expand mode")
        (recursive-edit)))))

(defun expand-create-menu-keymap ()
  (let ()
    (progn
      (if (not expand-menu-mode-map)
          (progn
            (setq expand-menu-mode-map (make-keymap))
            (suppress-keymap expand-menu-mode-map t)
            (define-key expand-menu-mode-map "q" 'expand-menu-quit)
            (define-key expand-menu-mode-map "Q" 'expand-menu-quit)
            (define-key expand-menu-mode-map "s" 'expand-menu-select)
            (define-key expand-menu-mode-map "S" 'expand-menu-select)
            (define-key expand-menu-mode-map " " 'next-line)
            (define-key expand-menu-mode-map "n" 'next-line)
            (define-key expand-menu-mode-map "N" 'next-line)
            (define-key expand-menu-mode-map "p" 'previous-line)
            (define-key expand-menu-mode-map "P" 'previous-line)
            (define-key expand-menu-mode-map "?" 'expand-menu-quit)
            (enable-dups 'expand-a-word 'expand-menu-select)
            (enable-dups 'next-line 'expand-menu-next-line)
            (enable-dups 'previous-line 'expand-menu-previous-line))))))

(defun expand-a-word (&optional search-this-list)
  "Expand the (partial) word located before point. Tries to
perform the expansion either using the current buffer contents or
an optional list of strings passed i.e. search-this-list"
  (interactive)
  (let ((target-string)
        (original-string)
        (start-of-string)
        (insert-position)
        (matched-string)
        (possible-matches)
        (case-search case-fold-search)
        (index 0)
        (search-limit)
        (result nil))
    ;; Only attempt an expansion if the preceding character is not whitespace
    (if (not (string-match "\\s-" (make-string 1 (preceding-char))))
        (progn
          (setq insert-position (point-marker))
          ;; Set up the search limit
          (beginning-of-line)
          (setq search-limit (point))
          (goto-char insert-position)
          ;; Set up the match-data - note that if the beginning of
          ;; line is matched then the matched-data set will be 1
          ;; element long rather than 2 i.e. there is no group 1.
          (re-search-backward "\\([^A-Za-z0-9_-]\\)\\|^" search-limit t)
          ;; Calculate where the match string starts - the difference
          ;; is if the beginning of line (^) was matched then the
          ;; calculation offset will differ
          (if (> (/ (length (match-data)) 2) 1)
              (setq start-of-string (+ (match-beginning 0) 1))
            (setq start-of-string (match-beginning 0)))

          (setq original-string (buffer-substring
                                 start-of-string
                                 (marker-position insert-position)))
          ;; check to see whether we should make the search case
          ;; sensitive i.e. follow the same rules as incremental
          ;; search, if there is an upper case character then make it
          ;; case-sensitive.
          (setq case-fold-search nil)
          (if (not (string-match "[A-Z]" original-string))
              ;; Search should not be case sensitive so change
              ;; case-fold-search back to it's original setting
              (setq case-fold-search case-search)
            ;; Otherwise leave it as a case sensitive search
            )

          ;;
          ;; Search for the target string, but make sure that the
          ;; target is at the start of a word, ie we don't want to
          ;; match the middle of a word!
          ;;
          (if search-this-list
              (progn
                ;; Build a regular expression from the target. There is an
                ;; assumption that when matching against a list of strings then
                ;; only strings that match at the beginning are candidates.
                (setq target-string (concat "^"
                                            original-string
                                            "[A-Za-z0-9_-]*"))
                ;; Search the list of elements passed into the defun
                ;; for possible matches.
                (while (< index (length search-this-list))
                  (progn
                    (if (string-match target-string (elt search-this-list index))
                        (setq possible-matches
                              (cons (elt search-this-list index) 
                                    possible-matches)))
                    (setq index (1+ index)))))
          
            (progn
              ;; Build the regular expression from the target.
              (setq target-string (concat "\\b"
                                          original-string
                                          "[A-Za-z0-9_-]*"))
              ;; search backwards and forwards in the current buffer
              (while (re-search-backward target-string nil t)
                (progn
                  (if (and (not (member (match-string 0) possible-matches))
                           (not (string= (match-string 0) original-string)))
                      (setq possible-matches
                            (cons (match-string 0) possible-matches)))))
              ;;
              ;; Search in both directions from point
              ;;
              (goto-char insert-position)
              (while (re-search-forward target-string nil t)
                (progn
                  (if (and (not (member (match-string 0) possible-matches))
                           (not (string= (match-string 0) original-string)))
                      (setq possible-matches
                            (cons (match-string 0) possible-matches)))))))
          ;;
          ;; Now test if anything was found, if not then just put back
          ;; the target-string
          ;;
          (cond ((= (length possible-matches) 0)
                 (setq matched-string original-string))
                ((> (length possible-matches) 1)
                 ;; If there are multiple choices then display a menu
                 ;; of all of the choices and allow the user to make a
                 ;; selection.
                 (progn
                   ;; Make sure we are positioned at the point where
                   ;; the search was started by the user.
                   (goto-char (marker-position insert-position))
                   (expand-display possible-matches)
                   (if expand-selected-text
                       (progn
                         (setq matched-string expand-selected-text)
                         (setq result t))
                     (setq matched-string original-string))))
                (t
                 ;; Must be exactly one match
                 (setq matched-string (car possible-matches))
                 (setq result t)))
          (goto-char (marker-position insert-position))
          (if (not (string= matched-string original-string))
              (progn
                (delete-region start-of-string (marker-position insert-position))
                (insert matched-string)))

          ;; Make sure that we reset the case-fold-search variable
          ;; back to entry conditions
          (setq case-fold-search case-search)))
    ;; Return the result of the match
    result))

(provide 'expand-a-word)

;;; expand-a-word.el ends here