;; -*- mode: emacs-lisp; unibyte: t; -*-
;; ekcomplete.el --- Changes include environment variables
;; Copyright (C) 1998-2000  Ehud karni <ehud@unix.simonwiesel.co.il>

;; This file is NOT part of GNU Emacs, distribution conditions below.
;;
;;              EHUD   KARNI            ינרק   דוהא
;;              Ben Gurion st'   14   ןוירוג ןב 'חר
;;              Kfar - Sava    44 257     אבס - רפכ
;;              ===================================
;;              <kehud@iname.com>  972-(0)9-7659599
;;              ===================================

;;     RCS: $Id: ekcomplete.el,v 1.101 2000/03/05 13:51:13 ehud Exp ehud $
;;
;;     LOG: $Log: ekcomplete.el,v $
;;  Revision 1.101  2000/03/05  13:51:13  ehud
;;  Comment headers changes (NOT GNU)  +  Hacked 20.5 partial-completion-mode.
;;
;;  Revision 1.100  1999/07/26  13:18:00  ehud
;;  Emacs 20.3 version (working)

;;  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 of the License, 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; if not, write to the Free Software
;;  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


(require 'complete)

(defvar PC-env-vars-alist nil
  "A list of the environment variable names and values.")

(defun partial-completion-mode (&optional arg)
  "Toggle Partial Completion mode.
With prefix ARG, turn Partial Completion mode on if ARG is positive.

When Partial Completion mode is enabled, TAB (or M-TAB if `PC-meta-flag' is
nil) is enhanced so that if some string is divided into words and each word is
delimited by a character in `PC-word-delimiters', partial words are completed
as much as possible.

For example, M-x p-c-m expands to M-x partial-completion-mode since no other
command begins with that sequence of characters, and
\\[find-file] f_b.c TAB might complete to foo_bar.c if that file existed and no
other file in that directory begin with that sequence of characters.

Unless `PC-disable-includes' is non-nil, the \"<...>\" sequence is interpreted
specially in \\[find-file].  For example,
\\[find-file] <sys/time.h> RET finds the file /usr/include/sys/time.h.
See also the variable `PC-include-file-path'."
  (interactive "P")
  (let ((on-p (if arg
                  (> (prefix-numeric-value arg) 0)
                (not partial-completion-mode))))
    ;; Deal with key bindings...
    (PC-bindings on-p)
    ;; Deal with include file feature...
    (cond ((not on-p)
           (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file))
          ((not PC-disable-includes)
           (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file)))
    ;; ... with some underhand redefining.
    (cond ((and (not on-p) (functionp PC-old-read-file-name-internal))
           (fset 'read-file-name-internal PC-old-read-file-name-internal))
          ((and (not PC-disable-includes) (not PC-old-read-file-name-internal))
           (setq PC-old-read-file-name-internal
                 (symbol-function 'read-file-name-internal))
           (fset 'read-file-name-internal
                 'PC-read-include-file-name-internal)))
    ;; Add environment processing option (Ehud Karni <ehud@unix.simonwiesel.co.il>)
    ;; Modified from code by eirik@theory.tn.cornell.edu and trost@reed.edu (1991 ?)
    ;;          Original idea by karl@cs.umb.edu
    (and on-p                          ;; PC is on
         (not PC-env-vars-alist)       ;; env vars table is empty
         (setq PC-env-vars-alist       ;; set it now
               (mapcar
                 (function
                   (lambda (string)
                     (let ((d (string-match "=" string)))
                        (cons (concat "$" (substring string 0 d))
                        (and d (substring string (1+ d)))))))
                 process-environment)))
    ;; Finally set the mode variable.
    (setq partial-completion-mode on-p)))


(defun file-name-quote-glob (file-name)
  "Quote any globing character ([, ? *) in FILE-NAME by enclosing them in []."
       (interactive)
       (let ((result "")                   ; result strings
             (start 0)                     ; index for search
             mb)                           ; temp match beginning
           (while (string-match "[^[][[?*$]" file-name start)
               (setq mb (1+ (match-beginning 0)))
               (setq result (concat result (substring file-name start mb)
                                    (if (= (aref file-name mb) ?$)
                                        "$$"
                                        (concat "[" (substring file-name mb (1+ mb)) "]"))))
               (setq start (1+ mb)))
           (concat result (substring file-name start))))


(defun file-name-quote-dollar (file-name)
  "Quote any single $ by doubling it"
       (interactive)
       (let ((result (if (= (aref file-name 0) ?$)
                         "$" ""))          ; result strings
             (start 0)                     ; index for search
             mb)                           ; temp match beginning
           (while (string-match "[^$][$][^$]" file-name start)
               (setq mb (1+ (match-beginning 0)))
               (setq result (concat result (substring file-name start mb) "$$"))
               (setq start (1+ mb)))
           (concat result (substring file-name start))))


(defun PC-do-completion (&optional mode beg end)
  (or beg (setq beg (point-min)))
  (or end (setq end (point-max)))
  (let* ((table minibuffer-completion-table)
         (pred minibuffer-completion-predicate)
         (filename (funcall PC-completion-as-file-name-predicate))
         (dirname nil)
         (dirlength 0)
         (str (buffer-substring beg end))
         (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
         (ambig nil)
         basestr
         env-on
         regex
         p offset
         (poss nil)
         helpposs
         (case-fold-search completion-ignore-case))

    ;; Check if buffer contents can already be considered complete
    (if (and (eq mode 'exit)
             (PC-is-complete-p str table pred))
        'complete

      ;; Record how many characters at the beginning are not included
      ;; in completion.
      (and filename
          (setq basestr (or (file-name-directory str) ""))
          (setq dirlength (length basestr))
      ;; Do substitutions in directory names
          (setq p (substitute-in-file-name basestr))
          (not (string-equal basestr p))
          (setq str (concat p (file-name-nondirectory str)))
          (progn
             (delete-region beg end)
             (insert str)
             (setq end (+ beg (length str)))))

      ;; Prepare various delimiter strings
      (or (equal PC-word-delimiters PC-delims)
          (setq PC-delims PC-word-delimiters
                PC-delim-regex (concat "[" PC-delims "]")
                PC-ndelims-regex (concat "[^" PC-delims "]*")
                PC-delims-list (append PC-delims nil)))

      ;; Look for wildcard expansions in directory name
      (and filename
           (string-match "\\*.*/" str)
           (let ((pat str)
                 files)
             (setq p (1+ (string-match "/[^/]*\\'" pat)))
             (while (setq p (string-match PC-delim-regex pat p))
               (setq pat (concat (substring pat 0 p)
                                 "*"
                                 (substring pat p))
                     p (+ p 2)))
             (setq files (PC-expand-many-files (concat pat "*")))
             (if files
                 (let ((dir (file-name-directory (car files)))
                       (p files))
                   (while (and (setq p (cdr p))
                               (equal dir (file-name-directory (car p)))))
                   (if p
                       (setq filename nil table nil pred nil
                             ambig t)
                     (delete-region beg end)
                     (setq str (concat dir (file-name-nondirectory str)))
                     (insert str)
                     (setq end (+ beg (length str)))))
               (setq filename nil table nil pred nil))))

      ;; Strip directory name if appropriate
      (if filename
          (if incname
              (setq basestr (substring str incname)
                    dirname (substring str 0 incname))
            (setq basestr (file-name-nondirectory str)
                  dirname (file-name-directory str)))
        (setq basestr str))

      ;; Convert search pattern to a standard regular expression
      (setq regex (regexp-quote basestr)
            offset (if (and (> (length regex) 0)
                            (not (eq (aref basestr 0) ?\*))
                            (or (eq PC-first-char t)
                                (and PC-first-char filename))) 1 0)
            p offset)
      (while (setq p (string-match PC-delim-regex regex p))
        (if (eq (aref regex p) ? )
            (setq regex (concat (substring regex 0 p)
                                PC-ndelims-regex
                                PC-delim-regex
                                (substring regex (1+ p)))
                  p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
          (let ((bump (if (memq (aref regex p)
                                '(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\))
                          -1 0)))
            (setq regex (concat (substring regex 0 (+ p bump))
                                PC-ndelims-regex
                                (substring regex (+ p bump)))
                  p (+ p (length PC-ndelims-regex) 1)))))
      (setq p 0)
      (if filename
          (while (setq p (string-match "\\\\\\*" regex p))
            (setq regex (concat (substring regex 0 p)
                                "[^/]*"
                                (substring regex (+ p 2))))))
      ;;(setq the-regex regex)
      (setq regex (concat "\\`" regex))

      (and (> (length basestr) 0)
          (= (aref basestr 0) ?$)
          (\= (aref basestr 1) ?$)
          (setq env-on t
                table PC-env-vars-alist
                pred nil))

      ;; Find an initial list of possible completions
      (if (not (setq p (string-match (concat PC-delim-regex
                                             (if filename "\\|\\*" ""))
                                     str
                                     (+ (length dirname) offset))))

          ;; Minibuffer contains no hyphens -- simple case!
          (setq poss (all-completions (if env-on
                                          basestr str)
                                      table
                                      pred))

        ;; Use all-completions to do an initial cull.  This is a big win,
        ;; since all-completions is written in C!
        (let ((compl (all-completions (if env-on
                                          (file-name-nondirectory (substring str 0 p))
                                          (substring str 0 p))
                                      table
                                      pred)))
          (setq p compl)
          (while p
            (and (string-match regex (car p))
                 (progn
                   (set-text-properties 0 (length (car p)) '() (car p))
                   (setq poss (cons (car p) poss))))
            (setq p (cdr p)))))

      (setq poss (mapcar 'file-name-quote-dollar poss))

      ;; Now we have a list of possible completions
      (cond

       ;; No valid completions found
       ((null poss)
        (if (and (eq mode 'word)
                 (not PC-word-failed-flag))
            (let ((PC-word-failed-flag t))
              (delete-backward-char 1)
              (PC-do-completion 'word))
          (beep)
          (PC-temp-minibuffer-message (if ambig
                                          " [Ambiguous dir name]"
                                        (if (eq mode 'help)
                                            " [No completions]"
                                          " [No match]")))
          nil))

       ;; More than one valid completion found
       ((or (cdr (setq helpposs poss))
            (memq mode '(help word)))

        ;; Handle completion-ignored-extensions
        (and filename
             (not (eq mode 'help))
             (let ((p2 poss))

               ;; Build a regular expression representing the extensions list
               (or (equal completion-ignored-extensions PC-ignored-extensions)
                   (setq PC-ignored-regexp
                         (concat "\\("
                                 (mapconcat
                                  'regexp-quote
                                  (setq PC-ignored-extensions
                                        completion-ignored-extensions)
                                  "\\|")
                                 "\\)\\'")))

               ;; Check if there are any without an ignored extension.
               ;; Also ignore `.' and `..'.
               (setq p nil)
               (while p2
                 (or (string-match PC-ignored-regexp (car p2))
                     (string-match "\\(\\`\\|/\\)[.][.]?/?\\'" (car p2))
                     (setq p (cons (car p2) p)))
                 (setq p2 (cdr p2)))

               ;; If there are "good" names, use them
               (and p (setq poss p))))

        ;; Is the actual string one of the possible completions?
        (setq p (and (not (eq mode 'help)) poss))
        (while (and p
                    (not (string-equal (car p) basestr)))
          (setq p (cdr p)))
        (and p (null mode)
             (PC-temp-minibuffer-message " [Complete, but not unique]"))
        (if (and p
                 (not (and (null mode)
                           (eq this-command last-command))))
            t

          ;; If ambiguous, try for a partial completion
          (let ((improved nil)
                prefix
                (pt nil)
                (skip "\\`"))

            ;; Check if next few letters are the same in all cases
            (if (and (not (eq mode 'help))
                     (setq prefix (try-completion "" (mapcar 'list poss))))
                (let ((first t) i)
                  (if (eq mode 'word)
                      (setq prefix (PC-chop-word prefix basestr)))
                  (goto-char (+ beg (length dirname)))
                  (while (and (progn
                                (setq i 0)
                                (while (< i (length prefix))
                                  (if (and (< (point) end)
                                           (eq (aref prefix i)
                                               (following-char)))
                                      (forward-char 1)
                                    (if (and (< (point) end)
                                             (or (and (looking-at " ")
                                                      (memq (aref prefix i)
                                                            PC-delims-list))
                                                 (eq (downcase (aref prefix i))
                                                     (downcase
                                                      (following-char)))))
                                        (progn
                                          (delete-char 1)
                                          (setq end (1- end)))
                                      (and filename (looking-at "\\*")
                                           (progn
                                             (delete-char 1)
                                             (setq end (1- end))))
                                      (setq improved t))
                                    (insert (substring prefix i (1+ i)))
                                    (setq end (1+ end)))
                                  (setq i (1+ i)))
                                (or pt (equal (point) beg)
                                    (setq pt (point)))
                                (looking-at PC-delim-regex))
                              (setq skip (concat skip
                                                 (regexp-quote prefix)
                                                 PC-ndelims-regex)
                                    prefix (try-completion
                                            ""
                                            (mapcar
                                             (function
                                              (lambda (x)
                                                (list
                                                 (and (string-match skip x)
                                                      (substring
                                                       x
                                                       (match-end 0))))))
                                             poss)))
                              (or (> i 0) (> (length prefix) 0))
                              (or (not (eq mode 'word))
                                  (and first (> (length prefix) 0)
                                       (setq first nil
                                             prefix (substring prefix 0 1))))))
                  (goto-char (if (eq mode 'word) end
                               (or pt beg)))))

            (if (and (eq mode 'word)
                     (not PC-word-failed-flag))

                (if improved

                    ;; We changed it... would it be complete without the space?
                    (if (PC-is-complete-p (buffer-substring 1 (1- end))
                                          table pred)
                        (delete-region (1- end) end)))

              (if improved

                  ;; We changed it... enough to be complete?
                  (and (eq mode 'exit)
                       (PC-is-complete-p (buffer-string) table pred))

                ;; If totally ambiguous, display a list of completions
                (if (or completion-auto-help
                        (eq mode 'help))
                    (with-output-to-temp-buffer "*Completions*"
                      (display-completion-list (sort helpposs 'string-lessp))
                      (save-excursion
                        (set-buffer standard-output)
                        ;; Record which part of the buffer we are completing
                        ;; so that choosing a completion from the list
                        ;; knows how much old text to replace.
                        (setq completion-base-size dirlength)))
                  (PC-temp-minibuffer-message " [Next char not unique]"))
                nil)))))

       ;; Only one possible completion
       (t
        (if (and (equal basestr (car poss))
                 (not (and env-on filename)))
            (if (null mode)
                (PC-temp-minibuffer-message " [Sole completion]"))
          (delete-region beg end)
          (insert (format "%s"
                          (if filename
                              (substitute-in-file-name (concat dirname (car poss)))
                            (car poss)))))
        t)))))


(defun PC-complete-as-file-name ()
  "Perform completion on file names preceding point.
Environment vars are converted to their values."
  (interactive)
  (let* ((end (point))
         (beg (if (re-search-backward "[^\\][ \t\n\"\`\'][^ \t\n\"\`\']" (point-min) t)
                  (+ (point) 2)
                  (point-min)))
         (minibuffer-completion-table 'read-file-name-internal)
         (minibuffer-completion-predicate "")
         (PC-not-minibuffer t)
         (word-before (buffer-substring beg end)))
    (goto-char end)
    (PC-do-completion nil beg end)))


(partial-completion-mode 1)    ;; Force reloading with env vars

;;; end of changes by Ehud Karni ============================================