;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001
;;        David J. Biesack

;; This file is not part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;; box.el
;; Emacs Lisp code for drawing a box in a buffer

;; Author: David Biesack (David.Biesack@sas.com  or biesack@mindspring.com)
;; Last Modified By: biesack@mindspring.com
;; Last Modified: Thu Mar 15 17:42:04 2001

(require 'picture)

(defvar box-ul-char ?.
  "*Character which picture-box-region uses to draw for upper left corner of boxes.")
(defvar box-ur-char ?.
  "*Character which picture-box-region uses to draw for upper right corner of boxes.")
(defvar box-ll-char ?`
  "*Character which picture-box-region uses to draw for lower left corner of boxes.")
(defvar box-lr-char ?'
  "*Character which picture-box-region uses to draw for lower right corner of boxes.")
(defvar box-top-char ?-
  "*Character which picture-box-region uses to draw for the top edge of boxes.")
(defvar box-bottom-char ?_
  "*Character which picture-box-region uses to draw for the bottom edge of boxes.")
(defvar box-right-char ?|
  "*Character which picture-box-region uses to draw for the right edge of boxes.")
(defvar box-left-char ?|
  "*Character which picture-box-region uses to draw for the left edge of boxes.")

(defun picture-box-region (start end)
  ;; compute start' and end' such that:
  ;;	start' is the upper-left corner of the region and
  ;;	end' is the lower-right corner
  ;; then compute the box width and height based on start' and end'
  ;; and invoke picture-box with that width and height
  (interactive "r")
  (save-excursion
    (if (< end start)
        (box-region end start))
    (let (col-start
          col-end
          width
          height)
      (goto-char start)
      (setq col-start (current-column))
      (goto-char end)
      (setq col-end (current-column))
      (setq width (- col-end col-start -1))
      (cond ((memq width '(-1 0 1))
             (error "region has no width")
             )
            ((< width 0)
             (goto-char start)
             (picture-backward-column (- col-start col-end))
             (setq start (point))
             (goto-char end)
             (picture-forward-column (- col-start col-end))
             (setq end (point))
             (box-region start end))
            ((zerop (setq height (picture-box-height start end width)))
             (error "region has no height"))
            (t
             (goto-char start)
             (picture-box width height))))))

(fset 'box-region 'picture-box-region)

(defun picture-box-height (start end width)
  (save-excursion
    (goto-char start)
    (let ((height 0))
      (while (search-forward "\n" end t)
        (setq height (1+ height)))
      ; (message (format "Height is %d" (1+ height))) (sit-for 2)
      (1+ height))))

(defun picture-draw-char (char)
  (move-to-column-force (1+ (current-column)))
  (backward-char 1)
  (insert-char char 1)
  (or (eolp) (delete-char 1))
  (backward-char 1))

(defun box-corners (&optional ul ur ll lr)
  (interactive)
  (setq box-ul-char (or ul (picture-corner-char "Upper Left"  box-ul-char)))
  (setq box-ur-char (or ur (picture-corner-char "Upper Right" box-ur-char)))
  (setq box-lr-char (or lr (picture-corner-char "Lower Right" box-lr-char)))
  (setq box-ll-char (or ll (picture-corner-char "Lower Left"  box-ll-char)))
  )

(defun picture-corner-char (label default)
  (message "Enter the new %s [%c]" label default)
  (let ((new-char (read-char)))
    (if (= ?\r new-char) default new-char)))

(defun box-edges (&optional top right bottom left)
  (interactive)
  (setq box-top-char    (or top    (picture-corner-char "Top Edges"   box-top-char)))
  (setq box-right-char  (or right  (picture-corner-char "Right Egde"  box-right-char)))
  (setq box-bottom-char (or bottom (picture-corner-char "Bottom Edge" box-bottom-char)))
  (setq box-left-char   (or left   (picture-corner-char "Left Edge"   box-left-char)))
  )

(defun picture-erase-box-region(start end)
  (interactive "r")
  (let ((box-ul-char ? )
        (box-ur-char ? )
        (box-ll-char ? )
        (box-lr-char ? )
        (box-top-char ? )
        (box-right-char ? )
        (box-bottom-char ? )
        (box-left-char ? ))
    (picture-box-region start end)))

(fset 'erase-box-region 'picture-erase-box-region)

(defun picture-box (width height)
  (interactive "nBox width: \nnBox height: ")
  (or (> width 1) (error "Box width %d not greater than one." width))
  (or (> height 1) (error "Box height %d not greater than one." height))

  (save-excursion
    (picture-draw-char box-ul-char)
    (picture-forward-column 1)
    (picture-horizontal-line (- width 2) box-top-char)
    (picture-draw-char box-ur-char)
    (picture-move-down 1)
    (picture-vertical-line (- height 1) box-right-char)
    )
  (save-excursion
    (picture-move-down 1)
    (picture-vertical-line (- height 1) box-left-char)
    (and (>= height 2) (picture-move-up 1))
    (picture-draw-char box-ll-char)
    (picture-forward-column 1)
    (picture-horizontal-line (- width 2) box-bottom-char)
    (picture-draw-char box-lr-char)
    ))

(defun picture-vertical-line (length &optional char)
  (setq char (or char box-right-char))
  (let (picture-vertical-step
        picture-horizontal-step)
    (picture-movement-down)
    (while (> length 0)
      (setq length (1- length))
      (picture-draw-char char)
      (picture-move))))

(defun picture-horizontal-line (length &optional char)
  (let (picture-vertical-step
        picture-horizontal-step)
    (setq char (or char ?-))
    (picture-movement-right)
    (while (> length 0)
      (setq length (1- length))
      (picture-draw-char char)
      (picture-move))))

(defun box-mode ()
  (define-key picture-mode-map "\C-cx" 'picture-box-region)
  (define-key picture-mode-map "\C-ce" 'picture-erase-box-region)
  (run-hooks 'box-mode-hooks))


(box-mode)

(provide 'box)