diff lisp/w3/w3-mouse.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/w3/w3-mouse.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,82 @@
+;;; w3-xemac.el,v --- XEmacs specific functions for emacs-w3
+;; Author: wmperry
+;; Created: 1996/05/29 18:21:00
+;; Version: 1.7
+;; Keywords: mouse, hypermedia
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Copyright (c) 1996 by William M. Perry (wmperry@spry.com)
+;;;
+;;; This file is part of GNU Emacs.
+;;;
+;;; GNU Emacs 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 2, or (at your option)
+;;; any later version.
+;;;
+;;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(require 'w3-vars)
+
+(defun w3-follow-mouse-other-frame (e)
+  "Function suitable to being bound to a mouse key.  Follows the link under
+the mouse click, opening it in another frame."
+  (interactive "e")
+  (mouse-set-point e)
+  (w3-follow-link-other-frame))
+
+(defun w3-follow-inlined-image-mouse (e)
+  "Follow an inlined image from the mouse"
+  (interactive "e")
+  (mouse-set-point e)
+  (w3-follow-inlined-image))
+
+(defun w3-follow-inlined-image ()
+  "Follow an inlined image, regardless of whether it is a hyperlink or not."
+  (interactive)
+  (let ((widget (widget-at (point))))
+    (and (not widget) (error "No inlined image at point."))
+    (setq widget (widget-get widget :parent))
+    
+    (and (or (not widget)
+	     (not (eq 'image (car widget))))
+	 (error "No inlined image at point."))
+    (and (widget-get widget 'src)
+	 (w3-fetch (widget-get widget 'src)))))
+
+(defvar w3-mouse-button1 (cond
+			  ((and w3-running-xemacs (featurep 'mouse)) 'button1)
+			  (w3-running-xemacs 'return)
+			  (t 'mouse-1)))
+(defvar w3-mouse-button2 (cond
+			  ((and w3-running-xemacs (featurep 'mouse)) 'button2)
+			  (w3-running-xemacs 'return)
+			  (t 'mouse-2)))
+(defvar w3-mouse-button3 (cond
+			  ((and w3-running-xemacs (featurep 'mouse)) 'button3)
+			  (w3-running-xemacs (list 'meta ?`)) 
+			  (t 'mouse-3)))
+
+(define-key w3-mode-map (vector w3-mouse-button2) 'w3-widget-button-click)
+(define-key w3-mode-map (vector w3-mouse-button3) 'w3-popup-menu)
+(define-key w3-mode-map (vector (list 'shift w3-mouse-button2))
+  'w3-follow-mouse-other-frame)
+
+(define-key w3-netscape-emulation-minor-mode-map (vector w3-mouse-button1)
+  'w3-widget-button-click)
+(define-key w3-netscape-emulation-minor-mode-map (vector w3-mouse-button2)
+  'w3-follow-mouse-other-frame)
+
+(if w3-running-FSF19
+    (progn
+      (define-key w3-mode-map [down-mouse-3] 'w3-popup-menu)
+      (define-key w3-mode-map [mouse-movement] 'w3-mouse-handler)))
+  
+(provide 'w3-mouse)