[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Suggest improve tool-bar
>>>>> In [emacs-w3m : No.09090] Leo wrote:
> Dear emacs-w3m developers,
> I recently used a patch posted in Emacs devel mailing list to enable
> support of png icons in tool-bar.el and instantly various packages
> such as Gnus support png tool-bar icons i.e. I can replace those icons
> with their .png version. However this is not the case for emacs-w3m. I
> am wondering if this can be improved. And also we might take this
> chance to obsoletes those *-disabled icon files.
> Thanks,
I've made a trial to enable emacs-w3m to use icons of all the
image types that Emacs supports, except for spinner.gif. The
patch is attached below. But there is at least one reason to
let me hesitate to install it in the CVS repository. That is,
Emacs seems not to support transparent colors in PNG files.
For example, I made antenna-up.png in this way:
xpmtoppm antenna-up.xpm| pnmtopng -transparent='#b6b2b6'> antenna-up.png
While ImageMagick's `display' shows the background of the image
transparent, Emacs[1] doesn't. It is the same problem for which
Chris Moore reported in the emacs-pretest-bug list[2], isn't it?
I don't want to install this feature until the problem is solved.
[1] I use LemonChiffon2 for the background color of the `tool-bar'
face. My Emacs 22 links /usr/lib/libpng12.so.0 in the Fedora
Core 6 system which I update every day.
[2] http://news.gmane.org/group/gmane.emacs.pretest.bugs/thread=16525
Regards,--- w3m-e21.el~ 2007-01-16 21:57:27 +0000
+++ w3m-e21.el 2007-01-22 02:43:33 +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,7 @@
(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 (w3m-find-image "antenna-up") t)
"Non-nil activates toolbar of w3m."
:group 'w3m
:type 'boolean)
@@ -401,35 +429,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 +886,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 +914,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"))