emacs: lisp/hippie-exp.el comparison

comparison lisp/hippie-exp.el @ 49549:99be3a1e2589

Cygwin support patch.

author	Juanma Barranquero <lekktu@gmail.com>
date	Fri, 31 Jan 2003 15:24:20 +0000
parents	7308bbc423d5
children	695cf19ef79e d7ddb3e565de

comparison

equal deleted inserted replaced

-:8b1c605f8c9b
+:99be3a1e2589
 ;;; Commentary:
 ;;  `hippie-expand' is a single function for a lot of different kinds
 ;;  of completions and expansions.  Called repeatedly it tries all
 ;;  possible completions in succession.
 ;;  Which kinds of completions to try, and in which order, is
 ;;  determined by the contents of `hippie-expand-try-functions-list'.
 ;;  Much customization of `hippie-expand' can be made by changing the
 ;;  order of, removing, or inserting new functions in this list.
 ;;  Given a positive numeric argument, `hippie-expand' jumps directly
 ;;  which then gives the same behavior as the original `dabbrev-expand'.
 ;;  The variable `hippie-expand-dabbrev-as-symbol' controls whether
 ;;  characters of syntax '_' is considered part of the words to expand
 ;;  dynamically.
 ;;  See also the macro `make-hippie-expand-function' below.
 ;;
 ;;  A short description of the current try-functions in this file:
 ;;    `try-complete-file-name' : very convenient to have in any buffer,
 ;;      and not just in the minibuffer or (some) shell-mode.  It goes
 ;;      through all possible completions instead of just completing as
 ;;      much as is unique.
 ;;    `try-complete-file-name-partially' : To insert in the list just
 ;;      before `try-complete-file-name' for those who want first to get
 ;;      a file name completed only as many characters as is unique.
 ;;    `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
 ;;      Otherwise it looks through all abbrev-tables, starting with
 ;;      the local followed by the global.
 ;;    `try-expand-line' : Searches the buffer for an entire line that
 ;;      begins exactly as the current line.  Convenient sometimes, for
 ;;      example as a substitute for (or complement to) the history
 ;;      list in shell-like buffers.  At other times, only confusing.
 ;;    `try-expand-line-all-buffers' : Like `try-expand-line' but searches
 ;;      in all buffers (except the current).  (This may be a little
 ;;      slow, don't use it unless you are really fond of `hippie-expand'.)
 ;;    `try-expand-list' : Tries to expand the text back to the nearest
 ;;      open delimiter, to a whole list from the buffer. Convenient for
 ;;      example when writing lisp or TeX.
 ;;    `try-expand-list-all-buffers' : Like `try-expand-list' but searches
 ;;      in all buffers (except the current).
 ;;    `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
 ;;      course in a way compatible with the other try-functions).
 ;;    `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
 ;;      like `dabbrev-expand' but searches all Emacs buffers (except the
 ;;      current) for matching words.  (No, I don't find this one
 ;;      particularly slow.)
 ;;    `try-expand-dabbrev-visible': Searches the currently visible parts of
 ;;      all windows.  Can be put before `try-expand-dabbrev-all-buffers' to
 ;;      first try the expansions you can see.
 ;;    `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable
 ;;      completion of the word.  Good to have, just in case the word was not
 ;;      Might be tedious (usually a lot of possible completions) and
 ;;      since its function is much like `lisp-complete-symbol', which
 ;;      already has a key of its own, you might want to remove this.
 ;;    `try-complete-lisp-symbol-partially' : To insert in the list just
 ;;      before `try-complete-lisp-symbol' for those who first want to get
 ;;      completion of what is unique in the name.
 ;;
 ;;  Not all of the above functions are by default in
 ;;  `hippie-expand-try-functions-list'.  This variable is better set
 ;;  in ".emacs" to make `hippie-expand' behave maximally convenient
 ;;  according to personal taste.  Also, instead of loading the
 ;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
 ;;      to the expansion is ok if that is enabled in the buffer.)
 ;;    `he-reset-string' : Resets the initialized region to its original
 ;;      contents.
 ;;  There is also a variable: `he-tried-table' which is meant to contain
 ;;  all tried expansions so far.  The try-function can check this
 ;;  variable to see whether an expansion has already been tried
 ;;  (hint: `he-string-member').
 ;;
 ;;  Known bugs
 ;;
 ;;  It may happen that some completion suggestion occurs twice, in
 ;;  spite of the use of `he-tried-table' to prevent that.  This is
 ;;  because different try-functions may try to complete different
 ;;  lengths of text, and thus put different amounts of the
 ;;  text in `he-tried-table'.  Anyway this seems to occur seldom enough
 ;;  not to be too disturbing.  Also it should NOT be possible for the
 ;;  opposite situation to occur, that `hippie-expand' misses some
 (defun hippie-expand (arg)
 "Try to expand text before point, using multiple methods.
 The expansion functions in `hippie-expand-try-functions-list' are
 tried in order, until a possible expansion is found.  Repeated
 application of `hippie-expand' inserts successively possible
 expansions.
 With a positive numeric argument, jumps directly to the ARG next
 function in this list.  With a negative argument or just \\[universal-argument],
 undoes the expansion."
 (interactive "P")
 (if (or (not arg)
 	  (and (integerp arg) (> arg 0)))
 (let ((first (or (= he-num -1)
 		       (not (equal this-command last-command)))))
 	(if first
 	    (progn
 	(if arg
 	    (if (not first) (he-reset-string))
 	    (setq arg 0))
 	(let ((i (max (+ he-num arg) 0)))
 	  (while (not (or (>= i (length hippie-expand-try-functions-list))
 			  (apply (nth i hippie-expand-try-functions-list)
 				 (list (= he-num i)))))
 	    (setq i (1+ i)))
 	  (setq he-num i))
 	(if (>= he-num (length hippie-expand-try-functions-list))
 	    (progn
 (insert he-search-string)
 (delete-region (point) he-string-end)
 (goto-char newpos)))
 ;; Substitutes an expansion STR into the correct region (the region
 ;; initialized with `he-init-string').
 ;; An optional argument TRANS-CASE means that it is ok to transfer case
 ;; from the abbreviation to the expansion if that is possible, and is
 ;; enabled in the buffer.
 (defun he-substitute-string (str &optional trans-case)
 (let ((trans-case (and trans-case
 ;;                             '(try-complete-file-name-partially
 ;;                               try-complete-file-name)))
 ;;    (fset 'my-complete-line (make-hippie-expand-function
 ;;                             '(try-expand-line
 ;;                               try-expand-line-all-buffers)))
 ;;
 ;;;###autoload
 (defmacro make-hippie-expand-function (try-list &optional verbose)
 "Construct a function similar to `hippie-expand'.
 Make it use the expansion functions in TRY-LIST.  An optional second
 argument VERBOSE non-nil makes the function verbose."
 `(function (lambda (arg)
 ,(concat
 "Try to expand text before point, using the following functions: \n"
 (mapconcat 'prin1-to-string (eval try-list) ", "))
 (interactive "P")
 (let ((hippie-expand-try-functions-list ,try-list)
 (hippie-expand-verbose ,verbose))
 "Try to complete text as a file name.
 The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible completions of the same
 string).  It returns t if a new completion is found, nil otherwise."
 (if (not old)
 (progn
 	(he-init-string (he-file-name-beg) (point))
 	(let ((name-part (he-file-name-nondirectory he-search-string))
 	      (dir-part (expand-file-name (or (he-file-name-directory
 					       he-search-string) ""))))
 	  (if (not (he-string-member name-part he-tried-table))
 	      (setq he-tried-table (cons name-part he-tried-table)))
 	  (if (and (not (equal he-search-string ""))
 		   (he-file-directory-p dir-part))
 	      (setq he-expand-list (sort (file-name-all-completions
 					  name-part
 					  dir-part)
 					 'string-lessp))
 	      (setq he-expand-list ())))))
 	t)))
 (defun try-complete-file-name-partially (old)
 "Try to complete text as a file name, as many characters as unique.
 The argument OLD has to be nil the first call of this function.  It
 returns t if a unique, possibly partial, completion is found, nil
 otherwise."
 (let ((expansion ()))
 (if (not old)
 	(progn
 	  (he-init-string (he-file-name-beg) (point))
 	  (let ((name-part (he-file-name-nondirectory he-search-string))
 		(dir-part (expand-file-name (or (he-file-name-directory
 						 he-search-string) ""))))
 	    (if (and (not (equal he-search-string ""))
 	  t))))
 (defvar he-file-name-chars
 (cond ((memq system-type '(vax-vms axp-vms))
 	 "-a-zA-Z0-9_/.,~^#$+=:\\[\\]")
-	((memq system-type '(ms-dos windows-nt))
+	((memq system-type '(ms-dos windows-nt cygwin))
 	 "-a-zA-Z0-9_/.,~^#$+=:\\\\")
 	(t			    ;; More strange file formats ?
 	 "-a-zA-Z0-9_/.,~^#$+="))
 "Characters that are considered part of the file name to expand.")
 (if (> (skip-syntax-backward "w") 0)  ;; No words with non-file chars
 	  op
 	(point)))))
 ;; Thanks go to Richard Levitte <levitte@e.kth.se> who helped to make these
 ;; work under VMS, and to David Hughes <ukchugd@ukpmr.cs.philips.nl> who
 ;; helped to make it work on PC.
 (defun he-file-name-nondirectory (file)
 "Fix to make `file-name-nondirectory' work for hippie-expand under VMS."
 (if (memq system-type '(axp-vms vax-vms))
 (let ((n (file-name-nondirectory file)))
 "Fix to make `file-directory-p' work for hippie-expand under VMS."
 (if (memq system-type '(vax-vms axp-vms))
 (or (file-directory-p file)
 	  (file-directory-p (concat file "[000000]")))
 (file-directory-p file)))
 (defun he-concat-directory-file-name (dir-part name-part)
 "Try to slam together two parts of a file specification, system dependently."
 (cond ((null dir-part) name-part)
 	((memq system-type '(axp-vms vax-vms))
 	 (if (and (string= (substring dir-part -1) "]")
 	 (if (and (string-match "\\\\" dir-part)
 		  (not (string-match "/" dir-part))
 		  (= (aref name-part (1- (length name-part))) ?/))
 	     (aset name-part (1- (length name-part)) ?\\))
 	 (concat dir-part name-part))
 	(t
 	 (concat dir-part name-part))))
 (defun try-complete-lisp-symbol (old)
 "Try to complete word as an Emacs Lisp symbol.
 The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible completions of the same
 string).  It returns t if a new completion is found, nil otherwise."
 (if (not old)
 (progn
 	(he-init-string (he-lisp-symbol-beg) (point))
 	(if (not (he-string-member he-search-string he-tried-table))
 	    (setq he-tried-table (cons he-search-string he-tried-table)))
 	(setq he-expand-list
 	      (and (not (equal he-search-string ""))
 		   (sort (all-completions he-search-string obarray
 					  (function (lambda (sym)
 					    (or (boundp sym)
 						(fboundp sym)
 	t)))
 (defun try-complete-lisp-symbol-partially (old)
 "Try to complete as an Emacs Lisp symbol, as many characters as unique.
 The argument OLD has to be nil the first call of this function.  It
 returns t if a unique, possibly partial, completion is found, nil
 otherwise."
 (let ((expansion ()))
 (if (not old)
 	(progn
 	  (he-init-string (he-lisp-symbol-beg) (point))
 	  (if (not (string= he-search-string ""))
 	      (setq expansion
 		    (try-completion he-search-string obarray
 				    (function (lambda (sym)
 				      (or (boundp sym)
 					  (fboundp sym)
 					  (symbol-plist sym)))))))
 	  (save-restriction
 	    (if hippie-expand-no-restriction
 		(widen))
 	    ;; Try looking backward unless inhibited.
 	    (if he-search-bw
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-line-search he-search-string
 						  strip-prompt t))
 		  (set-marker he-search-loc (point))
 		  (if (not expansion)
 		      (progn
 			(set-marker he-search-loc he-string-end)
 			(setq he-search-bw ())))))
 	    (if (not expansion) ; Then look forward.
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-line-search he-search-string
 						  strip-prompt nil))
 		  (set-marker he-search-loc (point)))))))
 (if (not expansion)
 	(progn
 	  (setq he-search-bufs (buffer-list))
 	  (setq he-searched-n-bufs 0)
 	  (set-marker he-search-loc 1 (car he-search-bufs))))
 (if (not (equal he-search-string ""))
 	(while (and he-search-bufs
 		    (not expansion)
 		    (or (not hippie-expand-max-buffers)
 			(< he-searched-n-bufs hippie-expand-max-buffers)))
 	  (set-buffer (car he-search-bufs))
 	  (if (and (not (eq (current-buffer) buf))
 		      (widen))
 		  (goto-char he-search-loc)
 		  (setq strip-prompt (and (get-buffer-process (current-buffer))
 					  comint-use-prompt-regexp-instead-of-fields
 					  comint-prompt-regexp))
 		  (setq expansion
 			(let ((case-fold-search orig-case-fold-search))
 			  (he-line-search he-search-string
 					  strip-prompt nil)))
 		  (set-marker he-search-loc (point))
 		  (if (not expansion)
 	  ())
 	(progn
 	  (he-substitute-string expansion t)
 	  t))))
 (defun he-line-search (str strip-prompt reverse)
 (let ((result ()))
 (while (and (not result)
 		(if reverse
 		    (re-search-backward
 		     (he-line-search-regexp str strip-prompt)
 		     nil t)
 		    (re-search-forward
 		     (he-line-search-regexp str strip-prompt)
 		     nil t)))
 	  (setq result nil)))		    ; if already in table, ignore
 result))
 (defun he-line-beg (strip-prompt)
 (save-excursion
 (if (re-search-backward (he-line-search-regexp "" strip-prompt)
 			    (save-excursion (beginning-of-line)
 					    (point)) t)
 	(match-beginning 2)
 (point))))
 (defun he-line-search-regexp (pat strip-prompt)
 (if strip-prompt
 (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
 	      (regexp-quote pat)
 	      "[^\n]*[^ \t\n]\\)")
 (concat "^\\(\\s-*\\)\\("
 	      (regexp-quote pat)
 	      "[^\n]*[^ \t\n]\\)")))
 (defun try-expand-list (old)
 "Try to complete the current beginning of a list.
 	  (save-restriction
 	    (if hippie-expand-no-restriction
 		(widen))
 	    ;; Try looking backward unless inhibited.
 	    (if he-search-bw
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-list-search he-search-string t))
 		  (set-marker he-search-loc (point))
 		  (if (not expansion)
 		      (progn
 			(set-marker he-search-loc he-string-end)
 			(setq he-search-bw ())))))
 	    (if (not expansion) ; Then look forward.
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-list-search he-search-string nil))
 		  (set-marker he-search-loc (point)))))))
 (if (not expansion)
 	  (setq he-search-bufs (buffer-list))
 	  (setq he-searched-n-bufs 0)
 	  (set-marker he-search-loc 1 (car he-search-bufs))))
 (if (not (equal he-search-string ""))
 	(while (and he-search-bufs
 		    (not expansion)
 		    (or (not hippie-expand-max-buffers)
 			(< he-searched-n-bufs hippie-expand-max-buffers)))
 	  (set-buffer (car he-search-bufs))
 	  (if (and (not (eq (current-buffer) buf))
 	      (save-excursion
 		(save-restriction
 		  (if hippie-expand-no-restriction
 		      (widen))
 		  (goto-char he-search-loc)
 		  (setq expansion
 			(let ((case-fold-search orig-case-fold-search))
 			  (he-list-search he-search-string nil)))
 		  (set-marker he-search-loc (point))
 		  (if (not expansion)
 		      (progn
 	  ())
 	(progn
 	  (he-substitute-string expansion t)
 	  t))))
 (defun he-list-search (str reverse)
 (let ((result ())
 	beg pos err)
 (while (and (not result)
 		(if reverse
 		    (search-backward str nil t)
 (goto-char beg)
 (setq err ())
 (condition-case ()
 	  (forward-list 1)
 	(error (setq err t)))
 (if (and reverse
 	       (> (point) he-string-beg))
 	  (setq err t))
 (if (not err)
 	  (progn
 	    (setq result (buffer-substring-no-properties beg (point)))
 for subsequent calls (for further possible expansions of the same
 string).  It returns t if a new expansion is found, nil otherwise."
 (if (not old)
 (progn
 	(he-init-string (he-dabbrev-beg) (point))
 	(setq he-expand-list
 	      (and (not (equal he-search-string ""))
 		   (mapcar (function (lambda (sym)
 			     (if (and (boundp sym) (vectorp (eval sym)))
 				 (abbrev-expansion (downcase he-search-string)
 						   (eval sym)))))
 			   (append '(local-abbrev-table
 				     global-abbrev-table)
 				   abbrev-table-name-list))))))
 (while (and he-expand-list
 	      (or (not (car he-expand-list))
 		  (he-string-member (car he-expand-list) he-tried-table t)))
 	  (save-restriction
 	    (if hippie-expand-no-restriction
 		(widen))
 	    ;; Try looking backward unless inhibited.
 	    (if he-search-bw
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-dabbrev-search he-search-string t))
 		  (set-marker he-search-loc (point))
 		  (if (not expansion)
 		      (progn
 			(set-marker he-search-loc he-string-end)
 			(setq he-search-bw ())))))
 	    (if (not expansion) ; Then look forward.
 		(progn
 		  (goto-char he-search-loc)
 		  (setq expansion (he-dabbrev-search he-search-string nil))
 		  (set-marker he-search-loc (point)))))))
 (if (not expansion)
 	(progn
 	  (if old (he-reset-string))
 	  ())
 	(progn
 	  (setq he-search-bufs (buffer-list))
 	  (setq he-searched-n-bufs 0)
 	  (set-marker he-search-loc 1 (car he-search-bufs))))
 (if (not (equal he-search-string ""))
 	(while (and he-search-bufs
 		    (not expansion)
 		    (or (not hippie-expand-max-buffers)
 			(< he-searched-n-bufs hippie-expand-max-buffers)))
 	  (set-buffer (car he-search-bufs))
 	  (if (and (not (eq (current-buffer) buf))
 		 (eq (marker-position he-string-beg) (match-beginning 0)))
 	    (setq expansion (he-dabbrev-search he-search-string ()
 					       (window-end he-search-window))))
 	(set-marker he-search-loc (point) (current-buffer)))
 (if (not expansion)
 	  (progn
 	    (setq he-search-window (next-window he-search-window nil flag))
 	    (if (eq he-search-window (selected-window))
 		(set-marker he-search-loc nil)
 	      (set-marker he-search-loc (window-start he-search-window)
 			  (window-buffer he-search-window))))))
 (set-buffer buf)
 (if (not expansion)
 	(progn
 	  (if old (he-reset-string))
 	  ())
 		      ((eq (char-syntax (aref pattern 0)) ?_)
 		       (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))
 		      (t
 		       (concat "\\<" (regexp-quote pattern)
 			       "\\(\\sw\\|\\s_\\)+")))))
 (while (and (not result)
 		(if reverse
 		     (re-search-backward regpat limit t)
 		     (re-search-forward regpat limit t)))
 (setq result (buffer-substring-no-properties (match-beginning 0)
 						   (match-end 0)))
 The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible completions of the same
 string).  It returns t if a new completion is found, nil otherwise."
 (let ((expansion ()))
 (if (not old)
 	(progn
 	  (he-init-string (he-dabbrev-beg) (point))
 	  (setq he-expand-list
 		(if (not (equal he-search-string ""))
 		    kill-ring))
 	  (setq he-search-loc2 0)))
 		       (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))
 		      (t
 		       (concat "\\<" (regexp-quote pattern)
 			       "\\(\\sw\\|\\s_\\)+"))))
 	(killstr (car he-expand-list)))
 (while (and (not result)
 		he-expand-list)
 (while (and (not result)
 		  (string-match regpat killstr he-search-loc2))
 	(setq result (substring killstr (match-beginning 0) (match-end 0)))
 	(set-text-properties 0 (length result) () result)
 		     (> (match-beginning 0) 0)
 		     (memq (char-syntax (aref killstr (1- (match-beginning 0))))
 			   '(?_ ?w)))
 		(he-string-member result he-tried-table t))
 	    (setq result nil)))     ; ignore if bad prefix or already in table
 (if (and (not result)
 		he-expand-list)
 	  (progn
 	    (setq he-expand-list (cdr he-expand-list))
 	    (setq killstr (car he-expand-list))
 	    (setq he-search-loc2 0))))
 result))
 (defun try-expand-whole-kill (old)
 The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible completions of the same
 string).  It returns t if a new completion is found, nil otherwise."
 (let ((expansion ()))
 (if (not old)
 	(progn
 	  (he-init-string (he-kill-beg) (point))
 	  (if (not (he-string-member he-search-string he-tried-table))
 	      (setq he-tried-table (cons he-search-string he-tried-table)))
 	  (setq he-expand-list
 		(if (not (equal he-search-string ""))
 		    kill-ring))
 	  (setq he-search-loc2 ())))
 (if (not (equal he-search-string ""))
 	(setq expansion (he-whole-kill-search he-search-string)))
 		 (he-string-member result he-tried-table))
 	    (setq result nil)))     ; ignore if already in table
 (if (and (not result)
 		he-expand-list)
 	  (progn
 	    (setq he-expand-list (cdr he-expand-list))
 	    (setq killstr (car he-expand-list))
 	    (setq pos -1))))
 result))
 (defun he-kill-beg ()

Mercurial > emacs

comparison lisp/hippie-exp.el @ 49549:99be3a1e2589