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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Enhancements For Emacs 19
;;; Based on enhancements for Lucid Emacs, by jsc@athena
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(require 'w3)
(require 'cl) ; for `last'

(if (eq window-system 'x)    ;; Only load this up in x, otherwise emacs will
    (progn                   ;; barf
      (require 'menubar "lmenu")
      (require 'lucid)))

(defvar w3-links-menu nil "Menu for w3-mode in emacs 19")
(make-variable-buffer-local 'w3-links-menu)

(defvar w3-popup-menu '("WWW Browser"
			["Open Local File" w3-open-local t]
			["Open URL" w3-fetch t]
			["View Current Url" w3-view-url t]
			["View Url At Point" w3-view-this-url t]
			"------------------"
			["Document Source" w3-document-source t]
			["Edit Document Source" w3-find-this-file t]
			["Reload Document" w3-reload-document t]
			["Mail Formatted" w3-mail-current-document t]
			["Print Document" w3-print-this-url t]
			["Print Url Under Point" w3-print-url-under-point t]
			["Submit Bug Report" w3-submit-bug t]
			"------------------"
			["Add Group Annotation" w3-add-group-annotation t]
			["Delete Group Annotation" w3-delete-group-annotation t]
			["Edit Group Annotation" w3-edit-group-annotation nil]
			["Add Personal Annotation" w3-add-personal-annotation t]
			["Delete Personal Annotation" w3-delete-personal-annotation t]
			["Edit Personal Annotation" w3-edit-personal-annotation nil])
  "Popup menu for emacs 19")


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

(defvar w3-menu nil "*Emacs menu for current buffer")

(defvar w3-emacs19-font "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-*"
  "*Font to use for emacs19")

(make-variable-buffer-local 'w3-menu)

(if (eq window-system 'x)
    (progn
      (if (not (find-face w3-header-style))
	  (progn
	    (make-face w3-default-style)
	    (make-face w3-header-style)
	    (make-face w3-bold-style)
	    (make-face w3-italic-style)
	    (make-face w3-underline-style)
	    (make-face w3-node-style)
	    (make-face w3-address-style)
	    (make-face w3-tt-style)))
      (if (not (face-differs-from-default-p w3-header-style))
	  (copy-face 'bold-italic w3-header-style))
      (if (not (face-differs-from-default-p w3-node-style))
	  (copy-face 'bold w3-node-style))
      (if (not (face-differs-from-default-p w3-address-style))
	  (copy-face 'italic w3-address-style))
      (if (not (face-differs-from-default-p w3-bold-style))
	  (copy-face 'bold w3-bold-style))
      (if (not (face-differs-from-default-p w3-italic-style))
	  (copy-face 'italic w3-italic-style))
      (if (not (face-differs-from-default-p w3-tt-style))
	  (copy-face 'default w3-tt-style))
      (if (not (face-differs-from-default-p w3-underline-style))
	  (copy-face 'underline w3-underline-style))))

(defalias 'w3-zone-start 'overlay-start)
(defalias 'w3-zone-end 'overlay-end)

(defun w3-emacs19-sort-fun (e1 e2)
  (< (overlay-start e1) (overlay-start e2)))

(defun w3-only-links ()
  (let* ((tmp (overlay-lists))
	 (big (append (car tmp) (cdr tmp)))
	 (fin '())
	 (dat nil))
    (while big
      (setq dat (overlay-get (car big) 'data))
      (if (not (memq (cdr-safe dat) '(w3form header style address)))
	  (setq fin (append fin (list (car big)))))
      (setq big (cdr big)))
    (sort fin 'w3-emacs19-sort-fun)))

(defun w3-add-hotlist-menu ()
  (if (eq major-mode 'w3-mode)
      (let ((hot-menu nil)
	    (hot w3-hotlist))
	(while hot
	  (setq hot-menu 
		(cons (vector (car (car hot))
			      (list 'w3-fetch (car (cdr (car hot))))
			      t) hot-menu)
		hot (cdr hot)))
	(add-menu '("WWW") "Hotlist       >" hot-menu))))

(defun w3-find-specific-link (link)
  "Find LINK in the current document"
  (let* ((all-overlays (overlay-lists))
	 (ovls (append (car all-overlays) (cdr all-overlays))))
    (while ovls
      (if (equal link (car-safe (cdr (overlay-get (car ovls) 'data))))
	  (goto-char (overlay-start (car ovls))))
      (setq ovls (cdr ovls)))))	

(defun w3-forward-link ()
  "Go forward 1 link"
  (interactive)
  (let ((zones w3-zones-list))
    (while (and zones
		(<= (overlay-start (car zones)) (point)))
      (setq zones (cdr zones)))
    (if zones
	(goto-char (overlay-start (car zones)))
      (error "No more links."))))

(defun w3-back-link ()
  "Go back 1 link"
  (interactive)
  (cond
   ((null w3-zones-list) (error "No links in this document."))
   ((>= (overlay-start (car w3-zones-list)) (point))
    (error "No previous link"))
   (t
    (let ((zones w3-zones-list))
      (while (and (cdr zones)
		  (< (overlay-start (car (cdr zones))) (point)))
	(setq zones (cdr zones)))
      (goto-char (overlay-start (car zones)))))))

(defun w3-add-zone (start end style data)
  "Add highlighting (emacs19)"
  (let ((ext (make-overlay start end)))
    (overlay-put ext 'face style)
    (overlay-put ext 'data data)))

(defun w3-follow-mouse (e)
  (interactive "e")
  (mouse-set-point e)
  (w3-follow-link))

(defun w3-follow-link ()
  "Attempt to follow the link under the cursor"
  (interactive)
  (let ((results '())
	(zones w3-zones-list)
	(x (point))
	(y nil)
	(z nil))
    (while zones
      (if (and
	   (<= (overlay-start (car zones)) x)
	   (>= (overlay-end (car zones)) x))
	  (setq results (cons
			 (list (car (cdr (cdr 
					  (overlay-get (car zones) 'data))))
			       nil) results)))
      (setq zones (cdr zones)))
    (if (> (length results) 1)
	(setq y (completing-read "More than one link at point, choose:"
				 results nil t))
      (setq y (car (car results))))
    (w3-maybe-relative y)))

(defun w3-view-this-url (&optional no-show)
  "View the URL of the link under point"
  (interactive)
  (let ((results '())
	(zones w3-zones-list)
	(x (point))
	(y nil)
	(z nil))
    (while zones
      (if (and
	   (<= (overlay-start (car zones)) x)
	   (>= (overlay-end (car zones)) x))
	  (setq results (cons
			 (list (car (cdr (cdr 
					  (overlay-get (car zones) 'data))))
			       nil) results)))
      (setq zones (cdr zones)))
    (if (> (length results) 1)
	(progn
	  (set-buffer (get-buffer-create "*Links*"))
	  (erase-buffer)
	  (while results
	    (insert (format "%s\n" (car results)))
	    (setq results (cdr results)))
	  (if w3-mutable-windows
	      (pop-to-buffer "*Links*")
	    (switch-to-buffer "*Links*")))
      (if (not no-show)
	  (message "%s" (car (car results)))
	(car (car results))))))

(define-key w3-mode-map [mouse-2] 'w3-follow-mouse)
(define-key w3-mode-map [mouse-3] 'w3-popup-menu)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to build menus of urls
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun w3-build-FSF19-menu ()
  "Build lemacs menus from w3-links-list"
  (let* ((hot w3-hotlist)
	 (hot-menu nil)
	 (overlays (overlay-lists))
	 (ovls (append (car overlays) (cdr overlays))))
    (while ovls
      (let ((data (overlay-get (car ovls) 'data)))
	(if (and (eq (car-safe data) 'w3)
		 (not (memq (cdr-safe data) '(header address style))))
	    (setq w3-links-menu 
		  (append w3-links-menu
			  (list
			   (vector (format "%s[%s]"
					   (car (cdr (cdr (cdr data))))
					   (car (cdr data)))
				   (list 'w3-maybe-relative
					 (car (cdr (cdr data)))) t))))))
      (setq ovls (cdr ovls)))
    (setq w3-links-menu (cons "Links         >" w3-links-menu))
    (while hot
      (setq hot-menu
	    (cons (vector (car (car hot))
			  (list 'w3-maybe-relative (car (cdr (car hot))))
			  t) hot-menu))
      (setq hot (cdr hot)))
    (setq hot-menu (cons "Hotlist       >" hot-menu))
    (set-buffer-menubar (copy-sequence current-menubar))
    (add-menu nil "WWW" (append
			 (cdr w3-popup-menu)
			 (list "------------------" hot-menu w3-links-menu)))))

(defun w3-popup-menu (e)
  "Pop up a menu of common w3 commands"
  (interactive "e")
  (mouse-set-point e)
  (popup-menu w3-popup-menu))

(defun w3-submit-form (actn)
  "Submit all forms to url ACTN"
  (let* ((tmp (overlay-lists))
	 (big (append (car tmp) (cdr tmp)))
	 (result '())
	 (dat nil))))

(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-emacs19)
