Background (adopted)

Synopsis

Another background selector.

Description

This script makes use of a custom widget (a gtk file chooser with embedded preview).

Installation

Place background.jl in ~/.sawfish/lisp.

Then place preview-image-selector.jl in /usr/share/sawfish/lisp/sawfish/gtk/widgets or in $SAWFISH_USER_LISP_DIR/sawfish/gtk/widgets.

Put this code in ~/.sawfishrc:

(require 'backgrounds)
(add-hook 'after-initialization-hook set-background-hook)

Code

;; background.jl
;; Based on Backgrounds-hack.jl
;; Author: Lucas Pandolfo

(defun set-background (path)
  (cond ((null path) nil)
  	(t (system (concat background-set-app " \"" path "\" &"))
  	   (if (not (null menu-changes-default-bg))
  	       (setq root-background path)))))

(defun set-background-hook ()
  (set-background root-background))


;; CUSTOMIZATION STUFF
(defgroup background "Background")

(defcustom root-background nil
  "Current root background"
  :type preview-image-selector
  :group background
  :after-set set-background-hook)

(defcustom background-set-app "fbsetbg"
  "Application to set desktop background"
  :type program-name
  :group background
  :after-set set-background-hook)

(defcustom menu-changes-default-bg nil
  "Does the menu change the default background?"
  :type boolean
  :group background)

(provide 'background)

;; preview-image-selector.jl
;; Based on file.jl
;; Author: Lucas Pandolfo
;; TODO: -Resize preview preserving aspect

(define-structure sawfish.gtk.widgets.preview-image-selector

    (export )

    (open rep
	  rep.system
          gui.gtk-2.gtk
          sawfish.gtk.widget)

  (define (make-preview-item changed-callback)
    (let* ((box (gtk-hbox-new nil box-spacing))
	   (entry (gtk-entry-new))
	   (button (gtk-file-chooser-button-new '() 'open))
	   (preview (gtk-image-new)))
      (gtk-container-set-border-width box box-border)
      (gtk-box-pack-start box entry)
      (gtk-box-pack-start box button)
      (when changed-callback
	(g-signal-connect
	 entry "changed" (make-signal-callback changed-callback)))

      (g-signal-connect button "update-preview" 
			(lambda (w) 
			  (let* ((filename (gtk-file-chooser-get-preview-filename w))
				 (pixbuf (gdk-pixbuf-new-from-file filename)))
			    (if pixbuf
				(progn (gtk-image-set-from-pixbuf preview (gdk-pixbuf-scale-simple pixbuf 256 200 'bilinear))
				       (gtk-file-chooser-set-preview-widget-active button t))
				(gtk-file-chooser-set-preview-widget-active button nil)))))

      (gtk-file-chooser-set-preview-widget button preview)

      (g-signal-connect button "file-set" (lambda (w) 
					    (gtk-entry-set-text entry (gtk-file-chooser-get-filename button))))
      (gtk-widget-show box)

      (lambda (op)
	(case op
	  ((set) (lambda (x)
		   (gtk-entry-set-text entry (and (stringp x) x))))
	  ((clear) (lambda ()
		     (gtk-entry-set-text entry "")))
	  ((ref) (lambda () (gtk-entry-get-text entry)))
	  ((gtk-widget) box)
	  ((validp) (lambda (x) (stringp x)))))))

  (define-widget-type 'preview-image-selector make-preview-item))