diff lisp/w3/w3-display.el @ 114:8619ce7e4c50 r20-1b9

Import from CVS: tag r20-1b9
author cvs
date Mon, 13 Aug 2007 09:21:54 +0200
parents fe104dbd9147
children 9f59509498e1
line wrap: on
line diff
--- a/lisp/w3/w3-display.el	Mon Aug 13 09:20:50 2007 +0200
+++ b/lisp/w3/w3-display.el	Mon Aug 13 09:21:54 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-display.el --- display engine v99999
 ;; Author: wmperry
-;; Created: 1997/03/14 06:33:15
-;; Version: 1.147
+;; Created: 1997/03/18 23:20:40
+;; Version: 1.150
 ;; Keywords: faces, help, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1668,13 +1668,9 @@
 	    (frameset
 	     (if w3-display-frames
 		 (progn
-		   (push 'frameset w3-frameset-structure)
-		   (let ((cols (assq 'cols args))
-			 (rows (assq 'rows args)))
-		     (if rows
-			 (setq w3-frameset-dimensions (push rows w3-frameset-dimensions)))
-		     (if cols
-			 (setq w3-frameset-dimensions (push cols w3-frameset-dimensions))))
+		   (push (list 'frameset
+			       (or (assq 'cols args) (assq 'rows args)))
+			 w3-frameset-structure)
 		   (w3-handle-content node))
 	       (w3-handle-content node)))
 	    (frame
@@ -1685,7 +1681,7 @@
 				  (w3-get-attribute 'title)
 				  (w3-get-attribute 'alt)
 				  "Unknown frame name")))
-		   (push 'frame w3-frameset-structure)
+		   (push (list 'frame name href) w3-frameset-structure)
 		   (w3-handle-content
 		    (list tag args
 			  (list
@@ -1694,10 +1690,7 @@
 				  (list 'a
 					(cons (cons 'href href)
 					      args)
-					(list
-					 (car w3-frame-labels)
-					 name
-					 (cdr w3-frame-labels)))))))))
+					(list "Fetch frame: " name))))))))
 	       (w3-handle-empty-tag)))
 	    (noframes
 	     (if w3-display-frames
@@ -1918,17 +1911,18 @@
 			       (lambda (n)
 				 (setq tmp (w3-normalize-spaces
 					    (apply 'concat (nth 2 n)))
-				       tmp (cons tmp
-						 (or
-						  (cdr-safe
-						   (assq 'value (nth 1 n)))
-						  tmp)))
+				       tmp (vector tmp
+						   (or
+						    (cdr-safe
+						     (assq 'value (nth 1 n)))
+						    tmp)
+						   (assq 'selected (nth 1 n))))
 				 (if (assq 'selected (nth 1 n))
-				     (setq value (car tmp)))
+				     (setq value (aref tmp 0)))
 				 tmp))
 			      (nth 2 node))))
 	       (if (not value)
-		   (setq value (caar options)))
+		   (setq value (aref (car options) 0)))
 	       (setq plist (plist-put plist 'value value))
 	       (if multiple
 		   (progn
@@ -1941,11 +1935,18 @@
 				      (list 'input
 					    (list (cons 'name name)
 						  (cons 'type "checkbox")
-						  (cons 'value (car opt))))
-				      " " (car opt) (list 'br nil nil)))))
+						  (cons (if (aref opt 2)
+							    'checked
+							  '__bogus__) "yes")
+						  (cons 'value (aref opt 1))))
+				      " " (aref opt 0) (list 'br nil nil)))))
 			    options))
 		     (setq node (list 'p nil options))
 		     (w3-handle-content node))
+		 (setq options (mapcar (function
+					(lambda (x)
+					  (cons (aref x 0) (aref x 1))))
+				       options))
 		 (setq plist (plist-put plist 'type 'option)
 		       plist (plist-put plist 'options options))
 		 (w3-form-add-element plist w3-active-faces)
@@ -2119,63 +2120,66 @@
 	  (cl-puthash url (buffer-name) url-history-list)
 	  (if (fboundp 'w3-shuffle-history-menu)
 	      (w3-shuffle-history-menu)))))
-  )
+  (w3-maybe-fetch-frames))
+
+(defun w3-maybe-fetch-frames ()
+  (if w3-frameset-structure
+      (cond ((or (eq w3-display-frames t)
+		 (and (eq w3-display-frames 'ask)
+		      (y-or-n-p "Fetch frames? ")))
+	     (w3-frames)
+	     t))))
 
 (defun w3-frames (&optional new-frame)
   "Set up and fetch W3 frames. With optional prefix, do so in a new frame."
   (interactive "P")
+  (if (not w3-display-frames)
+      (let ((w3-display-frames t))
+	(w3-refresh-buffer)))
   (let* ((old-asynch url-be-asynchronous)
-	 (structure (reverse w3-frameset-structure))
-	 (dims (or (reverse w3-frameset-dimensions)
-		   t)))
+	 (structure (reverse w3-frameset-structure)))
     (if new-frame
 	(select-frame (make-frame-command)))
-    (goto-char (point-min))
     (setq-default url-be-asynchronous nil)
     ;; set up frames
-    (while (and structure dims)
-      (let* ((current-dims (list (car dims)))
-	     (cols (cdr-safe (assq 'cols current-dims)))
-	     (rows (cdr-safe (assq 'rows current-dims))))
-	(if (eq (car structure) 'frameset)
-	    (pop structure))
-	;; columns ?
-	(if cols
-	    (setq cols (w3-decode-frameset-dimensions cols (window-width)))
-	  ;; rows ?
-	  (if rows
-	      (setq rows (w3-decode-frameset-dimensions rows (window-height)))
-	    ;; default: columns of equal width
-	    (let ((nb-windows 0))
-	      (save-excursion
-		(while (re-search-forward w3-frame-regexp nil t)
-		  (setq nb-windows (1+ nb-windows))))
-	      (let ((fwidth (/ (window-width) nb-windows)))
-		(while (> nb-windows 0)
-		  (push fwidth cols)
-		  (setq nb-windows (1- nb-windows)))))))
-	(while (eq (car structure) 'frame)
-	  (if (re-search-forward w3-frame-regexp nil t)
-	      (progn
-		(if (cdr cols)
-		    (split-window-horizontally (min (car cols)
-						    (- (window-width) 12)))
-		  (if (cdr rows)
-		      (split-window-vertically (min (car rows)
-						    (- (window-height) 12)))))
-		(pop cols)
-		(pop rows)
-		(goto-char (+ (match-beginning 0) 5))
-		(let ((name (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
-		      (w3-notify 'semibully))
-		  (w3-widget-button-press)
-		  (setq w3-frame-name name
-			w3-target-window-distances nil))
-		(other-window 1)))
-	  (pop structure)))
-      (if (consp dims)
-	  (pop dims)
-	(setq dims nil)))
+    (while structure
+      (if (eq (car (car structure)) 'frameset)
+	  (let* ((current-dims (cdr (car structure)))
+		 (cols (cdr-safe (assq 'cols current-dims)))
+		 (rows (cdr-safe (assq 'rows current-dims))))
+	    (pop structure)
+	    ;; columns ?
+	    (if cols
+		(setq cols (w3-decode-frameset-dimensions cols (window-width) window-min-width))
+	      ;; rows ?
+	      (if rows
+		  (setq rows (w3-decode-frameset-dimensions rows (window-height) window-min-height))
+		;; default: columns of equal width
+		(let ((nb-windows 0)
+		      (frames structure))
+		  (while (and frames (eq (car (car frames)) 'frame))
+		      (setq nb-windows (1+ nb-windows)))
+		  (let ((fwidth (/ (window-width) nb-windows)))
+		    (while (> nb-windows 0)
+		      (push fwidth cols)
+		      (setq nb-windows (1- nb-windows)))))))
+	    (while (eq (car (car structure)) 'frame)
+	      (cond ((cdr cols)
+		     (split-window-horizontally (car cols))
+		     (pop cols))
+		    ((cdr rows)
+		     (split-window-vertically (car rows))
+		     (pop rows)))
+	      (let ((href (nth 2 (car structure)))
+		    (name (nth 1 (car structure)))
+		    (url-working-buffer url-default-working-buffer) ; in case url-multiple-p is t
+		    (w3-notify 'semibully))
+		(w3-fetch href)
+		(setq w3-frame-name name
+		      w3-target-window-distances nil))
+	      (other-window 1)
+	      (pop structure)))
+	(pop structure)))
     ;; compute target window distances
     (let ((origin-buffer (current-buffer))
 	  (stop nil))
@@ -2204,7 +2208,21 @@
 	  (setq stop t)))
     window-distances))
 
-(defun w3-decode-frameset-dimensions (dims available-dimension)
+(if (not (fboundp 'frame-char-height))
+    (defun frame-char-height (&optional frame)
+      "Height in pixels of a line in the font in frame FRAME.
+If FRAME is omitted, the selected frame is used.
+For a terminal frame, the value is always 1."
+      (font-height (face-font 'default frame))))
+
+(if (not (fboundp 'frame-char-width))
+    (defun frame-char-width (&optional frame)
+      "Width in pixels of characters in the font in frame FRAME.
+If FRAME is omitted, the selected frame is used.
+For a terminal screen, the value is always 1."
+      (font-width (face-font 'default frame))))
+
+(defun w3-decode-frameset-dimensions (dims available-dimension min-dim)
   "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions"
   (let ((dimensions nil))
     (if dims
@@ -2228,7 +2246,7 @@
 			    ;; absolute number: pixel height
 			    (push (max (1+ (/ (car (read-from-string match))
 					      (frame-char-height)))
-				       window-min-height)
+				       min-dim)
 				  dimensions)))
 		     (setq remaining-available-dimension
 			   (- remaining-available-dimension (car dimensions)))))))