home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / help-lucid-emacs / text0523.txt < prev    next >
Encoding:
Text File  |  1993-07-14  |  25.8 KB  |  824 lines
  1. Hi,
  2.  
  3.  
  4. I've just written a new version of my hm--dired-menu.el which fixes a bug and
  5. adds some new features. The file provides a pulldown and popup menu for the
  6. dired mode, scrolling with the mouse by clicking on the modeline (derived
  7. from the code from Bob Weiner and Mike Scheidler), find-file with the middle 
  8. mouse button, marking files in a region, selecting a subdirectory from a 
  9. submenu and selcting an absolut directory from a submenu, which can be
  10. defined by an extra file. And you can limit the number of active dired
  11. buffers. ------------------ For more details look at the description in the
  12. file hm--dired-menu.el. You need also the file hm--mouse-on-modeline-ext.el,
  13. which is also included in this posting.
  14.  
  15. I've tested the code with the lemacs 19.4 on SUN under SunOS 4.1.3 and on a
  16. PC under Linux. 
  17.  
  18. There are also some installation hints in the files.
  19.  
  20.  
  21. ---- Begin of hm--dired-menu.el ----
  22. ;;;  hm--dired-menu.el: A menu for the dired-mode.
  23. ;;;  v2.00; 9 Jun 1993
  24. ;;;  Copyright (C) 1993  Heiko Muenkel
  25. ;;;  email: muenkel@tnt.uni-hannover.de
  26. ;;;
  27. ;;;  This program is free software; you can redistribute it and/or modify
  28. ;;;  it under the terms of the GNU General Public License as published by
  29. ;;;  the Free Software Foundation; either version 1, or (at your option)
  30. ;;;  any later version.
  31. ;;;
  32. ;;;  This program is distributed in the hope that it will be useful,
  33. ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  34. ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  35. ;;;  GNU General Public License for more details.
  36. ;;;
  37. ;;;  You should have received a copy of the GNU General Public License
  38. ;;;  along with this program; if not, write to the Free Software
  39. ;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  40. ;;;
  41. ;;; Description:
  42. ;;;
  43. ;;;   This file provides a puldown and a popup menu for the dired mode
  44. ;;;   in the lemacs. You can reach most of the dired functions from this
  45. ;;;   menu. But the file adds also some other usefull functions. One is
  46. ;;;   the posibility to limit the maximum number of dired buffers to a value
  47. ;;;   bigger or equal to 2. That can be done over the menu item ("Dired"
  48. ;;;   "Customize" "Set no of active buffers") or with the function 
  49. ;;;   hm--dired-set-no-of-active-buffers or by direct setting of the
  50. ;;;   variable hm--dired-no-of-active-buffers. 
  51. ;;;   Another usefull feature is the possibility to run the command find-file
  52. ;;;   on the file under the mouse button (therefor the line is highlighted)
  53. ;;;   only by clicking on the second mouse button.
  54. ;;;   To switch to a subdirectory of the current directory you can also use
  55. ;;;   the submenu items of ("Dired" "Directory" "Goto relativ").
  56. ;;;   With the submenu items of ("Dired" "Directory" "Goto absolut") you can
  57. ;;;   switch to another "absolut" directory. This submenu contains normaly
  58. ;;;   only the item "Homedirectory" but you can add further items by writing
  59. ;;;   a file specified by the variable hm--dired-absolutdirs-filename, which
  60. ;;;   has the defaultvalue "~/.lemacs-absolutdirs-menu". The lines in that
  61. ;;;   file should look like the following 3 lines (without ;;;):
  62. ;;;      "-" "-"
  63. ;;;      "Binaries" "/usr/bin"
  64. ;;;      "Emacs"    "/usr/local/emacs"
  65. ;;;
  66. ;;;   Another added feature is the posibiltity to mark files (i.e. for copy 
  67. ;;;   operations) which are in a active region.  
  68. ;;; 
  69. ;;;   If you load the file hm--mouse-on-modeline-ext.el after this file, you
  70. ;;;   can scroll the dired buffers with the left and the rigth mouse buttons,
  71. ;;;   if the mouse pointer is on a modeline. 
  72. ;;;
  73. ;;; Installation: 
  74. ;;;   Put hm--dired-menu.el and hm--mouse-on-modeline-ext.el in a load-path- 
  75. ;;;   directory (lisp/dired for example).
  76. ;;;   Write the following 2 lines in your .emacs- file:
  77. ;;;
  78. ;;;   (load-library "hm--dired-menu")
  79. ;;;   (load-library "hm--mouse-on-modeline-ext")
  80. ;;;  
  81. ;;;   If you want to load this files only, if you use the dired-mode, you
  82. ;;;   you should instead write the above lines at the end of the dired.el 
  83. ;;;   file (don't forget to recompile the dired.el after that).
  84. ;;;
  85. ;;;   If you don't want to use the file hm--mouse-on-modeline-ext.el, you
  86. ;;;   must uncomment the line 
  87. ;;;     (define-key dired-mode-map '(button3) 'hm--popup-dired-menu)
  88. ;;;   and comment the line
  89. ;;;     (define-key dired-mode-map '(button3) 'hm--dired-mouse-right)
  90. ;;;   in the function hm--dired-define-keys at the end of this file.
  91. ;;;
  92.  
  93.  
  94. (provide 'hm--dired-menu)
  95. (require 'dired)
  96. (require 'mode-motion)
  97.  
  98.  
  99.  
  100. ; Try to set the max-lisp-eval-depth higher, if one of the following
  101. ; function fails with the message that the max lisp eval depth is
  102. ; excided.
  103.  
  104. (if (< max-lisp-eval-depth 400)
  105.     (setq max-lisp-eval-depth 400))
  106.  
  107.  
  108. ;; Popup and Pulldown Menu
  109.  
  110.  
  111. (defvar hm--dired-menu nil "*A list with the menue Dired.")
  112.  
  113.  
  114. (setq hm--dired-menu
  115.        '("Dired Menu"
  116.      ("Mark"
  117. ;      ["Mark file" dired-mark-file t]
  118.       ["Mark subdir or file" dired-mark-subdir-or-file t]
  119.       ["Mark region" hm--dired-mark-region t]
  120.       ["Mark files regexp..." dired-mark-files-regexp t]
  121.       ["Mark directories" dired-mark-directories t]
  122. ;      ["Mark subdir files" dired-mark-subdir-files nil]
  123.       ["Mark executables" dired-mark-executables t]
  124.       ["Mark symlinks" dired-mark-symlinks t]
  125.       "----"
  126.       ["Unmark file" dired-unmark-subdir-or-file t]
  127.       ["Unmark all files" (dired-unflag-all-files nil) t]
  128.       ["Query unmark all files..." (dired-unflag-all-files nil t) t]
  129.       )
  130.      "----"
  131.      ("Copy/Link"
  132.       ["Copy files..." dired-do-copy t]
  133.       ["Copy regexp files..." dired-do-copy-regexp t]
  134.       "----"
  135.       ["Sym-link files in directory..." dired-do-symlink t]
  136.       ["Sym-link regexp files in directory..." 
  137.        dired-do-symlink-regexp t]
  138.       "----"
  139.       ["Hard-link files in directory..." dired-do-hardlink t]
  140.       ["Hard-link regexp files in directory..." 
  141.        dired-do-hardlink-regexp t]
  142.       )
  143.      ("Rename"
  144.       ["Rename files..." dired-do-move t]
  145.       ["Rename regexp files..." dired-do-rename-regexp t]
  146.       "----"
  147.       ["Downcase files..." dired-downcase t]
  148.       ["Upcase files..." dired-upcase t]
  149.       )
  150.      ("Delete"
  151.       ["Delete marked files..." dired-do-delete t]
  152.       ["Delete flaged files..." dired-do-deletions t]
  153.       "----"
  154.       ["Flag file" dired-flag-file-deleted t]
  155.       ["Flag regexp files..."  dired-flag-regexp-files t]
  156.       ["Flag backup files" dired-clean-directory t]
  157.       ["Flag auto save files" dired-flag-auto-save-files t]
  158.       "----"
  159.       ["Unflag file" dired-unflag t]
  160.       ["Unflag backup files" dired-backup-unflag t]
  161.       ["Unflag all files" (dired-unflag-all-files nil) t]
  162.       ["Query unflag all files..." (dired-unflag-all-files nil) t]
  163.       )
  164.      ("Shell commands"
  165.       ["Compress files..." dired-do-compress t]
  166.       ["Uncompress files..." dired-do-uncompress t]
  167.       ["Print files..." dired-do-print t]
  168.       ["Shell command on files..." dired-do-shell-command t]
  169.       ["Byte compile files..." dired-do-byte-compile t]
  170.       "----"
  171.       ("Compare"
  172.        ["Backup diff" dired-backup-diff t]
  173.        ["Diff file..." dired-diff t]
  174.        )
  175.       ("File properties"
  176.        ["Change mod of files..." dired-do-chmod t]
  177.        ["Change group of files..." dired-do-chgrp t]
  178.        ["Change owner of files..." dired-do-chown t]
  179.        )
  180.       )
  181.      ("Load/Find"
  182.       ["Load file" dired-do-load t]
  183.       ["Find file" dired-find-file t]
  184.       ["Find file other window" dired-find-file-other-window t]
  185.       ["View file" dired-view-file t]
  186.       )
  187.      "----"
  188.      ("Directory"
  189.       ("Goto relativ"
  190.        ["Up directory" dired-up-directory t]
  191.        )
  192.       ("Goto absolut"
  193.        ["Homedirectory" (dired "~/") t]
  194.        )
  195.       "----"
  196.       ["Dired..." dired t]
  197.       ["Dired other window..." dired-other-window t]
  198.       ["Quit" dired-quit t]
  199.       "----"
  200.       ["Create directory..." dired-create-directory t]
  201.       "----"
  202.       ["Insert subdir" dired-insert-subdir t]
  203. ;      ["Maybe insert subdir" dired-maybe-insert-subdir t]
  204.       ["Hide subdir" dired-kill-subdir t]
  205.       ["Hide all subdirs..." dired-kill-tree t]
  206. ;      ["Build subdir alist" dired-build-subdir-alist t]
  207.       )
  208.      ("Goto"
  209.       ["Next Page" scroll-up t]
  210.       ["Next dirline" dired-next-dirline t]
  211.       ["Next marked file" dired-next-marked-file t]
  212. ;      ["Next line" dired-next-line t]
  213.       ["End of buffer" end-of-buffer t]
  214.       "----"
  215.       ["Previous Page" scroll-down t]
  216.       ["Previous dirline" dired-prev-dirline t]
  217.       ["Previous marked file" dired-prev-marked-file t]
  218. ;            ["Previous line" dired-previous-line t]
  219.       ["Begin of buffer" beginning-of-buffer t]
  220.       "----"
  221.       ["File..." dired-goto-file t]
  222.       ["Headerline..." dired-goto-subdir t]
  223.       ["Subdir down" dired-tree-down t]
  224.       ["Subdir up" dired-tree-up t]
  225.       )
  226.      ("Customize"
  227.       ["Undisplay line or subdir" dired-kill-line-or-subdir t]
  228. ;      ["Undisplay line" dired-kill-line t]
  229. ;      ["Undisplay subdir" dired-kill-subdir t]
  230.       ["Undisplay tree" dired-kill-tree t]
  231.       ["Undisplay marked lines" dired-do-kill t]
  232.       "----"
  233. ;      ["(Un)Hide subdir" dired-hide-subdir t]
  234. ;      ["Hide all subdirs" dired-hide-subdir t]
  235.       ["Toggle sort by date/name" dired-sort-toggle-or-edit t]
  236.       ["Hide '.' files" hm--dired-hide-.-files t]
  237.       ["Show '.' files" hm--dired-show-.-files t]
  238.       ["Edit ls switches..." (dired-sort-toggle-or-edit t) t]
  239.       "----"
  240.       ["Redisplay all files" revert-buffer t]
  241.       ["Redisplay all marked files" dired-do-redisplay t]
  242.       ["Undo" dired-undo t]
  243.       "----"
  244.       ["Set no of active buffers" hm--dired-set-no-of-active-buffers
  245.        t]
  246.       ["Define mouse bottons" hm--dired-define-keys t]
  247. ;;;;      ["Kill all dired buffers" 
  248. ;      ["Summary" dired-summary t]
  249.       ["Why" dired-why t]
  250.       )
  251.      ))
  252.  
  253.  
  254. (defun hm--install-dired-menu ()
  255.   "Installs the Dired menu at the menubar."
  256.   (if (and current-menubar (not (assoc "Dired" current-menubar)))
  257.       (progn
  258.     (set-buffer-menubar (copy-sequence current-menubar))
  259.     (add-menu nil "Dired" (cdr hm--dired-menu)))))
  260.  
  261.  
  262. (defun hm--popup-dired-menu (event)
  263.   "Display the Dired Menu."
  264.   (interactive "@e")
  265.   (mouse-set-point event)
  266.   (hm--dired-make-submenu-with-subdirs)
  267.   (popup-menu hm--dired-menu))
  268.  
  269.  
  270.  
  271. ;; Highlighting
  272.  
  273.  
  274. (defun hm--dired-highlight ()
  275.   "Highlights the lines in the dired buffer under the mouse."
  276. ;  (require 'mode-motion)
  277.   (setq mode-motion-hook 'mode-motion-highlight-line))
  278.  
  279.  
  280.  
  281. ;; Find file with the mouse
  282.  
  283.  
  284. (defun hm--dired-mouse-find-file (event)
  285.   "Function for find-file with the mouse."
  286.   (interactive "e")
  287.   (mouse-set-point event)
  288.   (dired-find-file))
  289.  
  290.  
  291.  
  292. ;; Functions and Variables which limits the number of dired buffers 
  293.  
  294.  
  295. (defvar hm--dirbuffer-list nil "*List with all dired buffers")
  296.  
  297.  
  298. (defun hm--dired-put-dirbuffer-in-list ()
  299.   (setq hm--dirbuffer-list (append hm--dirbuffer-list (list (buffer-name)))))
  300.  
  301.  
  302. (defun hm--dired-remove-dirbuffer-from-list (dirbuffer-list)
  303.   "Functions removes a dirbuffer from the list dirbuffer-list.
  304. It is nessessary to do this with the hm--dirbuffer-list, if 
  305. a dired-buffer is killed with kill-buffer."
  306.   (cond ((not dirbuffer-list) nil)
  307.     ((string= (car dirbuffer-list) (buffer-name))
  308.      (cdr dirbuffer-list))
  309.     (t (cons (car dirbuffer-list) 
  310.          (hm--dired-remove-dirbuffer-from-list 
  311.           (cdr dirbuffer-list))))))
  312.  
  313.  
  314. (defvar hm--dired-remove-dirbuffer-from-hm--dirbuffer-list t
  315.   "Controls, if the dirbuffer must removed from the hm--dirbuffer-list.
  316. Don't change this variable !")
  317.  
  318.  
  319. (defun hm--dired-remove-dirbuffer-from-hm--dirbuffer-list ()
  320.   "Function removes a dirbuffer from the list hm--dirbuffer-list.
  321. It is nessessary to do this, if a dired-buffer is killed with kill-buffer."
  322.   (if hm--dired-remove-dirbuffer-from-hm--dirbuffer-list
  323.       (setq hm--dirbuffer-list
  324.         (hm--dired-remove-dirbuffer-from-list hm--dirbuffer-list))))
  325.  
  326.  
  327. (defun hm--dired-kill-buffer (buffer)
  328.   "Internal Function for killing a buffer in the dired-mode."
  329.   (setq hm--dired-remove-dirbuffer-from-hm--dirbuffer-list nil)
  330.   (kill-buffer buffer)
  331.   (setq hm--dired-remove-dirbuffer-from-hm--dirbuffer-list t))
  332.  
  333.  
  334. (defun hm--dired-add-kill-buffer-hook ()
  335.   "Adds the function hm--dired-remove-dirbuffer-from-hm--dirbuffer-list
  336. to the kill-buffer-hook and makes the hook bufferlocal."
  337.   (make-local-variable 'kill-buffer-hook)
  338.   (add-hook 'kill-buffer-hook 
  339.         'hm--dired-remove-dirbuffer-from-hm--dirbuffer-list))
  340.  
  341.  
  342. (defvar hm--dired-old-buffer-name nil
  343.   "Holds the old buffername.")
  344.  
  345.  
  346. (defun hm--dired-kill-oldest-n-buffers (n)
  347.   "Kill the oldest n dired buffers."
  348.   (buffer-name)
  349.   (cond ((zerop n))
  350.     (t (cond ((equal (buffer-name) (car hm--dirbuffer-list))
  351.           (setq hm--dirbuffer-list 
  352.             (cdr (append hm--dirbuffer-list (list (buffer-name)))))
  353.           (hm--dired-kill-oldest-n-buffers n))
  354.          ((equal hm--dired-old-buffer-name (car hm--dirbuffer-list))
  355.           (setq hm--dirbuffer-list 
  356.             (cdr (append hm--dirbuffer-list 
  357.                      (list hm--dired-old-buffer-name))))
  358.           (hm--dired-kill-oldest-n-buffers n))
  359.          (t (hm--dired-kill-buffer (car hm--dirbuffer-list))
  360.             (setq hm--dirbuffer-list
  361.               (cdr hm--dirbuffer-list))
  362.             (hm--dired-kill-oldest-n-buffers (- n 1)))))))
  363.   
  364.  
  365. (defvar hm--dired-no-of-active-buffers 2 
  366. "*nil = all dired buffers will be active;
  367. n = only n dired buffers will be active;")
  368.  
  369.  
  370. (defun hm--dired-kill-oldest-buffers ()
  371.   "Kill the oldest dired buffers, so that only 
  372. hm--dired-no-of-active-buffers will be active after 
  373. this function call."
  374.   (interactive)
  375.   (if (and hm--dired-no-of-active-buffers
  376.        (< hm--dired-no-of-active-buffers (length hm--dirbuffer-list)))
  377.       (hm--dired-kill-oldest-n-buffers 
  378.        (- (length hm--dirbuffer-list) hm--dired-no-of-active-buffers))))
  379.  
  380.  
  381. (defun hm--dired-set-no-of-active-buffers (n)
  382.   "Set the number of active dired buffers.
  383. A negative value or 0 or 1 means, that no buffers will be killed."
  384.   (interactive "nMax no of active dired buffers (0 = no limit, 2, 3, 4,...): ")
  385.   (if (<= n 1)
  386.       (setq hm--dired-no-of-active-buffers nil)
  387.     (setq hm--dired-no-of-active-buffers n))
  388.   (hm--dired-kill-oldest-buffers))
  389.  
  390.  
  391. (defvar old-buf nil 
  392.   "This variable is normaly declared in the file dired.el and is
  393. used in the hm--dired-menu to determine the last visted dired-buffer.
  394. This is nessessary, because there is no other way (a hook for example)
  395. to do that.")
  396.  
  397.  
  398. (defun hm--dired-update-bufferlist-and-kill-oldest-buffers ()
  399.   (hm--dired-put-dirbuffer-in-list)
  400.   (setq hm--dired-old-buffer-name (buffer-name old-buf))
  401.   (switch-to-buffer (buffer-name))
  402.   (hm--dired-kill-oldest-buffers))
  403.  
  404.  
  405.  
  406. ;; Mark files in region for Copy, Delete ...
  407.  
  408.  
  409. (defun hm--dired-mark-region ()
  410.   "Mark all Files in the region."
  411.   (interactive)
  412.   (let ((start (region-beginning))
  413.     (end (region-end))
  414.     (position (point)))
  415.     (goto-char start)
  416.     (beginning-of-line)
  417.     (setq start (point))
  418.     (dired-mark-files-in-region start end)
  419.     (goto-char position)
  420.     (zmacs-deactivate-region)))
  421.  
  422.  
  423. ;; Functions and Variables for hiding and showing dot-files.
  424.  
  425.  
  426. (defvar hm--dired-hide-.-files nil 
  427.   "t = .-files are hide in the current buffer")
  428.  
  429. ;(setq hm--dired-hide-.-files nil)
  430.  
  431. ;(make-variable-buffer-local 'hm--dired-hide-.-files)
  432.  
  433.  
  434. (defun hm--dired-hide-.-files-in-buffer (buffer)
  435.   "Hide .-files in the dired-mode in the buffer buffer."
  436.   (set-buffer buffer)
  437.   (setq hm--dired-hide-.-files t)
  438.   (add-menu-item '("Dired") "Up directory" 'dired-up-directory t "Mark")
  439.   (setq dired-listing-switches "-l")
  440.   (setq dired-actual-switches "-l")
  441.   (revert-buffer))
  442.  
  443.  
  444. (defun hm--dired-hide-.-files-in-buffer-list (buffer-list)
  445.   "Hide .-files in the dired-mode in all buffers of the buffer-list."
  446.   (if buffer-list
  447.       (progn
  448.     (hm--dired-hide-.-files-in-buffer (car buffer-list))
  449.     (hm--dired-hide-.-files-in-buffer-list (cdr buffer-list)))))
  450.  
  451.  
  452. (defun hm--dired-hide-.-files ()
  453.   "Hide .-files in the dired-mode in all buffers."
  454.   (interactive)
  455.   (save-excursion
  456.     (if (not hm--dired-hide-.-files)
  457.     (progn
  458.       (setq hm--dired-menu 
  459.         (append '()
  460.             (list (car hm--dired-menu)
  461.                   ["Up directory" dired-up-directory t]
  462.                   "----")
  463.             (cdr hm--dired-menu)))
  464.       (hm--dired-hide-.-files-in-buffer-list hm--dirbuffer-list)))))
  465.  
  466.  
  467. (defun hm--dired-show-.-files-in-buffer (buffer)
  468.   "Show .-files in the dired-mode in buffer buffer."
  469.   (set-buffer buffer)
  470.   (setq hm--dired-hide-.-files nil)
  471.   (delete-menu-item '("Dired" "Up directory"))
  472.   (setq dired-listing-switches "-al")
  473.   (setq dired-actual-switches "-al")
  474.   (revert-buffer))
  475.  
  476.  
  477. (defun hm--dired-show-.-files-in-buffer-list (buffer-list)
  478.   "Show .-files in the dired-mode in all buffers of the buffer-list."
  479.   (if buffer-list
  480.       (progn
  481.     (hm--dired-show-.-files-in-buffer (car buffer-list))
  482.     (hm--dired-show-.-files-in-buffer-list (cdr buffer-list)))))
  483.  
  484.  
  485. (defun hm--dired-show-.-files ()
  486.   "Show .-files in the dired-mode in all buffers."
  487.   (interactive)
  488.   (save-excursion
  489.     (if hm--dired-hide-.-files
  490.     (progn
  491.       (setq hm--dired-menu 
  492.         (append '()
  493.             (list (car hm--dired-menu))
  494.             (cdr (cdr (cdr hm--dired-menu)))))
  495.       (hm--dired-show-.-files-in-buffer-list hm--dirbuffer-list)))))
  496.  
  497.  
  498.  
  499. ;; Clearing a buffer
  500.  
  501.  
  502. (defun hm--clear-buffer (buffer)
  503.   "Functions clears the buffer."
  504.   (interactive "bBuffername")
  505.   (delete-region (point-min) (point-max)))
  506.  
  507.  
  508.  
  509. ;; Functions which builds a submenu with the subdirectories
  510. ;; of the current directory.
  511.  
  512.  
  513. (defvar hm--dired-ls-flags "-AFL" 
  514.   "*A String with the flags used in the function hm--dired-ls for
  515. the ls command. This function is used to build the Menu
  516. (\"Dired\" \"Directory\" \"Goto relativ\"). Be carefull if you want to
  517. change this variable. The ls command must append a / on all files
  518. which are directories. The original flags are -AFL.")
  519.  
  520.  
  521. (defun hm--dired-ls ()
  522. "List the current directory in the buffer *hm-dired-tmp*."
  523.   (interactive)
  524.   (switch-to-buffer "*hm-dired-tmp*")
  525.   (hm--clear-buffer "*hm-dired-tmp*")
  526.   (call-process "ls" nil "*hm-dired-tmp*" nil hm--dired-ls-flags)
  527.   (goto-char (point-min)))
  528.  
  529.  
  530. (defun hm--dired-get-next-dir ()
  531. "Returns the next directoryname of the current buffer as string." 
  532.   (interactive)
  533.   (let ((repeat-search-p t)
  534.     (subdirectory nil))
  535.     (while repeat-search-p
  536.       (forward-word 1)
  537.       (end-of-line)
  538.       (if (not (char-after (point)))
  539.       (setq repeat-search-p nil)
  540.        (cond ((char-equal (char-after (- (point) 1)) ?/)
  541.           (set-mark (point))
  542.           (beginning-of-line)
  543.           (exchange-point-and-mark)
  544.           (setq subdirectory
  545.             (buffer-substring (mark t) (- (point) 1)))
  546.           (setq repeat-search-p nil)))))
  547.     subdirectory))
  548.  
  549.  
  550. ; The foolowing recursive function is correct, but fails if to many
  551. ; files are in a directory and the max-lisp-eval-depth is to small (Then
  552. ; the max-lisp-eval-depth exceeds.)
  553.  
  554. ;(defun hm--dired-get-next-dir ()
  555. ;"Returns the next directoryname of the current buffer as string." 
  556. ;; (interactive)
  557. ;  (forward-word 1)
  558. ;  (end-of-line)
  559. ;   (if (not (char-after (point)))
  560. ;       nil
  561. ;     (progn
  562. ;       (cond ((char-equal (char-after (- (point) 1)) ?/)
  563. ;          (set-mark (point))
  564. ;          (beginning-of-line)
  565. ;          (exchange-point-and-mark)
  566. ;          (buffer-substring (mark t) (- (point) 1)))
  567. ;         (t (hm--dired-get-next-dir))))))
  568.  
  569.  
  570. (defun hm--dired-make-subdirlist (subdirname)
  571. "Function returns a list with the subdirmenu."
  572.   (cond ((not subdirname) ())
  573.     (t (cons (vector subdirname
  574.              (list 'dired subdirname)
  575.              t)
  576.          (hm--dired-make-subdirlist (hm--dired-get-next-dir))))))
  577.  
  578.  
  579. (defun hm--dired-make-submenu-with-subdirs ()
  580.   "Function generates the \"Goto relativ\" submenu with the subdir entries."
  581.   (interactive)
  582.   (let ((submenu nil))
  583.     (save-excursion
  584.       (hm--dired-ls)
  585.       (setq submenu
  586.         (hm--dired-make-subdirlist (hm--dired-get-next-dir)))
  587.       (kill-buffer "*hm-dired-tmp*"))
  588.     (add-menu '("Dired" "Directory") 
  589.           "Goto relativ"
  590.           (cons
  591.            ["Up directory" dired-up-directory t]
  592.            (cons
  593.         "----"
  594.         submenu)))))
  595.  
  596.  
  597. (defun hm--dired-build-subdir-pulldown-menu ()
  598. "Hook-Function which builds a new subdir menu, if one selects the
  599. menubar in the Dired-mode. It is an activate-menubar-hook."
  600.   (if (string-equal mode-name "Dired")
  601.       (hm--dired-make-submenu-with-subdirs)))
  602.  
  603.  
  604.  
  605. ;; Functions which builds a submenu with the subdirectories
  606. ;; and menu item names defined in the file .lemacs-absolutdirs-menu.
  607.  
  608.  
  609. (defvar hm--dired-absolutdirs-filename "~/.lemacs-absolutdirs-menu"
  610.   "Name of the file (with path) which spezifies the menu items for
  611. the \"Goto absolut\".")
  612.  
  613.  
  614. (defun hm--dired-load-file-with-absolutdirs ()
  615.   "Function loads a file with specifies the menu items for the
  616. \"Goto absolut\" menu and returns the buffername or nil, if
  617. the file doesn't exist."
  618.   (if (file-readable-p hm--dired-absolutdirs-filename)
  619.       (let ((buffername (generate-new-buffer "*absolut-subdirs*")))
  620.     (switch-to-buffer buffername)
  621.     (insert-file hm--dired-absolutdirs-filename)
  622.     (goto-char (point-min))
  623.     buffername)
  624.     nil))
  625.  
  626.  
  627. (defun hm--dired-make-absolutdirlist (item-name directory-name)
  628.   "Returns a list with a menu item for the \"Goto absolut\" menu
  629. with item name item-name and the directory directory-name."
  630.   (cond ((not (and item-name directory-name)) ())
  631.     ((string= "-" directory-name) 
  632.      (cons item-name
  633.          (hm--dired-make-absolutdirlist (hm--dired-get-next-string)
  634.                         (hm--dired-get-next-string))))
  635.     (t (cons (vector item-name
  636.              (list 'dired directory-name)
  637.              t)
  638.          (hm--dired-make-absolutdirlist (hm--dired-get-next-string)
  639.                         (hm--dired-get-next-string))
  640.          ))))
  641.  
  642.  
  643. (defun hm--dired-get-next-string ()
  644.   "Returns the next string from the current buffer and moves the
  645. point behind that string. It returns nil, if the end of the buffer
  646. is reached !"
  647.   (interactive)
  648.   (forward-sexp)
  649.   (if (= (point) (point-max))
  650.       nil
  651.     (mark-sexp -1)
  652.     (buffer-substring (+ (mark t) 1) (- (point) 1))))
  653.  
  654.  
  655. (defun hm--dired-make-submenu-with-absolutdirs ()
  656.   "Function generates the \"Goto absolut\" submenu 
  657. with the absolut dir entries. The names of the menu-items
  658. and the directory strings must be in the current buffer.
  659. The point must be on the beginning of the buffer."
  660.   (interactive)
  661.   (let ((submenu nil))
  662.     (save-excursion
  663.       (let ((dirbuffer (hm--dired-load-file-with-absolutdirs)))
  664.     (if dirbuffer
  665.         (progn
  666.           (setq submenu
  667.             (hm--dired-make-absolutdirlist 
  668.              (hm--dired-get-next-string)
  669.              (hm--dired-get-next-string)))
  670.           (kill-buffer dirbuffer)))))
  671.     (add-menu '("Dired" "Directory") 
  672.           "Goto absolut"
  673.           (cons
  674.            ["Homedirectory"  (dired "~/") t]
  675.            submenu))))
  676.  
  677.  
  678. (defun hm--dired-install-submenu-with-absolutdirs ()
  679.   "Installs the submenu with the \"Goto absolut\" submenu."
  680.   (hm--dired-make-submenu-with-absolutdirs)
  681.   (remove-hook 'dired-mode-hook 'hm--dired-install-submenu-with-absolutdirs))
  682.  
  683.  
  684.  
  685. ;; Adding Hooks
  686.  
  687.  
  688. (add-hook 'dired-mode-hook  'hm--dired-install-submenu-with-absolutdirs)
  689.  
  690.  
  691. (add-hook 'activate-menubar-hook 'hm--dired-build-subdir-pulldown-menu)
  692.  
  693.  
  694. (add-hook 'dired-mode-hook 'hm--dired-highlight)
  695.  
  696.  
  697. (add-hook 'dired-mode-hook 'hm--install-dired-menu)
  698.  
  699.  
  700. (add-hook 'dired-mode-hook ;'dired-after-readin-hook 
  701.       'hm--dired-update-bufferlist-and-kill-oldest-buffers)
  702.  
  703.  
  704. (add-hook 'dired-mode-hook 'hm--dired-add-kill-buffer-hook)
  705.  
  706.  
  707. ;; Defining the mouse buttons
  708.  
  709. (defun hm--dired-define-keys ()
  710.   "Function defines keys for the hm--dired-menu.
  711. This function is used in the dired menu."
  712.   (interactive)
  713.   (define-key dired-mode-map '(button2) 'hm--dired-mouse-find-file)
  714.   (define-key dired-mode-map '(button3) 'hm--dired-mouse-right)
  715. ;  (define-key dired-mode-map '(button3) 'hm--popup-dired-menu)
  716.   )
  717.  
  718. (hm--dired-define-keys)
  719.  
  720. ---- end of hm--dired-menu.el ----
  721. ---- begin of hm--mouse-on-modeline-ext.el ----
  722. ;;; hm--mouse-on-modeline-ext.el: 
  723. ;;; v1.01; 6 Jun 1993
  724. ;;; Copyright (C) 1993  Heiko Muenkel
  725. ;;; email: muenkel@tnt.uni-hannover.de
  726. ;;;
  727. ;;; This file is based on some lips code which was posted by Mike Scheidler 
  728. ;;; and Bob Weiner. Thank you for this nice code !
  729. ;;;
  730. ;;;
  731. ;;;  This program is free software; you can redistribute it and/or modify
  732. ;;;  it under the terms of the GNU General Public License as published by
  733. ;;;  the Free Software Foundation; either version 1, or (at your option)
  734. ;;;  any later version.
  735. ;;;
  736. ;;;  This program is distributed in the hope that it will be useful,
  737. ;;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  738. ;;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  739. ;;;  GNU General Public License for more details.
  740. ;;;
  741. ;;;  You should have received a copy of the GNU General Public License
  742. ;;;  along with this program; if not, write to the Free Software
  743. ;;;  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  744. ;;;
  745. ;;; 
  746. ;;; Description:
  747. ;;;
  748. ;;;    Scrolls the current buffer, if you are clicking the left or the rigth
  749. ;;;     button on a modeline.
  750. ;;; 
  751. ;;; Installation: 
  752. ;;;   
  753. ;;;    Put the following line in your .emacs:
  754. ;;;       (load-library "hm--mouse-on-modeline-ext")
  755. ;;;     and this file in one of your load-path-directories (lisp/dired for 
  756. ;;;     example).  
  757. ;;;
  758.  
  759.  
  760. (defun mouse-on-modeline-p ()
  761.   "Non-nil iff mouse pointer is within a modeline."
  762.   (equal x-mode-pointer-shape (cdr (assq 'pointer (screen-parameters)))))
  763.  
  764. (defun mouse-left (event)
  765.   "Perform commands bound to left mouse button."
  766.   (interactive "@e")
  767.   (if (mouse-on-modeline-p)
  768.       (scroll-down)
  769.     (mouse-track event)))
  770.  
  771. ;; Mode specific scroll functions
  772.  
  773. (defun hm--dired-mouse-right (event)
  774.   "Perform commands bound to right mouse button."
  775.   (interactive "@e")
  776.   (if (mouse-on-modeline-p)
  777.       (scroll-up)
  778.     (hm--popup-dired-menu event)))
  779.  
  780. (defun hm--info-mouse-right (event)
  781.   "Perform commands bound to right mouse button."
  782.   (interactive "@e")
  783.   (if (mouse-on-modeline-p)
  784.       (scroll-up)
  785.     (Info-select-node-menu event)))
  786.  
  787. (defun hm--buffer-mouse-right (event)
  788.   "Perform commands bound to right mouse button."
  789.   (interactive "@e")
  790.   (if (mouse-on-modeline-p)
  791.       (scroll-up)
  792.     (Buffer-menu-popup-menu event)))
  793.  
  794.  
  795. ;; Key-Bindings
  796.  
  797. (global-set-key 'button1 'mouse-left)
  798.  
  799. (define-key Info-mode-map '(button3) 'hm--info-mouse-right)
  800.  
  801. (define-key Buffer-menu-mode-map '(button3) 'hm--buffer-mouse-right)
  802.  
  803.  
  804.  
  805. ---- end of hm--mouse-on-modeline-ext.el ----
  806.  
  807.  
  808. Heiko
  809.  
  810.  
  811. PS: I've tried to post a similar posting in the mornig, but it seems, that 
  812.     something was going wrong with that.
  813. --
  814. ________________________________________________________________________________
  815.  
  816. Dipl.-Ing. Heiko Muenkel           Universitaet Hannover
  817.                    Institut fuer Theoretische Nachrichtentechnik
  818.                    und Informationsverarbeitung
  819. muenkel@tnt.uni-hannover.de        Appelstrasse 9A
  820. fax:    +49-511-762-5333           D-3000 Hannover 1
  821. phone:  +49-511-762-5323           Germany
  822. ________________________________________________________________________________
  823.  
  824.