diff lisp/w3/w3-menu.el @ 14:9ee227acff29 r19-15b90

Import from CVS: tag r19-15b90
author cvs
date Mon, 13 Aug 2007 08:48:42 +0200
parents ac2d302a0011
children 0293115a14e9
line wrap: on
line diff
--- a/lisp/w3/w3-menu.el	Mon Aug 13 08:48:18 2007 +0200
+++ b/lisp/w3/w3-menu.el	Mon Aug 13 08:48:42 2007 +0200
@@ -1,11 +1,12 @@
 ;;; w3-menu.el --- Menu functions for emacs-w3
 ;; Author: wmperry
-;; Created: 1996/07/21 18:29:01
-;; Version: 1.7
+;; Created: 1996/12/31 15:37:49
+;; Version: 1.19
 ;; Keywords: menu, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Copyright (c) 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.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (require 'w3-vars)
@@ -37,6 +39,7 @@
 (defvar w3-menu-fsfemacs-view-menu nil)
 (defvar w3-menu-fsfemacs-options-menu nil)
 (defvar w3-menu-fsfemacs-style-menu nil)
+(defvar w3-menu-fsfemacs-search-menu nil)
 (defvar w3-menu-w3-menubar nil)
 (defvar w3-links-menu nil "Menu for w3-mode in XEmacs.")
 (make-variable-buffer-local 'w3-links-menu)
@@ -60,8 +63,9 @@
 options		-- Various options
 buffers		-- The standard buffers menu
 emacs		-- A toggle button to switch back to normal emacs menus
-style		-- Control fonts and who gets to set them
-help		-- The help 
+style		-- Control style information and who gets to set what
+search          -- Various search engines
+help		-- The help menu
 nil		-- ** special **
 
 If nil appears in the list, it should appear exactly once.  All
@@ -78,7 +82,41 @@
 				(list 'w3-fetch (car (cdr (car hot))))
 				t) hot-menu)
 		hot (cdr hot)))
-	(or hot-menu '(["No Hotlist" undefined nil])))))
+	(or hot-menu '(["No Hotlist" nil nil])))))
+
+(defun w3-menu-html-links-constructor (menu-items)
+  (or menu-items
+      (let ((links (mapcar 'cdr w3-current-links))
+	    (menu nil))
+	(if links
+	    (setq links (delete*
+			 nil
+			 (reduce 'append links)
+			 :test-not (function
+				    (lambda (a b) ; arg order unknown
+				      (member
+				       (car (or a b))
+				       w3-defined-link-types))))))
+	(while links
+	  (let ((name (caar links))
+		(vals (cdar links))
+		(href nil)
+		(new nil))
+	    (if (= (length vals) 1)
+		(setq vals (car vals)
+		      new (vector (or (plist-get vals 'title)
+				      (capitalize name))
+				  (list 'w3-fetch (plist-get vals 'href)) t))
+	      (setq new (cons (capitalize name)
+			      (mapcar (function
+				       (lambda (x)
+					 (setq href (plist-get x 'href))
+					 (vector (or (plist-get x 'title) href)
+						 (list 'w3-fetch href) t)))
+				      vals))))
+	    (setq links (cdr links)
+		  menu (cons new menu))))
+	(or menu '(["None" nil nil])))))
 
 (defun w3-menu-links-constructor (menu-items)
   (or menu-items
@@ -90,13 +128,14 @@
 		href (widget-get widget 'href)
 		menu (cons
 		      (vector (w3-truncate-menu-item
-			       (w3-fix-spaces
-				(buffer-substring
-				 (widget-get widget :from)
-				 (widget-get widget :to))))
+			       (or (widget-get widget 'title)
+				   (w3-fix-spaces
+				    (buffer-substring
+				     (widget-get widget :from)
+				     (widget-get widget :to)))))
 			      (list 'url-maybe-relative href) t) menu)))
 	(setq menu (w3-breakup-menu menu w3-max-menu-length))
-	(or menu '(["No Links" undefined nil])))))
+	(or menu '(["No Links" nil nil])))))
 
 (defun w3-toggle-minibuffer ()
   (interactive)
@@ -217,6 +256,7 @@
    ["View Parse Tree" (w3-display-parse-tree w3-current-parse)
     w3-current-parse]
    ["View Stylesheet" w3-display-stylesheet w3-current-stylesheet]
+   ["Reload Stylesheets" w3-refresh-stylesheets t]
    )
   "W3 menu debug list.")
 
@@ -230,7 +270,10 @@
    "----"
    (if w3-running-xemacs
        '("Links" :filter w3-menu-links-constructor)
-     ["Link..." w3-e19-show-links-menu t])
+     ["Links..." w3-e19-show-links-menu t])
+   (if w3-running-xemacs
+       '("Navigate" :filter w3-menu-html-links-constructor)
+     ["Navigate..." w3-e19-show-navigate-menu t])
    )
   "W3 menu go list.")
 
@@ -294,10 +337,10 @@
    ["Allow Document Stylesheets" (setq w3-honor-stylesheets
 				       (not w3-honor-stylesheets))
     :style toggle :selected w3-honor-stylesheets]
-   ["IE 3.0 Compatible Parsing" (setq w3-style-ie-compatibility
-				      (not w3-style-ie-compatibility))
+   ["IE 3.0 Compatible Parsing" (setq css-ie-compatibility
+				      (not css-ie-compatibility))
     :style toggle :selected (and w3-honor-stylesheets
-				 w3-style-ie-compatibility)]
+				 css-ie-compatibility)]
    ["Honor Color Requests" (setq w3-user-colors-take-precedence
 				 (not w3-user-colors-take-precedence))
     :style toggle :selected (not w3-user-colors-take-precedence)]
@@ -315,6 +358,16 @@
     nil)
   "W3 menu buffer list.")
 
+(defconst w3-menu-search-menu
+  (list
+   "Search"
+   ["Yahoo!"    (w3-fetch "http://www.yahoo.com/") t]
+   ["Excite"    (w3-fetch "http://www.excite.com/") t]
+   ["AltaVista" (w3-fetch "http://www.altavista.digital.com/") t]
+   "---"
+   )
+  "W3 search menu")
+
 (defconst w3-menu-emacs-button
   (vector
    (if w3-running-xemacs "XEmacs" "Emacs") 'w3-menu-toggle-menubar t))
@@ -363,6 +416,8 @@
 			  w3-menu-options-menu)
 	(easy-menu-define w3-menu-fsfemacs-style-menu (list dummy) nil
 			  w3-menu-style-menu)
+	(easy-menu-define w3-menu-fsfemacs-search-menu (list dummy) nil
+			  w3-menu-search-menu)
 
 	;; block the global menubar entries in the map so that W3
 	;; can take over the menubar if necessary.
@@ -398,6 +453,8 @@
 		  (cons "View" w3-menu-fsfemacs-view-menu))
 		 (style
 		  (cons "Style" w3-menu-fsfemacs-style-menu))
+		 (search
+		  (cons "Search" w3-menu-fsfemacs-search-menu))
 		 (emacs
 		  (cons "[Emacs]" 'w3-menu-toggle-menubar))))
 	      cons
@@ -434,6 +491,7 @@
 	   (go       . w3-menu-go-menu)
 	   (help     . w3-menu-help-menu)
 	   (options  . w3-menu-options-menu)
+	   (search   . w3-menu-search-menu)
 	   (view     . w3-menu-view-menu)
 	   )
 	 )
@@ -580,7 +638,7 @@
 		  w3-preferences-ok-hook
 		  w3-preferences-setup-hook
 		  w3-source-file-hook
-		  w3-style-ie-compatibility
+		  css-ie-compatibility
 		  w3-toolbar-orientation
 		  w3-toolbar-type
 		  w3-use-menus
@@ -608,8 +666,11 @@
   (let* ((glyph (event-glyph e))
 	 (widget (or (and glyph (glyph-property glyph 'widget))
 		     (widget-at (point))))
-	 (href (and widget (widget-get widget 'href)))
-	 (imag (and widget (widget-get widget 'src)))
+	 (parent (and widget (widget-get widget :parent)))
+	 (href (or (and widget (widget-get widget 'href))
+		   (and parent (widget-get parent 'href))))
+	 (imag (or (and widget (widget-get widget 'src))
+		   (and parent (widget-get parent 'src))))
 	 (menu (copy-tree w3-popup-menu))
 	 url val trunc-url)
     (if href