;; photoblogger
;; Copyright (C) 2004 Andy Wingo

;; This program is free software; you can redistribute it and/or    
;; modify it under the terms of the GNU General Public License as   
;; published by the Free Software Foundation; either version 2 of   
;; the License, or (at your option) any later version.              
;;                                                                  
;; This program is distributed in the hope that it will be useful,  
;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
;; GNU General Public License for more details.                     
;;                                                                  
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       gnu@gnu.org

;;; Commentary:
;;
;; Photoblogger uses the same GConf behavior as Owen Taylor's font
;; viewer app. That is to say, it saves the complete app state into
;; GConf. State is initialized from GConf on load, saved as changes
;; occur, but we don't monitor changes to the configuration source. This
;; makes it useful to have multiple copies of the app running.
;;
;; FIXME: need a state-changed hook or signal or something so that views
;; can update in response to state changes within the app. As it is
;; there are hacks around the preferences window and editors to reload
;; state.
;;
;;; Code:

(define-module (photoblogger state)
  :use-module (photoblogger)
  :use-module (srfi srfi-1)
  :use-module (oop goops)
  :use-module (gnome gconf)
  :export (*state* state-ref state-set!))

(define gconf-client (gconf-client-get-default))
(define gconf-dir "/apps/photoblogger")
(gconf-client-add-dir gconf-client gconf-dir 'preload-onelevel)
(define (gconf-key s)
  (string-append gconf-dir "/" (symbol->string s)))

(define (predicate-union . procs)
  (lambda (x) (and-map (lambda (p) (p x)) procs)))

(define state-schema
  `((photos #f ())
    (write-url-base ,string? "")
    (http-url-base ,string? "")
    (scaled-image-width ,(predicate-union integer? positive?) 400)
    (scaled-image-height ,(predicate-union integer? positive?) 400)))

(define *state* 
  (map
   (lambda (s)
     (cons
      (car s)
      (catch #t
             (lambda ()
               (let ((val (gconf-client-get
                           gconf-client (gconf-key (car s)))))
                 (cond
                  ((cadr s)
                   (or ((cadr s) val) (throw 'invalid))
                   val)
                  ((eq? (car s) 'photos)
                   (let ((pickled (with-input-from-string val read)))
                     (map
                      (lambda (slot-defs)
                        (apply make <photo>
                               (append-map
                                (lambda (def)
                                  (list (symbol->keyword (car def))
                                        (cdr def)))
                                slot-defs)))
                      pickled)))
                  (else (throw 'bad-schema s)))))
             (lambda args
               (if (eq? (car args) 'bad-schema)
                   (apply throw args)
                   (pk 'using-default args (caddr s)))))))
   state-schema))

(define (dump-slots x slots)
  (map (lambda (slot) (cons slot (slot-ref x slot)))
       slots))

(define (state-ref key)
  (assq-ref *state* key))

(define (state-set! key val)
  (or (assq key *state*) (error "unknown key" key))
  (assq-set! *state* key val)
  (gconf-client-set
   gconf-client (gconf-key key)
   (case key
     ((photos)
      (with-output-to-string ;; abusing gconf
        (lambda ()
          (write
           (map
            (lambda (x)
              (dump-slots x '(source-uri pformat base-name description
                              already-uploaded)))
            (reverse val))))))
     (else val))))