Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-menu.el @ 36:c53a95d3c46d r19-15b101

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b101
author cvs
date Mon, 13 Aug 2007 08:53:38 +0200
parents e04119814345
children 8d2a9b52c682
comparison
equal deleted inserted replaced
35:279432d5c479 36:c53a95d3c46d
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/03/13 19:25:10 3 ;; Created: 1997/03/18 00:45:01
4 ;; Version: 1.32 4 ;; Version: 1.34
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.
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 ;;; Spiffy new menus (for both Emacs and XEmacs) 32 ;;; Spiffy new menus (for both Emacs and XEmacs)
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 (defvar w3-menu-fsfemacs-bookmark-menu nil) 34 (defvar w3-menu-fsfemacs-bookmark-menu nil)
34 (defvar w3-menu-fsfemacs-debug-menu nil) 35 (defvar w3-menu-fsfemacs-debug-menu nil)
674 (fset 'event-glyph 'ignore)) 675 (fset 'event-glyph 'ignore))
675 676
676 (defun w3-popup-menu (e) 677 (defun w3-popup-menu (e)
677 "Pop up a menu of common w3 commands" 678 "Pop up a menu of common w3 commands"
678 (interactive "e") 679 (interactive "e")
679 (mouse-set-point e) 680 (if (not w3-popup-menu-on-mouse-3)
680 (let* ((glyph (event-glyph e)) 681 (call-interactively (lookup-key global-map (vector w3-mouse-button3)))
681 (widget (or (and glyph (glyph-property glyph 'widget)) 682 (mouse-set-point e)
682 (widget-at (point)))) 683 (let* ((glyph (event-glyph e))
683 (parent (and widget (widget-get widget :parent))) 684 (widget (or (and glyph (glyph-property glyph 'widget))
684 (href (or (and widget (widget-get widget 'href)) 685 (widget-at (point))))
685 (and parent (widget-get parent 'href)))) 686 (parent (and widget (widget-get widget :parent)))
686 (imag (or (and widget (widget-get widget 'src)) 687 (href (or (and widget (widget-get widget 'href))
687 (and parent (widget-get parent 'src)))) 688 (and parent (widget-get parent 'href))))
688 (menu (copy-tree w3-popup-menu)) 689 (imag (or (and widget (widget-get widget 'src))
689 url val trunc-url) 690 (and parent (widget-get parent 'src))))
690 (if href 691 (menu (copy-tree w3-popup-menu))
691 (progn 692 url val trunc-url)
692 (setq url href) 693 (if href
693 (if url (setq trunc-url (url-truncate-url-for-viewing 694 (progn
694 url 695 (setq url href)
695 w3-max-menu-width))) 696 (if url (setq trunc-url (url-truncate-url-for-viewing
697 url
698 w3-max-menu-width)))
699 (setcdr menu (append (cdr menu)
700 '("---")
701 (mapcar
702 (function
703 (lambda (x)
704 (vector (format (car x) trunc-url)
705 (list (cdr x) url) t)))
706 w3-hyperlink-menu)))))
707 (if imag
708 (progn
709 (setq url imag
710 trunc-url (url-truncate-url-for-viewing url
711 w3-max-menu-width))
712 (setcdr menu (append (cdr menu)
713 '("---")
714 (mapcar
715 (function
716 (lambda (x)
717 (vector (format (car x) trunc-url)
718 (list (cdr x) url) t)))
719 w3-graphlink-menu)))))
720 (if (not (w3-menubar-active))
696 (setcdr menu (append (cdr menu) 721 (setcdr menu (append (cdr menu)
697 '("---") 722 '("---" ["Show Menubar" w3-toggle-menubar t]))))
698 (mapcar 723 (popup-menu menu))))
699 (function
700 (lambda (x)
701 (vector (format (car x) trunc-url)
702 (list (cdr x) url) t)))
703 w3-hyperlink-menu)))))
704 (if imag
705 (progn
706 (setq url imag
707 trunc-url (url-truncate-url-for-viewing url
708 w3-max-menu-width))
709 (setcdr menu (append (cdr menu)
710 '("---")
711 (mapcar
712 (function
713 (lambda (x)
714 (vector (format (car x) trunc-url)
715 (list (cdr x) url) t)))
716 w3-graphlink-menu)))))
717 (if (not (w3-menubar-active))
718 (setcdr menu (append (cdr menu)
719 '("---" ["Show Menubar" w3-toggle-menubar t]))))
720 (popup-menu menu)))
721 724
722 (provide 'w3-menu) 725 (provide 'w3-menu)