[closure-cvs] CVS closure/src/gui

emarsden emarsden at common-lisp.net
Thu Jan 4 23:49:13 UTC 2007


Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv12921/src/gui

Modified Files:
	clue-gui.lisp 
Log Message:
Add title to the PT that is generated for image/* and text/plain
pages; adapt to new LHTML syntax.


--- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2006/12/31 15:42:40	1.6
+++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp	2007/01/04 23:49:13	1.7
@@ -97,15 +97,18 @@
                       (let ((cs (assoc :charset parameters :test #'string-equal)))
                         (when cs
                           (setf charset (cdr cs))))
-                      (netlib::find-mime-type (format nil "~A/~A" type subtype)))))
+                      (netlib::find-mime-type (format nil "~A/~A" type subtype))))
+         (url-text (url:unparse-url url)))
     (let ((pt (progn 
                 (cond ((member mime-type (list (netlib:find-mime-type "image/png")
                                                (netlib:find-mime-type "image/gif")
                                                (netlib:find-mime-type "image/jpeg")))
                        (sgml:lhtml->pt
                         `(:HTML
+                          (:HEAD
+                           (:TITLE ,url-text))
                           (:BODY
-                           (:IMG :SRC ,(url:unparse-url url))))))
+                           ((:IMG :SRC ,url-text))))))
                       ((member mime-type (list (netlib:find-mime-type "text/lml")))
                        (sgml:lhtml->pt (read-from-string (with-output-to-string (bag)
                                                            (do ((x (glisp:g/read-byte input nil nil)
@@ -123,6 +126,8 @@
                                                    (netlib:find-mime-type "text/css"))))
                        (sgml:lhtml->pt
                         `(:HTML
+                          (:HEAD
+                           (:TITLE ,url-text))
                           (:BODY
                            (:PRE
                             ,(gstream-as-string input))))))




More information about the Closure-cvs mailing list