diff lisp/hm--html-menus/adapt.el @ 153:25f70ba0133c r20-3b3

Import from CVS: tag r20-3b3
author cvs
date Mon, 13 Aug 2007 09:38:25 +0200
parents 9f59509498e1
children 6075d714658b
line wrap: on
line diff
--- a/lisp/hm--html-menus/adapt.el	Mon Aug 13 09:37:21 2007 +0200
+++ b/lisp/hm--html-menus/adapt.el	Mon Aug 13 09:38:25 2007 +0200
@@ -1,4 +1,4 @@
-;;; $Id: adapt.el,v 1.3 1997/03/28 02:28:41 steve Exp $
+;;; $Id: adapt.el,v 1.4 1997/05/29 23:49:41 steve Exp $
 ;;;
 ;;; Copyright (C) 1993 - 1997  Heiko Muenkel
 ;;; email: muenkel@tnt.uni-hannover.de
@@ -236,7 +236,23 @@
 	    (and (eventp obj)
 		 (or (eq 'mouse-1 (event-basic-type obj))
 		     (eq 'mouse-2 (event-basic-type obj))
-		     (eq 'mouse-3 (event-basic-type obj))))))
+		     (eq 'mouse-3 (event-basic-type obj))
+		     (eq 'down-mouse-1 (event-basic-type obj))
+		     (eq 'down-mouse-2 (event-basic-type obj))
+		     (eq 'down-mouse-3 (event-basic-type obj))
+		     (eq 'up-mouse-1 (event-basic-type obj))
+		     (eq 'up-mouse-2 (event-basic-type obj))
+		     (eq 'up-mouse-3 (event-basic-type obj))
+		     (eq 'drag-mouse-1 (event-basic-type obj))
+		     (eq 'drag-mouse-2 (event-basic-type obj))
+		     (eq 'drag-mouse-3 (event-basic-type obj))
+		     ))))
+
+      (if (not (fboundp 'button-drag-event-p))
+	  (defun button-drag-event-p (obj)
+	    "True if OBJ is a mouse-button-drag event object."
+	    (and (button-event-p obj)
+		 (member 'drag (event-modifiers obj)))))
 
       (if (not (fboundp 'button-press-event-p))
 	  (defun button-press-event-p (obj)
@@ -266,37 +282,55 @@
 
       (if (not (fboundp 'event-window))
 	  (defun event-window (event)
-	    "Return the window of the given mouse event.
- This may be nil if the event occurred in the border or over a toolbar.
- The modeline is considered to be in the window it represents."
-	    (and (eventp event)
-		 (listp event)
-		 (listp (cdr event))
-		 (listp (car (cdr event)))
-		 (car (car (cdr event))))))
+	    "Return the window of the given mouse EVENT.
+This may be nil if the event occurred in the border or over a toolbar.
+The modeline is considered to be in the window it represents.
+
+If the EVENT is a mouse drag event, then the end event window is returned."
+	    (if (button-drag-event-p event)
+		(and (listp event)
+		     (third event)
+		     (listp (third event))
+		     (windowp (car (third event)))
+		     (car (third event)))
+	      (and (eventp event)
+		   (listp event)
+		   (second event)
+		   (listp (second event))
+		   (windowp (car (second event)))
+		   (car (second event))))))
+
+;		   (listp (cdr event))
+;		   (listp (car (cdr event)))
+;		   (windowp (car (car (cdr event))))
+;		   (car (car (cdr event))))))
 
       (if (not (fboundp 'event-buffer))
 	  (defun event-buffer (event)
-	    "Given a mouse-motion, button-press, or button-release event, return
- the buffer on which that event occurred.  This will be nil for non-mouse
- events.  If event-over-text-area-p is nil, this will also be nil."
+	    "Given a mouse-motion, button-press, or button-release event,
+return the buffer on which that event occurred.  This will be nil for 
+non-mouse events.  If event-over-text-area-p is nil, this will also be nil."
 	    (if (button-event-p event)
 		(window-buffer (event-window event)))))
 
 
       (if (not (fboundp 'event-closest-point))
 	  (defun event-closest-point (event)
-	    "Return the character position of the given mouse event.
-If the event did not occur over a window or over text, return the
-closest point to the location of the event.  If the Y pixel position
+	    "Return the character position of the given mouse EVENT.
+If the EVENT did not occur over a window or over text, return the
+closest point to the location of the EVENT.  If the Y pixel position
 overlaps a window and the X pixel position is to the left of that
 window, the closest point is the beginning of the line containing the
 Y position.  If the Y pixel position overlaps a window and the X pixel
 position is to the right of that window, the closest point is the end
 of the line containing the Y position.  If the Y pixel position is
 above a window, return 0.  If it is below a window, return the value
-of (window-end)."
-	    (posn-point (event-start event))))
+of (window-end).
+
+If the EVENT is a drag event, the event-end will be used."
+	    (if (button-drag-event-p event)
+		(posn-point (event-end event))
+	      (posn-point (event-start event)))))
 
       (if (not (fboundp 'add-minor-mode))
 	  (defun add-minor-mode (toggle 
@@ -345,6 +379,80 @@
       (if (not (fboundp 'mouse-track))
 	  (defalias 'mouse-track 'mouse-drag-region))
 
+      (if (not (fboundp 'windows-of-buffer))
+	  (defun windows-of-buffer (&optional buffer)
+	    "Returns a list of windows that have BUFFER in them.
+If BUFFER is not specified, the current buffer will be used."
+	    (get-buffer-window-list buffer)))
+
+      (if (not (boundp 'help-selects-help-window))
+	  (defvar help-selects-help-window t
+	    "*If nil, use the \"old Emacs\" behavior for Help buffers.
+This just displays the buffer in another window, rather than selecting
+the window."))
+
+      (if (not (fboundp 'with-displaying-help-buffer))
+	  (defun with-displaying-help-buffer (thunk)
+	    (let ((winconfig (current-window-configuration))
+		  (was-one-window (one-window-p))
+		  (help-not-visible
+		   (not (and (windows-of-buffer "*Help*") ;shortcut
+			     (member (selected-frame)
+				     (mapcar 'window-frame
+					     (windows-of-buffer "*Help*")))))))
+	      (prog1 (with-output-to-temp-buffer "*Help*"
+		       (prog1 (funcall thunk)
+			 (save-excursion
+			   (set-buffer standard-output)
+			   (help-mode))))
+		(let ((helpwin (get-buffer-window "*Help*")))
+		  (if helpwin
+		      (progn
+			(save-excursion
+			  (set-buffer (window-buffer helpwin))
+			  ;;If the *Help* buffer is already displayed on this
+			  ;; frame, don't override the previous configuration
+;			  (if help-not-visible
+;			      (set-frame-property
+;			       (selected-frame)
+;			       'help-window-config winconfig)))
+			  )
+			(if help-selects-help-window
+			    (select-window helpwin))
+			(cond ((eq helpwin (selected-window))
+			       (message
+				(substitute-command-keys
+				 "\\[scroll-up] to scroll the help."
+				 )))
+			      (was-one-window
+			       (message
+				(substitute-command-keys
+				 "\\[scroll-other-window] to scroll the help."
+				 )))
+			      (t
+			       (message
+				(substitute-command-keys
+				 "\\[scroll-other-window] to scroll the help."
+				 )))))))))))
+
+      (if (not (fboundp 'set-extent-mouse-face))
+	  (defun set-extent-mouse-face (extent face)
+	    "Set the face used to highlight EXTENT when the mouse passes over it.
+FACE can also be a list of faces, and all faces listed will apply,
+with faces earlier in the list taking priority over those later in the
+list.
+
+In the Emacs 19, the argument FACE could not be a list of faces."
+	    (put-text-property (overlay-start extent)
+			       (overlay-end extent)
+			       'mouse-face face)
+	    ))
+
+
+      (if (not (fboundp 'read-directory-name))
+	  (defalias 'read-directory-name 'read-file-name))
+
+	
       ))