Subject: New version of hm--dired-menu.el
From: [email-masked] (Heiko Muenkel)
Date: 12 Jun 1993 00:20:16 +0300
Newsgroups: alt.lucid-emacs.help,comp.os.linux.announce

Hi !

I've written a new Version of my hm--dired-menu.el which fixes a bug and adds
some new features. You need also the file hm--mouse-on-modeline-ext.el, which 
is based on some lisp code posted by Mike Scheidler and Bob Weiner.
These files are providing a pulldown and popup menu, scrolling with the mouse,
find-file with the second mousebutton and some other usefull
functions for the dired mode in the lemacs. Look at the description of 
hm--dired-menu.el for more details.

I've tested this code with the lemacs 19.4 under SunOS 4.1.3 and under Linux,
but I think it should work also with lemacs 19.6 and on other platforms.

You can find some installation hints in the file hm--dired-menu.el.

Here are the 2 files:

---- begin of hm--dired-menu.el ----
;;;  hm--dired-menu.el: A menu for the dired-mode.
;;;  v2.00; 9 Jun 1993
;;;  Copyright (C) 1993  Heiko Muenkel
;;;  email: [email-masked]
;;;
;;;  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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; Description:
;;;
;;;   This file provides a puldown and a popup menu for the dired mode
;;;   in the lemacs. You can reach most of the dired functions from this
;;;   menu. But the file adds also some other usefull functions. One is
;;;   the posibility to limit the maximum number of dired buffers to a value
;;;   bigger or equal to 2. That can be done over the menu item ("Dired"
;;;   "Customize" "Set no of active buffers") or with the function 
;;;   hm--dired-set-no-of-active-buffers or by direct setting of the
;;;   variable hm--dired-no-of-active-buffers. 
;;;   Another usefull feature is the possibility to run the command find-file
;;;   on the file under the mouse button (therefor the line is highlighted)
;;;   only by clicking on the second mouse button.
;;;   To switch to a subdirectory of the current directory you can also use
;;;   the submenu items of ("Dired" "Directory" "Goto relativ").
;;;   With the submenu items of ("Dired" "Directory" "Goto absolut") you can
;;;   switch to another "absolut" directory. This submenu contains normaly
;;;   only the item "Homedirectory" but you can add further items by writing
;;;   a file specified by the variable hm--dired-absolutdirs-filename, which
;;;   has the defaultvalue "~/.lemacs-absolutdirs-menu". The lines in that
;;;   file should look like the following 3 lines (without ;;;):
;;;      "-" "-"
;;;      "Binaries" "/usr/bin"
;;;      "Emacs"    "/usr/local/emacs"
;;;
;;;   Another added feature is the posibiltity to mark files (i.e. for copy 
;;;   operations) which are in a active region.  
;;; 
;;;   If you load the file hm--mouse-on-modeline-ext.el after this file, you
;;;   can scroll the dired buffers with the left and the rigth mouse buttons,
;;;   if the mouse pointer is on a modeline. 
;;;
;;; Installation: 
;;;   Put hm--dired-menu.el and hm--mouse-on-modeline-ext.el in a load-path- 
;;;   directory (lisp/dired for example).
;;;   Write the following 2 lines in your .emacs- file:
;;;
;;;   (load-library "hm--dired-menu")
;;;   (load-library "hm--mouse-on-modeline-ext")
;;;  
;;;   If you want to load this files only, if you use the dired-mode, you
;;;   you should instead write the above lines at the end of the dired.el 
;;;   file (don't forget to recompile the dired.el after that).
;;;
;;;   If you don't want to use the file hm--mouse-on-modeline-ext.el, you
;;;   must uncomment the line 
;;;     (define-key dired-mode-map '(button3) 'hm--popup-dired-menu)
;;;   and comment the line
;;;     (define-key dired-mode-map '(button3) 'hm--dired-mouse-right)
;;;   in the function hm--dired-define-keys at the end of this file.
;;;

(provide 'hm--dired-menu)
(require 'dired)
(require 'mode-motion)

; Try to set the max-lisp-eval-depth higher, if one of the following
; function fails with the message that the max lisp eval depth is
; excided.

(if (< max-lisp-eval-depth 400)
    (setq max-lisp-eval-depth 400))

;; Popup and Pulldown Menu

(defvar hm--dired-menu nil "*A list with the menue Dired.")

(setq hm--dired-menu
       '("Dired Menu"
	 ("Mark"
;	  ["Mark file" dired-mark-file t]
	  ["Mark subdir or file" dired-mark-subdir-or-file t]
	  ["Mark region" hm--dired-mark-region t]
	  ["Mark files regexp..." dired-mark-files-regexp t]
	  ["Mark directories" dired-mark-directories t]
;	  ["Mark subdir files" dired-mark-subdir-files nil]
	  ["Mark executables" dired-mark-executables t]
	  ["Mark symlinks" dired-mark-symlinks t]
	  "----"
	  ["Unmark file" dired-unmark-subdir-or-file t]
	  ["Unmark all files" (dired-unflag-all-files nil) t]
	  ["Query unmark all files..." (dired-unflag-all-files nil t) t]
	  )
	 "----"
	 ("Copy/Link"
	  ["Copy files..." dired-do-copy t]
	  ["Copy regexp files..." dired-do-copy-regexp t]
	  "----"
	  ["Sym-link files in directory..." dired-do-symlink t]
	  ["Sym-link regexp files in directory..." 
	   dired-do-symlink-regexp t]
	  "----"
	  ["Hard-link files in directory..." dired-do-hardlink t]
	  ["Hard-link regexp files in directory..." 
	   dired-do-hardlink-regexp t]
	  )
	 ("Rename"
	  ["Rename files..." dired-do-move t]
	  ["Rename regexp files..." dired-do-rename-regexp t]
	  "----"
	  ["Downcase files..." dired-downcase t]
	  ["Upcase files..." dired-upcase t]
	  )
	 ("Delete"
	  ["Delete marked files..." dired-do-delete t]
	  ["Delete flaged files..." dired-do-deletions t]
	  "----"
	  ["Flag file" dired-flag-file-deleted t]
	  ["Flag regexp files..."  dired-flag-regexp-files t]
	  ["Flag backup files" dired-clean-directory t]
	  ["Flag auto save files" dired-flag-auto-save-files t]
	  "----"
	  ["Unflag file" dired-unflag t]
	  ["Unflag backup files" dired-backup-unflag t]
	  ["Unflag all files" (dired-unflag-all-files nil) t]
	  ["Query unflag all files..." (dired-unflag-all-files nil) t]
	  )
	 ("Shell commands"
	  ["Compress files..." dired-do-compress t]
	  ["Uncompress files..." dired-do-uncompress t]
	  ["Print files..." dired-do-print t]
	  ["Shell command on files..." dired-do-shell-command t]
	  ["Byte compile files..." dired-do-byte-compile t]
	  "----"
	  ("Compare"
	   ["Backup diff" dired-backup-diff t]
	   ["Diff file..." dired-diff t]
	   )
	  ("File properties"
	   ["Change mod of files..." dired-do-chmod t]
	   ["Change group of files..." dired-do-chgrp t]
	   ["Change owner of files..." dired-do-chown t]
	   )
	  )
	 ("Load/Find"
	  ["Load file" dired-do-load t]
	  ["Find file" dired-find-file t]
	  ["Find file other window" dired-find-file-other-window t]
	  ["View file" dired-view-file t]
	  )
	 "----"
	 ("Directory"
	  ("Goto relativ"
	   ["Up directory" dired-up-directory t]
	   )
	  ("Goto absolut"
	   ["Homedirectory" (dired "~/") t]
	   )
	  "----"
	  ["Dired..." dired t]
	  ["Dired other window..." dired-other-window t]
	  ["Quit" dired-quit t]
	  "----"
	  ["Create directory..." dired-create-directory t]
	  "----"
	  ["Insert subdir" dired-insert-subdir t]
;	  ["Maybe insert subdir" dired-maybe-insert-subdir t]
	  ["Hide subdir" dired-kill-subdir t]
	  ["Hide all subdirs..." dired-kill-tree t]
;	  ["Build subdir alist" dired-build-subdir-alist t]
	  )
	 ("Goto"
	  ["Next Page" scroll-up t]
	  ["Next dirline" dired-next-dirline t]
	  ["Next marked file" dired-next-marked-file t]
;	  ["Next line" dired-next-line t]
	  ["End of buffer" end-of-buffer t]
	  "----"
	  ["Previous Page" scroll-down t]
	  ["Previous dirline" dired-prev-dirline t]
	  ["Previous marked file" dired-prev-marked-file t]
;      	  ["Previous line" dired-previous-line t]
	  ["Begin of buffer" beginning-of-buffer t]
	  "----"
	  ["File..." dired-goto-file t]
	  ["Headerline..." dired-goto-subdir t]
	  ["Subdir down" dired-tree-down t]
	  ["Subdir up" dired-tree-up t]
	  )
	 ("Customize"
	  ["Undisplay line or subdir" dired-kill-line-or-subdir t]
;	  ["Undisplay line" dired-kill-line t]
;	  ["Undisplay subdir" dired-kill-subdir t]
	  ["Undisplay tree" dired-kill-tree t]
	  ["Undisplay marked lines" dired-do-kill t]
	  "----"
;	  ["(Un)Hide subdir" dired-hide-subdir t]
;	  ["Hide all subdirs" dired-hide-subdir t]
	  ["Toggle sort by date/name" dired-sort-toggle-or-edit t]
	  ["Hide '.' files" hm--dired-hide-.-files t]
	  ["Show '.' files" hm--dired-show-.-files t]
	  ["Edit ls switches..." (dired-sort-toggle-or-edit t) t]
	  "----"
	  ["Redisplay all files" revert-buffer t]
	  ["Redisplay all marked files" dired-do-redisplay t]
	  ["Undo" dired-undo t]
	  "----"
	  ["Set no of active buffers" hm--dired-set-no-of-active-buffers
	   t]
	  ["Define mouse bottons" hm--dired-define-keys t]
;;;;	  ["Kill all dired buffers" 
;	  ["Summary" dired-summary t]
	  ["Why" dired-why t]
	  )
	 ))

(defun hm--install-dired-menu ()
  "Installs the Dired menu at the menubar."
  (if (and current-menubar (not (assoc "Dired" current-menubar)))
      (progn
	(set-buffer-menubar (copy-sequence current-menubar))
	(add-menu nil "Dired" (cdr hm--dired-menu)))))

(defun hm--popup-dired-menu (event)
  "Display the Dired Menu."
  (interactive "@e")
  (mouse-set-point event)
  (hm--dired-make-submenu-with-subdirs)
  (popup-menu hm--dired-menu))

;; Highlighting

(defun hm--dired-highlight ()
  "Highlights the lines in the dired buffer under the mouse."
;  (require 'mode-motion)
  (setq mode-motion-hook 'mode-motion-highlight-line))

;; Find file with the mouse

(defun hm--dired-mouse-find-file (event)
  "Function for find-file with the mouse."
  (interactive "e")
  (mouse-set-point event)
  (dired-find-file))

;; Functions and Variables which limits the number of dired buffers 

(defvar hm--dirbuffer-list nil "*List with all dired buffers")

(defun hm--dired-put-dirbuffer-in-list ()
  (setq hm--dirbuffer-list (append hm--dirbuffer-list (list (buffer-name)))))

(defun hm--dired-remove-dirbuffer-from-list (dirbuffer-list)
  "Functions removes a dirbuffer from the list dirbuffer-list.
It is nessessary to do this with the hm--dirbuffer-list, if 
a dired-buffer is killed with kill-buffer."
  (cond ((not dirbuffer-list) nil)
	((string= (car dirbuffer-list) (buffer-name))
	 (cdr dirbuffer-list))
	(t (cons (car dirbuffer-list) 
		 (hm--dired-remove-dirbuffer-from-list 
		  (cdr dirbuffer-list))))))

(defvar hm--dired-remove-dirbuffer-from-hm--dirbuffer-list t
  "Controls, if the dirbuffer must removed from the hm--dirbuffer-list.
Don't change this variable !")

(defun hm--dired-remove-dirbuffer-from-hm--dirbuffer-list ()
  "Function removes a dirbuffer from the list hm--dirbuffer-list.
It is nessessary to do this, if a dired-buffer is killed with kill-buffer."
  (if hm--dired-remove-dirbuffer-from-hm--dirbuffer-list
      (setq hm--dirbuffer-list
	    (hm--dired-remove-dirbuffer-from-list hm--dirbuffer-list))))

(defun hm--dired-kill-buffer (buffer)
  "Internal Function for killing a buffer in the dired-mode."
  (setq hm--dired-remove-dirbuffer-from-hm--dirbuffer-list nil)
  (kill-buffer buffer)
  (setq hm--dired-remove-dirbuffer-from-hm--dirbuffer-list t))

(defun hm--dired-add-kill-buffer-hook ()
  "Adds the function hm--dired-remove-dirbuffer-from-hm--dirbuffer-list
to the kill-buffer-hook and makes the hook bufferlocal."
  (make-local-variable 'kill-buffer-hook)
  (add-hook 'kill-buffer-hook 
	    'hm--dired-remove-dirbuffer-from-hm--dirbuffer-list))

(defvar hm--dired-old-buffer-name nil
  "Holds the old buffername.")

(defun hm--dired-kill-oldest-n-buffers (n)
  "Kill the oldest n dired buffers."
  (buffer-name)
  (cond ((zerop n))
	(t (cond ((equal (buffer-name) (car hm--dirbuffer-list))
		  (setq hm--dirbuffer-list 
			(cdr (append hm--dirbuffer-list (list (buffer-name)))))
		  (hm--dired-kill-oldest-n-buffers n))
		 ((equal hm--dired-old-buffer-name (car hm--dirbuffer-list))
		  (setq hm--dirbuffer-list 
			(cdr (append hm--dirbuffer-list 
				     (list hm--dired-old-buffer-name))))
		  (hm--dired-kill-oldest-n-buffers n))
		 (t (hm--dired-kill-buffer (car hm--dirbuffer-list))
		    (setq hm--dirbuffer-list
			  (cdr hm--dirbuffer-list))
		    (hm--dired-kill-oldest-n-buffers (- n 1)))))))

(defvar hm--dired-no-of-active-buffers 2 
"*nil = all dired buffers will be active;
n = only n dired buffers will be active;")

(defun hm--dired-kill-oldest-buffers ()
  "Kill the oldest dired buffers, so that only 
hm--dired-no-of-active-buffers will be active after 
this function call."
  (interactive)
  (if (and hm--dired-no-of-active-buffers
	   (< hm--dired-no-of-active-buffers (length hm--dirbuffer-list)))
      (hm--dired-kill-oldest-n-buffers 
       (- (length hm--dirbuffer-list) hm--dired-no-of-active-buffers))))

(defun hm--dired-set-no-of-active-buffers (n)
  "Set the number of active dired buffers.
A negative value or 0 or 1 means, that no buffers will be killed."
  (interactive "nMax no of active dired buffers (0 = no limit, 2, 3, 4,...): ")
  (if (<= n 1)
      (setq hm--dired-no-of-active-buffers nil)
    (setq hm--dired-no-of-active-buffers n))
  (hm--dired-kill-oldest-buffers))

(defvar old-buf nil 
  "This variable is normaly declared in the file dired.el and is
used in the hm--dired-menu to determine the last visted dired-buffer.
This is nessessary, because there is no other way (a hook for example)
to do that.")

(defun hm--dired-update-bufferlist-and-kill-oldest-buffers ()
  (hm--dired-put-dirbuffer-in-list)
  (setq hm--dired-old-buffer-name (buffer-name old-buf))
  (switch-to-buffer (buffer-name))
  (hm--dired-kill-oldest-buffers))

;; Mark files in region for Copy, Delete ...

(defun hm--dired-mark-region ()
  "Mark all Files in the region."
  (interactive)
  (let ((start (region-beginning))
	(end (region-end))
	(position (point)))
    (goto-char start)
    (beginning-of-line)
    (setq start (point))
    (dired-mark-files-in-region start end)
    (goto-char position)
    (zmacs-deactivate-region)))

;; Functions and Variables for hiding and showing dot-files.

(defvar hm--dired-hide-.-files nil 
  "t = .-files are hide in the current buffer")

;(setq hm--dired-hide-.-files nil)

;(make-variable-buffer-local 'hm--dired-hide-.-files)

(defun hm--dired-hide-.-files-in-buffer (buffer)
  "Hide .-files in the dired-mode in the buffer buffer."
  (set-buffer buffer)
  (setq hm--dired-hide-.-files t)
  (add-menu-item '("Dired") "Up directory" 'dired-up-directory t "Mark")
  (setq dired-listing-switches "-l")
  (setq dired-actual-switches "-l")
  (revert-buffer))

(defun hm--dired-hide-.-files-in-buffer-list (buffer-list)
  "Hide .-files in the dired-mode in all buffers of the buffer-list."
  (if buffer-list
      (progn
	(hm--dired-hide-.-files-in-buffer (car buffer-list))
	(hm--dired-hide-.-files-in-buffer-list (cdr buffer-list)))))

(defun hm--dired-hide-.-files ()
  "Hide .-files in the dired-mode in all buffers."
  (interactive)
  (save-excursion
    (if (not hm--dired-hide-.-files)
	(progn
	  (setq hm--dired-menu 
		(append '()
			(list (car hm--dired-menu)
			      ["Up directory" dired-up-directory t]
			      "----")
			(cdr hm--dired-menu)))
	  (hm--dired-hide-.-files-in-buffer-list hm--dirbuffer-list)))))

(defun hm--dired-show-.-files-in-buffer (buffer)
  "Show .-files in the dired-mode in buffer buffer."
  (set-buffer buffer)
  (setq hm--dired-hide-.-files nil)
  (delete-menu-item '("Dired" "Up directory"))
  (setq dired-listing-switches "-al")
  (setq dired-actual-switches "-al")
  (revert-buffer))

(defun hm--dired-show-.-files-in-buffer-list (buffer-list)
  "Show .-files in the dired-mode in all buffers of the buffer-list."
  (if buffer-list
      (progn
	(hm--dired-show-.-files-in-buffer (car buffer-list))
	(hm--dired-show-.-files-in-buffer-list (cdr buffer-list)))))

(defun hm--dired-show-.-files ()
  "Show .-files in the dired-mode in all buffers."
  (interactive)
  (save-excursion
    (if hm--dired-hide-.-files
	(progn
	  (setq hm--dired-menu 
		(append '()
			(list (car hm--dired-menu))
			(cdr (cdr (cdr hm--dired-menu)))))
	  (hm--dired-show-.-files-in-buffer-list hm--dirbuffer-list)))))

;; Clearing a buffer

(defun hm--clear-buffer (buffer)
  "Functions clears the buffer."
  (interactive "bBuffername")
  (delete-region (point-min) (point-max)))

;; Functions which builds a submenu with the subdirectories
;; of the current directory.

(defvar hm--dired-ls-flags "-AFL" 
  "*A String with the flags used in the function hm--dired-ls for
the ls command. This function is used to build the Menu
(\"Dired\" \"Directory\" \"Goto relativ\"). Be carefull if you want to
change this variable. The ls command must append a / on all files
which are directories. The original flags are -AFL.")

(defun hm--dired-ls ()
"List the current directory in the buffer *hm-dired-tmp*."
  (interactive)
  (switch-to-buffer "*hm-dired-tmp*")
  (hm--clear-buffer "*hm-dired-tmp*")
  (call-process "ls" nil "*hm-dired-tmp*" nil hm--dired-ls-flags)
  (goto-char (point-min)))

(defun hm--dired-get-next-dir ()
"Returns the next directoryname of the current buffer as string." 
  (interactive)
  (let ((repeat-search-p t)
	(subdirectory nil))
    (while repeat-search-p
      (forward-word 1)
      (end-of-line)
      (if (not (char-after (point)))
	  (setq repeat-search-p nil)
       (cond ((char-equal (char-after (- (point) 1)) ?/)
	      (set-mark (point))
	      (beginning-of-line)
	      (exchange-point-and-mark)
	      (setq subdirectory
		    (buffer-substring (mark t) (- (point) 1)))
	      (setq repeat-search-p nil)))))
    subdirectory))

; The foolowing recursive function is correct, but fails if to many
; files are in a directory and the max-lisp-eval-depth is to small (Then
; the max-lisp-eval-depth exceeds.)

;(defun hm--dired-get-next-dir ()
;"Returns the next directoryname of the current buffer as string." 
;; (interactive)
;  (forward-word 1)
;  (end-of-line)
;   (if (not (char-after (point)))
;       nil
;     (progn
;       (cond ((char-equal (char-after (- (point) 1)) ?/)
;	      (set-mark (point))
;	      (beginning-of-line)
;	      (exchange-point-and-mark)
;	      (buffer-substring (mark t) (- (point) 1)))
;	     (t (hm--dired-get-next-dir))))))

(defun hm--dired-make-subdirlist (subdirname)
"Function returns a list with the subdirmenu."
  (cond ((not subdirname) ())
	(t (cons (vector subdirname
			 (list 'dired subdirname)
			 t)
		 (hm--dired-make-subdirlist (hm--dired-get-next-dir))))))

(defun hm--dired-make-submenu-with-subdirs ()
  "Function generates the \"Goto relativ\" submenu with the subdir entries."
  (interactive)
  (let ((submenu nil))
    (save-excursion
      (hm--dired-ls)
      (setq submenu
	    (hm--dired-make-subdirlist (hm--dired-get-next-dir)))
      (kill-buffer "*hm-dired-tmp*"))
    (add-menu '("Dired" "Directory") 
	      "Goto relativ"
	      (cons
	       ["Up directory" dired-up-directory t]
	       (cons
		"----"
		submenu)))))

(defun hm--dired-build-subdir-pulldown-menu ()
"Hook-Function which builds a new subdir menu, if one selects the
menubar in the Dired-mode. It is an activate-menubar-hook."
  (if (string-equal mode-name "Dired")
      (hm--dired-make-submenu-with-subdirs)))

;; Functions which builds a submenu with the subdirectories
;; and menu item names defined in the file .lemacs-absolutdirs-menu.

(defvar hm--dired-absolutdirs-filename "~/.lemacs-absolutdirs-menu"
  "Name of the file (with path) which spezifies the menu items for
the \"Goto absolut\".")

(defun hm--dired-load-file-with-absolutdirs ()
  "Function loads a file with specifies the menu items for the
\"Goto absolut\" menu and returns the buffername or nil, if
the file doesn't exist."
  (if (file-readable-p hm--dired-absolutdirs-filename)
      (let ((buffername (generate-new-buffer "*absolut-subdirs*")))
	(switch-to-buffer buffername)
	(insert-file hm--dired-absolutdirs-filename)
	(goto-char (point-min))
	buffername)
    nil))

(defun hm--dired-make-absolutdirlist (item-name directory-name)
  "Returns a list with a menu item for the \"Goto absolut\" menu
with item name item-name and the directory directory-name."
  (cond ((not (and item-name directory-name)) ())
	((string= "-" directory-name) 
	 (cons item-name
		 (hm--dired-make-absolutdirlist (hm--dired-get-next-string)
						(hm--dired-get-next-string))))
	(t (cons (vector item-name
			 (list 'dired directory-name)
			 t)
		 (hm--dired-make-absolutdirlist (hm--dired-get-next-string)
						(hm--dired-get-next-string))
		 ))))

(defun hm--dired-get-next-string ()
  "Returns the next string from the current buffer and moves the
point behind that string. It returns nil, if the end of the buffer
is reached !"
  (interactive)
  (forward-sexp)
  (if (= (point) (point-max))
      nil
    (mark-sexp -1)
    (buffer-substring (+ (mark t) 1) (- (point) 1))))

(defun hm--dired-make-submenu-with-absolutdirs ()
  "Function generates the \"Goto absolut\" submenu 
with the absolut dir entries. The names of the menu-items
and the directory strings must be in the current buffer.
The point must be on the beginning of the buffer."
  (interactive)
  (let ((submenu nil))
    (save-excursion
      (let ((dirbuffer (hm--dired-load-file-with-absolutdirs)))
	(if dirbuffer
	    (progn
	      (setq submenu
		    (hm--dired-make-absolutdirlist 
		     (hm--dired-get-next-string)
		     (hm--dired-get-next-string)))
	      (kill-buffer dirbuffer)))))
    (add-menu '("Dired" "Directory") 
	      "Goto absolut"
	      (cons
	       ["Homedirectory"  (dired "~/") t]
	       submenu))))

(defun hm--dired-install-submenu-with-absolutdirs ()
  "Installs the submenu with the \"Goto absolut\" submenu."
  (hm--dired-make-submenu-with-absolutdirs)
  (remove-hook 'dired-mode-hook 'hm--dired-install-submenu-with-absolutdirs))

;; Adding Hooks

(add-hook 'dired-mode-hook  'hm--dired-install-submenu-with-absolutdirs)

(add-hook 'activate-menubar-hook 'hm--dired-build-subdir-pulldown-menu)

(add-hook 'dired-mode-hook 'hm--dired-highlight)

(add-hook 'dired-mode-hook 'hm--install-dired-menu)

(add-hook 'dired-mode-hook ;'dired-after-readin-hook 
	  'hm--dired-update-bufferlist-and-kill-oldest-buffers)

(add-hook 'dired-mode-hook 'hm--dired-add-kill-buffer-hook)

;; Defining the mouse buttons

(defun hm--dired-define-keys ()
  "Function defines keys for the hm--dired-menu.
This function is used in the dired menu."
  (interactive)
  (define-key dired-mode-map '(button2) 'hm--dired-mouse-find-file)
  (define-key dired-mode-map '(button3) 'hm--dired-mouse-right)
;  (define-key dired-mode-map '(button3) 'hm--popup-dired-menu)
  )

(hm--dired-define-keys)

---- end of hm--dired-menu.el ----

---- begin of hm--mouse-on-modeline-ext.el ----
;;; hm--mouse-on-modeline-ext.el: 
;;; v1.01; 6 Jun 1993
;;; Copyright (C) 1993  Heiko Muenkel
;;; email: [email-masked]
;;;
;;; This file is based on some lips code which was posted by Mike Scheidler 
;;; and Bob Weiner. Thank you for this nice code !
;;;
;;;
;;;  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 1, 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., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; 
;;; Description:
;;;
;;;	Scrolls the current buffer, if you are clicking the left or the rigth
;;;     button on a modeline.
;;; 
;;; Installation: 
;;;   
;;;	Put the following line in your .emacs:
;;;       (load-library "hm--mouse-on-modeline-ext")
;;;     and this file in one of your load-path-directories (lisp/dired for 
;;;     example).  
;;;

(defun mouse-on-modeline-p ()
  "Non-nil iff mouse pointer is within a modeline."
  (equal x-mode-pointer-shape (cdr (assq 'pointer (screen-parameters)))))

(defun mouse-left (event)
  "Perform commands bound to left mouse button."
  (interactive "@e")
  (if (mouse-on-modeline-p)
      (scroll-down)
    (mouse-track event)))

;; Mode specific scroll functions

(defun hm--dired-mouse-right (event)
  "Perform commands bound to right mouse button."
  (interactive "@e")
  (if (mouse-on-modeline-p)
      (scroll-up)
    (hm--popup-dired-menu event)))

(defun hm--info-mouse-right (event)
  "Perform commands bound to right mouse button."
  (interactive "@e")
  (if (mouse-on-modeline-p)
      (scroll-up)
    (Info-select-node-menu event)))

(defun hm--buffer-mouse-right (event)
  "Perform commands bound to right mouse button."
  (interactive "@e")
  (if (mouse-on-modeline-p)
      (scroll-up)
    (Buffer-menu-popup-menu event)))

;; Key-Bindings

(global-set-key 'button1 'mouse-left)

(define-key Info-mode-map '(button3) 'hm--info-mouse-right)

(define-key Buffer-menu-mode-map '(button3) 'hm--buffer-mouse-right)

---- end of hm--mouse-on-modeline-ext.el ----

Heiko
--
________________________________________________________________________________

Dipl.-Ing. Heiko Muenkel           Universitaet Hannover
				   Institut fuer Theoretische Nachrichtentechnik
				   und Informationsverarbeitung
[email-masked]        Appelstrasse 9A
fax:    +49-511-762-5333           D-3000 Hannover 1
phone:  +49-511-762-5323           Germany
________________________________________________________________________________