diff lisp/w3/w3-display.el @ 102:a145efe76779 r20-1b3

Import from CVS: tag r20-1b3
author cvs
date Mon, 13 Aug 2007 09:15:49 +0200
parents 4be1180a9e89
children 360340f9fd5f
line wrap: on
line diff
--- a/lisp/w3/w3-display.el	Mon Aug 13 09:15:13 2007 +0200
+++ b/lisp/w3/w3-display.el	Mon Aug 13 09:15:49 2007 +0200
@@ -1,7 +1,7 @@
 ;;; w3-display.el --- display engine v99999
 ;; Author: wmperry
-;; Created: 1997/02/15 23:38:28
-;; Version: 1.128
+;; Created: 1997/02/20 21:48:44
+;; Version: 1.135
 ;; Keywords: faces, help, hypermedia
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -367,6 +367,7 @@
   (goto-char (point-max))
   (add-text-properties w3-scratch-start-point
 		       (point) (list 'face w3-active-faces
+				     'html-stack w3-display-open-element-stack
 				     'start-open t
 				     'end-open t
 				     'rear-nonsticky t
@@ -414,7 +415,8 @@
 	(pop check)))))
 
 (defun w3-follow-hyperlink (widget &rest ignore)
-  (let* ((target (widget-get widget 'target))
+  (let* ((target (or (widget-get widget 'target)
+		     w3-base-target))
 	 (href (widget-get widget 'href)))
     (if target (setq target (intern (downcase target))))
     (case target
@@ -424,6 +426,11 @@
        (delete-other-windows)
        (w3-fetch href))
       (otherwise
+       (and target
+	    (let ((window-distance (cdr-safe (assq target w3-target-window-distances))))
+	      (if (numberp window-distance)
+		  (other-window window-distance)
+		(error "target %S not found." target))))
        (w3-fetch href)))))
 
 (defun w3-balloon-help-callback (object &optional event)
@@ -1497,6 +1504,7 @@
 	(right-margin-stack (list fill-column))
 	(left-margin-stack (list 0))
 	(inhibit-read-only t)
+	(widget-push-button-gui nil)
 	node
 	insert-before
 	insert-after
@@ -1648,26 +1656,37 @@
 	     (w3-handle-empty-tag))
 	    (frameset
 	     (if w3-display-frames
-		 (w3-handle-content node)
+		 (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))))
+		   (w3-handle-content node))
 	       (w3-handle-empty-tag)))
 	    (frame
-	     (let* ((href (or (w3-get-attribute 'src)
-			      (w3-get-attribute 'href)))
-		    (name (or (w3-get-attribute 'name)
-			      (w3-get-attribute 'title)
-			      (w3-get-attribute 'alt)
-			      "Unknown frame name")))
-	       (w3-handle-content
-		(list tag args
-		      (list
-		       (list 'p nil
-			     (list
-			      (list 'a
-				    (cons (cons 'href href)
-					  args)
-				    (list
-				     "Fetch frame: "
-				     name)))))))))
+	     (if w3-display-frames
+		 (let* ((href (or (w3-get-attribute 'src)
+				  (w3-get-attribute 'href)))
+			(name (or (w3-get-attribute 'name)
+				  (w3-get-attribute 'title)
+				  (w3-get-attribute 'alt)
+				  "Unknown frame name")))
+		   (push 'frame w3-frameset-structure)
+		   (w3-handle-content
+		    (list tag args
+			  (list
+			   (list 'p nil
+				 (list
+				  (list 'a
+					(cons (cons 'href href)
+					      args)
+					(list
+					 (car w3-frame-labels)
+					 name
+					 (cdr w3-frame-labels)))))))))))
 	    (noframes
 	     (if w3-display-frames
 		 (w3-handle-empty-tag)
@@ -1775,11 +1794,12 @@
 		   (set-buffer (generate-new-buffer "Untitled")))
 	       (setq w3-current-form-number 0
 		     w3-display-open-element-stack nil
-		     w3-last-fill-pos (point-min)
-		     fill-column (min (- (or w3-strict-width (window-width))
-					 w3-right-margin)
-				      (or w3-maximum-line-length
-					  (window-width))))
+		     w3-last-fill-pos (point-min))
+	       (setcar right-margin-stack
+		       (min (- (or w3-strict-width (window-width))
+			       w3-right-margin)
+			    (or w3-maximum-line-length
+				(window-width))))
 	       (switch-to-buffer (current-buffer))
 	       (buffer-disable-undo (current-buffer))
 	       (mapcar (function (lambda (x) (set (car x) (cdr x)))) info)
@@ -1790,10 +1810,6 @@
 	       (setq w3-current-stylesheet (css-copy-stylesheet
 					    w3-user-stylesheet)
 		     w3-last-fill-pos (point)
-		     fill-column (min (- (or w3-strict-width (window-width))
-					 w3-right-margin)
-				      (or w3-maximum-line-length
-					  (window-width)))
 		     fill-prefix "")
 	       (set (make-local-variable 'inhibit-read-only) t))
 	     (w3-handle-content node)
@@ -1840,6 +1856,9 @@
 		 (rename-buffer (generate-new-buffer-name
 				 (w3-fix-spaces potential-title)))))
 	     (w3-handle-empty-tag))
+	    (base
+	     (setq w3-base-target (cdr-safe (assq 'target args)))
+	     (w3-handle-content node))
 	    (form
 	     (setq w3-current-form-number (1+ w3-current-form-number))
 	     (let* (
@@ -2016,9 +2035,15 @@
       (condition-case nil
 	  (widget-value-set widget glyph)
 	(error nil))))
+  (if (and url-current-object (url-target url-current-object))
+      (progn
+	(push-mark (point) t)
+	(w3-find-specific-link (url-target url-current-object)))
+    (goto-char (point-min)))
   (and (not w3-running-xemacs)
        (not (eq (device-type) 'tty))
        (w3-fixup-eol-faces))
+  (message "Drawing... done")
   ;;(w3-handle-headers)
   )
 
@@ -2067,7 +2092,6 @@
     (w3-finish-drawing)
     (w3-mode)
     (set-buffer-modified-p nil)
-    (goto-char (point-min))
     (if url-keep-history
 	(let ((url (url-view-url t)))
 	  (if (not url-history-list)
@@ -2077,4 +2101,132 @@
 	      (w3-shuffle-history-menu)))))
   )
 
+(defun w3-frames (&optional new-frame)
+  "Set up and fetch W3 frames. With optional prefix, do so in a new frame."
+  (interactive "P")
+  (let* ((old-asynch url-be-asynchronous)
+	 (structure (reverse w3-frameset-structure))
+	 (dims (or (reverse w3-frameset-dimensions)
+		   t)))
+    (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)))
+    ;; compute target window distances
+    (let ((origin-buffer (current-buffer))
+	  (stop nil))
+      (while (not stop)
+	(or w3-target-window-distances
+	    (setq w3-target-window-distances
+		  (w3-compute-target-window-distances)))
+	(other-window 1)
+	(if (eq (current-buffer) origin-buffer)
+	    (setq stop t))))
+    (setq-default url-be-asynchronous old-asynch)))
+
+(defun w3-compute-target-window-distances ()
+  "Compute an alist of target names and window distances"
+  (let ((origin-buffer (current-buffer))
+	(distance 0)
+	(stop nil)
+	(window-distances nil))
+    (while (not stop)
+      (if w3-frame-name
+	  (push (cons (intern (downcase w3-frame-name)) distance)
+		window-distances))
+      (other-window 1)
+      (setq distance (1+ distance))
+      (if (eq (current-buffer) origin-buffer)
+	  (setq stop t)))
+    window-distances))
+
+(defun w3-decode-frameset-dimensions (dims available-dimension)
+  "Returns numbers of lines or columns in Emacs, computed from specified frameset dimensions"
+  (let ((dimensions nil))
+    (if dims
+	(let ((nb-stars 0)
+	      (remaining-available-dimension available-dimension))
+	  (while (string-match "\\(\\*\\|[0-9]+%?\\)" dims)
+	    (let ((match (substring dims (match-beginning 1) (match-end 1))))
+	      (setq dims (substring dims (match-end 1)))
+	      (cond ((string-match "\\*" match)
+		     ;; * : divide rest equally
+		     (push '* dimensions)
+		     (setq nb-stars (1+ nb-stars)))
+		    (t
+		     (cond ((string-match "\\([0-9]+\\)%" match)
+			    ;; percentage of available height
+			    (push (/ (* (car (read-from-string (substring match 0 -1)))
+					available-dimension)
+				     100)
+				  dimensions))
+			   (t
+			    ;; absolute number: pixel height
+			    (push (max (1+ (/ (car (read-from-string match))
+					      (frame-char-height)))
+				       window-min-height)
+				  dimensions)))
+		     (setq remaining-available-dimension
+			   (- remaining-available-dimension (car dimensions)))))))
+	  (if (zerop nb-stars)
+	      ;; push => reverse order
+	      (reverse dimensions)
+	    ;; substitute numbers for *
+	    (let ((star-replacement (/ remaining-available-dimension nb-stars))
+		    (star-dimensions dimensions))
+		(setq dimensions nil)
+		(while star-dimensions
+		  (push (if (eq '* (car star-dimensions))
+			    star-replacement
+			  (car star-dimensions))
+			dimensions)
+		  (pop star-dimensions))
+		;; push + push => in order
+		dimensions))))))
+
+
 (provide 'w3-display)