Mercurial > hg > xemacs-beta

comparison lisp/w3/w3-toolbar.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 8d2a9b52c682
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; w3-toolbar.el --- Toolbar functions for emacs-w3 1 ;;; w3-toolbar.el --- Toolbar functions for emacs-w3
2 ;; Author: wmperry 2 ;; Author: wmperry
3 ;; Created: 1997/03/26 00:01:47 3 ;; Created: 1996/06/30 18:12:43
4 ;; Version: 1.9 4 ;; Version: 1.2
5 ;; Keywords: mouse, toolbar 5 ;; Keywords: mouse, toolbar
6 6
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu) 8 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
9 ;;; Copyright (c) 1996, 1997 Free Software Foundation, Inc.
10 ;;; 9 ;;;
11 ;;; This file is part of GNU Emacs. 10 ;;; This file is part of GNU Emacs.
12 ;;; 11 ;;;
13 ;;; GNU Emacs is free software; you can redistribute it and/or modify 12 ;;; 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 13 ;;; it under the terms of the GNU General Public License as published by
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details. 20 ;;; GNU General Public License for more details.
22 ;;; 21 ;;;
23 ;;; You should have received a copy of the GNU General Public License 22 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with GNU Emacs; see the file COPYING. If not, write to the 23 ;;; along with GNU Emacs; see the file COPYING. If not, write to
25 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 24 ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
26 ;;; Boston, MA 02111-1307, USA.
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 26
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;; Toolbar specific function for XEmacs 19.12+ 28 ;;; Toolbar specific function for XEmacs 19.12+
31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 (condition-case () 30 (require 'xpm-button)
33 (progn 31 (require 'xbm-button)
34 (require 'xpm-button)
35 (require 'xbm-button))
36 (error nil))
37 32
38 (defvar w3-toolbar-icon-directory nil "Where the toolbar icons for w3 are.") 33 (defvar w3-toolbar-icon-directory nil "Where the toolbar icons for w3 are.")
39 (defvar w3-toolbar-back-icon nil "Toolbar icon for back") 34 (defvar w3-toolbar-back-icon nil "Toolbar icon for back")
40 (defvar w3-toolbar-forw-icon nil "Toolbar icon for forward") 35 (defvar w3-toolbar-forw-icon nil "Toolbar icon for forward")
41 (defvar w3-toolbar-home-icon nil "Toolbar icon for home") 36 (defvar w3-toolbar-home-icon nil "Toolbar icon for home")
77 72
78 Only has any meaning in XEmacs 19.12 when w3-toolbar-orientation is 73 Only has any meaning in XEmacs 19.12 when w3-toolbar-orientation is
79 not `none'.") 74 not `none'.")
80 75
81 (defvar w3-toolbar 76 (defvar w3-toolbar
82 '([w3-toolbar-back-icon w3-history-backward (car (w3-history-find-url-internal (url-view-url t))) "Back in history"] 77 '([w3-toolbar-back-icon w3-backward-in-history t "Back in history"]
83 [w3-toolbar-forw-icon w3-history-forward (cdr (w3-history-find-url-internal (url-view-url t))) "Forward in history"] 78 [w3-toolbar-forw-icon w3-forward-in-history t "Forward in history"]
84 [w3-toolbar-home-icon w3 t "Go home"] 79 [w3-toolbar-home-icon w3 t "Go home"]
85 [:style 2d :size 5] 80 [:style 2d :size 5]
86 [w3-toolbar-reld-icon w3-reload-document t "Reload document"] 81 [w3-toolbar-reld-icon w3-reload-document t "Reload document"]
87 [w3-toolbar-hotl-icon w3-show-hotlist t "View hotlist"] 82 [w3-toolbar-hotl-icon w3-show-hotlist t "View hotlist"]
88 [w3-toolbar-imag-icon w3-load-delayed-images w3-delayed-images 83 [w3-toolbar-imag-icon w3-load-delayed-images w3-delayed-images
161 (setq w3-toolbar-icon-directory 156 (setq w3-toolbar-icon-directory
162 (file-name-as-directory 157 (file-name-as-directory
163 (expand-file-name "w3" data-directory)))) 158 (expand-file-name "w3" data-directory))))
164 (cond 159 (cond
165 ((not (file-exists-p w3-toolbar-icon-directory)) 160 ((not (file-exists-p w3-toolbar-icon-directory))
166 (and w3-running-xemacs 161 (w3-warn 'files "Toolbar directory does not exist."))
167 (w3-warn 'files "Toolbar directory does not exist.")))
168 ((not (fboundp 'toolbar-make-button-list)) 162 ((not (fboundp 'toolbar-make-button-list))
169 nil) 163 nil)
170 ((eq w3-toolbar-type 'text) 164 ((eq w3-toolbar-type 'text)
171 (w3-toolbar-make-text-buttons)) 165 (w3-toolbar-make-text-buttons))
172 ((boundp 'toolbar-buttons-captioned-p) 166 ((boundp 'toolbar-buttons-captioned-p)
174 (t 168 (t
175 (w3-toolbar-make-picture-buttons)))) 169 (w3-toolbar-make-picture-buttons))))
176 170
177 (defun w3-link-is-defined (rel &optional rev) 171 (defun w3-link-is-defined (rel &optional rev)
178 (or 172 (or
179 (cdr-safe (assoc rel (cdr-safe (assq 'rel w3-current-links)))) 173 (cdr-safe (assoc rel (cdr-safe (assoc "Parent of" w3-current-links))))
180 (cdr-safe (assoc (or rev rel) (cdr-safe (assq 'rev w3-current-links)))))) 174 (cdr-safe (assoc (or rev rel) (cdr-safe (assoc "Child of"
175 w3-current-links))))))
181 176
182 ;; Need to create w3-toolbar-glos-icon 177 ;; Need to create w3-toolbar-glos-icon
183 ;; w3-toolbar-toc-icon 178 ;; w3-toolbar-toc-icon
184 ;; w3-toolbar-copy-icon 179 ;; w3-toolbar-copy-icon
185 (defvar w3-link-toolbar 180 (defvar w3-link-toolbar
291 (let* ((w3-toolbar-orientation w3-link-toolbar-orientation) 286 (let* ((w3-toolbar-orientation w3-link-toolbar-orientation)
292 (toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) 287 (toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))
293 (if toolbar 288 (if toolbar
294 (if (w3-toolbar-active) 289 (if (w3-toolbar-active)
295 (set-specifier toolbar (cons (current-buffer) nil)) 290 (set-specifier toolbar (cons (current-buffer) nil))
296 (set-specifier toolbar w3-link-toolbar (current-buffer)))))) 291 (set-specifier toolbar (cons (current-buffer) w3-link-toolbar))))))
297 292
298 (defun w3-toggle-toolbar () 293 (defun w3-toggle-toolbar ()
299 (interactive) 294 (interactive)
300 (if (eq major-mode 'w3-mode) 295 (if (eq major-mode 'w3-mode)
301 (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation))) 296 (let ((toolbar (w3-toolbar-from-orientation w3-toolbar-orientation)))