guile feature
[bpt/emacs.git] / lisp / hippie-exp.el
index 49d7754..ec6007e 100644 (file)
@@ -1,19 +1,18 @@
 ;;; hippie-exp.el --- expand text trying various ways to find its expansion
 
-;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2014 Free Software Foundation, Inc.
 
 ;; Author: Anders Holst <aho@sans.kth.se>
-;; Last change: 3 March 1998
+;; Maintainer: emacs-devel@gnu.org
 ;; Version: 1.6
 ;; Keywords: abbrev convenience
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -21,9 +20,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -82,8 +79,8 @@
 ;;      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.
+;;      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
 ;;  variable with all kinds of try-functions above, it might be an
 ;;  idea to use `make-hippie-expand-function' to construct different
 ;;  `hippie-expand'-like functions, with different try-lists and bound
-;;  to different keys. It is also possible to make
+;;  to different keys.  It is also possible to make
 ;;  `hippie-expand-try-functions-list' a buffer local variable, and
 ;;  let it depend on the mode (by setting it in the mode-hooks).
 ;;
 ;;  opposite situation to occur, that `hippie-expand' misses some
 ;;  suggestion because it thinks it has already tried it.
 ;;
-;;  Acknowledgement
+;;  Acknowledgment
 ;;
 ;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
 ;;  of this function took form.
 
 ;;; Code:
 
-(eval-when-compile (require 'comint))
+(require 'comint)
 
 (defgroup hippie-expand nil
   "Expand text trying various ways to find its expansion."
 
 (defvar he-search-window ())
 
+;;; Autoloaded for historical reasons (bug#12982)
 ;;;###autoload
 (defcustom hippie-expand-try-functions-list
   '(try-complete-file-name-partially
@@ -220,49 +218,42 @@ or insert functions in this list."
   :type '(repeat function)
   :group 'hippie-expand)
 
-;;;###autoload
 (defcustom hippie-expand-verbose t
-  "*Non-nil makes `hippie-expand' output which function it is trying."
+  "Non-nil makes `hippie-expand' output which function it is trying."
   :type 'boolean
   :group 'hippie-expand)
 
-;;;###autoload
 (defcustom hippie-expand-dabbrev-skip-space nil
-  "*Non-nil means tolerate trailing spaces in the abbreviation to expand."
+  "Non-nil means tolerate trailing spaces in the abbreviation to expand."
   :group 'hippie-expand
   :type 'boolean)
 
-;;;###autoload
 (defcustom hippie-expand-dabbrev-as-symbol t
-  "*Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
+  "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter."
   :group 'hippie-expand
   :type 'boolean)
 
-;;;###autoload
 (defcustom hippie-expand-no-restriction t
-  "*Non-nil means that narrowed buffers are widened during search."
+  "Non-nil means that narrowed buffers are widened during search."
   :group 'hippie-expand
   :type 'boolean)
 
-;;;###autoload
 (defcustom hippie-expand-max-buffers ()
-  "*The maximum number of buffers (apart from the current) searched.
+  "The maximum number of buffers (apart from the current) searched.
 If nil, all buffers are searched."
   :type '(choice (const :tag "All" nil)
                 integer)
   :group 'hippie-expand)
 
-;;;###autoload
 (defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
-  "*A list specifying which buffers not to search (if not current).
+  "A list specifying which buffers not to search (if not current).
 Can contain both regexps matching buffer names (as strings) and major modes
 \(as atoms)"
   :type '(repeat (choice regexp (symbol :tag "Major Mode")))
   :group 'hippie-expand)
 
-;;;###autoload
 (defcustom hippie-expand-only-buffers ()
-  "*A list specifying the only buffers to search (in addition to current).
+  "A list specifying the only buffers to search (in addition to current).
 Can contain both regexps matching buffer names (as strings) and major modes
 \(as atoms).  If non-nil, this variable overrides the variable
 `hippie-expand-ignore-buffers'."
@@ -305,7 +296,7 @@ undoes the expansion."
                  (message "No further expansions found"))
              (ding))
            (if (and hippie-expand-verbose
-                    (not (window-minibuffer-p (selected-window))))
+                    (not (window-minibuffer-p)))
                (message "Using %s"
                         (nth he-num hippie-expand-try-functions-list)))))
       (if (and (>= he-num 0)
@@ -314,7 +305,7 @@ undoes the expansion."
            (setq he-num -1)
            (he-reset-string)
            (if (and hippie-expand-verbose
-                    (not (window-minibuffer-p (selected-window))))
+                    (not (window-minibuffer-p)))
                (message "Undoing expansions"))))))
 
 ;; Initializes the region to expand (to between BEG and END).
@@ -394,7 +385,7 @@ undoes the expansion."
              lst)))
 
 ;; Check if current buffer matches any atom or regexp in LST.
-;; Atoms are interpreted as major modes, strings as regexps mathing the name.
+;; Atoms are interpreted as major modes, strings as regexps matching the name.
 (defun he-buffer-member (lst)
   (or (memq major-mode lst)
       (progn
@@ -441,13 +432,13 @@ 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
+       (let ((name-part (file-name-nondirectory he-search-string))
+             (dir-part (expand-file-name (or (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))
+                  (file-directory-p dir-part))
              (setq he-expand-list (sort (file-name-all-completions
                                          name-part
                                          dir-part)
@@ -462,7 +453,7 @@ string).  It returns t if a new completion is found, nil otherwise."
        (if old (he-reset-string))
        ())
       (let ((filename (he-concat-directory-file-name
-                      (he-file-name-directory he-search-string)
+                      (file-name-directory he-search-string)
                       (car he-expand-list))))
        (he-substitute-string filename)
        (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
@@ -478,11 +469,11 @@ 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
+         (let ((name-part (file-name-nondirectory he-search-string))
+               (dir-part (expand-file-name (or (file-name-directory
                                                 he-search-string) ""))))
            (if (and (not (equal he-search-string ""))
-                    (he-file-directory-p dir-part))
+                    (file-directory-p dir-part))
                (setq expansion (file-name-completion name-part
                                                      dir-part)))
            (if (or (eq expansion t)
@@ -495,16 +486,14 @@ otherwise."
          (if old (he-reset-string))
          ())
        (let ((filename (he-concat-directory-file-name
-                        (he-file-name-directory he-search-string)
+                        (file-name-directory he-search-string)
                         expansion)))
          (he-substitute-string filename)
          (setq he-tried-table (cons expansion (cdr he-tried-table)))
          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 cygwin))
+  (cond ((memq system-type '(ms-dos windows-nt cygwin))
         "-a-zA-Z0-9_/.,~^#$+=:\\\\")
        (t                          ;; More strange file formats ?
         "-a-zA-Z0-9_/.,~^#$+="))
@@ -518,44 +507,12 @@ otherwise."
          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
+;; Thanks go 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)))
-       (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
-           (concat "[." (substring n (match-beginning 2) (match-end 2)))
-         n))
-    (file-name-nondirectory file)))
-
-(defun he-file-name-directory (file)
-  "Fix to make `file-name-directory' work for hippie-expand under VMS."
-  (if (memq system-type '(axp-vms vax-vms))
-      (let ((n (file-name-nondirectory file))
-           (d (file-name-directory file)))
-       (if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
-           (concat d (substring n (match-beginning 1) (match-end 1)) "]")
-         d))
-    (file-name-directory file)))
-
-(defun he-file-directory-p (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) "]")
-                 (string= (substring name-part 0 2) "[."))
-            (concat (substring dir-part 0 -1) (substring name-part 1))
-          (concat dir-part name-part)))
-       ((memq system-type '(ms-dos w32))
+       ((eq system-type 'ms-dos)
         (if (and (string-match "\\\\" dir-part)
                  (not (string-match "/" dir-part))
                  (= (aref name-part (1- (length name-part))) ?/))
@@ -680,15 +637,27 @@ string).  It returns t if a new completion is found, nil otherwise."
 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."
+  (he--all-buffers
+   old
+   (lambda () (he-line-beg (and (get-buffer-process (current-buffer))
+                           comint-use-prompt-regexp
+                           comint-prompt-regexp)))
+   (lambda (string)
+     (he-line-search string
+                     (and (get-buffer-process (current-buffer))
+                          comint-use-prompt-regexp
+                          comint-prompt-regexp)
+                     nil))))
+
+(defun he--all-buffers (old beg-function search-function)
   (let ((expansion ())
-       (strip-prompt (and (get-buffer-process (current-buffer))
-                          comint-use-prompt-regexp
-                          comint-prompt-regexp))
-       (buf (current-buffer))
-       (orig-case-fold-search case-fold-search))
+        (buf (current-buffer))
+        (only-buffers hippie-expand-only-buffers)
+        (ignore-buffers hippie-expand-ignore-buffers)
+        (orig-case-fold-search case-fold-search))
     (if (not old)
-       (progn
-         (he-init-string (he-line-beg strip-prompt) (point))
+        (progn
+         (he-init-string (funcall beg-function) (point))
          (setq he-search-bufs (buffer-list))
          (setq he-searched-n-bufs 0)
          (set-marker he-search-loc 1 (car he-search-bufs))))
@@ -697,24 +666,20 @@ string).  It returns t if a new completion is found, nil otherwise."
        (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))
-                  (if hippie-expand-only-buffers
-                      (he-buffer-member hippie-expand-only-buffers)
-                    (not (he-buffer-member hippie-expand-ignore-buffers))))
-             (save-excursion
-               (save-restriction
-                 (if hippie-expand-no-restriction
+                        (< he-searched-n-bufs hippie-expand-max-buffers)))
+          (set-buffer (car he-search-bufs))
+          (if (and (not (eq (current-buffer) buf))
+                   (if only-buffers
+                       (he-buffer-member only-buffers)
+                     (not (he-buffer-member ignore-buffers))))
+              (save-excursion
+                (save-restriction
+                  (if hippie-expand-no-restriction
                      (widen))
                  (goto-char he-search-loc)
-                 (setq strip-prompt (and (get-buffer-process (current-buffer))
-                                         comint-use-prompt-regexp
-                                         comint-prompt-regexp))
                  (setq expansion
                        (let ((case-fold-search orig-case-fold-search))
-                         (he-line-search he-search-string
-                                         strip-prompt nil)))
+                         (funcall search-function he-search-string)))
                  (set-marker he-search-loc (point))
                  (if (not expansion)
                      (progn
@@ -729,9 +694,9 @@ string).  It returns t if a new completion is found, nil otherwise."
        (progn
          (if old (he-reset-string))
          ())
-       (progn
-         (he-substitute-string expansion t)
-         t))))
+      (progn
+        (he-substitute-string expansion t)
+        t))))
 
 (defun he-line-search (str strip-prompt reverse)
   (let ((result ()))
@@ -752,14 +717,13 @@ string).  It returns t if a new completion is found, nil otherwise."
 (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)
+                           (line-beginning-position) t)
        (match-beginning 2)
       (point))))
 
 (defun he-line-search-regexp (pat strip-prompt)
   (if strip-prompt
-      (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
+      (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(?2:"
              (regexp-quote pat)
              "[^\n]*[^ \t\n]\\)")
       (concat "^\\(\\s-*\\)\\("
@@ -813,53 +777,9 @@ string).  It returns t if a new completion is found, nil otherwise."
 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 ())
-       (buf (current-buffer))
-       (orig-case-fold-search case-fold-search))
-    (if (not old)
-       (progn
-         (he-init-string (he-list-beg) (point))
-         (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))
-                  (if hippie-expand-only-buffers
-                      (he-buffer-member hippie-expand-only-buffers)
-                    (not (he-buffer-member hippie-expand-ignore-buffers))))
-             (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
-                       (setq he-search-bufs (cdr he-search-bufs))
-                       (setq he-searched-n-bufs (1+ he-searched-n-bufs))
-                       (set-marker he-search-loc 1 (car he-search-bufs))))))
-           (setq he-search-bufs (cdr he-search-bufs))
-           (set-marker he-search-loc 1 (car he-search-bufs)))))
-
-    (set-buffer buf)
-    (if (not expansion)
-       (progn
-         (if old (he-reset-string))
-         ())
-       (progn
-         (he-substitute-string expansion t)
-         t))))
+  (he--all-buffers old #'he-list-beg #'he-list-search))
 
-(defun he-list-search (str reverse)
+(defun he-list-search (str &optional reverse)
   (let ((result ())
        beg pos err)
     (while (and (not result)
@@ -964,55 +884,11 @@ string).  It returns t if a new expansion is found, nil otherwise."
          t))))
 
 (defun try-expand-dabbrev-all-buffers (old)
-  "Tries to expand word \"dynamically\", searching all other buffers.
+  "Try to expand word \"dynamically\", searching all other buffers.
 The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible expansions of the same
 string).  It returns t if a new expansion is found, nil otherwise."
-  (let ((expansion ())
-       (buf (current-buffer))
-       (orig-case-fold-search case-fold-search))
-    (if (not old)
-       (progn
-         (he-init-string (he-dabbrev-beg) (point))
-         (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))
-                  (if hippie-expand-only-buffers
-                      (he-buffer-member hippie-expand-only-buffers)
-                    (not (he-buffer-member hippie-expand-ignore-buffers))))
-             (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-dabbrev-search he-search-string nil)))
-                 (set-marker he-search-loc (point))
-                 (if (not expansion)
-                     (progn
-                       (setq he-search-bufs (cdr he-search-bufs))
-                       (setq he-searched-n-bufs (1+ he-searched-n-bufs))
-                       (set-marker he-search-loc 1 (car he-search-bufs))))))
-           (setq he-search-bufs (cdr he-search-bufs))
-           (set-marker he-search-loc 1 (car he-search-bufs)))))
-
-    (set-buffer buf)
-    (if (not expansion)
-       (progn
-         (if old (he-reset-string))
-         ())
-       (progn
-         (he-substitute-string expansion t)
-         t))))
+  (he--all-buffers old #'he-dabbrev-beg #'he-dabbrev-search))
 
 ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
 ;; suggested this one.
@@ -1022,40 +898,37 @@ The argument OLD has to be nil the first call of this function, and t
 for subsequent calls (for further possible expansions of the same
 string).  It returns t if a new expansion is found, nil otherwise."
   (let ((expansion ())
-       (buf (current-buffer))
-       (flag (if (frame-visible-p (window-frame (selected-window)))
+       (flag (if (frame-visible-p (window-frame))
                  'visible t)))
-    (if (not old)
-       (progn
-          (he-init-string (he-dabbrev-beg) (point))
-          (setq he-search-window (selected-window))
-          (set-marker he-search-loc
-                      (window-start he-search-window)
-                      (window-buffer he-search-window))))
+    (unless old
+      (he-init-string (he-dabbrev-beg) (point))
+      (setq he-search-window (selected-window))
+      (set-marker he-search-loc
+                  (window-start he-search-window)
+                  (window-buffer he-search-window)))
 
     (while (and (not (equal he-search-string ""))
-               (marker-position he-search-loc)
-               (not expansion))
-      (save-excursion
-       (set-buffer (marker-buffer he-search-loc))
-       (goto-char he-search-loc)
-       (setq expansion (he-dabbrev-search he-search-string ()
-                                          (window-end he-search-window)))
-       (if (and expansion
-                (eq (marker-buffer he-string-beg) (current-buffer))
-                (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))))))
+                (marker-position he-search-loc)
+                (not expansion))
+      (with-current-buffer (marker-buffer he-search-loc)
+        (save-excursion
+          (goto-char he-search-loc)
+          (setq expansion (he-dabbrev-search he-search-string ()
+                                             (window-end he-search-window)))
+          (if (and expansion
+                   (eq (marker-buffer he-string-beg) (current-buffer))
+                   (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))))
+      (unless expansion
+        (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))
@@ -1223,5 +1096,4 @@ string).  It returns t if a new completion is found, nil otherwise."
 
 (provide 'hippie-exp)
 
-;;; arch-tag: 5e6e00bf-b061-4a7a-9b46-de0ae105ab99
 ;;; hippie-exp.el ends here