diff lisp/w3/w3-e19.el @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents e04119814345
children 1ce6082ce73f
line wrap: on
line diff
--- a/lisp/w3/w3-e19.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/w3/w3-e19.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,12 +1,11 @@
 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3
 ;; Author: wmperry
-;; Created: 1997/03/12 20:07:18
-;; Version: 1.19
+;; Created: 1996/07/11 04:49:02
+;; Version: 1.3
 ;; Keywords: faces, help, mouse, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
-;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
 ;;;
 ;;; This file is part of GNU Emacs.
 ;;;
@@ -21,9 +20,8 @@
 ;;; 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, Inc., 59 Temple Place - Suite 330,
-;;; Boston, MA 02111-1307, USA.
+;;; along with GNU Emacs; see the file COPYING.  If not, write to
+;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -31,62 +29,100 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (require 'w3-forms)
 (require 'font)
-(require 'w3-script)
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Help 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))
+(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)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Functions to build menus of urls
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(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-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-links-menu ()
-  (interactive)
+(defun w3-e19-show-links-menu (e)
+  (interactive "e")
   (if (not w3-e19-links-menu)
       (w3-build-FSF19-menu))
-  (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))))
+  (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)))))
     (if (and x y)
 	(funcall y))))
 
 (defun w3-build-FSF19-menu ()
   ;; Build emacs19 menus from w3-links-list
-  (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))))
+  (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))))))
 
 (defun w3-setup-version-specifics ()
   ;; Set up routine for emacs 19
-  (require 'lmenu) ; for popup-menu
-  )
+  (require 'lmenu))
 
 (defun w3-store-in-clipboard (str)
   "Store string STR in the Xwindows clipboard"
@@ -97,30 +133,37 @@
     (ns-store-pasteboard-internal str))
    (t nil)))
 
-(defun w3-e19-no-read-only (st nd)
-  ;; Make sure we don't yank any read-only data out of this buffer
-  (let ((inhibit-read-only t))
-    (put-text-property st nd 'read-only nil)))
-
 (defun w3-mode-version-specifics ()
   ;; Emacs 19 specific stuff for w3-mode
   (make-local-variable 'track-mouse)
-  (set (make-local-variable 'buffer-access-fontify-functions) 'w3-e19-no-read-only)
-  (if w3-track-mouse (setq track-mouse t)))
+  (if w3-track-mouse (setq track-mouse t))
+  (if (or (memq (device-type) '(x pm ns)))
+      (w3-build-FSF19-menu)))
 
 (defun w3-mouse-handler (e)
   "Function to message the url under the mouse cursor"
   (interactive "e")
   (let* ((pt (posn-point (event-start e)))
 	 (good (eq (posn-window (event-start e)) (selected-window)))
-	 (mouse-events nil))
-    (if (not (and good pt (number-or-marker-p pt)))
-	nil
-      (widget-echo-help pt)
-      ;; Need to handle onmouseover, on mouseout
-      (setq mouse-events (w3-script-find-event-handlers pt 'mouse))
-      (if (assq 'onmouseover mouse-events)
-	  (w3-script-evaluate-form (cdr (assq 'onmouseover mouse-events)))))))
+	 (widget (and good pt (number-or-marker-p pt) (widget-at pt)))
+	 (link (and widget (widget-get widget 'href)))
+	 (form (and widget (widget-get widget 'w3-form-data)))
+	 (imag nil) ; (nth 1 (memq 'w3graphic props))))
+	 )
+    (cond
+     (link (message "%s" link))
+     (form
+      (cond
+       ((eq 'submit (w3-form-element-type form))
+	(message "Submit form to %s"
+		 (cdr-safe (assq 'action (w3-form-element-action form)))))
+       ((eq 'reset (w3-form-element-type form))
+	(message "Reset form contents"))
+       (t
+	(message "Form entry (name=%s, type=%s)" (w3-form-element-name form)
+		 (w3-form-element-type form)))))
+     (imag (message "Inlined image (%s)" (car imag)))
+     (t (message "")))))
 
 (defun w3-color-values (color)
   (cond