home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / complete-fn.el < prev    next >
Encoding:
Text File  |  1993-03-03  |  4.8 KB  |  131 lines
  1. ;; LCD Archive Entry:
  2. ;; complete-fn|Juergen Nickelsen|nickel@cs.tu-berlin.de|
  3. ;; File name completion in a buffer.|
  4. ;; 1993-02-25|1.1|~/functions/complete-fn.el.Z|
  5.  
  6.  
  7. ; complete-fn.el implements completion of a file name which is typed in
  8. ; a buffer. If you really like to type file names like
  9. ; 
  10. ; /home/stone/shape/development/src/atfs/conf/s-ultrix_4/AtFS/Data/config.h
  11. ; 
  12. ; you don't need it. (This is a real world example!)
  13. ; 
  14. ; I have complete-file-name bound to C-c TAB, and when I realize that I
  15. ; am just, typing a monster like the example above, I can type somewhere
  16. ; in the middle C-c TAB and finish typing the file name in the
  17. ; minibuffer with the usual completion.
  18. ; 
  19. ; If you invoke it, it grabs a string from your current buffer that is
  20. ; surrounded by the following characters: ]\n\t |&;:\$*?()['"`<> 
  21. ; This string is then used as initial input for the minibuffer.  (If you
  22. ; *do* use these characters in file names, change the value of
  23. ; file-name-boundary-regexp.)
  24. ; 
  25. ; Sometimes a file name occurs next to a character that could belong to
  26. ; a file name, but does not, e.g. in Makefiles:
  27. ; 
  28. ;     INCLUDEPATH=/usr/local/include
  29. ; 
  30. ; If you have already typed
  31. ; 
  32. ;     INCLUDEPATH=/usr/loca
  33. ; 
  34. ; and realize that you want to use complete-file-name, you can go back
  35. ; to the first "/", set the mark, and give a single C-u prefix-argument
  36. ; to complete-file-name. The string is then grabbed from the buffer
  37. ; beginning at the mark. (Or should I make it at the point?)
  38. ; 
  39. ; If you don't want a string grabbed from the buffer at all, type C-u
  40. ; twice before invoking complete-file-name.
  41. ; 
  42. ; All other prefix arguments are silently ignored.
  43. ; 
  44. ; 
  45. ; Some time a ago I posted a first version of this function, which had
  46. ; a bug: The completion said "complete, but not unique" even when the
  47. ; file name *was* unique -- I had not really understood how completion
  48. ; using completing-read worked. Handling of the prefix arguments was
  49. ; also different then.
  50. ; 
  51. ; Have fun! I appreciate any comments.
  52. ; 
  53. ;;; $Header: complete-fn.el[1.1] Thu Feb 25 23:53:22 1993 nickel@cs.tu-berlin.de saved $
  54. ;;; Author: nickel@cs.tu-berlin.de
  55. ;;; complete-fn.el
  56. ;;; The command complete-filename lets you use filename completion on
  57. ;;; a filename the cursor is at or after in a text buffer.
  58. ;;; complete-filename tries to guess what text in the buffer already
  59. ;;; belongs to a filename. file-name-boundary-regexp is used to find
  60. ;;; possible delimiters of the filename.
  61.  
  62. (defvar file-name-boundary-regexp "[]\n\t |&;:\\\\\\$*?()['\"`<>]"
  63.   "Regexp matching characters that are supposed not to occur in filenames.")
  64.  
  65. (defun complete-file-name (arg)
  66.   "Complete filename point is at or after using the minibuffer.
  67. With one C-u, use the value of mark as the beginning of the filename.
  68. With two C-u's, don't grab an initial string from the buffer.
  69. Any other prefix argument is ignored."
  70.   (interactive "P")
  71.   (let* ((grab-from (if (equal arg '(4))
  72.             (mark-marker)))
  73.      (dont-grab (equal arg '(16)))
  74.      (file-name
  75.       (if dont-grab
  76.           ""
  77.         (grab-file-name nil grab-from)))
  78.      (template (complete-file-name-internal file-name nil nil 'use-it))
  79.      (completion (completing-read "Complete Filename: "
  80.                       'complete-file-name-internal
  81.                       nil nil template)))
  82.     (if (equal file-name completion)
  83.     (message "No completion")
  84.       (or dont-grab (grab-file-name 'delete grab-from))
  85.       (insert completion))))
  86.  
  87.  
  88. (defun complete-file-name-internal (file-name pred flag &optional use-it)
  89.   "Internal subroutine for complete-file-name. Do not call this."
  90.   (let ((dir (file-name-directory file-name))
  91.     (nondir (file-name-nondirectory file-name)))
  92.     (cond ((null flag)
  93.        (let ((completion (file-name-completion nondir (or dir ""))))
  94.          (if (stringp completion)
  95.          (concat dir completion)
  96.            (if use-it
  97.            file-name
  98.          completion))))
  99.       ((eq flag t)
  100.        (file-name-all-completions nondir (or dir "")))
  101.       ((eq flag 'lambda)
  102.        (file-name-all-completions nondir (or dir ""))))))
  103.  
  104.  
  105. (defun grab-file-name (delete begin)
  106.   "Return filename point is at or after. If DELETE is non-nil, delete
  107. the filename from the buffer. If BEGIN is non-nil, this is the
  108. beginning of the filename."
  109.   (save-excursion
  110.     (if (and (or (eobp) (looking-at file-name-boundary-regexp))
  111.          (or (bobp) (string-match file-name-boundary-regexp
  112.                       (buffer-substring (1- (point))
  113.                             (point)))))
  114.     ""
  115.       (let* ((fnbeg (if begin
  116.             begin
  117.               (save-excursion
  118.             (re-search-backward file-name-boundary-regexp
  119.                         (point-min) 'just-move)
  120.             (if (looking-at file-name-boundary-regexp)
  121.                 (forward-char 1))
  122.             (point))))
  123.          (fnend (progn (re-search-forward file-name-boundary-regexp
  124.                           (point-max) 'just-move)
  125.                (or (eobp) (forward-char -1))
  126.                (point))))
  127.     (prog1
  128.         (buffer-substring fnbeg fnend)
  129.       (if delete
  130.           (delete-region fnbeg fnend)))))))
  131.