[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Suggest improve tool-bar
>>>>> In [emacs-w3m : No.09094] Leo wrote:
> On 2007-01-22, Katsumi Yamaoka said:
>> I use LUCID, not GTK. So, the cause of the problem will probably be
>> in the Emacs core.
> We can wait until Emacs got proper png support.
> However I can't use the patch you posted:
> In toplevel form:
> w3m-antenna.el:48:1:Error: Symbol's value as variable is void: w3m-icon-directory
Sorry. Here's a corrected one:
--- w3m-e21.el~ 2007-01-16 21:57:27 +0000
+++ w3m-e21.el 2007-01-22 03:37:20 +0000
@@ -290,6 +290,34 @@
(and (display-images-p)
(image-type-available-p image-type)))
+(defun w3m-find-image (name &optional directory)
+ "Find image file for NAME and return cons of file name and type.
+This function searches only in DIRECTORY, that defaults to the value of
+`w3m-icon-directory', for an image file of which the base name is NAME.
+Files of types that Emacs does not support are ignored."
+ (unless directory
+ (setq directory w3m-icon-directory))
+ (when (and directory
+ (file-directory-p directory)
+ (display-images-p))
+ (let* ((case-fold-search nil)
+ (files (directory-files directory t
+ (concat "\\`" (regexp-quote name) "\\.")))
+ file type)
+ (while files
+ (when (string-match "\\.\\([^.]+\\)\\'" (setq file (pop files)))
+ (setq type (intern (downcase (match-string 1 file))))
+ (setq type (or (cdr (assq type '((tif . tiff)
+ (jpg . jpeg)
+ (ps . postscript)
+ (pgm . pbm)
+ (ppm . pbm))))
+ type))
+ (when (memq type image-types)
+ (setq files nil))))
+ (when type
+ (cons file type)))))
+
;;; Form buttons
(defface w3m-form-button-face
'((((type x w32 mac) (class color))
@@ -366,7 +394,9 @@
(setq widget-button-pressed-face 'w3m-form-button-pressed-face))
;;; Toolbar
-(defcustom w3m-use-toolbar (w3m-image-type-available-p 'xpm)
+(defcustom w3m-use-toolbar (and (not noninteractive)
+ (w3m-find-image "antenna-up")
+ t)
"Non-nil activates toolbar of w3m."
:group 'w3m
:type 'boolean)
@@ -401,35 +431,35 @@
(defun w3m-e21-make-toolbar-buttons (buttons)
(dolist (button buttons)
- (let ((up (expand-file-name (concat button "-up.xpm")
- w3m-icon-directory))
- (down (expand-file-name (concat button "-down.xpm")
- w3m-icon-directory))
- (disabled (expand-file-name (concat button "-disabled.xpm")
- w3m-icon-directory))
+ (let ((up (w3m-find-image (concat button "-up")))
+ (down (w3m-find-image (concat button "-down")))
+ (disabled (w3m-find-image (concat button "-disabled")))
(icon (intern (concat "w3m-toolbar-" button "-icon")))
+ ;; Make the color, which is specified as backgroundToolBarColor
+ ;; in xpm images, transparent.
(props '(:ascent
center
:color-symbols (("backgroundToolBarColor" . "None")))))
(unless (boundp icon)
- (if (file-exists-p up)
+ (if up
(progn
- (setq up (apply 'create-image up 'xpm nil props))
- (if (file-exists-p down)
- (setq down (apply 'create-image down 'xpm nil props))
- (setq down nil))
- (if (file-exists-p disabled)
- (setq disabled (apply 'create-image disabled 'xpm nil props))
- (setq disabled nil))
+ (setq up (apply 'create-image (car up) (cdr up) nil
+ (when (eq (cdr up) 'xpm)
+ props)))
+ (when down
+ (setq down (apply 'create-image (car down) (cdr down) nil
+ (when (eq (cdr up) 'xpm)
+ props))))
+ (when disabled
+ (setq disabled (apply 'create-image
+ (car disabled) (cdr disabled) nil
+ (when (eq (cdr disabled) 'xpm)
+ props))))
(set icon (vector down up disabled disabled)))
- (error "Icon file %s not found" up))))))
+ (error "Icon file %s-up.* not found" button))))))
(defun w3m-setup-toolbar ()
- (when (and w3m-use-toolbar
- w3m-icon-directory
- (file-directory-p w3m-icon-directory)
- (file-exists-p (expand-file-name "antenna-up.xpm"
- w3m-icon-directory)))
+ (when w3m-use-toolbar
(w3m-e21-make-toolbar-buttons w3m-toolbar-buttons)
(w3m-e21-setup-toolbar w3m-mode-map w3m-toolbar)))
@@ -858,33 +888,27 @@
(defun w3m-initialize-graphic-icons (&optional force)
"Make icon images which will be displayed in the mode-line."
(interactive "P")
- (let ((defs '((w3m-modeline-status-off-icon
- "state-00.xpm"
+ (let ((defs `((w3m-modeline-status-off-icon
+ ,(w3m-find-image "state-00")
w3m-modeline-status-off)
(w3m-modeline-image-status-on-icon
- "state-01.xpm"
+ ,(w3m-find-image "state-01")
w3m-modeline-image-status-on)
(w3m-modeline-ssl-status-off-icon
- "state-10.xpm"
+ ,(w3m-find-image "state-10")
w3m-modeline-ssl-status-off)
(w3m-modeline-ssl-image-status-on-icon
- "state-11.xpm"
+ ,(w3m-find-image "state-11")
w3m-modeline-ssl-image-status-on)))
- def icon file status keymap)
+ def icon file type status keymap)
(while defs
(setq def (car defs)
defs (cdr defs)
icon (car def)
- file (nth 1 def)
+ file (car (nth 1 def))
+ type (cdr (nth 1 def))
status (nth 2 def))
- (if (and window-system
- w3m-show-graphic-icons-in-mode-line
- (display-images-p)
- (image-type-available-p 'xpm)
- w3m-icon-directory
- (file-directory-p w3m-icon-directory)
- (file-exists-p
- (setq file (expand-file-name file w3m-icon-directory))))
+ (if (and w3m-show-graphic-icons-in-mode-line file)
(progn
(when (or force (not (symbol-value icon)))
(unless keymap
@@ -892,7 +916,7 @@
'w3m-reload-this-page)))
(set icon (propertize
" "
- 'display (create-image file 'xpm nil :ascent 'center)
+ 'display (create-image file type nil :ascent 'center)
'local-map keymap
'mouse-face 'mode-line-highlight
'help-echo "mouse-2 reloads this page"))