;; Visible-mark-mode.el   by Hiroyuki Komatsu <komatsu@taiyaki.org>

(defvar visible-mark-mode nil "Non-nil means display eof and enter marks.")
(make-variable-buffer-local 'visible-mark-mode)
(if (not (assq 'visible-mark-mode minor-mode-alist))
    (setq minor-mode-alist
	  (cons '(visible-mark-mode " Mark") minor-mode-alist)))

(defvar visible-mark--extents nil "Internal use only.")
(make-variable-buffer-local 'visible-mark--extents)

(defvar visible-mark--last-window-start nil "Internal use only.")
(make-variable-buffer-local 'visible-mark--last-window-start)
(defvar visible-mark--last-window-end nil "Internal use only.")
(make-variable-buffer-local 'visible-mark--last-window-end)

(defvar visible-mark-enter-face (make-face 'visible-mark-enter-face)
  "Face used for Enter mark.")
(defvar visible-mark-enter-string "<" "String for Enter mark")
(set-face-foreground visible-mark-enter-face "yellow")
(defvar visible-mark-eof-face (make-face 'visible-mark-eof-face)
  "Face used for EOF mark.")
(defvar visible-mark-eof-string "[EOF]" "String for EOF mark")
(set-face-foreground visible-mark-eof-face "SkyBlue")

(defvar visible-mark--enter-glyph nil "Internal use only.")
(defvar visible-mark--eof-glyph nil "Internal use only.")

(defun visible-mark-mode (&optional arg)
"Toggle Visible Mark mode.
With arg, turn Visible Mark mode on iff arg is positive.
When Visible Mark mode is enabled, the mark of EOL and
marks of enter are visible."
  (interactive "P")
  (setq visible-mark-mode (if (null arg)
			      (not visible-mark-mode)
			    (> (prefix-numeric-value arg) 0)))
  (run-hooks 'visible-mark-hook)
  (if visible-mark-mode
      (progn
	(visible-mark-init (* (window-width) 2))
	(setq visible-mark--last-window-start nil
	      visible-mark--last-window-end nil))
    (visible-mark-hide)))
  
(defun visible-mark-init (arg)
  "Initialling values for visible-mark-init.
Lists of glyphs for enter and eof will be initialled."
  (setq visible-mark--enter-glyph nil)
  (setq visible-mark--eof-glyph nil)
  (while (>= (setq arg (1- arg)) 0)
    (let ((enter-glyph (make-glyph (concat (make-string arg ? )
					   visible-mark-enter-string)))
	  (eof-glyph (make-glyph (concat (make-string arg ? )
					 visible-mark-eof-string))))
      (set-glyph-face enter-glyph visible-mark-enter-face)
      (set-glyph-face eof-glyph   visible-mark-eof-face)
      (setq visible-mark--enter-glyph 
	    (cons enter-glyph visible-mark--enter-glyph))
      (setq visible-mark--eof-glyph 
	    (cons eof-glyph visible-mark--eof-glyph)))))

(defun visible-mark-hide ()
  "Hide marks in current-buffer shown by 'visible-mark-show'."
  (let (extent)
    (while (setq extent (pop visible-mark--extents))
      (and (extent-live-p extent)
	   (delete-extent extent))))
  (setq visible-mark--extents nil)
)

(defun visible-mark-show ()
  "Show marks in current-buffer.
This function is called by 'visible-mark-post-command-cb'"
  (let ((ws (min (window-start) (point)))
	(we (max (window-end) (point)))
	(ec (* (frame-height) 5))
	(count (frame-height)))
    (if (or (not (eq visible-mark--last-window-start ws))
	    (not (eq visible-mark--last-window-end   we)))
	(save-excursion
	  (visible-mark-hide)
	  (goto-char ws)
	  (while (> count 0)
	    (if (< (setq ec (1- ec)) 0) (error "Error: visible-mark-show"))
	    (end-of-line)
	    (let ((extent (make-extent (point) (point)))
		  (eol (current-column))
		  last last-lim line mark)
	      (vertical-motion 0)
	      (setq last-lim (point))
	      (end-of-line)
	      (skip-chars-backward " \t" last-lim)
	      (setq last (current-column))
	      
	      (if (= (vertical-motion 1) 1)
		  (setq mark (nth (- eol last) visible-mark--enter-glyph))
		(setq mark (nth (- eol last) visible-mark--eof-glyph))
		(setq count 1))

	      (set-extent-property extent 'end-glyph mark)
	      (set-extent-end-glyph-layout extent 'whitespace)
	      (push extent visible-mark--extents)
	      (setq count (1- count))))))
    
    (setq visible-mark--last-window-start ws
	  visible-mark--last-window-end   we)))

(defun visible-mark-post-command-cb ()
"Callback attached to 'post-command-hook' to make 'visible-mark-mode' working."
  (and visible-mark-mode
       (visible-mark-show)))

(add-hook 'post-command-hook 'visible-mark-post-command-cb)

(provide 'visible-mark-mode)

; $Id: visible-mark-mode.el,v 1.1 2003/03/19 12:59:45 komatsu Exp $