[Date Prev][Date Next][Thread Prev][][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"))