Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-menu.el @ 165:5a88923fcbfe r20-3b9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b9
author cvs
date Mon, 13 Aug 2007 09:44:42 +0200
parents 34a5b81f86ba
children 8eaf7971accc
comparison
equal deleted inserted replaced
164:4e0740e5aab2 165:5a88923fcbfe
1 ;;; w3-menu.el --- Menu functions for emacs-w3 1 ;;; w3-menu.el --- Menu functions for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/04/17 15:50:07 3 ;; Created: 1997/06/24 13:59:48
4 ;; Version: 1.37 4 ;; Version: 1.40
5 ;; Keywords: menu, hypermedia 5 ;; Keywords: menu, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc. 9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
26 ;;; Boston, MA 02111-1307, USA. 26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 28
29 (require 'w3-vars) 29 (require 'w3-vars)
30 (require 'w3-mouse) 30 (require 'w3-mouse)
31 (require 'widget)
32
33 (define-widget-keywords :href :src :title)
34
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;;; InfoDock stuff
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38 (if (not (fboundp 'id-menubar-set))
39 (fset 'id-menubar-set 'ignore))
40
41 (id-menubar-set 'w3-mode 'w3-menu-make-xemacs-menubar)
42
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 ;;; Spiffy new menus (for both Emacs and XEmacs) 44 ;;; Spiffy new menus (for both Emacs and XEmacs)
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 (defvar w3-menu-fsfemacs-bookmark-menu nil) 46 (defvar w3-menu-fsfemacs-bookmark-menu nil)
35 (defvar w3-menu-fsfemacs-debug-menu nil) 47 (defvar w3-menu-fsfemacs-debug-menu nil)
141 (let ((widgets (w3-only-links)) 153 (let ((widgets (w3-only-links))
142 widget href menu) 154 widget href menu)
143 (while widgets 155 (while widgets
144 (setq widget (car widgets) 156 (setq widget (car widgets)
145 widgets (cdr widgets) 157 widgets (cdr widgets)
146 href (widget-get widget 'href) 158 href (widget-get widget :href)
147 menu (cons 159 menu (cons
148 (vector (w3-truncate-menu-item 160 (vector (w3-truncate-menu-item
149 (or (widget-get widget 'title) 161 (or (widget-get widget :title)
150 (w3-fix-spaces 162 (w3-fix-spaces
151 (buffer-substring 163 (buffer-substring
152 (widget-get widget :from) 164 (widget-get widget :from)
153 (widget-get widget :to))))) 165 (widget-get widget :to)))))
154 (list 'url-maybe-relative href) t) menu))) 166 (list 'url-maybe-relative href) t) menu)))
551 (nreverse menubar))) 563 (nreverse menubar)))
552 564
553 (defun w3-menu-install-menubar () 565 (defun w3-menu-install-menubar ()
554 (cond 566 (cond
555 (w3-running-xemacs 567 (w3-running-xemacs
556 (if (not (featurep 'menubar)) 568 (cond
557 nil ; No menus available 569 ((not (featurep 'menubar)) nil) ; No menus available
570 ((featurep 'infodock) nil) ; InfoDock does it automatically
571 (t
558 (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar)) 572 (setq w3-menu-w3-menubar (w3-menu-make-xemacs-menubar))
559 (set-buffer-menubar w3-menu-w3-menubar))) 573 (set-buffer-menubar w3-menu-w3-menubar))))
560 ((not (fboundp 'vm-menu-undo-menu)) 574 ((not (fboundp 'vm-menu-undo-menu))
561 (w3-menu-initialize-w3-mode-menu-map) 575 (w3-menu-initialize-w3-mode-menu-map)
562 (define-key w3-mode-map [menu-bar] 576 (define-key w3-mode-map [menu-bar]
563 (lookup-key w3-mode-menu-map [rootmenu w3]))))) 577 (lookup-key w3-mode-menu-map [rootmenu w3])))))
564 578
705 (mouse-set-point e) 719 (mouse-set-point e)
706 (let* ((glyph (event-glyph e)) 720 (let* ((glyph (event-glyph e))
707 (widget (or (and glyph (glyph-property glyph 'widget)) 721 (widget (or (and glyph (glyph-property glyph 'widget))
708 (widget-at (point)))) 722 (widget-at (point))))
709 (parent (and widget (widget-get widget :parent))) 723 (parent (and widget (widget-get widget :parent)))
710 (href (or (and widget (widget-get widget 'href)) 724 (href (or (and widget (widget-get widget :href))
711 (and parent (widget-get parent 'href)))) 725 (and parent (widget-get parent :href))))
712 (imag (or (and widget (widget-get widget 'src)) 726 (imag (or (and widget (widget-get widget :src))
713 (and parent (widget-get parent 'src)))) 727 (and parent (widget-get parent :src))))
714 (menu (copy-tree w3-popup-menu)) 728 (menu (copy-tree w3-popup-menu))
715 url val trunc-url) 729 url val trunc-url)
716 (if href 730 (if href
717 (progn 731 (progn
718 (setq url href) 732 (setq url href)