home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / xfile.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  3.4 KB  |  86 lines
  1. ;Path: ark1!uakari.primate.wisc.edu!gem.mps.ohio-state.edu!tut.cis.ohio-state.edu!starbase.mitre.org!israel
  2. ;From: israel@starbase.mitre.org (Bruce Israel)
  3. ;Newsgroups: gnu.emacs.bug
  4. ;Subject: Find-file using X menus
  5. ;Message-ID: <8911152003.AA19225@starbase>
  6. ;Date: 15 Nov 89 20:03:48 GMT
  7. ;Sender: daemon@tut.cis.ohio-state.edu
  8. ;Distribution: gnu
  9. ;Organization: GNUs Not Usenet
  10. ;Lines: 74
  11. ;
  12. ;Here's a useful function I wrote recently.  A friend convinced me that it
  13. ;is generally useful and that I should send it out to this list.
  14. ;
  15. ;It is a function to find a file using menus under X that can be bound to a
  16. ;mouse key.  It pops up a menu of the current directory, but if you select
  17. ;an entry from that menu that's a directory, it will then pop that up as a
  18. ;new menu.  It includes . and .. in the list, so it's possible to move
  19. ;around the entire filesystem using this.  It's also possible to select the
  20. ;directory itself, and then dired will be run on it.
  21. ;
  22. ;The main work is in the utility function x-get-filename, which can be
  23. ;adapted for other uses extremely easily.
  24. ;
  25. ;Enjoy.
  26. ;
  27. ;Bruce
  28.  
  29. ;
  30. ; xfile.el - Use menus under X to select a file to visit.
  31. ;   Written by - Bruce Israel <israel@starbase.mitre.org>, October 11, 1989
  32. ;  
  33. ; When the mouse button invoking x-find-file is pressed, a menu of the
  34. ; files in the current directory will pop up.  If a file is selected, that
  35. ; file is put up on the screen for editing.  If the button is pressed over
  36. ; a directory and held, a menu for that directory will be popped up, where
  37. ; it is possible to select a file or directory by releasing the mouse
  38. ; button.  Through alternatively pressing and releasing the mouse button,
  39. ; it is possible to travel throughout the system directories until the
  40. ; desired file is found.
  41.  
  42. (defun x-get-filename (dir arg)
  43.   "Find a file via menus in X.  The selected file is returned.
  44.    DIR is the default directory to begin the search in, and ARG
  45.    is the argument passed in by the X mouse software"
  46.   (let (menu files result key file limit (continue t))
  47.     (while continue
  48.       (setq limit (/ (screen-height) 2)
  49.         menu (list (cons (format "SELECT %s" dir) (cons 'ACCEPT dir)))
  50.         files (cons nil (directory-files dir)))
  51.       (while (setq files (cdr files))
  52.     (setq file (car files)
  53.           key 'ACCEPT)
  54.     (if (file-directory-p (concat dir file))
  55.         (setq key 'EXPAND
  56.           file (concat file "/")))
  57.     (if (string-equal file "//") (setq file "/"))
  58.     (setq menu (cons (cons file (cons key file)) menu)))
  59.       (if (> (length menu) limit)
  60.       (let ((pane nil) (panes nil) (count 0))
  61.         (setq limit (/ (length menu) (1+ (/ (length menu) limit))))
  62.         (while menu
  63.           (setq pane (cons (car menu) pane))
  64.           (setq menu (cdr menu)
  65.             count (1+ count))
  66.           (and (> count limit)
  67.            (setq panes (cons (cons dir pane) panes))
  68.            (setq pane nil
  69.              count 0)))
  70.         (if pane (setq panes (cons (cons dir pane) panes)))
  71.         (setq menu panes))
  72.     (setq menu (cons (cons dir (nreverse menu)) nil)))
  73.       (setq result (x-popup-menu arg (cons "find file menu" menu)))
  74.       (setq file (expand-file-name (concat dir (cdr result))))
  75.       (cond ((null result)         (setq continue nil))
  76.         ((eq (car result) 'ACCEPT)  (setq continue nil result file))
  77.         (t                 (setq continue t dir file))))
  78.     result))
  79.  
  80. (defun x-find-file (arg)
  81.   "Select and edit a file using menus under X."
  82.   (let ((name (x-get-filename default-directory arg)))
  83.     (if name (find-file name))))
  84.  
  85. (define-key mouse-map x-button-s-right 'x-find-file)
  86.