1: ;;; box.el -- Place a box around some text
  2: ;;; Mark Ardis, Wang Institute of Graduate Studies
  3:
  4: (defvar box-top-left-pattern "/*"
  5:   "* Top left corner of box as a string."
  6: ) ; box-top-left-pattern
  7:
  8: (defvar box-top-right-pattern "*\"
  9:   "* Top right corner of box as a string."
 10: ) ; box-top-left-pattern
 11:
 12: (defvar box-bottom-left-pattern "\*"
 13:   "* Bottom left corner of box as a string."
 14: ) ; box-top-left-pattern
 15:
 16: (defvar box-bottom-right-pattern "*/"
 17:   "* Bottom right corner of box as a string."
 18: ) ; box-top-left-pattern
 19:
 20: ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 21:
 22: (defun box-region (arg)
 23:   "Enclose the region between point and mark with a box.  With an
 24:    argument, center the region after boxing.
 25:    The region is 'untabify'ed as a side effect of this command.
 26:    This function may give unexpected results if the beginning and
 27:    end of the region are not at the beginning and end of their
 28:    respective lines."
 29:   (interactive "P")
 30:                                         ; Local Variables
 31:   (let (width)
 32:                                         ; Body
 33:     (save-excursion
 34:       (narrow-to-region (point) (mark))
 35:       (untabify (point-min) (point-max))
 36:                                         ; Find the widest line
 37:       (goto-char (point-min))
 38:       (setq width 0)
 39:       (end-of-line 1)
 40:       (setq width (max width (current-column)))
 41:       (while (not (eobp))
 42:         (end-of-line 2)
 43:         (setq width (max width (current-column)))
 44:       ) ; while (not (eobp))
 45:                                         ; Adjust the width for the
 46:                                         ;   left side of the box
 47:       (setq width (+ width 2))
 48:                                         ; Insert beginning of box
 49:       (goto-char (point-min))
 50:       (open-line 1)
 51:       (insert box-top-left-pattern)
 52:       (box-make-wide-enough width "*")
 53:       (insert box-top-right-pattern)
 54:                                         ; Add vertical bars
 55:       (while (not (eobp))
 56:         (beginning-of-line 2)
 57:         (insert "* ")
 58:         (box-make-wide-enough width " ")
 59:         (insert " *")
 60:       ) ; while (not (eobp))
 61:                                         ; Insert end of box
 62:       (newline)
 63:       (insert box-bottom-left-pattern)
 64:       (box-make-wide-enough width "*")
 65:       (insert box-bottom-right-pattern)
 66:                                         ; Check for prefix argument
 67:       (if arg
 68:         (progn
 69:           (goto-char (point-min))
 70:           (center-line)
 71:           (end-of-line 1)
 72:           (while (not (eobp))
 73:             (next-line 1)
 74:             (center-line)
 75:             (end-of-line 1)
 76:           ) ; while (not (eobp))
 77:         ) ; progn
 78:       ) ; if arg
 79:                                         ; restore initial state
 80:       (widen)
 81:     ) ; save-excursion
 82:   ) ; let
 83: ) ; defun box-region
 84:
 85: ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 86:
 87: (defun box-make-wide-enough (length char)
 88:   "Increase the length of the current line to LENGTH,
 89:    by padding with CHAR at the end."
 90:                                         ; Local Variables
 91:   (let ()
 92:                                         ; Body
 93:     (end-of-line 1)
 94:     (while (< (current-column) length)
 95:       (insert char)
 96:     ) ; while (< (current-column) length)
 97:   ) ; let
 98: ) ; defun box-make-wide-enough
 99:
100: ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
101:
102: (defun unbox (arg)
103:   "Remove the box around the text that includes point.
104:    With an argument, left-justify lines, also.
105:    Lines unboxed have all trailing blankspace removed.
106:    Sets region around unboxed area."
107:   (interactive "P")
108:                                         ; Local Variables
109:   (let (start start-marker stop-marker)
110:                                         ; Body
111:                                         ; Find the beginning
112:     (if (search-backward box-top-left-pattern (point-min) t)
113:       (progn
114:         (setq start (point))
115:         (beginning-of-line 2)
116:         (re-search-forward "\\(\\s \\)*")
117:         (setq start-marker (make-marker))
118:         (set-marker start-marker (+ (point) 2))
119:       ) ; progn
120:     ; else
121:       (progn
122:         (error "Cannot find the box!")
123:       ) ; progn
124:     ) ; if
125:                                         ; Find the end
126:     (if (search-forward box-bottom-right-pattern (point-max) t)
127:       (progn
128:         (end-of-line 0)
129:         (backward-char 2)
130:         (setq stop-marker (make-marker))
131:         (set-marker stop-marker (point))
132:       ) ; progn
133:                                         ; else
134:       (progn
135:         (error "Cannot find the box!")
136:       ) ; progn
137:     ) ; if
138:                                         ; Remove the top line
139:     (goto-char start)
140:     (beginning-of-line)
141:     (kill-line 1)
142:                                         ; Remove the vertical bars
143:     (while (< (point) (marker-position stop-marker))
144:       (if arg
145:         (delete-horizontal-space)
146:       ; else
147:         (re-search-forward "\\(\\s \\)*")
148:       ) ; if arg
149:       (delete-char 2)
150:       (end-of-line 1)
151:       (delete-backward-char 2)
152:                                         ; Trim the end of the line
153:       (delete-horizontal-space)
154:       (beginning-of-line 2)
155:     ) ; while
156:                                         ; Remove the end of the box
157:     (kill-line 1)
158:                                         ; Set the region
159:     (end-of-line 0)
160:     (set-mark (marker-position start-marker))
161:   ) ; let
162: ) ; defun unbox