;;!emacs
;; $Id: 
;;
;; FILE:         hui-epV4-b.el
;; SUMMARY:      Support color and flashing of hyper-buttons under Epoch V4
;; USAGE:        Epoch Lisp Library
;;
;; AUTHOR:       Bob Weiner
;; ORG:          Brown U.
;;
;; ORIG-DATE:    27-Apr-91 at 05:37:10
;; LAST-MOD:     11-Nov-92 at 18:56:47 by Bob Weiner
;;
;; This file is part of Hyperbole.
;; It is for use with Epoch, a modified version of GNU Emacs.
;;
;; Copyright (C) 1991, Brown University, Providence, RI
;; Developed with support from Motorola Inc.
;; 
;; Permission to use, modify and redistribute this software and its
;; documentation for any purpose other than its incorporation into a
;; commercial product is hereby granted without fee.  A distribution fee
;; may be charged with any redistribution.  Any distribution requires
;; that the above copyright notice appear in all copies, that both that
;; copyright notice and this permission notice appear in supporting
;; documentation, and that neither the name of Brown University nor the
;; author's name be used in advertising or publicity pertaining to
;; distribution of the software without specific, written prior permission.
;; 
;; Brown University makes no representations about the suitability of this
;; software for any purpose.  It is provided "as is" without express or
;; implied warranty.
;;
;;
;; DESCRIPTION:  
;;
;;   Requires Epoch 4.0a or greater.
;;
;;   This is truly prototype code.
;;
;; DESCRIP-END.

(if (or (not (boundp 'epoch::version))
	(string< epoch::version "Epoch 4"))
    (error "(hui-epV4-b.el): Load only under Epoch V4 or higher."))

(load "button")
(require 'hui-ep-but)

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

(defvar ep:item-highlight-color (foreground)
  "Color with which to highlight list/menu selections.
Call (ep:set-item-highlight <color>) to change value.")

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(defun ep:but-create (&optional start-delim end-delim regexp-match)
  "Mark all hyper-buttons in buffer as Epoch buttons, for later highlighting.
Will use optional strings START-DELIM and END-DELIM instead of default values.
If END-DELIM is a symbol, e.g. t, then START-DELIM is taken as a regular
expression which matches an entire button string.
If REGEXP-MATCH is non-nil, only buttons matching this argument are
highlighted."
  ;; Clear out Hyperbole button zones.
  (ep:but-clear)
  ;; Then recreate them.
  (ep:but-create-all start-delim end-delim regexp-match))

(defun ep:but-clear ()
  "Delete all Hyperbole button zones from current buffer."
  (interactive)
  (mapcar (function (lambda (zone)
		      (if (eq (epoch::zone-style zone) ep:but)
			  (epoch::delete-zone zone))))
	  (epoch::zone-list)))

(defun ep:cycle-but-color (&optional color)
  "Switches button color to optional COLOR name or next item referenced by ep:color-ptr."
  (interactive "sHyperbole button color: ")
  (if (<= (epoch::number-of-colors) 2)
      nil
    (if color (setq ep:color-ptr nil))
    (epoch::set-style-foreground
     ep:but (or color (car (ep:list-cycle ep:color-ptr ep:good-colors))))
    (ep:set-flash-color)
    (redraw-display)
    t))

(defun ep:but-flash ()
  "Flash a Hyperbole button at point to indicate selection, when using Epoch."
  (interactive)
  (let ((ibut) (prev)
	(start (hattr:get 'hbut:current 'lbl-start))
	(end   (hattr:get 'hbut:current 'lbl-end)))
    (and start end (setq prev (epoch::button-at start)
			 ibut t)
	 (if (not prev) (ep:but-add start end ep:but)))
    (let* ((b (and start (epoch::button-at start)))
	   (a (and (epoch::buttonp b) (epoch::button-style b))))
      (if a
	  (progn
	    (epoch::set-button-style b ep:flash-style)
	    (epoch::redisplay-screen)
	    ;; Delay before redraw button
	    (let ((i 0)) (while (< i ep:but-flash-time) (setq i (1+ i))))
	    (epoch::set-button-style b a)
	    (epoch::redisplay-screen)
	    )))
    (if (and ibut (not prev)) (ep:but-delete start))
    ))

(defun ep:set-item-highlight (&optional color-name)
  "Setup or reset item highlight style using optional color-name."
  (make-local-variable 'ep:item-style)
  (if (stringp color-name) (setq ep:item-highlight-color color-name))
  (if (not ep:style_highlight)
      (progn 
	(setq ep:style_highlight (make-style))
	(set-style-foreground ep:style_highlight (background))
	(set-style-background ep:style_highlight ep:item-highlight-color)
	(set-style-underline ep:style_highlight nil)))
  (if (not (equal (style-background ep:style_highlight)
		  (epoch::get-color ep:item-highlight-color)))
      (set-style-background ep:style_highlight ep:item-highlight-color))
  (setq ep:item-style ep:style_highlight)
  )

(defun ep:select-item (&optional pnt)
  "Select item in current buffer at optional position PNT using ep:item-style."
  (or ep:item-button
      (setq ep:item-button (add-button (point) (point) ep:item-style)))
  (if pnt (goto-char pnt))
  (skip-chars-forward " \t")
  (skip-chars-backward "^ \t\n")
  (let ((start (point)))
    (save-excursion
      (skip-chars-forward "^ \t\n")
      (move-button ep:item-button start (point))
      ))
  (epoch::redisplay-screen)
  )

(defun ep:select-line (&optional pnt)
  "Select line in current buffer at optional position PNT using ep:item-style."
  (or ep:item-button
      (setq ep:item-button (add-button (point) (point) ep:item-style)))
  (if pnt (goto-char pnt))
  (save-excursion
    (beginning-of-line)
    (move-button ep:item-button (point) (progn (end-of-line) (point)))
    )
  (epoch::redisplay-screen)
  )

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defun ep:set-flash-color ()
  "Set button flashing colors based upon current color set."
  (if (<= (epoch::number-of-colors) 2)
      nil
    (epoch::set-style-background ep:flash-style (ep:but-color))
    (epoch::set-style-foreground ep:flash-style (epoch::background))
    ))

;;; ************************************************************************
;;; Private variables
;;; ************************************************************************

(defvar ep:but (epoch::make-style) "Style for hyper-buttons.")
(epoch::set-style-foreground ep:but (ep:but-color))
(epoch::set-style-background ep:but (epoch::background))

(defvar ep:flash-style (epoch::make-style) "Style for flashing hyper-buttons.")
(ep:set-flash-color)

(make-variable-buffer-local 'ep:item-button)
(defvar ep:item-style nil "Style for item marking.")
(defvar ep:style_highlight nil "Highlight style available for item marking.")

(provide 'hui-epV4-b)