;; ibp.el:  Common functions for emacs IBP banding data extensions
;;----------------------------------------------------------------
;; Do not edit this file. It is extracted automatically from the
;; documentation, here:
;;   http://www.nmt.edu/~shipman/z/ibp/doc/iband7/emacs/
;;----------------------------------------------------------------
;; - - -   i b p - t a b   - - -

(defun ibp-tab (count)
  "Tab function for IBP data entry; supports repeat count."
  (interactive "p")      ;; Argument is the repeat count, default 1
  (while (> count 0)
    (ibp-tab-once)
    (setq count (1- count))))
(defun ibp-tab-once ()
  "Tab function for IBP data entry.

    [ if (line containing point does not have a tail)
      or (point is beyond the end of the tail) ->
        signal an error and terminate
      else if both point and the end of the line are within the
      same field ->
        buffer  :=  buffer with filler appended from the element of
                    ibp-field-list corresponding to that field, so as
                    to bring the end of line to the end of that field
        point   :=  point advanced past that field
      else ->
        point  :=  point advanced past the field containing point ]"
  (let (line       ;; ibp-line-object for the line containing point
        field)     ;; ibp-field-object for field containing end of line
    ;; [ line  :=  ibp-line-object for the line containing point ]
    (setq line (ibp-analyze-line))
    ;; [ if line has a tail -> I
    ;;   else -> error/exit ]
    (if (not (ibp-line-has-tail-p line))
        (error "Tab is valid only on transaction lines with a tail."))
    ;; [ if line has a tail ->
    ;;      if point is in the head of line ->
    ;;        field  :=  an ibp-field-object representing the head, with
    ;;                   nil filler
    ;;     if point is in a tail field ->
    ;;       field  :=  an ibp-field-object representing that field and
    ;;                  its filler from ibp-field-list
    ;;     if point is beyond the tail fields ->
    ;;       error/exit ]
    (setq field (ibp-bracket-field line (point)))
    (if (null field)
        (error "You are beyond the fields we know."))
    (ibp-field-fill field line)))
;; - - -   i b p - a n a l y z e - l i n e   - - -

(defun ibp-analyze-line ()
  "Finds the type and cardinal points of the line containing point.

    [ return the ibp-line-object for the line containing point ]
  "
  (let (line-kind         ;; Line type code
        line-beg          ;; Line beginning position
        line-end          ;; Line end position
        tail-beg)         ;; Line tail beginning position, if any
    ;; [ line-beg  :=  starting position of the line containing point
    ;;   line-end  :=  end position of the line containing point ]
    (save-excursion           ;; Saves point while executing this block:
      (beginning-of-line)     ;; Move to start of line containing point
      (setq line-beg (point))
      (end-of-line)
      (setq line-end (point)))
    ;; [ line-kind  :=  a symbol for the type of the line
    ;;       containing point ]
    (setq line-kind (ibp-classify-line line-beg line-end))
    ;; [ if line-kind is 'non-trans ->
    ;;     tail-beg  :=  nil
    ;;   else ->
    ;;     tail-beg  :=  line-beg + (head length for lines of
    ;;                   type line-kind) ]
    (setq tail-beg
          (if (eq line-kind 'non-trans)
              nil
            (+ line-beg (ibp-line-head-length line-kind))))
    ;; [ return an ibp-line-object with .kind=line-kind, .beg=line-beg,
    ;;   .end=line-end, and .tail=tail-beg ]
    (ibp-line-object line-kind line-beg line-end tail-beg)))
;; - - -   i b p - c l a s s i f y - l i n e   - - -

(defun ibp-classify-line (beg end)
  "Examines the given line and returns a symbol describing its type.

Return values:
    'non-trans          Not a transaction record (empty, @, or #)
    'lost-destroyed     Lost or destroyed band transaction
    'short-head         Transaction with 3-character head: u or n
    'short-recap        Recap with no prefix, 9-character head
    'long-head          Transaction with 10-character head: r or g
----------------------------------------------------------------"
  (let ((line-text (buffer-substring beg end)))
    (if (string= line-text "")
        'non-trans
      (let ((prefix (string-to-char (substring line-text 0 1))))
        (cond
         ((= prefix ?n) 'short-head)       ;; New band (short form)
         ((= prefix ?u) 'short-head)       ;; Unbanded
         ((= prefix ? ) 'short-recap)     ;; Short recaps start w/space
         ((and (<= ?0 prefix)                 ;; ...or a digit
               (<= prefix ?9)) 'short-recap)
         ((= prefix ??)                       ;; ...or a question mark
          'short-recap)
         ((= prefix ?r) 'long-head)           ;; Recap with 'r' prefix
         ((= prefix ?c) 'long-head)           ;; Recap, changed band
         ((= prefix ?a) 'long-head)           ;; Recap, double-banded
         ((= prefix ?g) 'long-head)           ;; New band (long form)
         ((= prefix ?l) 'lost-destroyed)      ;; Lost band
         ((= prefix ?d) 'lost-destroyed)      ;; Destroyed band
         (t 'non-trans))))))
;; - - -   i b p - l i n e - h e a d - l e n g t h   - - -

(defun ibp-line-head-length (kind)
  "Determines the length of the head part of a line of a given type.

    [ if (line is a ibp-line-object) ->
        return the head length in characters for line's type ]
  "
  (cond ((eq kind 'lost-destroyed) 3)
        ((eq kind 'short-head) 3)
        ((eq kind 'short-recap) 9)
        ((eq kind 'long-head) 10)
        (t nil)))        ;; Not defined except for transaction lines
;; - - -   i b p - b r a c k e t - f i e l d   - - -

(defun ibp-bracket-field (line p)
  "Find the field containing a position p within an ibp-line-object

    [ if (line is a ibp-line-object for a line with a tail)
      and (p is a position within line) ->
        if p is in the head part of line ->
          return an ibp-field-object representing the head part, with
          nil filler
        else if p is in a tail field of line ->
          return an ibp-field-object representing that field
        else ->
          return nil ]
----------------------------------------------------------------"
  (if (< p (ibp-line-tail line))
      (ibp-field-object (ibp-line-beg line) (ibp-line-tail line) nil)
    (ibp-bracket-tail-field line)))
;; - - -   i b p - b r a c k e t - t a i l - f i e l d   - - -

(defun ibp-bracket-tail-field (line)
  "Finds the tail field containing point, if any.

    [ if (line is a ibp-line-object for the line containing point)
      and (line is a type that has a tail) ->
        if point is within a tail field ->
          return an ibp-field-object describing that field
        else ->
          return nil ]
----------------------------------------------------------------"
  (let (flag                 ;; Changing this value exits the while loop
        fieldx               ;; Indexes ibp-field-list
        n-fields             ;; Index of last element of ibp-field-list
        field-def            ;; Holds each field-def object in turn
        f-beg                ;; Walks the start columns of each field
        f-end                ;; End of the current field
        f-len)               ;; Length of the current field
    ;; [ flag      :=  'scanning
    ;;   fieldx    :=  0
    ;;   n-fields  :=  index of last element of ibp-field-list
    ;;   f-beg     :=  location of tail of line ]
    (setq flag 'scanning)
    (setq fieldx 0)
    (setq n-fields (length ibp-field-list))
    (setq f-beg (ibp-line-tail line))
    ;; [ if point is within a field whose length is given in
    ;;   elements fieldx through (n-fields - 1) of ibp-field-list ->
    ;;     flag   :=  'found
    ;;     f-beg  :=  position of the start of that field
    ;;     f-end  :=  position of the end of that field
    ;;   else ->
    ;;     flag   :=  'not-found
    ;;     f-beg  :=  anything
    ;;     f-end  :=  anything ]
    (while (eq flag 'scanning)
      ;; [ if fieldx >= n-fields ->
      ;;     flag  :=  'not-found
      ;;   else if point is within a field starting at f-beg and having
      ;;   length field-lengths[fieldx] ->
      ;;     flag  :=  'found
      ;;   else ->
      ;;     f-beg   :=  f-beg + ibp-field-list[fieldx].len
      ;;     fieldx  :=  fieldx + 1 ]
      (if (>= fieldx n-fields)
          (setq flag 'not-found)
        (progn         ;; The field exists, is point in it?
          (setq field-def (elt ibp-field-list fieldx))
          (setq f-len (ibp-field-def-len field-def)) ;; Get the length...
          (setq f-end (+ f-beg f-len))        ;; ...and end of next field
          (if (and (>= (point) f-beg)   ;; Is f-beg<=point<f-end?
                  (< (point) f-end))
              (setq flag 'found)         ;; Yes, found it
            (progn                       ;; No, keep looking
              (setq f-beg f-end)
              (setq fieldx (1+ fieldx)))))))
    ;; [ if flag is 'not-found ->
    ;;     return nil
    ;;   else ->
    ;;     return an ibp-field-object whose .beg=f-beg, .end=f-end,
    ;;     and .filler=ibp-field-list[fieldx].filler ]
    (if (eq flag 'not-found)
        nil
      (ibp-field-object f-beg f-end
                    (ibp-field-def-filler (elt ibp-field-list fieldx))))))
;; - - -   i b p - f i e l d - f i l l   - - -

(defun ibp-field-fill (field line)
  "If field is not full, fill it.  In any case, move to end of field.

    [ if (line is a ibp-line-object with a tail) ->
        if line.end is inside field ->
          buffer  :=  buffer with ibp-field-fill (field, line.end,
                      field.filler) appended after line.end
          point   :=  field.end
        else ->
          point  :=  field.end ]
----------------------------------------------------------------"
  (let (fill-size         ;; Size of fill string to be inserted
        fill-string       ;; Fill string to be inserted
        field-off         ;; Offset within the field to insertion point
        field-size)       ;; Size of the field
    (if (>= (ibp-line-end line) (field-end field)) 
        (goto-char (field-end field))
      (progn
        ;; [ field-size  :=  size of field
        ;;   field-off   :=  line.end - field.beg
        ;;   fill-size   :=  field.end - line.end ]
        (setq field-size (- (field-end field) (field-beg field)))
        (setq field-off  (- (ibp-line-end line) (field-beg field)))
        (setq fill-size  (- (field-end field) (ibp-line-end line)))
        ;; [ if field.filler is nil ->
        ;;     fill-string  :=  a string of fill-size blanks
        ;;   else ->
        ;;     fill-string  :=  field.filler[field.off:field-size] ]
        (setq fill-string
              (if (null (ibp-field-filler field))
                  (make-string fill-size ? )
                (substring (ibp-field-filler field) field-off field-size)))
        ;; [ buffer  :=  buffer with fill-string appended at line.end
        ;;   point   :=  field.end ]
        (goto-char (ibp-line-end line))
        (insert fill-string)))))
;; - - -   i b p - d i t t o   - - -

(defun ibp-ditto (count)
  "Field duplication function for IBP data entry; supports repeat count."
  (interactive "p")
  (while (> count 0)
    (ibp-ditto-once)
    (setq count (1- count))))
;; - - -   i b p - d i t t o - o n c e   - - -

(defun ibp-ditto-once ()
  "Duplicate a field from the corresponding field of the previous tail.

    [ if there are no previous lines with tails ->
        error/exit
      else if point is not at end of line, or beyond all tail fields ->
        error/exit
      else ->
        buffer  :=  buffer with text appended after point
                      copied from the corresponding tail position of
                      the last previous line with a tail
        point   :=  point advanced to the end of the field containing
                      point ]
----------------------------------------------------------------"
  (let (line            ;; ibp-line-object for the line containing point
        prev            ;; ibp-line-object for last prev. line with a tail
        field           ;; ibp-field-object for the field containing point
        dup-beg         ;; Start position of string to be duplicated
        dup-end         ;; End position of string to be duplicated
        dup-len         ;; Length of string to be duplicated
        dup-string      ;; String to be duplicated
        tail-off)       ;; Offset relative to tail of point
    ;; [ line  :=  a ibp-line-object representing the line
    ;;             containing point ]
    (setq line (ibp-analyze-line))
    ;; [ if (line.kind is 'non-trans)
    ;;   or (point is not at end of line) ->
    ;;     error/exit
    ;;  else -> I ]
    (if (or (eq (ibp-line-kind line) 'non-trans)
            (/= (point) (ibp-line-end line)))
        (error "Duplication is valid only at the end of a line."))
    ;; [ if there is at least one line with a tail preceding the line
    ;;   containing point ->
    ;;     prev  :=  an ibp-line-object representing that line
    ;;   else -> error/exit ]
    (setq prev (ibp-find-prev-trans))
    (if (null prev)
        (error "No previous line to duplicate."))
    ;; [ if point is in the head part of line ->
    ;;     field  :=  an ibp-field-object representing the head,
    ;;                with nil filler
    ;;   if point is in a tail field ->
    ;;     field  :=  an ibp-field-object representing that field
    ;;   if point is beyond all tail fields ->
    ;;     error/exit ]
    (setq field (ibp-bracket-field line (point)))
    (if (null field)
        (error "You are beyond the fields we know."))
    ;; [ if prev does not have characters corresponding to [line.end:
    ;;   field.end] ->
    ;;     error/exit
    ;;   else ->
    ;;     dup-string  :=  characters from prev whose position relative to
    ;;                     prev's tail correspond to characters [line.end:
    ;;                     field.end] ]
    (setq tail-off
          (- (ibp-line-end line) (ibp-line-tail line)))
    (setq dup-beg    (+ (ibp-line-tail prev) tail-off))
    (setq dup-len    (- (field-end field) (ibp-line-end line)))
    (setq dup-end    (+ dup-beg dup-len))
    (if (> dup-end (ibp-line-end prev))
        (error "Previous line is too short to duplicate."))
    (setq dup-string (buffer-substring dup-beg dup-end))
    ;; [ buffer  :=  buffer with dup-string inserted before point ]
    (insert dup-string)))
;; - - -   i b p - f i n d - p r e v - t r a n s   - - -

(defun ibp-find-prev-trans ()
  "Search backward from the current line to find the last line with a tail.

    [ if there is at least one line with a tail preceding the line
      containing point ->
        prev  :=  an ibp-line-object representing that line
      else -> return nil ]"
  (let (line        ;; ibp-line-object for each line we search
        flag)       ;; Set to 'found or 'not-found to terminate the loop
    (save-excursion           ;; Save point while executing this block
      ;; [ flag   :=  'scanning
      ;;   point  :=  beginning of line containing point ]
      (setq flag 'scanning)
      (beginning-of-line)
      ;; [ if there is a line before point that has a tail ->
      ;;     flag   :=  'found
      ;;     point  :=  the beginning of the last such line
      ;;     line   :=  an ibp-line-object representing that line
      ;;   else ->
      ;;     flag   :=  'not-found
      ;;     point  :=  anything
      ;;     line   :=  anything ]
      (while (eq flag 'scanning)
        ;; [ if point is at the start of the buffer ->
        ;;     flag  :=  'not-found
        ;;   else if the line before point has no tail ->
        ;;     point  :=  beginning of line before line containing point
        ;;   else ->
        ;;     flag  :=  'found
        ;;     line  :=  an ibp-line-object representing the line before
        ;;               the line containing point ]
        (if (= (point) (point-min))        ;; Beginning of buffer?
            (setq flag 'not-found)         ;; Yes, fail
          (progn
            (beginning-of-line 0)          ;; Move to previous line
            (setq line (ibp-analyze-line)) ;; Make ibp-line-object
            (if (ibp-line-has-tail-p line)     ;; Does it have a tail?
                (setq flag 'found))))))    ;; Yes, succeed
    ;; [ if flag is 'not-found ->
    ;;     return nil
    ;;   else ->
    ;;     return line ]
    (if (eq flag 'not-found)
        nil
      line)))

;; - - - - -   c l a s s   f i e l d - d e f - o b j e c t   - - - - -

(defun ibp-field-def (len filler)
  "Constructor for a ibp-field-def, representing one field definition

    [ if (len is the length of a field as a positive integer)
      and (filler is the default content of the field, or nil if
      its default content is blank) ->
        return a ibp-field-def representing those values ]
  "
  (vector len filler))
(defun ibp-field-def-len    (field-def) (elt field-def 0))
(defun ibp-field-def-filler (field-def) (elt field-def 1))
;; - - - - -   c l a s s   i b p - l i n e - o b j e c t

(defun ibp-line-object (kind beg end tail)
  "Constructor for a line object, representing the parts of a line.

    [ if (kind is a line type symbol as returned by ibp-classify-line)
      and (beg is the position of the start of the line)
      and (end is the position of the end of the line)
      and (tail is the position of the start of the tail part,
      or nil if this is not a tail-type line) ->
        return a ibp-line-object representing those values ]
  "
  (vector kind beg end tail))
(defun ibp-line-kind (ibp-line-object) (elt ibp-line-object 0))
(defun ibp-line-beg  (ibp-line-object) (elt ibp-line-object 1))
(defun ibp-line-end  (ibp-line-object) (elt ibp-line-object 2))
(defun ibp-line-tail (ibp-line-object) (elt ibp-line-object 3))
(defun ibp-line-has-tail-p (ibp-line-object)
  "Predicate: is this line one of the types that has a tail?
  "
  (if (or (eq (ibp-line-kind ibp-line-object) 'non-trans)
          (eq (ibp-line-kind ibp-line-object) 'lost-destroyed))
      nil
    t))
;; - - - - -   c l a s s   i b p - f i e l d - o b j e c t

(defun ibp-field-object (beg end filler)
  "Constructor for a field object, representing the location of a field.

    [ if (beg is the position of the start of a field)
      and (end is the position of the end of a field, which may be
      beyond the end of its line)
      and (filler is the default contents of the field, or nil if
      the default is blank) ->
        return an ibp-field-object representing those values ]
  "
  (vector beg end filler))
(defun field-beg    (ibp-field-object) (elt ibp-field-object 0))
(defun field-end    (ibp-field-object) (elt ibp-field-object 1))
(defun ibp-field-filler (ibp-field-object) (elt ibp-field-object 2))