diff lisp/w3/w3-e19.el @ 80:1ce6082ce73f r20-0b90

Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 131b0175ea99
children 6a378aca36af
line wrap: on
line diff
--- a/lisp/w3/w3-e19.el	Mon Aug 13 09:05:44 2007 +0200
+++ b/lisp/w3/w3-e19.el	Mon Aug 13 09:06:37 2007 +0200
@@ -1,11 +1,12 @@
 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3
 ;; Author: wmperry
-;; Created: 1996/07/11 04:49:02
-;; Version: 1.3
+;; Created: 1996/12/31 15:38:51
+;; Version: 1.12
 ;; Keywords: faces, help, mouse, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
+;;; Copyright (c) 1996 Free Software Foundation, Inc.
 ;;;
 ;;; This file is part of GNU Emacs.
 ;;;
@@ -20,8 +21,9 @@
 ;;; 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.
+;;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;; Boston, MA 02111-1307, USA.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -32,97 +34,57 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Help menu
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar w3-links-menu nil "Menu for w3-mode in emacs 19.")
-(make-variable-buffer-local 'w3-links-menu)
-
-(defun w3-add-hotlist-menu ()
-  ;; Add the hotlist menu to this buffer - used when it changes.
-  (let ((hot-menu (make-sparse-keymap "w3-hotlist"))
-	(ctr 0)
-	(hot w3-hotlist))
-    (while hot
-      (define-key hot-menu (vector (intern (concat "w3-hotlist-"
-						   (int-to-string ctr))))
-	(cons (car (car hot))
-	      (list 'lambda () '(interactive)
-		    (list 'w3-fetch (car (cdr (car hot)))))))
-      (setq ctr (1+ ctr)
-	    hot (cdr hot)))
-    (setq w3-e19-hotlist-menu hot-menu)))
+(defvar w3-e19-hotlist-menu nil "A menu for hotlists.")
+(defvar w3-e19-links-menu nil "A buffer-local menu for hyperlinks.")
+(defvar w3-e19-nav-menu nil "A buffer-local menu for html based <link> tags.")
+(mapcar 'make-variable-buffer-local
+	'(w3-e19-hotlist-menu w3-e19-links-menu w3-e19-nav-menu))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Functions to build menus of urls
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun w3-e19-show-hotlist-menu (e)
-  (interactive "e")
-  (if w3-html-bookmarks
-      (popup-menu w3-html-bookmarks)
-    (let* ((x (condition-case ()
-		  (x-popup-menu e w3-e19-hotlist-menu)
-		(error nil)))		; to trap for empty menus
-	   (y (and x (lookup-key w3-e19-hotlist-menu (apply 'vector x)))))
-      (if (and x y)
-	  (funcall y)))))
+(defun w3-e19-show-hotlist-menu ()
+  (interactive)
+  (let ((keymap (easy-menu-create-keymaps "Hotlist"
+					  (w3-menu-hotlist-constructor nil)))
+	(x nil)
+	(y nil))
+    (setq x (x-popup-menu t keymap)
+	  y (and x (lookup-key keymap (apply 'vector x))))
+    (if (and x y)
+	(funcall y))))
 
-(defun w3-e19-show-links-menu (e)
-  (interactive "e")
+(defun w3-e19-show-links-menu ()
+  (interactive)
   (if (not w3-e19-links-menu)
       (w3-build-FSF19-menu))
-  (let* ((x (condition-case ()
-		(x-popup-menu e w3-e19-links-menu)
-	      (error nil)))		; to trap for empty menus
-	 (y (and x (lookup-key w3-e19-links-menu (apply 'vector x)))))
+  (let (x y)
+    (setq x (x-popup-menu t w3-e19-links-menu)
+	  y (and x (lookup-key w3-e19-links-menu (apply 'vector x))))
+    (if (and x y)
+	(funcall y))))
+
+(defun w3-e19-show-navigate-menu ()
+  (interactive)
+  (if (not w3-e19-nav-menu)
+      (w3-build-FSF19-menu))
+  (let (x y)
+    (setq x (x-popup-menu t w3-e19-nav-menu)
+	  y (and x (lookup-key w3-e19-nav-menu (apply 'vector x))))
     (if (and x y)
 	(funcall y))))
 
 (defun w3-build-FSF19-menu ()
   ;; Build emacs19 menus from w3-links-list
-  (let* ((ctr 0)
-	 (menu-ctr 0)
-	 (tmp nil)
-	 (widgets (w3-only-links))
-	 (widget nil)
-	 (href nil)
-	 (menus nil))
-     (setq tmp (make-sparse-keymap "Links"))
-     (while widgets
-       (setq widget (car widgets)
-	     widgets (cdr widgets)
-	     href (widget-get widget 'href))
-       (if (> ctr w3-max-menu-length)
-	   (setq menus (cons tmp menus)
-		 ctr 0
-		 tmp (make-sparse-keymap
-		      (concat "Links" (int-to-string
-				       (setq menu-ctr
-					     (1+ menu-ctr)))))))
-       (let ((ttl (w3-fix-spaces
-		   (buffer-substring
-		    (widget-get widget :from)
-		    (widget-get widget :to))))
-	     (key (vector (intern (concat "link"
-					  (int-to-string
-					   (setq ctr (1+ ctr))))))))
-	 (if (and (> (length ttl) 0) href)
-	     (define-key tmp key 
-	       (cons ttl
-		     (list 'lambda () '(interactive)
-			   (list 'w3-fetch href)))))))
-     (if (not menus)
-	 (setq w3-e19-links-menu tmp)
-       (setq w3-e19-links-menu (make-sparse-keymap "LinkMenu")
-	     menus (nreverse (cons tmp menus))
-	     ctr 0)
-       (while menus
-	 (define-key w3-e19-links-menu
-	   (vector (intern (concat "SubMenu" ctr)))
-	   (cons "More..." (car menus)))
-	 (setq menus (cdr menus)
-	       ctr (1+ ctr))))))
+  (let ((links (w3-menu-html-links-constructor nil))
+	(hlink (w3-menu-links-constructor nil)))
+    (setq w3-e19-nav-menu (easy-menu-create-keymaps "Navigate" links)
+	  w3-e19-links-menu (easy-menu-create-keymaps "Links" hlink))))
 
 (defun w3-setup-version-specifics ()
   ;; Set up routine for emacs 19
-  (require 'lmenu))
+  (require 'lmenu) ; for popup-menu
+  )
 
 (defun w3-store-in-clipboard (str)
   "Store string STR in the Xwindows clipboard"
@@ -137,7 +99,7 @@
   ;; Emacs 19 specific stuff for w3-mode
   (make-local-variable 'track-mouse)
   (if w3-track-mouse (setq track-mouse t))
-  (if (or (memq (device-type) '(x pm ns)))
+  '(if (or (memq (device-type) '(x pm ns)))
       (w3-build-FSF19-menu)))
 
 (defun w3-mouse-handler (e)
@@ -146,12 +108,13 @@
   (let* ((pt (posn-point (event-start e)))
 	 (good (eq (posn-window (event-start e)) (selected-window)))
 	 (widget (and good pt (number-or-marker-p pt) (widget-at pt)))
-	 (link (and widget (widget-get widget 'href)))
+	 (link (and widget (or (widget-get widget 'href)
+			       (widget-get widget 'name))))
 	 (form (and widget (widget-get widget 'w3-form-data)))
 	 (imag nil) ; (nth 1 (memq 'w3graphic props))))
 	 )
     (cond
-     (link (message "%s" link))
+     (link (w3-widget-echo widget))
      (form
       (cond
        ((eq 'submit (w3-form-element-type form))