[closure-cvs] CVS closure/src/gui

[emarsden]

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

Modified Files:
	clim-gui.lisp 
Log Message:
Follow HTTP redirects (HTML-level redirects still not supported).


--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2007/01/03 16:14:57	1.29
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp	2007/01/07 19:32:06	1.30
@@ -4,7 +4,7 @@
 ;;;   Created: 2002-07-22
 ;;;    Author: Gilbert Baumann <gilbert at base-engineering.com>
 ;;;   License: MIT style (see below)
-;;;       $Id: clim-gui.lisp,v 1.29 2007/01/03 16:14:57 emarsden Exp $
+;;;       $Id: clim-gui.lisp,v 1.30 2007/01/07 19:32:06 emarsden Exp $
 ;;; ---------------------------------------------------------------------------
 ;;;  (c) copyright 2002 by Gilbert Baumann
 
@@ -28,6 +28,9 @@
 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; $Log: clim-gui.lisp,v $
+;; Revision 1.30  2007/01/07 19:32:06  emarsden
+;; Follow HTTP redirects (HTML-level redirects still not supported).
+;;
 ;; Revision 1.29  2007/01/03 16:14:57  emarsden
 ;; - new function RENDER-LHTML that renders LHTML
 ;; - new command "Inspect Page" that runs Clouseau on the current document
@@ -601,8 +604,13 @@
                (setf (sheet-pointer-cursor *pane*) :busy)
                (setq url (r2::parse-url* url))
                (let ((request (clue-gui2::make-request :url url :method :get)))
-                 (multiple-value-bind (io header) (clue-gui2::open-document-4 request)
-                   (write-status "Fetching Document ...")
+                 (write-status "Fetching Document ...")
+                 (multiple-value-bind (io header)
+                     (clue-gui2::open-document-4 request)
+                   (let ((new-location (netlib::get-header-field header :location)))
+                     (when new-location
+                       (unless (string-equal new-location (url:unparse-url url))
+                         (setq url (url:parse-url new-location)))))
                    (let* ((doc (make-instance 'r2::document
                                               :processes-hooks nil
                                               :location (r2::parse-url* url)