;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;******************************************************************************
;;;;FILE: pjb-layers.el
;;;;LANGUAGE: emacs lisp
;;;;SYSTEM: emacs
;;;;USER-INTERFACE: emacs
;;;;DESCRIPTION
;;;;
;;;; This module exports a major mode for editing layers of texts.
;;;; The layers are pages (separated by ^L) which can be merged.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;; 2002-01-01 <PJB> Creation.
;;;;
;;;;BUGS
;;;; pjb-layers-merge-strings is too slow. Why?
;;;;
;;;; pjb-layers-mode should display the characters of the layers below
;;;; the current layer in a lighter color, and readonly.
;;;;LEGAL
;;;; LGPL
;;;;
;;;; Copyright Pascal J. Bourguignon 2002 - 2011
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;;;
;;;;******************************************************************************
(provide 'pjb-layers)
(defvar pjb-layers-mode-map nil
"Keymap used in pjb-layers mode.")
(if pjb-layers-mode-map
()
(setq pjb-layers-mode-map (make-keymap))
;; Bind keys.
(define-key pjb-layers-mode-map [(prior)] 'pjb-layers-up)
(define-key pjb-layers-mode-map [(next)] 'pjb-layers-down)
(define-key pjb-layers-mode-map "\C-o" 'pjb-layers-insert-above)
);;if
(defun pjb-layers-mode ()
"Major mode for editing layers."
(interactive)
(setq major-mode 'pjb-layers-mode)
(setq mode-name "Pjb-Layers")
(force-mode-line-update)
(use-local-map pjb-layers-mode-map)
(run-hooks 'array-mode-hook)
(widen)
(goto-char (point-min))
(narrow-to-page)
);;pjb-layers-mode
(defmacro ilayer-index (ilayer)
"PRIVATE"
`(aref ,ilayer 0)
);;ilayer-index
(defmacro ilayer-length (ilayer)
"PRIVATE"
`(aref ,ilayer 1)
);;ilayer-length
(defmacro ilayer-chars (ilayer)
"PRIVATE"
`(aref ,ilayer 2)
);;ilayer-chars
(defmacro ilayer-set-index (ilayer index)
"PRIVATE"
`(aset ,ilayer 0 ,index)
);;ilayer-set-index
(defmacro ilayer-set-length (ilayer index)
"PRIVATE"
`(aset ,ilayer 1 ,index)
);;ilayer-set-length
(defmacro ilayer-current-char (ilayer)
"PRIVATE"
`(let ( (il ,ilayer) )
(aref (aref il 2) (aref il 0)))
);;ilayer-current-char
(defmacro ilayer-at-eoln (ilayer)
"PRIVATE"
`(= (ilayer-current-char ,ilayer) 10)
);;ilayer-at-eoln
(defmacro ilayer-at-eof (ilayer)
"PRIVATE"
`(let ( (il ,ilayer) )
(>= (ilayer-index il) (ilayer-length il)))
);;ilayer-at-eof
(defun ilayer-new (layer)
"PRIVATE"
(let ( (result (make-vector 3 layer)) )
(ilayer-set-index result 0)
(ilayer-set-length result (length layer))
result
));;make-ilayer
(defun ilayer-advance (ilayer)
"PRIVATE"
(ilayer-set-index ilayer (1+ (ilayer-index ilayer)))
nil);;ilayer-advance
(defun ilayer-advance-to-eoln (ilayers)
"PRIVATE"
(let ( (result nil) (ilayer) )
(while ilayers
(setq ilayer (car ilayers)
ilayers (cdr ilayers))
(ilayer-set-index ilayer (1+ (ilayer-index ilayer)))
(or (ilayer-at-eof ilayer)
(ilayer-at-eoln ilayer)
(setq result (cons ilayer result))))
(nreverse result)
));;ilayer-advance-to-eoln
(defun ilayer-advance-to-eof (ilayers)
"PRIVATE"
(let ( (result nil) (ilayer) )
(while ilayers
(setq ilayer (car ilayers)
ilayers (cdr ilayers))
(ilayer-set-index ilayer (1+ (ilayer-index ilayer)))
(or (ilayer-at-eof ilayer)
(setq result (cons ilayer result))))
(nreverse result)
));;ilayer-advance-to-eof
(defun ilayer-append-char (ilayer new-char)
"PRIVATE"
(aset (ilayer-chars ilayer) (ilayer-index ilayer) new-char)
(ilayer-set-index ilayer (1+ (ilayer-index ilayer)))
(when (ilayer-at-eof ilayer)
(let* ( (old-string (ilayer-chars ilayer))
(old-length (ilayer-length ilayer))
(new-length (* 2 old-length))
(new-string (make-string new-length 0))
(i 0) )
(while (< i old-length)
(aset new-string i (aref old-string i))
(setq i (1+ i)))
(aset ilayer 2 new-string)
(ilayer-set-length ilayer new-length)
));;when
ilayer
);;ilayer-append-char
(defun ilayer-to-string (ilayer)
(substring (ilayer-chars ilayer) 0 (ilayer-index ilayer))
);;ilayer-to-string
(defun pjb-layers-merge-strings (layers)
"DO: merge the list of layers.
RETURN: the merged layer.
NOTE: each layer is a string of lines.
the layers are ordered the front-most first.
"
(let* ( (pjb-layers-not-at-eof
(apply 'append (mapcar (lambda (layer)
(if (< 0 (length layer))
(list (ilayer-new layer))
nil)) layers)))
(merge (ilayer-new
(make-string (apply 'max
(mapcar (lambda (ilayer)
(ilayer-length ilayer))
pjb-layers-not-at-eof))
0)))
pjb-layers-not-at-eoln
pjb-layers-with-visible-char
current-char
)
(while pjb-layers-not-at-eof
(setq pjb-layers-not-at-eoln
(apply 'append (mapcar (lambda (ilayer)
(if (ilayer-at-eoln ilayer)
nil
(list ilayer)))
pjb-layers-not-at-eof)))
(while pjb-layers-not-at-eoln
(setq pjb-layers-with-visible-char pjb-layers-not-at-eoln)
(setq current-char
(ilayer-current-char (car pjb-layers-with-visible-char)))
(setq pjb-layers-with-visible-char (cdr pjb-layers-with-visible-char))
(while (and (= current-char 32) pjb-layers-with-visible-char)
(setq current-char
(ilayer-current-char (car pjb-layers-with-visible-char)))
(setq pjb-layers-with-visible-char (cdr pjb-layers-with-visible-char))
);;while
(ilayer-append-char merge current-char)
(setq pjb-layers-not-at-eoln
(ilayer-advance-to-eoln pjb-layers-not-at-eoln))
);;while not all eoln
(ilayer-append-char merge 10)
(setq pjb-layers-not-at-eof( ilayer-advance-to-eof pjb-layers-not-at-eof))
);;while not all eof
(ilayer-to-string merge)
));;pjb-layers-merge-strings
(defun pjb-layers-up ()
"DO: Moves up one layer and narrow to it."
(interactive)
(widen)
(if (search-backward "\f" nil 'at-limit)
(backward-char)
(goto-char (point-min)))
(narrow-to-page)
);;pjb-layers-up
(defun pjb-layers-down ()
"DO: Moves down one layer and narrow to it."
(interactive)
(widen)
(if (search-forward "\f" nil 'at-limit)
nil
(goto-char (point-max)))
(narrow-to-page)
);;pjb-layers-down
(defun pjb-layers-insert-above ()
"DO: Insert a new layer above the current layer, and narrow to it."
(interactive)
(widen)
(unless (search-backward "\f" nil 'at-limit)
(goto-char (point-min)))
(insert "\f\n")
(backward-char)
(narrow-to-page)
);;layer-insert-above
(defun pjb-layers-insert-below ()
"DO: Insert a new layer below the current layer, and narrow to it."
(interactive)
(widen)
(unless (search-forward "\f" nil 'at-limit)
(goto-char (point-max)))
(insert "\n\f")
(backward-char 2)
(narrow-to-page)
);;layer-insert-below
(defun pjb-layers-merge ()
"DO: Merges the layers found in the current buffer into a new buffer."
(interactive)
(let ( (pmin (point-min))
(pmax (point-max))
merged
)
(widen)
(setq merged (pjb-layers-merge-strings (split-string (buffer-string) "\f")))
(narrow-to-region pmin pmax)
(switch-to-buffer (get-buffer-create
(format "*Merged %s*" (buffer-name (current-buffer)))))
(erase-buffer)
(insert merged)
));;pjb-layers-merge
;;;; pjb-layers.el -- 2002-01-01 19:57:18 -- pascal ;;;;