emacs_el/tiny-tools/other/fnexpand.el

   1 ;;; fnexpand.el --- filename expansion anywhere
   2
   3 ;; This file is not part of Emacs
   4
   5 ;; Copyright (C) 1991-2007 eirik and trost
   6
   7 ;; Author: <eirik@theory.tn.cornell.edu> and <trost@reed.edu>
   8 ;; Adapted-By: Jari Aalto
   9 ;; Idea by:  karl@cs.umb.edu
  10 ;; Keywords: tools
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with program; see the file COPYING. If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26 ;;
  27 ;; Visit <http://www.gnu.org/copyleft/gpl.html> for more information
  28
  29 ;;; Install:
  30
  31 ;;   Put this file on your Emacs-Lisp load path, add following into your
  32 ;;   ~/.emacs startup file.
  33 ;;
  34 ;;      (require 'fnexpand)
  35 ;;
  36 ;;   or use this; your .emacs loads up a bit quicker
  37 ;;
  38 ;;      (autoload 'fnexpand-complete "fnexpand" t t)
  39 ;;
  40 ;;   You should also add some keybinding to use the expansion feature
  41 ;;   The following example replaces seldom used original emacs binding.
  42 ;;
  43 ;;   (global-set-key                             "\e`" 'fnexpand-complete)
  44 ;;   (define-key minibuffer-local-must-match-map "\e`" 'fnexpand-complete)
  45 ;;   (define-key minibuffer-local-completion-map "\e`" 'fnexpand-complete)
  46 ;;
  47 ;;   If you want to expand executables, you should add following statement
  48 ;;   before any require command. Loading this package slows down remarkably
  49 ;;   after this though.
  50 ;;
  51 ;;      (setq fnexpand-executable-enable t)
  52 ;;
  53
  54 ;;; Commentary:
  55
  56 ;;  The enclosed elisp code provides completion of user names and
  57 ;;  environment variables, as well as a function which does filename
  58 ;;  completion "in place", in any buffer.  The latter function is
  59 ;;  particularly useful as the local binding of the TAB key in shell
  60 ;;  mode, but it can be used in global bindings too.
  61 ;;
  62 ;; Code to do completion of $envvar and ~username in filenames
  63 ;; Code to do completion of filenames in place (e.g. in shell buffers)
  64 ;; Sample binding:
  65 ;;
  66 ;; (setq shell-mode-hook
  67 ;;      (function
  68 ;;        (lambda () (local-set-key "\^I" 'fnexpand-complete ))))
  69 ;;
  70 ;;
  71 ;; If you want to expand
  72 ;;
  73 ;;
  74 ;; The code that does expansion on $ and ~ only works if the $ or ~ is
  75 ;; either at the beginning of the buffer, or after "/".  One result of
  76 ;; this is that file names which end in ~ are still allowed.
  77
  78 ;;; Change Log:
  79
  80 ;; May  12       1997    [jari]          19.28   v1.10          NotReleased
  81 ;; - William A. Hoffman" <hoffman@albirio.crd.ge.com> reported that
  82 ;;   Emacs asked to save /etc/passwd buffer.
  83 ;; - Changed the code so that no direct file buffer is used any more.
  84 ;;   This also inhibits reverting the contents, but since /etc/passwd
  85 ;;   changes so seldom, I don't believe the revert loss can be noticed in
  86 ;;   real use.
  87 ;;
  88 ;; Apr  22       1997    [jari]          19.28   v1.8-1.9       NotReleased
  89 ;; - Added advice to complete Env variables in minibuffer prompt (TAB/SPC)
  90 ;;
  91 ;; Mar  20       1997    [jari]          19.28   v1.7           Released
  92 ;; - Added new user variable fnexpand-passwd-eval-form which now reads
  93 ;;   also Solaris NIS+ password table.
  94 ;; - rewrote fnexpand-complete-username
  95 ;;
  96 ;; Mar  19       1997    [jari]          19.28   v1.6           Released
  97 ;; - Added varaible fnexpand-expand-env-directories which controls
  98 ;;   expand mode for directory env variables.
  99 ;; - Corrected byteComp errors.
 100 ;;
 101 ;; May  17       1996    [jari]          19.28   v1.2-1.5       Released
 102 ;; - Found this code lying around in my ~/elisp. I cannot recall where
 103 ;;   did I get this file.
 104 ;; - Rewrote most of the package. Added fnexpand- prefix to every function
 105 ;;   and variable. Added the executable file expanding.
 106 ;; - got rid of the redefinitions of emacs functions. Cleared the pacakge.
 107
 108 ;;; Code:
 109
 110 (require 'assoc)
 111
 112 (eval-when-compile
 113   (require 'advice))
 114
 115 ;;; ....................................................... &v-private ...
 116
 117 (defconst fnexpand-version
 118   "$Id: fnexpand.el,v 2.12 2007/05/07 10:50:05 jaalto Exp $"
 119   "Latest RCS modification time and version number.")
 120
 121 (defvar fnexpand-envvars nil
 122   "Private, a list of environment variable names and values.
 123 Format: '((ENV-VAR-NAME . ENAV-VAR-VALUE).")
 124
 125 (defvar fnexpand-executable-file-cache  nil
 126   "Private, list of executable files. The list is updated periodically.
 127 Format: '((FILE . 1) (FILE . 2) ..).")
 128
 129 (defvar fnexpand-executable-file-cache-counter  nil
 130   "Private, incremented every time when executable file cache is asked.")
 131
 132 (defvar fnexpand-yp-passwd-buffer " *fnexpand-yp-passwords*"
 133   "Password buffer name.")
 134
 135 ;;; ........................................................ &v-public ...
 136 ;;; User configurable
 137
 138 (defvar fnexpand-expand-env-directories  nil
 139   "If nono-nil then environment varaiables $DIR which contain
 140 directory slash are expanded.
 141
 142 Examples; when nil, suppose PROJECT holds directory
 143
 144   $PROJ[TAB] --> $PROJECT
 145   $PRIN[TAB] --> $PRINTER
 146
 147 When non-nil
 148
 149   $PROJ[TAB] --> /user/local/project/dbms/
 150   $PRIN[TAB] --> $PRINTER
 151
 152 ")
 153
 154 (defvar fnexpand-passwd-eval-form
 155   (cond
 156    ((string-match "hppa\\|hpux" (emacs-version))
 157     '(call-process "ypcat" nil
 158                    (get-buffer-create fnexpand-yp-passwd-buffer)
 159                    nil "passwd"))
 160    ((and (string-match "solaris" (emacs-version))
 161          (file-exists-p "/var/nis"))
 162     '(call-process "niscat" nil
 163                    (get-buffer-create fnexpand-yp-passwd-buffer)
 164                    nil "passwd.org_dir"))
 165    (t
 166     (insert-file-contents "/etc/passwd" t)
 167     (setq buffer-file-name nil)))      ;Make sure it is not saved back
 168   "EVAL form to readt the password file to fnexpand-yp-passwd-buffer.
 169 HPUX     'ypcat     --> ypcat passwd
 170 Solaris  'NIS+      --> niscat passwd.org_dir
 171 others    nil       --> cat /etc/passwd
 172 ")
 173
 174 ;;; You don't want to update cache very often...
 175 ;;;
 176 (defvar fnexpand-executable-file-cache-update  200
 177   "*Counter when to update fnexpand-executable-file-cache.
 178 Default every 200th call. See also 'fnexpand-executable-enable'.")
 179
 180 (defvar fnexpand-executable-cache-no-dirs  "RCS"
 181   "*Regexp, which directories in path not to cache. Eg looking into
 182 RCS directory makes no sense.")
 183
 184 ;;;###autoload
 185 (defvar fnexpand-executable-enable nil
 186   "*if non-nil, then try to expand executable files too.
 187 Beware, this may be time consuming.")
 188
 189 (defvar fnexpand-filename-boundary-chars "[^#$%+-9=@-Z_a-z~]"
 190   "*Characters used to bound filenames in 'fnexpand-find-filename'.")
 191
 192 (defvar fnexpand-complete-filename-look-right nil
 193   "*If t, consider text on both sides of point in fnexpand-complete-filename.")
 194
 195 ;;; .................................................... compatibility ...
 196
 197 (eval-and-compile
 198   (cond
 199    ((fboundp 'read-file-name-internal-primitive)
 200     (defalias 'fnexpand-read-file-name-internal-primitive
 201       'read-file-name-internal-primitive))
 202    (t
 203     (defalias 'fnexpand-read-file-name-internal-primitive
 204       (symbol-function 'read-file-name-internal)))))
 205
 206 ;;; ............................................................ funcs ...
 207
 208 (defun fnexpand-getenv  (&optional var)
 209   "Return env VAR slot. If VAR is t, then update
 210 global list 'fnexpand-envvars' if needed and return all variables
 211 in format '((ENV-VAR-NAME . ENAV-VAR-VALUE) (E-NAME. E-VAL) ..)"
 212   (cond
 213    ((eq t var)
 214     (if fnexpand-envvars
 215         fnexpand-envvars                ;read from cache
 216       (setq fnexpand-envvars
 217             (mapcar
 218              (function
 219               (lambda (string)
 220                 (let ((d (string-match "=" string)))
 221                   (cons (substring string 0 d)
 222                         (and d (substring string (1+ d)))))))
 223              process-environment))))
 224    (t
 225     (getenv var))))
 226
 227 (defun fnexpand-read-file-name-internal (name dir action)
 228   "Like 'read-file-name-internal' that expands partial usernames and
 229 environment variable names.
 230
 231 NAME is the filename to complete; DIR is the directory to complete in.
 232 ACTION is nil to complete, t to return list of completions, lambda to
 233 verify final value."
 234   (let* ((buf (current-buffer))
 235          (char (progn
 236                  (set-buffer (get-buffer-create " *read*"))
 237                  (erase-buffer)
 238                  (insert name)
 239                  (and (re-search-backward "[$~]" nil t)
 240                       (char-after (point)))))
 241          (can (and char
 242                    (or (eq (point) (point-min))
 243                        (save-excursion (backward-char 1)
 244                                        (looking-at "/")))
 245                    (not (progn
 246                           (forward-char 1)
 247                           (save-excursion
 248                             (search-forward "/"
 249                                             (point-max) t))))
 250                    (buffer-substring (point) (point-max)))))
 251     (set-buffer buf)
 252     (if (null can) (fnexpand-read-file-name-internal-primitive
 253                     name dir action)
 254       (let ((prefix (substring name 0 (- (length name) (length can) 1))))
 255         (cond
 256          ((eq char ?~)
 257           (let ((s (fnexpand-complete-username can nil action)))
 258             (cond ((stringp s)
 259                    (concat "~" s
 260                            (and
 261                             (eq t (fnexpand-complete-username s nil action))
 262                             (file-directory-p
 263                              (expand-file-name (concat "~" s)))
 264                             "/")))
 265                   ((eq t s) (concat name
 266                                     (if (file-directory-p
 267                                          (expand-file-name name))
 268                                         "/")))
 269                   (t s))))
 270          ((eq char ?$)
 271           (let ((completion-list
 272                  (all-completions
 273                   can (fnexpand-getenv t))))
 274             (cond
 275              ((null action)
 276               (let* ((un (and (eq (length completion-list) 1)
 277                               (car completion-list)))
 278                      (unv (and un (fnexpand-getenv un)))
 279                      (dirp (and unv (> (length unv) 0)
 280                                 (file-directory-p unv)
 281                                 "/")))
 282                 (if (and un (string-equal un can))
 283                     (concat prefix unv dirp)
 284                   (let ((s (try-completion can (fnexpand-getenv t)))
 285                         exp)
 286                     (cond
 287                      ((stringp s)
 288                       (setq exp (getenv s))
 289                       (if (or (null fnexpand-expand-env-directories)
 290                               (not (string-match "/" exp)))
 291                           (concat prefix "$" s dirp)
 292                         (concat prefix exp dirp)))
 293                      (t
 294                       s))))))
 295              ((eq t action)
 296               completion-list)
 297              (t
 298               (eq 1 (length completion-list)))))))))))
 299
 300 (defun fnexpand-find-completing-names (string predicate yp-p)
 301   "Looking for USERNAME completions matching PREDICATE (if non-nil) in current
 302 buffer.  Does not do save-excursion.  If third argument YP-P is non-nil, allow
 303 matches for individual yp entries as well."
 304   (let ((regexp (concat (if yp-p "^+?" "^") string "[^:]*:"))
 305         ret)
 306     (goto-char (point-min))
 307     (while (re-search-forward regexp () t)
 308       (let ((name (buffer-substring (match-beginning 0) (1- (match-end 0)))))
 309         (if (or (not predicate) (funcall predicate name))
 310             (setq ret (cons (if (eq (string-to-char name) ?+)
 311                                 (substring name 1)
 312                               name)
 313                             ret)))
 314         (end-of-line)))
 315     ret))
 316
 317 (defun fnexpand-complete-username (string predicate flag)
 318   "Use passwd file to expand a ~.  A \"+\" at the beginning of the
 319 line is assumed to indicate a yp entry."
 320   (let* ((buffer            "*passwd*")
 321          (pwbuf     (get-buffer buffer))
 322          yp-p
 323          list)
 324     (if (string-match ":" string)
 325         nil
 326       (save-excursion
 327         (cond
 328          (pwbuf
 329           (set-buffer pwbuf))
 330          (t
 331           (set-buffer (get-buffer-create buffer))
 332           (insert-file-contents "/etc/passwd" t)
 333           (setq buffer-file-name nil))) ;Make sure it is not saved back
 334
 335         (goto-char (point-min))
 336         (cond
 337          ((and (setq yp-p (re-search-forward "^+:" nil t))
 338                (null (get-buffer fnexpand-yp-passwd-buffer)))
 339           (eval fnexpand-passwd-eval-form)))
 340         (setq buffer-read-only t)
 341
 342 ;;;     (d! "YP" yp-p (current-buffer) string predicate)
 343
 344         (cond
 345          ((eq flag t)
 346           (nconc (fnexpand-find-completing-names string predicate t)
 347                  (if yp-p
 348                      (progn
 349                        (set-buffer (get-buffer fnexpand-yp-passwd-buffer))
 350                        (fnexpand-find-completing-names
 351                         string predicate nil)))))
 352          (flag                     ; should this be (eq flag 'lambda)?
 353           (if (or (re-search-forward (concat "^+?" string ":") nil t)
 354                   (and yp-p
 355                        (progn
 356                          (set-buffer fnexpand-yp-passwd-buffer)
 357                          (re-search-forward (concat "^" string ":") nil t))))
 358               t))
 359          (t
 360           (setq list (mapcar 'list
 361                              (fnexpand-complete-username string nil t)))
 362           (or (and (eq (length list) 1)
 363                    (fnexpand-complete-username string predicate 'lambda))
 364               (try-completion string list))))))))
 365
 366 (defun fnexpand-path-list  ()
 367   "Return PATH in list format '(PATH PATH ..). Only unique paths are
 368 returned."
 369   (let* ((path (or (getenv "PATH")
 370                    (getenv "path")))
 371          list
 372          elt)
 373     (while path
 374       (cond
 375        ((string-match "^[^:]+" path)
 376         (setq elt (substring path 0 (match-end 0)))
 377
 378         (if (> (length path) (match-end 0))
 379             (setq path  (substring path (1+ (match-end 0))))
 380           (setq path nil))              ;no more
 381
 382         ;; make sure, has ending slash
 383         (if (not (string-match "/$" elt))
 384             (setq elt (concat elt "/")))
 385
 386         ;; consing is faster that append.
 387         (if (not (member elt list))
 388             (setq list (cons elt list ))))))
 389     (reverse list)))                    ;preserve order
 390
 391 (defun fnexpand-executables  (&optional verb)
 392   "Return all unique executable files. If VERB is non-nil, print
 393 verbose messages during updating cache. Cache is updated only
 394 if it's nil or of cache counter reaches certain value.
 395
 396 References:
 397   'fnexpand-executable-file-cache-counter'
 398   'fnexpand-executable-file-cache-update'
 399   'fnexpand-executable-file-cache'
 400 "
 401   (let* ((counter 0)
 402          path-list
 403          path
 404          file
 405          files)
 406
 407     (if (integerp fnexpand-executable-file-cache-counter)
 408         (setq fnexpand-executable-file-cache-counter
 409               (1+ fnexpand-executable-file-cache-counter))
 410       (setq fnexpand-executable-file-cache-counter 0))
 411
 412     ;; time's up? update cache if needed
 413     ;;
 414     (cond
 415      ((or (null fnexpand-executable-file-cache)
 416           (eq 0 (% fnexpand-executable-file-cache-counter
 417                    fnexpand-executable-file-cache-update)))
 418
 419       (setq fnexpand-executable-file-cache-counter 1
 420             fnexpand-executable-file-cache         nil
 421             path-list                              (fnexpand-path-list))
 422
 423       (while path-list
 424         (setq path (car path-list))
 425
 426         (if verb
 427             (message (format "fnexpand: cacheing executables %s" path)))
 428
 429         (cond
 430          ((and (not (string-match fnexpand-executable-cache-no-dirs path))
 431                (file-exists-p path))    ;ignore non-existing paths
 432           (setq files (directory-files path))
 433           (mapcar
 434            '(lambda (x)
 435               (setq file (concat path x))
 436
 437               (cond
 438                ((and (not (file-directory-p file))
 439                      (file-executable-p file)
 440                      (not (assoc x fnexpand-executable-file-cache)))
 441
 442                 (setq fnexpand-executable-file-cache
 443                       (cons
 444                        (list x counter)
 445                        fnexpand-executable-file-cache ))
 446                 (setq counter (1+ counter)))))
 447            files)))
 448         (setq path-list (cdr path-list))) ;; while path-list
 449       (if verb (message ""))))
 450
 451     fnexpand-executable-file-cache))
 452
 453 (defun fnexpand-executable-completions  (name)
 454   "Return executable completions for NAME. If there is only one completion,
 455 return string."
 456   (let* ((list (fnexpand-executables 'verb))
 457          ret)
 458     (setq ret (all-completions name list))
 459     (if (eq 1 (length ret))
 460         (setq ret (car ret)))
 461     ret))
 462
 463 (defun fnexpand-find-filename ()
 464   "Return the largest substring to the left of point which can contain
 465 a file name. Ignore the most recent prompt in a shell buffer"
 466   (let ((mark (let ((process (get-buffer-process (current-buffer))))
 467                 (and process (process-mark process)))))
 468     (buffer-substring
 469      (save-excursion
 470        (if (re-search-backward fnexpand-filename-boundary-chars
 471                                (and mark (>= (point) mark) mark)
 472                                1)
 473            (1+ (point))
 474          (point)))
 475      (point))))
 476
 477 ;;;###autoload
 478 (defun fnexpand-complete ()
 479   "Expand the file name, env var or command near point"
 480   (interactive)
 481   (and fnexpand-complete-filename-look-right
 482        (re-search-forward fnexpand-filename-boundary-chars nil 1)
 483        (forward-char -1))
 484
 485   (let* ((name (fnexpand-find-filename))
 486          (completion
 487           (fnexpand-read-file-name-internal name default-directory nil)))
 488
 489     (cond
 490      ((eq completion t)
 491       (insert " "))
 492
 493      ((and (null completion)            ;try command name
 494            fnexpand-executable-enable)
 495
 496       (setq completion (fnexpand-executable-completions name))
 497
 498       (cond
 499        ((stringp completion)
 500         (delete-region (- (point) (length name)) (point))
 501         (insert completion))
 502
 503        ((and (listp completion)
 504              (> (length completion) 0))
 505         (save-window-excursion
 506           (with-output-to-temp-buffer " *Completions*"
 507             (display-completion-list
 508              completion))
 509           (sit-for 32767)))
 510        (t
 511         (message "[No match]"))))
 512
 513      (completion
 514       (if (equal completion name)
 515           (save-window-excursion
 516             (with-output-to-temp-buffer " *Completions*"
 517               (display-completion-list
 518                (fnexpand-read-file-name-internal name
 519                                                  default-directory t)))
 520             (sit-for 32767))
 521         (unwind-protect
 522             (if (eq t (fnexpand-read-file-name-internal
 523                        completion
 524                        default-directory
 525                        nil))
 526                 (setq completion (concat completion " "))))
 527         (delete-region (- (point) (length name)) (point))
 528         (insert completion)))
 529      (t (message "[No match]")))))
 530
 531 ;;; ----------------------------------------------------------------------
 532 ;;;
 533 (defun fnexpand-env-var-complete ()
 534   "This function completes environment varaible.
 535 It is used in minibuffer. Returns t if completion was not initiated."
 536   (cond
 537    ((save-excursion
 538       (and (skip-chars-backward "^$ \t\n")
 539            (string= (char-to-string (preceding-char)) "$")))
 540     (call-interactively 'fnexpand-complete)
 541     nil)
 542    (t
 543     t)))
 544
 545 ;;; ----------------------------------------------------------------------
 546 ;;; minibuffer's TAB key from complete.el
 547 ;;;
 548 (defadvice PC-complete  (around fnexpand  act)
 549   "Complete Envinronment variable."
 550   (if (fnexpand-env-var-complete) ad-do-it))
 551
 552 ;;; ----------------------------------------------------------------------
 553 ;;; TAB
 554 ;;;
 555 (defadvice minibuffer-complete  (around fnexpand  act)
 556   "Complete Envinronment variables."
 557   (if (fnexpand-env-var-complete) ad-do-it))
 558
 559 ;;; ----------------------------------------------------------------------
 560 ;;; SPACE
 561 ;;;
 562 (defadvice PC-complete-word  (around fnexpand  act)
 563   "Complete Envinronment variable."
 564   (if (fnexpand-env-var-complete) ad-do-it))
 565
 566 ;;; ----------------------------------------------------------------------
 567 ;;; SPACE
 568 ;;;
 569 (defadvice minibuffer-complete-word  (around fnexpand  act)
 570   "Complete Envinronment variables."
 571   (if (fnexpand-env-var-complete) ad-do-it))
 572
 573 (if fnexpand-executable-enable          ;update cache immediately
 574     (fnexpand-executables 'verb))
 575
 576 (provide 'fnexpand)
 577
 578 ;;; fnexpand.el ends here