Mercurial > hg > xemacs-beta

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 131b0175ea99
children 6a378aca36af
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
1 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3 1 ;;; w3-e19.el --- Emacs 19.xx specific functions for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1996/07/11 04:49:02 3 ;; Created: 1996/12/31 15:38:51
4 ;; Version: 1.3 4 ;; Version: 1.12
5 ;; Keywords: faces, help, mouse, hypermedia 5 ;; Keywords: faces, help, mouse, hypermedia
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1993 - 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
9 ;;; 10 ;;;
10 ;;; This file is part of GNU Emacs. 11 ;;; This file is part of GNU Emacs.
11 ;;; 12 ;;;
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify 13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by 14 ;;; it under the terms of the GNU General Public License as published by
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details. 21 ;;; GNU General Public License for more details.
21 ;;; 22 ;;;
22 ;;; You should have received a copy of the GNU General Public License 23 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to 24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;;; Boston, MA 02111-1307, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 28
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; Enhancements For Emacs 19 30 ;;; Enhancements For Emacs 19
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 (require 'w3-forms) 32 (require 'w3-forms)
31 (require 'font) 33 (require 'font)
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;; Help menu 35 ;;; Help menu
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 (defvar w3-links-menu nil "Menu for w3-mode in emacs 19.") 37 (defvar w3-e19-hotlist-menu nil "A menu for hotlists.")
36 (make-variable-buffer-local 'w3-links-menu) 38 (defvar w3-e19-links-menu nil "A buffer-local menu for hyperlinks.")
37 39 (defvar w3-e19-nav-menu nil "A buffer-local menu for html based <link> tags.")
38 (defun w3-add-hotlist-menu () 40 (mapcar 'make-variable-buffer-local
39 ;; Add the hotlist menu to this buffer - used when it changes. 41 '(w3-e19-hotlist-menu w3-e19-links-menu w3-e19-nav-menu))
40 (let ((hot-menu (make-sparse-keymap "w3-hotlist"))
41 (ctr 0)
42 (hot w3-hotlist))
43 (while hot
44 (define-key hot-menu (vector (intern (concat "w3-hotlist-"
45 (int-to-string ctr))))
46 (cons (car (car hot))
47 (list 'lambda () '(interactive)
48 (list 'w3-fetch (car (cdr (car hot)))))))
49 (setq ctr (1+ ctr)
50 hot (cdr hot)))
51 (setq w3-e19-hotlist-menu hot-menu)))
52 42
53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 ;;; Functions to build menus of urls 44 ;;; Functions to build menus of urls
55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 (defun w3-e19-show-hotlist-menu (e) 46 (defun w3-e19-show-hotlist-menu ()
57 (interactive "e") 47 (interactive)
58 (if w3-html-bookmarks 48 (let ((keymap (easy-menu-create-keymaps "Hotlist"
59 (popup-menu w3-html-bookmarks) 49 (w3-menu-hotlist-constructor nil)))
60 (let* ((x (condition-case () 50 (x nil)
61 (x-popup-menu e w3-e19-hotlist-menu) 51 (y nil))
62 (error nil))) ; to trap for empty menus 52 (setq x (x-popup-menu t keymap)
63 (y (and x (lookup-key w3-e19-hotlist-menu (apply 'vector x))))) 53 y (and x (lookup-key keymap (apply 'vector x))))
64 (if (and x y) 54 (if (and x y)
65 (funcall y))))) 55 (funcall y))))
66 56
67 (defun w3-e19-show-links-menu (e) 57 (defun w3-e19-show-links-menu ()
68 (interactive "e") 58 (interactive)
69 (if (not w3-e19-links-menu) 59 (if (not w3-e19-links-menu)
70 (w3-build-FSF19-menu)) 60 (w3-build-FSF19-menu))
71 (let* ((x (condition-case () 61 (let (x y)
72 (x-popup-menu e w3-e19-links-menu) 62 (setq x (x-popup-menu t w3-e19-links-menu)
73 (error nil))) ; to trap for empty menus 63 y (and x (lookup-key w3-e19-links-menu (apply 'vector x))))
74 (y (and x (lookup-key w3-e19-links-menu (apply 'vector x))))) 64 (if (and x y)
65 (funcall y))))
66
67 (defun w3-e19-show-navigate-menu ()
68 (interactive)
69 (if (not w3-e19-nav-menu)
70 (w3-build-FSF19-menu))
71 (let (x y)
72 (setq x (x-popup-menu t w3-e19-nav-menu)
73 y (and x (lookup-key w3-e19-nav-menu (apply 'vector x))))
75 (if (and x y) 74 (if (and x y)
76 (funcall y)))) 75 (funcall y))))
77 76
78 (defun w3-build-FSF19-menu () 77 (defun w3-build-FSF19-menu ()
79 ;; Build emacs19 menus from w3-links-list 78 ;; Build emacs19 menus from w3-links-list
80 (let* ((ctr 0) 79 (let ((links (w3-menu-html-links-constructor nil))
81 (menu-ctr 0) 80 (hlink (w3-menu-links-constructor nil)))
82 (tmp nil) 81 (setq w3-e19-nav-menu (easy-menu-create-keymaps "Navigate" links)
83 (widgets (w3-only-links)) 82 w3-e19-links-menu (easy-menu-create-keymaps "Links" hlink))))
84 (widget nil)
85 (href nil)
86 (menus nil))
87 (setq tmp (make-sparse-keymap "Links"))
88 (while widgets
89 (setq widget (car widgets)
90 widgets (cdr widgets)
91 href (widget-get widget 'href))
92 (if (> ctr w3-max-menu-length)
93 (setq menus (cons tmp menus)
94 ctr 0
95 tmp (make-sparse-keymap
96 (concat "Links" (int-to-string
97 (setq menu-ctr
98 (1+ menu-ctr)))))))
99 (let ((ttl (w3-fix-spaces
100 (buffer-substring
101 (widget-get widget :from)
102 (widget-get widget :to))))
103 (key (vector (intern (concat "link"
104 (int-to-string
105 (setq ctr (1+ ctr))))))))
106 (if (and (> (length ttl) 0) href)
107 (define-key tmp key
108 (cons ttl
109 (list 'lambda () '(interactive)
110 (list 'w3-fetch href)))))))
111 (if (not menus)
112 (setq w3-e19-links-menu tmp)
113 (setq w3-e19-links-menu (make-sparse-keymap "LinkMenu")
114 menus (nreverse (cons tmp menus))
115 ctr 0)
116 (while menus
117 (define-key w3-e19-links-menu
118 (vector (intern (concat "SubMenu" ctr)))
119 (cons "More..." (car menus)))
120 (setq menus (cdr menus)
121 ctr (1+ ctr))))))
122 83
123 (defun w3-setup-version-specifics () 84 (defun w3-setup-version-specifics ()
124 ;; Set up routine for emacs 19 85 ;; Set up routine for emacs 19
125 (require 'lmenu)) 86 (require 'lmenu) ; for popup-menu
87 )
126 88
127 (defun w3-store-in-clipboard (str) 89 (defun w3-store-in-clipboard (str)
128 "Store string STR in the Xwindows clipboard" 90 "Store string STR in the Xwindows clipboard"
129 (cond 91 (cond
130 ((memq (device-type) '(x pm)) 92 ((memq (device-type) '(x pm))
135 97
136 (defun w3-mode-version-specifics () 98 (defun w3-mode-version-specifics ()
137 ;; Emacs 19 specific stuff for w3-mode 99 ;; Emacs 19 specific stuff for w3-mode
138 (make-local-variable 'track-mouse) 100 (make-local-variable 'track-mouse)
139 (if w3-track-mouse (setq track-mouse t)) 101 (if w3-track-mouse (setq track-mouse t))
140 (if (or (memq (device-type) '(x pm ns))) 102 '(if (or (memq (device-type) '(x pm ns)))
141 (w3-build-FSF19-menu))) 103 (w3-build-FSF19-menu)))
142 104
143 (defun w3-mouse-handler (e) 105 (defun w3-mouse-handler (e)
144 "Function to message the url under the mouse cursor" 106 "Function to message the url under the mouse cursor"
145 (interactive "e") 107 (interactive "e")
146 (let* ((pt (posn-point (event-start e))) 108 (let* ((pt (posn-point (event-start e)))
147 (good (eq (posn-window (event-start e)) (selected-window))) 109 (good (eq (posn-window (event-start e)) (selected-window)))
148 (widget (and good pt (number-or-marker-p pt) (widget-at pt))) 110 (widget (and good pt (number-or-marker-p pt) (widget-at pt)))
149 (link (and widget (widget-get widget 'href))) 111 (link (and widget (or (widget-get widget 'href)
112 (widget-get widget 'name))))
150 (form (and widget (widget-get widget 'w3-form-data))) 113 (form (and widget (widget-get widget 'w3-form-data)))
151 (imag nil) ; (nth 1 (memq 'w3graphic props)))) 114 (imag nil) ; (nth 1 (memq 'w3graphic props))))
152 ) 115 )
153 (cond 116 (cond
154 (link (message "%s" link)) 117 (link (w3-widget-echo widget))
155 (form 118 (form
156 (cond 119 (cond
157 ((eq 'submit (w3-form-element-type form)) 120 ((eq 'submit (w3-form-element-type form))
158 (message "Submit form to %s" 121 (message "Submit form to %s"
159 (cdr-safe (assq 'action (w3-form-element-action form))))) 122 (cdr-safe (assq 'action (w3-form-element-action form)))))