|
2
|
1 ;;; w3-toolbar.el --- Toolbar functions for emacs-w3
|
|
0
|
2 ;; Author: wmperry
|
|
80
|
3 ;; Created: 1996/12/30 16:04:40
|
|
|
4 ;; Version: 1.6
|
|
0
|
5 ;; Keywords: mouse, toolbar
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2
|
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
80
|
9 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
|
|
0
|
10 ;;;
|
|
|
11 ;;; This file is part of GNU Emacs.
|
|
|
12 ;;;
|
|
|
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
16 ;;; any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
80
|
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
26 ;;; Boston, MA 02111-1307, USA.
|
|
0
|
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
28
|
|
|
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
30 ;;; Toolbar specific function for XEmacs 19.12+
|
|
|
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
80
|
32 (condition-case ()
|
|
|
33 (progn
|
|
|
34 (require 'xpm-button)
|
|
|
35 (require 'xbm-button))
|
|
|
36 (error nil))
|
|
0
|
37
|
|
|
38 (defvar w3-toolbar-icon-directory nil "Where the toolbar icons for w3 are.")
|
|
|
39 (defvar w3-toolbar-back-icon nil "Toolbar icon for back")
|
|
|
40 (defvar w3-toolbar-forw-icon nil "Toolbar icon for forward")
|
|
|
41 (defvar w3-toolbar-home-icon nil "Toolbar icon for home")
|
|
|
42 (defvar w3-toolbar-reld-icon nil "Toolbar icon for reload")
|
|
|
43 (defvar w3-toolbar-imag-icon nil "Toolbar icon for images")
|
|
|
44 (defvar w3-toolbar-open-icon nil "Toolbar icon for open url")
|
|
|
45 (defvar w3-toolbar-print-icon nil "Toolbar icon for printing")
|
|
|
46 (defvar w3-toolbar-find-icon nil "Toolbar icon for find")
|
|
|
47 (defvar w3-toolbar-stop-icon nil "Toolbar icon for stop")
|
|
|
48 (defvar w3-toolbar-help-icon nil "Toolbar icon for help")
|
|
|
49 (defvar w3-toolbar-hotl-icon nil "Toolbar icon for hotlist")
|
|
|
50
|
|
|
51 (defvar w3-link-toolbar-orientation 'bottom
|
|
|
52 "*Where to put the document specific toolbar. Must be one of these symbols:
|
|
|
53
|
|
|
54 default -- place at location specified by `default-toolbar-position'
|
|
|
55 top -- place along the top of the frame
|
|
|
56 bottom -- place along the bottom of the frame
|
|
|
57 right -- place along the right edge of the frame
|
|
|
58 left -- place along the left edge of the frame
|
|
|
59 none -- no toolbar")
|
|
|
60
|
|
|
61 (defvar w3-toolbar-orientation 'default
|
|
|
62 "*Where to put the w3 toolbar. Must be one of these symbols:
|
|
|
63
|
|
|
64 default -- place at location specified by `default-toolbar-position'
|
|
|
65 top -- place along the top of the frame
|
|
|
66 bottom -- place along the bottom of the frame
|
|
|
67 right -- place along the right edge of the frame
|
|
|
68 left -- place along the left edge of the frame
|
|
|
69 none -- no toolbar")
|
|
|
70
|
|
|
71 (defvar w3-toolbar-type 'both
|
|
|
72 "*What the toolbar looks like. Must be one of these symbols:
|
|
|
73
|
|
|
74 pictures -- Show icons (without captions if in XEmacs 19.13)
|
|
|
75 both -- Show icons (with captions if in XEmacs 19.13)
|
|
|
76 text -- Show only text buttons
|
|
|
77
|
|
|
78 Only has any meaning in XEmacs 19.12 when w3-toolbar-orientation is
|
|
|
79 not `none'.")
|
|
|
80
|
|
|
81 (defvar w3-toolbar
|
|
70
|
82 '([w3-toolbar-back-icon w3-backward-in-history t "Back in history"]
|
|
|
83 [w3-toolbar-forw-icon w3-forward-in-history t "Forward in history"]
|
|
0
|
84 [w3-toolbar-home-icon w3 t "Go home"]
|
|
|
85 [:style 2d :size 5]
|
|
|
86 [w3-toolbar-reld-icon w3-reload-document t "Reload document"]
|
|
|
87 [w3-toolbar-hotl-icon w3-show-hotlist t "View hotlist"]
|
|
|
88 [w3-toolbar-imag-icon w3-load-delayed-images w3-delayed-images
|
|
|
89 "Load images"]
|
|
|
90 [toolbar-file-icon w3-fetch t "Fetch a URL"]
|
|
|
91 [toolbar-printer-icon w3-mouse-print-this-url t "Print document"]
|
|
|
92 [w3-toolbar-find-icon w3-search-forward t "Search"]
|
|
|
93 ;;[w3-toolbar-stop-icon keyboard-quit t "Stop transaction"]
|
|
|
94 nil
|
|
|
95 [w3-toolbar-help-icon w3-show-info-node t "Help"])
|
|
|
96 "The toolbar for w3")
|
|
|
97
|
|
|
98 (defun w3-toolbar-make-captioned-buttons ()
|
|
|
99 (mapcar
|
|
|
100 (function
|
|
|
101 (lambda (x)
|
|
|
102 (let* ((ext (if (featurep 'xpm) ".xpm" ".xbm"))
|
|
|
103 (base w3-toolbar-icon-directory)
|
|
|
104 (up (expand-file-name (concat x "-up" ext) base))
|
|
|
105 (dn (expand-file-name (concat x "-dn" ext) base))
|
|
|
106 (no (expand-file-name (concat x "-no" ext) base))
|
|
|
107 (cap-up (expand-file-name (concat x "-cap-up" ext) base))
|
|
|
108 (cap-dn (expand-file-name (concat x "-cap-dn" ext) base))
|
|
|
109 (cap-no (expand-file-name (concat x "-cap-no" ext) base))
|
|
|
110 (var (intern (concat "w3-toolbar-" x "-icon"))))
|
|
|
111 (set var
|
|
|
112 (toolbar-make-button-list up dn no cap-up cap-dn cap-no)))))
|
|
|
113
|
|
|
114 '("back" "help" "find" "forw" "home" "hotl" "stop" "imag" "reld")))
|
|
|
115
|
|
|
116 (defun w3-make-text-toolbar-button (text)
|
|
|
117 (let ((bgcol (or
|
|
|
118 (cdr-safe (assq 'background-toolbar-color (frame-parameters)))
|
|
|
119 "#befbbefbbefb")))
|
|
|
120 (if (featurep 'xpm)
|
|
|
121 (mapcar 'make-glyph (xpm-button-create text 0 "black" bgcol))
|
|
|
122 (xbm-button-create text 0))))
|
|
|
123
|
|
|
124 (defun w3-toolbar-make-text-buttons ()
|
|
|
125 (let ((bgcol (or (cdr-safe (assq 'background-toolbar-color
|
|
|
126 (frame-parameters)))
|
|
|
127 "#befbbefbbefb")))
|
|
|
128 (setq w3-toolbar-back-icon (w3-make-text-toolbar-button "Back")
|
|
|
129 w3-toolbar-forw-icon (w3-make-text-toolbar-button "Forward")
|
|
|
130 w3-toolbar-home-icon (w3-make-text-toolbar-button "Home")
|
|
|
131 w3-toolbar-reld-icon (w3-make-text-toolbar-button "Reload")
|
|
|
132 w3-toolbar-hotl-icon (w3-make-text-toolbar-button "Hotlist")
|
|
|
133 w3-toolbar-imag-icon (w3-make-text-toolbar-button "Images")
|
|
|
134 w3-toolbar-open-icon (w3-make-text-toolbar-button "Open")
|
|
|
135 w3-toolbar-print-icon (w3-make-text-toolbar-button "Print")
|
|
|
136 w3-toolbar-find-icon (w3-make-text-toolbar-button "Find")
|
|
|
137 w3-toolbar-help-icon (w3-make-text-toolbar-button "Help!"))))
|
|
|
138
|
|
|
139 (defun w3-toolbar-make-picture-buttons ()
|
|
|
140 (mapcar
|
|
|
141 (function
|
|
|
142 (lambda (x)
|
|
|
143 (let* ((ext (if (featurep 'xpm) ".xpm" ".xbm"))
|
|
|
144 (base w3-toolbar-icon-directory)
|
|
|
145 (up (expand-file-name (concat x "-cap-up" ext) base))
|
|
|
146 (dn (expand-file-name (concat x "-cap-dn" ext) base))
|
|
|
147 (no (expand-file-name (concat x "-cap-no" ext) base))
|
|
|
148 (var (intern (concat "w3-toolbar-" x "-icon"))))
|
|
|
149 (set var
|
|
|
150 (cond
|
|
|
151 ((and (file-exists-p up) (file-exists-p dn)
|
|
|
152 (file-exists-p no))
|
|
|
153 (toolbar-make-button-list up dn no))
|
|
|
154 ((file-exists-p up)
|
|
|
155 (toolbar-make-button-list up))
|
|
|
156 (t nil))))))
|
|
|
157 '("back" "help" "find" "forw" "home" "hotl" "imag" "reld")))
|
|
|
158
|
|
|
159 (defun w3-toolbar-make-buttons ()
|
|
|
160 (if (not w3-toolbar-icon-directory)
|
|
|
161 (setq w3-toolbar-icon-directory
|
|
|
162 (file-name-as-directory
|
|
|
163 (expand-file-name "w3" data-directory))))
|
|
|
164 (cond
|
|
|
165 ((not (file-exists-p w3-toolbar-icon-directory))
|
|
70
|
166 (w3-warn 'files "Toolbar directory does not exist."))
|
|
0
|
167 ((not (fboundp 'toolbar-make-button-list))
|
|
|
168 nil)
|
|
|
169 ((eq w3-toolbar-type 'text)
|
|
|
170 (w3-toolbar-make-text-buttons))
|
|
|
171 ((boundp 'toolbar-buttons-captioned-p)
|
|
|
172 (w3-toolbar-make-captioned-buttons))
|
|
|
173 (t
|
|
|
174 (w3-toolbar-make-picture-buttons))))
|
|
|
175
|
|
|
176 (defun w3-link-is-defined (rel &optional rev)
|
|
|
177 (or
|
|
80
|
178 (cdr-safe (assoc rel (cdr-safe (assq 'rel w3-current-links))))
|
|
|
179 (cdr-safe (assoc (or rev rel) (cdr-safe (assq 'rev w3-current-links))))))
|
|
0
|
180
|
|
|
181 ;; Need to create w3-toolbar-glos-icon
|
|
|
182 ;; w3-toolbar-toc-icon
|
|
|
183 ;; w3-toolbar-copy-icon
|
|
|
184 (defvar w3-link-toolbar
|
|
|
185 '([info::toolbar-prev-icon
|
|
|
186 (w3-fetch (w3-link-is-defined "previous" "next"))
|
|
|
187 (w3-link-is-defined "previous" "next")
|
|
|
188 "Back"]
|
|
|
189 [info::toolbar-next-icon
|
|
|
190 (w3-fetch (w3-link-is-defined "next" "previous"))
|
|
|
191 (w3-link-is-defined "next" "previous")
|
|
|
192 "Next"]
|
|
|
193 [info::toolbar-up-icon
|
|
|
194 (w3-fetch (w3-link-is-defined "up" "down"))
|
|
|
195 (w3-link-is-defined "up" "down")
|
|
|
196 "Up"]
|
|
|
197 [w3-toolbar-home-icon
|
|
|
198 (w3-fetch (w3-link-is-defined "home"))
|
|
|
199 (w3-link-is-defined "home")
|
|
|
200 "Home"]
|
|
|
201 [w3-toolbar-toc-icon
|
|
|
202 (w3-fetch (w3-link-is-defined "toc"))
|
|
|
203 (w3-link-is-defined "toc")
|
|
|
204 "Contents"]
|
|
|
205 [w3-toolbar-find-icon
|
|
|
206 (w3-fetch (w3-link-is-defined "index"))
|
|
|
207 (w3-link-is-defined "index")
|
|
|
208 "Index"]
|
|
|
209 [w3-toolbar-glos-icon
|
|
|
210 (w3-fetch (w3-link-is-defined "glossary"))
|
|
|
211 (w3-link-is-defined "glossary")
|
|
|
212 "Glossary"]
|
|
|
213 [w3-toolbar-copy-icon
|
|
|
214 (w3-fetch (w3-link-is-defined "copyright"))
|
|
|
215 (w3-link-is-defined "copyright")
|
|
|
216 "Copyright"]
|
|
|
217 [w3-toolbar-hotl-icon
|
|
|
218 (w3-fetch (w3-link-is-defined "bookmark"))
|
|
|
219 (w3-link-is-defined "bookmark")
|
|
|
220 "Bookmarks"]
|
|
|
221 nil
|
|
|
222 [w3-toolbar-help-icon
|
|
|
223 (w3-fetch (w3-link-is-defined "help"))
|
|
|
224 (w3-link-is-defined "help")
|
|
|
225 "Help"]
|
|
|
226 ))
|
|
|
227
|
|
|
228 (defun w3-toolbar-from-orientation (orientation)
|
|
|
229 (cond
|
|
|
230 ((eq 'default w3-toolbar-orientation) default-toolbar)
|
|
|
231 ((eq 'bottom w3-toolbar-orientation) bottom-toolbar)
|
|
|
232 ((eq 'top w3-toolbar-orientation) top-toolbar)
|
|
|
233 ((eq 'left w3-toolbar-orientation) left-toolbar)
|
|
|
234 ((eq 'right w3-toolbar-orientation) right-toolbar)))
|
|
|
235
|
|
|
236 (defun w3-toolbar-dimension-from-orientation (orientation)
|
|
|
237 (cond
|
|
|
238 ((eq 'default w3-toolbar-orientation) nil)
|
|
|
239 ((eq 'bottom w3-toolbar-orientation) bottom-toolbar-height)
|
|
|
240 ((eq 'top w3-toolbar-orientation) top-toolbar-height)
|
|
|
241 ((eq 'left w3-toolbar-orientation) left-toolbar-width)
|
|
|
242 ((eq 'right w3-toolbar-orientation) right-toolbar-width)))
|
|
|
243
|
|
|
244 (defun w3-ensure-toolbar-visible (orientation)
|
|
|
245 ;; Make sure a certain toolbar is visible if necessary
|
|
|
246 ;; This can modify frame parameters, so watch out.
|
|
|
247 (let ((dimension (w3-toolbar-dimension-from-orientation orientation))
|
|
|
248 (toolbar (w3-toolbar-from-orientation orientation))
|
|
|
249 (dimensions nil)
|
|
|
250 (widths nil)
|
|
|
251 (heights nil)
|
|
|
252 (needs nil)
|
|
|
253 (has nil))
|
|
|
254 (if (and dimension toolbar
|
|
|
255 (setq toolbar (specifier-instance toolbar)))
|
|
|
256 (progn
|
|
|
257 (setq dimensions (mapcar
|
|
|
258 (function
|
|
|
259 (lambda (glyph)
|
|
|
260 (and (glyphp glyph)
|
|
|
261 (cons (glyph-width glyph)
|
|
|
262 (glyph-height glyph)))))
|
|
|
263 (mapcar 'car
|
|
|
264 (delq nil
|
|
|
265 (mapcar
|
|
|
266 (function (lambda (x)
|
|
|
267 (and x
|
|
|
268 (symbol-value
|
|
|
269 (aref x 0)))))
|
|
|
270 toolbar))))
|
|
|
271 widths (sort (mapcar 'car dimensions) '>=)
|
|
|
272 heights (sort (mapcar 'cdr dimensions) '>=)
|
|
|
273 needs (+ 7 (if (memq orientation '(top bottom))
|
|
|
274 (car heights)
|
|
|
275 (car widths)))
|
|
|
276 has (specifier-instance dimension))
|
|
|
277 (if (<= has needs)
|
|
|
278 (set-specifier dimension (cons (selected-frame) needs)))))))
|
|
|
279
|
|
|
280 (defun w3-toolbar-active ()
|
|
|
281 (interactive)
|
|
|
282 (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))
|
|
|
283 (if (and toolbar (specifier-instance toolbar))
|
|
|
284 t
|
|
|
285 nil)))
|
|
|
286
|
|
|
287 (defun w3-toggle-link-toolbar ()
|
|
|
288 (interactive)
|
|
|
289 (require 'info) ; For some toolbar buttons
|
|
|
290 (let* ((w3-toolbar-orientation w3-link-toolbar-orientation)
|
|
|
291 (toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))
|
|
|
292 (if toolbar
|
|
|
293 (if (w3-toolbar-active)
|
|
|
294 (set-specifier toolbar (cons (current-buffer) nil))
|
|
80
|
295 (set-specifier toolbar w3-link-toolbar (current-buffer))))))
|
|
0
|
296
|
|
|
297 (defun w3-toggle-toolbar ()
|
|
|
298 (interactive)
|
|
|
299 (if (eq major-mode 'w3-mode)
|
|
|
300 (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))
|
|
|
301 (cond
|
|
|
302 ((w3-toolbar-active)
|
|
|
303 (set-specifier toolbar (cons (current-buffer) nil)))
|
|
|
304 (toolbar
|
|
|
305 (set-specifier toolbar (cons (current-buffer) w3-toolbar)))
|
|
|
306 (t
|
|
|
307 (setq w3-toolbar-orientation 'default
|
|
|
308 toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))
|
|
|
309 (and toolbar
|
|
|
310 (set-specifier toolbar (cons (current-buffer) w3-toolbar))))))
|
|
|
311 (if (not (eq w3-toolbar-orientation 'none))
|
|
|
312 (setq w3-toolbar-orientation 'none)
|
|
|
313 (setq w3-toolbar-orientation 'default))))
|
|
|
314
|
|
|
315 (defun w3-show-info-node ()
|
|
|
316 (interactive)
|
|
|
317 (Info-goto-node "(w3.info)Top"))
|
|
|
318
|
|
|
319 (defun w3-mouse-print-this-url (&optional e)
|
|
|
320 (interactive "e")
|
|
|
321 (let ((descr '("Print document as"
|
|
|
322 ["PostScript" (w3-print-this-url nil "PostScript") t]
|
|
|
323 ["Formatted Text" (w3-print-this-url nil "Formatted Text") t]
|
|
|
324 ["HTML Source" (w3-print-this-url nil "HTML Source") t]
|
|
|
325 ["LaTeX'd" (w3-print-this-url nil "LaTeX'd") t]
|
|
|
326 nil
|
|
|
327 ["Cancel" (beep) t])))
|
|
|
328 (popup-dialog-box descr)))
|
|
|
329
|
|
|
330 (defun w3-add-toolbar-to-buffer ()
|
|
|
331 (if (not (featurep 'toolbar))
|
|
|
332 nil
|
|
|
333 (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))
|
|
|
334 (if toolbar
|
|
|
335 (set-specifier toolbar (cons (current-buffer) w3-toolbar))))
|
|
|
336 (set-specifier toolbar-buttons-captioned-p
|
|
|
337 (cons (current-buffer) (eq w3-toolbar-type 'both)))))
|
|
|
338
|
|
|
339 (provide 'w3-toolbar)
|
