// flickr and display on the monitor using TK
(set 'api "/services/rest") (set 'apikey "YOUR-OWN-KEY-HERE") (set 'host "http://flickr.com") (set 'email "") (set 'password "") (define (doget method auth params) (setq url (append host api "/?api_key=" apikey "&method=" method)) (if (list? params) (setq url (append url "&" (urlencode params)))) (if (not (nil? auth)) (setq url (append url "&email=" email "&password=" password))) (setq xmldata (get-url url))) (define (urlencode params) (setq urlstring "") (dolist (param1 params) (if (not (= urlstring "")) (setq urlstring (append urlstring "&"))) (setq urlstring (append urlstring (nth 0 param1) "=" (nth 1 param1))))) (define (xmlconvert data) (xml-type-tags nil nil nil nil) (setq sxmldata (xml-parse data (+ 1 2 4 8 16)))) (define (getphotos data) (if (ref 'photo sxmldata) (setq photolist (slice (data (chop (ref 'photo data) 2)) 2 -1)) (setq photolist '()))) (define (handlephotos sxmldata) (dolist (aphoto (getphotos sxmldata)) (setq pr (first (rest aphoto))) (print (format "http://static.flickr.com/%s/%s_%s_o.jpg" (lookup 'server pr) (lookup 'id pr) (lookup 'secret pr))))) (define (fiv) (tk "package require Img") (tk "destroy .fivwin") (tk "toplevel .fivwin") (tk "wm geometry .fivwin [winfo screenwidth .]x[winfo screenheight .]+0+0") ;; uncomment the following lines to make display "fullscreen" ;;(tk "bind .fivwin <Key> {destroy .fivwin}") ;;(tk "bind .fivwin <Motion> {destroy .fivwin}") ;;(tk "bind .fivwin <Button> {destroy .fivwin}") ;;(tk "wm overrideredirect .fivwin yes; focus -force .fivwin") (setq picture (tk "image create photo ")) (tk (append "label .fivwin.picture -image " picture)) (tk "pack .fivwin.picture") (setq xmldata (doget "flickr.interestingness.getList" nil '(("per_page" "100")("page" "1")))) ;; how many per page , from which page (setq sxmldata (xmlconvert xmldata)) (if (ref 'photo sxmldata) (setq photolist (slice (sxmldata (chop (ref 'photo sxmldata) 2)) 2 -1)) (exit)) (dolist (aphoto photolist) (if (= "0" (tk "winfo exists .fivwin")) (exit)) (setq photodesc (first (rest aphoto))) (setq photourl (format "http://static.flickr.com/%s/%s_%s_o.jpg" (lookup 'server photodesc) (lookup 'id photodesc) (lookup 'secret photodesc))) (tk "update idletasks") (setq file (last (parse photourl "/"))) (write-file file (get-url photourl)) (tk (append picture " configure -file " file)) (delete-file file)))