Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-e19.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; w3-e19.el,v --- Emacs 19.xx specific functions for emacs-w3
2 ;; Author: wmperry
3 ;; Created: 1996/06/06 14:14:34
4 ;; Version: 1.157
5 ;; Keywords: faces, help, mouse, hypermedia
6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1993, 1994, 1995 by William M. Perry (wmperry@spry.com)
9 ;;;
10 ;;; This file is part of GNU Emacs.
11 ;;;
12 ;;; 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 ;;; the Free Software Foundation; either version 2, or (at your option)
15 ;;; any later version.
16 ;;;
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
21 ;;;
22 ;;; 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 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;;; Enhancements For Emacs 19
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 (require 'w3-forms)
31 (require 'font)
32 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33 ;;; Help menu
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 (defvar w3-links-menu nil "Menu for w3-mode in emacs 19.")
36 (make-variable-buffer-local 'w3-links-menu)
37
38 (defun w3-add-hotlist-menu ()
39 ;; Add the hotlist menu to this buffer - used when it changes.
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
53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 ;;; Functions to build menus of urls
55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 (defun w3-e19-show-hotlist-menu (e)
57 (interactive "e")
58 (if w3-html-bookmarks
59 (popup-menu w3-html-bookmarks)
60 (let* ((x (condition-case ()
61 (x-popup-menu e w3-e19-hotlist-menu)
62 (error nil))) ; to trap for empty menus
63 (y (and x (lookup-key w3-e19-hotlist-menu (apply 'vector x)))))
64 (if (and x y)
65 (funcall y)))))
66
67 (defun w3-e19-show-links-menu (e)
68 (interactive "e")
69 (if (not w3-e19-links-menu)
70 (w3-build-FSF19-menu))
71 (let* ((x (condition-case ()
72 (x-popup-menu e w3-e19-links-menu)
73 (error nil))) ; to trap for empty menus
74 (y (and x (lookup-key w3-e19-links-menu (apply 'vector x)))))
75 (if (and x y)
76 (funcall y))))
77
78 (defun w3-build-FSF19-menu ()
79 ;; Build emacs19 menus from w3-links-list
80 (let* ((ctr 0)
81 (menu-ctr 0)
82 (tmp nil)
83 (widgets (w3-only-links))
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
123 (defun w3-setup-version-specifics ()
124 ;; Set up routine for emacs 19
125 (require 'lmenu))
126
127 (defun w3-store-in-clipboard (str)
128 "Store string STR in the Xwindows clipboard"
129 (cond
130 ((memq (device-type) '(x pm))
131 (x-select-text str))
132 ((eq (device-type) 'ns)
133 (ns-store-pasteboard-internal str))
134 (t nil)))
135
136 (defun w3-mode-version-specifics ()
137 ;; Emacs 19 specific stuff for w3-mode
138 (make-local-variable 'track-mouse)
139 (if w3-track-mouse (setq track-mouse t))
140 (if (or (memq (device-type) '(x pm ns)))
141 (w3-build-FSF19-menu)))
142
143 (defun w3-mouse-handler (e)
144 "Function to message the url under the mouse cursor"
145 (interactive "e")
146 (let* ((pt (posn-point (event-start e)))
147 (good (eq (posn-window (event-start e)) (selected-window)))
148 (widget (and good pt (number-or-marker-p pt) (widget-at pt)))
149 (link (and widget (widget-get widget 'href)))
150 (form (and widget (widget-get widget 'w3-form-data)))
151 (imag nil) ; (nth 1 (memq 'w3graphic props))))
152 )
153 (cond
154 (link (message "%s" link))
155 (form
156 (cond
157 ((eq 'submit (w3-form-element-type form))
158 (message "Submit form to %s"
159 (cdr-safe (assq 'action (w3-form-element-action form)))))
160 ((eq 'reset (w3-form-element-type form))
161 (message "Reset form contents"))
162 (t
163 (message "Form entry (name=%s, type=%s)" (w3-form-element-name form)
164 (w3-form-element-type form)))))
165 (imag (message "Inlined image (%s)" (car imag)))
166 (t (message "")))))
167
168 (defun w3-color-values (color)
169 (cond
170 ((eq window-system 'x)
171 (x-color-values color))
172 ((eq window-system 'ns)
173 (ns-color-values color))
174 (t nil)))
175
176 (defun w3-color-light-p (color-or-face)
177 (let (colors)
178 (cond
179 ((null window-system)
180 nil)
181 ((facep color-or-face)
182 (setq color-or-face (face-background color-or-face))
183 (if (null color-or-face)
184 (setq color-or-face (cdr-safe
185 (assq 'background-color (frame-parameters)))))
186 (setq colors (w3-color-values color-or-face)))
187 ((stringp color-or-face)
188 (setq colors (w3-color-values color-or-face)))
189 ((font-rgb-color-p color-or-face)
190 (setq colors (list (font-rgb-color-red color-or-face)
191 (font-rgb-color-green color-or-face)
192 (font-rgb-color-blue color-or-face))))
193 (t
194 (signal 'wrong-type-argument 'color-or-face-p)))
195 (not (< (apply '+ colors)
196 (/ (apply '+ (w3-color-values "white")) 3)))))
197
198
199
200 (provide 'w3-emacs19)
201 (provide 'w3-e19)