;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1993 by William M. Perry (wmperry@indiana.edu)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Epoch Enhancements
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'w3)

(defun w3-epoch-frob-resources ()
  "Grab Xresoures, and build the epoch fonts, etc"
  (if (epoch::get-default "w3*default-font")
      (set-style-font w3-default-style (epoch::get-default "w3*default-font")))
  
  (if (epoch::get-default "w3*default-background")
      (set-style-background w3-default-style
			    (epoch::get-default "w3*default-background")))
  
  (if (epoch::get-default "w3*default-foreground")
      (set-style-foreground w3-default-style
			    (epoch::get-default "w3*default-foreground")))
  
  (if (epoch::get-default "w3*tt-font")
      (set-style-font w3-tt-style (epoch::get-default "w3*tt-font"))
    (set-style-font w3-tt-style "6x13"))
  
  (if (epoch::get-default "w3*tt-background")
      (set-style-background w3-tt-style
			    (epoch::get-default "w3*tt-background")))
  
  (if (epoch::get-default "w3*tt-foreground")
      (set-style-foreground w3-tt-style
			    (epoch::get-default "w3*tt-foreground")))
  
  (if (epoch::get-default "w3*bold-font")
      (set-style-font w3-bold-style (epoch::get-default "w3*bold-font")))
  
  (if (epoch::get-default "w3*bold-background")
      (set-style-background w3-bold-style
			    (epoch::get-default "w3*bold-background")))
  
  (if (epoch::get-default "w3*bold-foreground")
      (set-style-foreground w3-bold-style
			    (epoch::get-default "w3*bold-foreground"))
    (set-style-foreground w3-bold-style "red"))
  
  (if (epoch::get-default "w3*italic-font")
      (set-style-font w3-italic-style
		      (epoch::get-default "w3*italic-font")))
  
  (if (epoch::get-default "w3*italic-background")
      (set-style-background w3-italic-style
			    (epoch::get-default "w3*italic-background")))
  
  (if (epoch::get-default "w3*italic-foreground")
      (set-style-foreground w3-italic-style
			    (epoch::get-default "w3*italic-foreground"))
    (set-style-foreground w3-italic-style "green"))
  
  (if (epoch::get-default "w3*underline-font")
      (set-style-font w3-underline-style
		      (epoch::get-default "w3*underline-font")))
  
  (if (epoch::get-default "w3*underline-background")
      (set-style-background w3-underline-style
			    (epoch::get-default "w3*underline-background")))
  
  (if (epoch::get-default "w3*underline-foreground")
      (set-style-background w3-underline-style
			    (epoch::get-default "w3*underline-foreground")))
  
  (if (equal (epoch::get-default "w3*underline-p") "True")
      (set-style-underline w3-underline-style
			   (epoch::style-foreground w3-underline-style)))
  
  (if (epoch::get-default "w3*header-font")
      (set-style-font w3-header-style (epoch::get-default "w3*header-font")))
  
  (if (epoch::get-default "w3*header-background")
      (set-style-background w3-header-style
			    (epoch::get-default "w3*header-background")))
  
  (if (epoch::get-default "w3*header-foreground")
      (set-style-foreground w3-header-style
			    (epoch::get-default "w3*header-foreground")))
  
  (if (not (equal (epoch::get-default "w3*header-underline-p") "False"))
      (set-style-underline w3-header-style
			   (epoch::style-foreground w3-header-style)))
  
  (if (epoch::get-default "w3*node-font")
      (set-style-font w3-node-style (epoch::get-default "w3*node-font")))
  
  (if (epoch::get-default "w3*node-background")
      (set-style-background w3-node-style
			    (epoch::get-default "w3*node-background"))
    (set-style-background w3-node-style "grey80"))
  
  (if (epoch::get-default "w3*node-foreground")
      (set-style-foreground w3-node-style
			    (epoch::get-default "w3*node-foreground"))
    (set-style-foreground w3-node-style "black")))

(defvar w3-tt-style (make-style) "Face used for fixed-width text")
(defvar w3-bold-style (make-style) "Face used for bold text")
(defvar w3-italic-style (make-style) "Face used for italicized text")
(defvar w3-underline-style (make-style) "Face used for underlined text")
(defvar w3-node-style (make-style) "Face used for hypertext links")
(defvar w3-header-style (make-style) "Face used for all headers")
(defvar w3-address-style w3-italic-style "Face used for address tags")
(defvar w3-default-style (make-style) "Face used for all text")

(defvar w3-mouse-map (create-mouse-map))

(w3-epoch-frob-resources)

(defun w3-find-specific-link (link)
  "Find LINK in the current document"
  (let* ((thezones (epoch::zones-in-region (point-min) (point-max))))
    (while (and thezones
		(not (equal link
			    (car-safe
			     (cdr (epoch::zone-data (car thezones)))))))
      (setq thezones (cdr thezones)))
    (if thezones
	(goto-char (zone-start (car thezones)))
      (message "Link %s was not found." link))))

(defun w3-zone-start (zone)
  (epoch::zone-start zone))

(defun w3-zone-end (zone)
  (epoch::zone-end zone))

(defun w3-forward-link ()
  "Go forward 1 link"
  (interactive)
  (let* ((thezones (epoch::zones-in-region 
		    (if (epoch::zone-at (point))
			(1+ (epoch::zone-end (epoch::zone-at (point))))
		      (point)) (point-max))))
    (while (and thezones
		(not (and
		      (equal (car (epoch::zone-data (car thezones))) 'w3)
		      (not (memq (cdr (epoch::zone-data
				       (car thezones)))
				 '(style address header))))))
      (setq thezones (cdr thezones)))
    (if (car thezones)
	(goto-char (epoch::zone-start (car thezones))))))

(defun w3-back-link ()
  "Go back 1 link"
  (interactive)
  (let* ((thezones (epoch::zones-in-region
		    (point-min)
		    (if (epoch::zone-at (point))
			(1- (epoch::zone-start (epoch::zone-at (point))))
		      (point)))))
    (while (and thezones
		(and
		 (equal (car-safe (epoch::zone-data (car (last thezones))))
			'w3)
		 (memq (cdr-safe (epoch::zone-data (car (last thezones))))
		       '(style address header))))
      (setq thezones (butlast thezones 1)))
    (if (car thezones)
	(goto-char (epoch::zone-start (car (last thezones)))))))

(defun w3-follow-mouse (mouse-data)
  "Follow the link under the mouse cursor"
  (interactive)
  (mouse::set-point mouse-data)
  (w3-follow-link))

(defun w3-follow-link ()
  "Attempt to follow link under cursor"
  (interactive)
  (if (epoch::zone-at (point))
      (let ((data (epoch::zone-data (epoch::zone-at (point)))))
	(if (and (equal (car-safe data) 'w3)
		 (not (memq (car (cdr data))
			    '(address header style))))
	    (w3-maybe-relative (car (cdr (cdr data))))
	  (message "Not on a link!")))))

(defun w3-add-zone (start end style data)
  "Add highlighting (epoch)"
  (let ((zone (add-zone start end style)))
    (epoch::set-zone-data zone data)))

(define-mouse w3-mouse-map mouse-middle mouse-down 'w3-follow-mouse)

(defun w3-view-this-url (&optional no-show)
  "View the URL of the link (if any) under point"
  (interactive)
  (if (epoch::zone-at (point))
      (let ((data (epoch::zone-data (epoch::zone-at (point)))))
	(if (and (equal (car data) 'w3)
		 (not (memq (cdr data) '(address style header))))
	    (if (not no-show)
		(message "%s" (car (cdr (cdr data))))
	      (car (cdr (cdr data))))
	  (error "Not on a link!")))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Graphics routines for Epoch
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-insert-filter (proc string)
  (if (string-match w3-telnet-ready-regexp string)
      (let ((buff (current-buffer)))
	(set-process-buffer proc (get-buffer-create " *PIC*"))
	(set-process-filter proc nil)
	(sit-for 1)
	(process-send-string proc (concat "GET " (process-name proc) "\n"))
	(set-buffer " *PIC*")
	(while (not (memq (process-status proc)
			  '(stop exit signal closed nil)))
	  (accept-process-output proc))
	(goto-char (point-min))
	(kill-line 1)
	(w3-replace-regexp "Connection.*" "")
	(w3-graphics-continue (process-name proc)))))

(defun w3-graphics-continue (name)
  (let* ((converter (assoc (w3-file-extension name)
			   w3-graphic-converter-alist))
	 bit)
    (if (not w3-use-telnet)
	(progn
	  (goto-char (point-min))
	  (w3-replace-regexp (format "Process %s exited.*\\\n" name) "")))
    (if (not converter)
	(progn
	  (message "%s is an unsupported graphic type!" name)
	  nil)
      (progn
	(message "Converting image %s..." name)
	(shell-command-on-region (point-min) (point-max) (cdr converter) t)
	(goto-char (point-min))
	(kill-line 1)
	(message "Reading image %s..." name)
	(write-region (point-min) (point-max) "/tmp/w3-tmp" nil 5)
	(setq bit (epoch::read-pixmap-file "/tmp/w3-tmp"))
	(delete-file "/tmp/w3-tmp")
	(setq w3-graphics-list (cons (cons name bit) w3-graphics-list))
	(if bit
	    (w3-finish-graphics bit)
	  (message "Conversion of %s failed, probably because of colormap."
		   name))))))

(defun w3-finish-graphics (bit)
  (set-buffer " *W3*")
  (add-graphic-zone bit (point) (1+ (point)) 0 '(w3 . pic) (current-buffer))
  (redisplay-screen)
  (message "Done..."))

(defun w3-get-graphic (name)
  (if (assoc name w3-graphics-list)
      (if (cdr (assoc name w3-graphics-list))
	  (w3-finish-graphics (cdr (assoc name w3-graphics-list)))
	(message "%s was undefined!" name))
    (progn
      (if (not (equal (string-to-char name) 47))
	  (setq name (concat (w3-basepath w3-current-file) "/" name)))
      (cond
       ((not w3-current-type)
	(progn
	  (set-buffer (get-buffer-create " *PIC*"))
	  (erase-buffer)
	  (insert-file-contents name)
	  (w3-graphics-continue name)))
       (t
	(let* ((proc (w3-open-stream name (get-buffer-create " *PIC*")
				     w3-current-server
				     (string-to-int w3-current-port))))
	  (set-buffer (get-buffer-create " *PIC*"))
	  (erase-buffer)
	  (process-send-string proc (format "GET %s\n" name))
	  (while (not (memq (process-status proc)
			    '(stop exit signal closed nil)))
	    (accept-process-output proc))
	  (w3-graphics-continue name)))))))

(defun w3-insert-graphic (name pt)
  (goto-char pt)
  (w3-get-graphic (w3-remove-relative-links name))
  (set-buffer " *W3*"))

(defvar w3-emphasis-style w3-italic-style)
(defvar w3-strong-style w3-bold-style)
(defvar w3-code-style w3-tt-style)
(defvar w3-samp-style w3-tt-style)
(defvar w3-kbd-style w3-tt-style)
(defvar w3-var-style w3-tt-style)
(defvar w3-dfn-style w3-bold-style)
(defvar w3-cite-style w3-underline-style)

(provide 'w3-epoch)
