Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

328 lines (307 sloc) 13.349 kb
;;; 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
Jump to Line
Something went wrong with that request. Please try again.