;; *************************************************************
;; IF YOU ONLY HAVE THIS FILE YOU ARE MISSING MAJOR PARTS OF THE
;; DISTRIBUTION, AND IT WON'T WORK!  
;; *************************************************************

;; Please pick up the latest public release at:
;; http://www.chungkuo.org/elisp/elip.zip

(require 'calendar)
(require 'database)

(setq elip-version-number 
   "ELIP Version 0.612 (beta) built 2004-05-24")

;;;;;;;;;;;;; code starting here can be removed if you are using
;;;;;;;;;;;;; my patched version of EDB routine db-time.el
;;;;;;;;;;;;; however use of patched routine now seems essential anyhow
;;;; can we check for the patch somehow? ;;;;

(defconst format-date-sub-syms-alist
  '(("day"     . ((date-day date) .   (date->weekday-abbrev date)))
    ("dd"      . ((date-day date) .   (format "%02d" (date-day date))))
    ("d"       . ((date-day date) .   (format "%d" (date-day date))))
    ("month"   . ((date-month date) . (integer->monthname (date-month date))))
    ("mon"     . ((date-month date) . 
		                    (integer->monthabbrev (date-month date))))
    ("mm"      . ((date-month date) . (format "%02d" (date-month date))))
    ("m"       . ((date-month date) . (format "%d" (date-month date))))
    ("year"    . ((date-year date) .  (format "%d" (date-year-long date))))
    ("yy"      . ((date-year date) .  (format "%02d" (date-year-short date))))
    ("jday"    . ((and (date-day date)
		       (date-month date)
		       (date-year date)) . (date->day-of-year date)))
    ("wday"    . ((and (date-day date)
		       (date-month date)
		       (date-year date)) . (date->weekday-index date)))
    ("weekday" . ((and (date-day date)
		       (date-month date)
		       (date-year date)) . (date->weekday-name date)))
    )
  "An alist of (NAME . (TEST . SEXP)) used by `format-date'.  Each NAME
is a string, which, when prefixed by \"%\", will be substituted by the
value resulting from evalling the associated SEXP but only if TEST evals
to non-null.")

(defsubst date-year-short (date)
"Extract the year and return it with the right two digits.
    Makes no sense for years in early 1900s or late 2000s."
  (% (date-year date) 100))
;;;;;;;;;;;;;; end of removable code

;; The presence of this and the subsequent few lines means this code
;; can't be loaded outside of an ELIP data buffer.  This isn't so bad 
;; except that in development byte-compile-and-load doesn't work.

;; changes for incremental reading: 
;; bookmark, article value are aux5 and aux6
;; can't change the db variable names or it voids earlier databases

(database-set-fieldnames-to-list database '( elip-question elip-answer 
          (elip-nextask . date) (elip-cycle . integer) 
          (elip-lscore . integer) (elip-trials . integer)
          (elip-tscore . integer )
	  (elip-ttime . integer ) 
	  (elip-lmissed . integer ) 
	  (elip-lhole . integer )
	  (elip-lnew . integer )
	  (elip-lright . integer )
	  (elip-percent . integer )
	  (elip-aux5 . integer )
	  (elip-aux6 . integer )
	  (elip-aux7 . integer )
	  (elip-aux8 . integer )
	  (elip-aux9 . integer )
) )

(setq elip-db database)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;            
;; TO-DO:
;; moved to elip.todo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Here we deal with the worst buffer local variable problems.  This
;; issue is complicated since ELIP itself doesn't always stay in the 
;; same buffer.

(setq elip-data-buffer (buffer-name))
(make-local-variable 'elip-local-data-buffer)
(setq elip-local-data-buffer elip-data-buffer)
(make-local-variable 'elip-local-db)
(setq elip-local-db elip-db)
(make-local-variable 'elip-local-data-path)
;; this only works by accident, since the dba file reloads
;; elip.elc every time, and allows setting up a new
;; data path
(setq elip-local-data-path elip-data-path)
(setq elip-file-name (substring (buffer-name) 0 
			(string-match "<" (buffer-name))))
(make-local-variable 'elip-local-file-name)
(setq elip-local-file-name elip-file-name)

;; local variables for question and report buffers
(make-local-variable 'elip-local-workload-buffer)
(setq elip-local-workload-buffer
   (concat "*" (buffer-name) ".workload*"))
(make-local-variable 'elip-local-ask-buffer)
(setq elip-local-ask-buffer
   (concat "*" (buffer-name) ".ask*"))
(make-local-variable 'elip-local-report-buffer)
(setq elip-local-report-buffer
   (concat "*" (buffer-name) ".report*"))
(make-local-variable 'elip-local-item-buffer)
(setq elip-local-item-buffer
   (concat "*" (buffer-name) ".item*"))
(make-local-variable 'elip-local-table-buffer)
(setq elip-local-table-buffer
   (concat "*" (buffer-name) ".table*"))
(make-local-variable 'elip-local-dump-buffer)
(setq elip-local-dump-buffer
   (concat "*" (buffer-name) ".dump*"))

;; This is not the title of the particular database.  This is a marker
;; to tell us we are in an ELIP database.
(if (not (database-local-p 'elip-marker elip-db))
  (progn
    (database-set-modified-p elip-db t)
    (database-make-local 'elip-marker elip-db)))
(database-set-local 'elip-marker elip-db "Emacs Learning Interval Program")
(if (not (database-local-p 'elip-learn-random elip-db))
  (progn
    (database-set-modified-p elip-db t)
    (database-make-local 'elip-learn-random elip-db)
;; Set to nil to learn items in entry sequence rather than randomized
    (database-set-local 'elip-learn-random elip-db t)))

;; Maximum number of new/old items to learn at once.  Don't make overly large.
;; If there are more than that many items, learn them in groups (which can be
;; done in the same sitting).  We now store these with the database.  This is 
;; done in a kind of dynamic manner so we don't invalidate databases from
;; previous program versions.

(setq elip-max-new 20)
;; This is usually 5 but some methods use a higher number.
(setq elip-leitner-last-box 5)
;; Score for acceptable answer.  Probably should not change.
(setq elip-ok-score 4)
;; Trial values
(setq elip-text-percent-min 20)
(setq elip-text-percent-max 90)
;; Hardwired
(setq elip-text-decrement 10)

(if (not (database-local-p 'elip-save-max-new elip-db))
  (progn
    (database-make-local 'elip-save-max-new elip-db)
    (database-set-local 'elip-save-max-new elip-db elip-max-new)
    (database-set-modified-p elip-db t)
       ) ;; else
    (setq elip-max-new (database-get-local 'elip-save-max-new elip-db)))
(if (not (database-local-p 'elip-save-ok-score elip-db))
   (progn
    (database-make-local 'elip-save-ok-score elip-db)
    (database-set-local 'elip-save-ok-score elip-db elip-ok-score)
    (database-set-modified-p elip-db t)
      )  ;; else
    (setq elip-ok-score (database-get-local 'elip-save-ok-score elip-db)))
(if (not (database-local-p 'elip-save-leitner-last-box elip-db))
   (progn
    (database-make-local 'elip-save-leitner-last-box elip-db)
    (database-set-local 'elip-save-leitner-last-box elip-db 
			elip-leitner-last-box)
    (database-set-modified-p elip-db t)
      )  ;; else
    (setq elip-leitner-last-box 
	  (database-get-local 'elip-save-leitner-last-box elip-db)))
(if (not (database-local-p 'elip-save-text-percent-max elip-db))
   (progn
    (database-make-local 'elip-save-text-percent-max elip-db)
    (database-set-local 'elip-save-text-percent-max elip-db 
			elip-text-percent-max)
    (database-set-modified-p elip-db t)
      )  ;; else
    (setq elip-text-max-percent
	  (database-get-local 'elip-save-text-percent-max elip-db)))
(if (not (database-local-p 'elip-save-text-percent-min elip-db))
   (progn
    (database-make-local 'elip-save-text-percent-min elip-db)
    (database-set-local 'elip-save-text-percent-min elip-db 
			elip-text-percent-min)
    (database-set-modified-p elip-db t)
      )  ;; else
    (setq elip-text-min-percent 
	  (database-get-local 'elip-save-text-percent-min elip-db)))

(setq db-new-record-function 'elip-init-values)
(setq db-after-read-hooks 'elip-after-read)

;; these must be buffer local
(make-local-variable 'elip-fmt1-string)
(make-local-variable 'elip-fmt2-string)
; find front of path without .dat.  hard because stuff like <2> can be at end
; do in pieces to keep comprehensible
(setq elip-temp
     (substring elip-local-data-buffer
			0 (string-match "<" elip-local-data-buffer)))
(setq elip-temp
     (substring elip-temp
		        0 (string-match "\.dat" elip-temp)))
(setq elip-temp (concat elip-local-data-path "/" elip-temp))
(setq elip-fmt1-string (concat elip-temp ".fmt"))
(setq elip-fmt2-string (concat elip-temp ".fmt2"))

;; practice mode
(make-local-variable 'elip-flashcard-mode)
(make-local-variable 'elip-flashcard-style)
(setq elip-flashcard-mode nil)

;; Deal with sorting issues
(if (not (fboundp 'db-sort-original))
  (fset 'db-sort-original (symbol-function 'db-sort)))
(fset 'db-sort 'elip-sort)

;; Deal with quit vs exit issue.  A quit just buries buffers, which is
;; not at all what we want.
(if (not (fboundp 'db-quit-original))
  (fset 'db-quit-original (symbol-function 'db-quit)))
(fset 'db-quit 'elip-quit)

(random t)

;; set up current date
(setq elip-current-date (calendar-absolute-from-gregorian 
                             (calendar-current-date)))

(setq elip-auto-learn 0)

;; keys for incremental reading/grabbing
;(define-key global-map [f6] 'elip-snarf-region)
;(define-key global-map [f7] 'elip-snarf-buffer)

;; numerous ways to grab something
;; -grab region from current buffer
;; -grab entire current buffer
;; -paste from clipboard

(defun elip-snarf-region ()
  "grab a region to an incremental reading database"
  (interactive)
  (setq erip-snarfed-text (buffer-substring (region-beginning) (region-end)))
  (elip-erip-new-record)
)

(defun elip-snarf-buffer ()
  "grab a buffer to an incremental reading database"
  (interactive)
  (setq elip-snarfed-text (buffer-substring 1 (buffer-size)))
  (elip-erip-new-record)
)

(defun elip-erip-new-record ()
  "set up and fill a new ERIP record"
  (setq elip-snarf-to-db 
     (read-from-minibuffer "Copy text to what database? "))
  (save-excursion
   (progn
    (if (get-buffer elip-snarf-to-db)
      (switch-to-buffer elip-snarf-to-db)
;;  else
      (if (and (file-exists-p  elip-snarf-to-db)
                  (file-writable-p elip-snarf-to-db))
          (db-find-file elip-snarf-to-db)
;;     else
          (progn
	    (if (yes-or-no-p "That database doesn't exist, create it (yes/no)? ")
              (progn
		(elip-make-database elip-snarf-to-db)
		(db-find-file elip-snarf-to-db)
              )
;;           else
	      (error "No database to save to!"))        
           )))
;; here with a valid db buffer loaded up
    (elip-check-db)
    (db-first-record)
;; init basic values comes on add record hook
    (db-add-record)
;; now add article dependent stuff, including article!

)))


(defun elip-reading ()
"Do some incremental reading"
 (interactive)
)

(defun elip-init-values (record database)
  "Fill in new learning item template."
  (record-set-field record 'elip-nextask
    (parse-date-string  (calendar-date-string 
			 (calendar-current-date))) database)
  (record-set-field record 'elip-cycle 0 database)
  (record-set-field record 'elip-lscore 0 database)
  (record-set-field record 'elip-trials 0 database)
  (record-set-field record 'elip-tscore 0 database)
  (record-set-field record 'elip-ttime 0 database)
  (record-set-field record 'elip-lmissed 0 database)
  (record-set-field record 'elip-lhole 0 database)
  (record-set-field record 'elip-lnew 0 database)
  (record-set-field record 'elip-lright 0 database)
  (record-set-field record 'elip-percent 90 database)
  (record-set-field record 'elip-aux5 0 database)
  (record-set-field record 'elip-aux6 0 database)
  (record-set-field record 'elip-aux7 0 database)
  (record-set-field record 'elip-aux8 0 database)
  (record-set-field record 'elip-aux9 0 database)
  )

(defun elip-text-check-for-finished ()
"See if the database has been completed in Leitner mode"
 (setq elip-text-finished t)
;; negative value means done
  (maprecords-macro
    (progn
     (if (>= (record-field maprecords-record 'elip-percent elip-db)
           0)
      (progn
	 (setq elip-text-finished nil)
	 (maprecords-break)))
     ) elip-db)
;; return val
  (equal t elip-text-finished)
)

(defun elip-learn-text ()
"Learn to memorize passages in context."
(interactive)
 (setq elip-text-loop t)
(while elip-text-loop
  (progn
 (elip-check-db)
 (setq elip-text-loop nil)
 (setq elip-flashcard-mode nil)
 (setq elip-interval-mode nil)
 (setq elip-leitner-mode nil)
 (setq elip-text-mode t)
 (setq elip-new-found 0)
 (if (elip-text-check-for-finished)
      (error "Text mode complete for this database, reset first"))
 (setq elip-learn-item (make-vector elip-max-new nil))
 (maplinks-macro
   (progn
;; looking for used unfinished text cards first:
;; if >0 percentage, since -1 is done and 0 is unused:
     (if (> (record-field (link-record maplinks-link) 'elip-percent
		elip-db) 0)
      (progn
;; usable record
        (aset elip-learn-item elip-new-found maplinks-index)
        (setq elip-new-found (1+ elip-new-found))
           (if (>= elip-new-found elip-max-new)
	       (maplinks-break))
       )))  elip-db)
;; if we don't have elip-max-new used unfinished text cards,
;; we go back and add enough text-new cards to make up the
;; difference, or as many as we have left at least
  (if (< elip-new-found elip-max-new)
      (maplinks-macro
       (progn
	 (if (= 
	      (record-field 
	       (link-record maplinks-link) 'elip-percent elip-db) 0)
	   (progn
;; start at max percent
             (record-set-field (link-record maplinks-link) 
		       'elip-percent elip-text-percent-max elip-db)
             (aset elip-learn-item elip-new-found maplinks-index)
	     (setq elip-new-found (1+ elip-new-found))
	     (if (>= elip-new-found elip-max-new)
		 (maplinks-break))
	    ))
	            ) elip-db))
     (if (and 
	    (> elip-new-found 0)
	    (> elip-max-new elip-new-found))
         (read-from-minibuffer 
            (concat "Learning last " (int-to-string elip-new-found) 
            " text items.  Press ENTER to continue."))
      )
;; now maybe learn the items
 (if (> elip-new-found 0)
       (progn        
         (read-from-minibuffer 
"Begin text learning: press ENTER when ready.")
 	 (elip-learn-list)
;; in text mode we don't rerun errors, so prompt for another run
     (if (yes-or-no-p "Text round complete, do more cards? ")
         (setq elip-text-loop t)
         (setq elip-text-loop nil)) ) ;; else no more
;; we're done!
       (message "No text items left to learn, reset database"))
 )) ;; end outer text loop
)


(defun elip-learn-flashcards ()
"Learn practice flashcard style without time intervals and saved scores."
(interactive)
 (elip-check-db)
 (setq elip-interval-mode nil)
 (setq elip-leitner-mode nil)
 (setq elip-text-mode nil)
 (setq elip-flashcard-mode t)
 (if (= elip-auto-learn 0)
   (setq elip-flashcard-style nil)
   (setq elip-flashcard-style "h"))
 (while (equal nil elip-flashcard-style)
;; choices are new items, old items, all items, hardest items
  (progn
   (setq elip-flashcard-style 
     (read-from-minibuffer 
"Old items (o), new items (n), all items (a), or hardest items (h): "))
   (if (and
	(not (equal "o" elip-flashcard-style))
	(not (equal "n" elip-flashcard-style))
	(not (equal "h" elip-flashcard-style))
	(not (equal "a" elip-flashcard-style)))
       (setq elip-flashcard-style nil))))

   (setq elip-database-size (database-no-of-records elip-db))
   (setq elip-new-found 0)
   (setq elip-learn-item (make-vector elip-max-new nil))
   (setq elip-random-array (make-vector elip-database-size nil))
   (setq elip-random-numbers (make-vector elip-database-size nil))

;; 'h' is way different
  (if (not (equal "h" elip-flashcard-style))
   (progn
;; set up randomization
    (setq elip-i 0)
    (while (< elip-i elip-database-size)
      (progn
;; set numerical order
	(aset elip-random-array elip-i elip-i)
;; set randoms
	(aset elip-random-numbers elip-i (random))
	(setq elip-i (1+ elip-i))))
;; now sort.  similar to code below but not quite the same
    (setq elip-i 0)
    (setq elip-j 0)
    (while (< elip-i elip-database-size)
     (progn
       (setq elip-j (+ 1 elip-i))
       (while (< elip-j elip-database-size)
         (progn
           (if (< (aref elip-random-numbers elip-i) 
                  (aref elip-random-numbers elip-j))
            (progn
              (setq elip-random-temp (aref elip-random-array elip-j))
              (aset elip-random-array elip-j (aref elip-random-array elip-i))
              (aset elip-random-array elip-i elip-random-temp)
              (setq elip-random-temp (aref elip-random-numbers elip-j))
              (aset elip-random-numbers elip-j 
		    (aref elip-random-numbers elip-i))
	      (aset elip-random-numbers elip-i elip-random-temp)))
           (setq elip-j (+ 1 elip-j)))))
        (setq elip-i (+ 1 elip-i)))
;; now we have a global random order in elip-random-array.
;; pick out what we need
   (setq elip-i 0)
   (while (and
	   (< elip-i elip-database-size)
	   (< elip-new-found elip-max-new))
    (progn
      (cond ( (equal "a" elip-flashcard-style)
 	      (aset elip-learn-item elip-new-found
		    (aref elip-random-array elip-i))
	      (setq elip-new-found (1+ elip-new-found)))
;; this has been corrected - if tried in any mode it is old
	    ( (equal "o" elip-flashcard-style)
	      (if 
		   (> (record-field 
		    (link-record 
		     (database-link elip-db 
		       (aref elip-random-array elip-i)))
		        'elip-trials elip-db ) 0)
                   
               (progn
	        (aset elip-learn-item elip-new-found
		      (aref elip-random-array elip-i))
	        (setq elip-new-found (1+ elip-new-found)))))
;; corrected - it is only new if never tried in any mode
	    ( (equal "n" elip-flashcard-style)
	      (if 
		   (= (record-field 
		    (link-record
		     (database-link elip-db 
		       (aref elip-random-array elip-i)))
		        'elip-trials elip-db ) 0)
		   
               (progn
	        (aset elip-learn-item elip-new-found
		      (aref elip-random-array elip-i))
	        (setq elip-new-found (1+ elip-new-found)))))  )
      (setq elip-i (1+ elip-i))
   ))
   ) ;; end of not equal h -- else if h:
    (progn
;; misnomers for the sake of reuse.
;; elip-random-array contains link numbers
;; elip-random-numbers contains number of misses
;; first find all items with at least one miss
   (setq elip-i 0)
   (maplinks-macro 
    (progn
      (setq elip-times-missed 
       (- (record-field (link-record maplinks-link) 'elip-trials elip-db)
	(record-field (link-record maplinks-link) 'elip-lright elip-db) ))
      (if (> elip-times-missed 0)
        (progn
	  (aset elip-random-array elip-new-found maplinks-index)
          (aset elip-random-numbers elip-new-found elip-times-missed)
	  (setq elip-new-found (1+ elip-new-found))))
      ) elip-db )
;; now sort by hardest.  repeat the sort code yet one more time.
;; someday clean up and make a function!
    (setq elip-i 0)
    (setq elip-j 0)
    (while (< elip-i elip-new-found)
     (progn
       (setq elip-j (+ 1 elip-i))
       (while (< elip-j elip-new-found)
         (progn
           (if (< (aref elip-random-numbers elip-i) 
                  (aref elip-random-numbers elip-j))
            (progn
              (setq elip-random-temp (aref elip-random-array elip-j))
              (aset elip-random-array elip-j (aref elip-random-array elip-i))
              (aset elip-random-array elip-i elip-random-temp)
              (setq elip-random-temp (aref elip-random-numbers elip-j))
              (aset elip-random-numbers elip-j 
		    (aref elip-random-numbers elip-i))
	      (aset elip-random-numbers elip-i elip-random-temp)))
           (setq elip-j (+ 1 elip-j)))))
        (setq elip-i (+ 1 elip-i)))
;; still not done.  take the top group and put in elip-learn-item
;; the max is either elip-max-new or 20% database size.
        (if (< elip-max-new (/ elip-database-size 5))
	    (setq elip-hardest-limit elip-max-new)
	    (setq elip-hardest-limit (/ elip-database-size 5)))
        (if (> elip-new-found elip-hardest-limit)
	    (setq elip-new-found elip-hardest-limit))
	(setq elip-i 0)
	(while (< elip-i elip-new-found)
	  (progn
	    (aset elip-learn-item elip-i (aref elip-random-array elip-i))
	    (setq elip-i (1+ elip-i)))) 
   )
  ) ;; done with equal h stuff
 (makunbound 'elip-random-array)
 (makunbound 'elip-random-numbers)
;;;;; finally, ask the questions, wow.
  (if (> elip-new-found 0)
   (progn
     (read-from-minibuffer 
           (concat (int-to-string elip-new-found) 
                   " item flashcard drill, press ENTER when ready."))
      (elip-learn-list))   ;; else
      (read-from-minibuffer "No items meet your flashcard selection criteria; press ENTER."))
)

(defun elip-learn-new () (interactive)
"Learn some new ELIP items"
 (setq elip-learn-more-new 1)
 (while (= elip-learn-more-new 1)
 (progn
 (elip-check-db)
 (setq elip-flashcard-mode nil)
 (setq elip-leitner-mode nil)
 (setq elip-text-mode nil)
 (setq elip-interval-mode t)
 (setq elip-new-found 0)
;; find up to elip-max-new items to learn
 (setq elip-learn-item (make-vector elip-max-new nil))
 (maplinks-macro
    (progn
;; We must distinguish a new non-Leitner item from a new Leitner item.
;; And, they both could be going on at once.  Attempts, time, trials, all
;; won't work because both modes track them.  So we will have to chew up an
;; aux variable for this.  And this will also make sorting messier.
;; A new Leitner item is easy, it just has the Leitner box = 0.
      (if (= (record-field (link-record maplinks-link) 'elip-lnew elip-db) 0)
;; Usable item, save to list
	   (progn
	      (aset elip-learn-item elip-new-found maplinks-index)
              (setq elip-new-found (+ 1 elip-new-found))
            )) ;; progn ;; if
     (if (>= elip-new-found elip-max-new)
       (progn
	 (maplinks-break))))
     elip-db)
;; now maybe learn the items
 (if (> elip-new-found 0)
       (progn        
         (setq elip-learn-new-maybe (read-from-minibuffer 
         (concat "Next " (int-to-string elip-new-found) 
                   " new items, press ENTER to learn or 'q' ENTER to quit. ")))
         (if (or (equal elip-learn-new-maybe "q") (equal elip-learn-new-maybe "Q"))
           (progn
             (setq elip-learn-more-new 0)
;; be sure to clear auto-learn flag
             (setq elip-auto-learn 0)
           )
;; else - go ahead and learn
             (progn
 	        (elip-learn-list)
;; if in auto-learning mode, only do one round
                (if (= elip-auto-learn 1)
                    (setq elip-learn-more-new 0))
                (read-from-minibuffer "End of round, press ENTER"))))
;; else - nothing new under the sun
      (progn
       (setq elip-learn-more-new 0)
       (db-view-mode)
       (if (= elip-auto-learn 0)
;; message only in new mode
         (read-from-minibuffer "No (more) new items to learn, press ENTER.")
	 )
))
))
)

(defun elip-add-to-leitner-1 ()
"Add an unused (leitner-new) card to the first Leitner box"
 (maplinks-macro
   (progn
     (if (= (record-field (link-record maplinks-link) 'elip-lhole elip-db) 0)
      (progn
	(record-set-field (link-record maplinks-link) 'elip-lhole 1 elip-db)
	(maplinks-break)))) elip-db)
)

(defun elip-leitner-check-for-finished ()
"See if the database has been completed in Leitner mode"
 (setq elip-leitner-finished t)
  (maprecords-macro
    (progn
     (if (<= (record-field maprecords-record 'elip-lhole elip-db)
           elip-leitner-last-box)
      (progn
	 (setq elip-leitner-finished nil)
	 (maprecords-break)))
     ) elip-db)
;; return val
  (equal t elip-leitner-finished)
)  

(defun elip-learn-leitner () 
"Learn items Leitner flashcard style"
(interactive)
 (setq elip-leitner-loop t)
(while elip-leitner-loop
  (progn
 (elip-check-db)
 (setq elip-leitner-loop nil)
 (setq elip-flashcard-mode nil)
 (setq elip-interval-mode nil)
 (setq elip-text-mode nil)
 (setq elip-leitner-mode t)
 (setq elip-new-found 0)
 (if (elip-leitner-check-for-finished)
      (error "Leitner mode complete for this database, reset first"))
 (setq elip-learn-item (make-vector elip-max-new nil))
 (maplinks-macro
   (progn
;; looking for used unfinished leitner cards first:
;; if not zero (new) and less than or eq max position (done):
     (if (and
	  (<= (record-field (link-record maplinks-link) 'elip-lhole
		elip-db) elip-leitner-last-box)
	  (not (=
	   (record-field (link-record maplinks-link) 
			 'elip-lhole elip-db) 0)))
      (progn
;; usable record
        (aset elip-learn-item elip-new-found maplinks-index)
        (setq elip-new-found (1+ elip-new-found))
           (if (>= elip-new-found elip-max-new)
	       (maplinks-break))
       )))  elip-db)
;; if we don't have elip-max-new used unfinished Leitner cards,
;; we go back and add enough leitner-new cards to make up the
;; difference, or as many as we have left at least
  (if (< elip-new-found elip-max-new)
      (maplinks-macro
       (progn
	 (if (= 
	      (record-field (link-record maplinks-link) 'elip-lhole elip-db) 0)
	   (progn
             (record-set-field (link-record maplinks-link) 
			       'elip-lhole 1 elip-db)
             (aset elip-learn-item elip-new-found maplinks-index)
	     (setq elip-new-found (1+ elip-new-found))
	     (if (>= elip-new-found elip-max-new)
		 (maplinks-break))
	    ))
	            ) elip-db))
     (if (and 
	    (> elip-new-found 0)
	    (> elip-max-new elip-new-found))
         (read-from-minibuffer 
            (concat "Learning last " (int-to-string elip-new-found) 
            " Leitner items.  Press ENTER to continue."))
      )
;; now maybe learn the items
 (if (> elip-new-found 0)
       (progn        
         (read-from-minibuffer 
"Begin Leitner learning: press ENTER when ready.")
 	 (elip-learn-list)
;; in leitner mode we don't rerun errors, so prompt for another run
     (if (yes-or-no-p "Leitner round complete, do more cards? ")
         (setq elip-leitner-loop t)
         (setq elip-leitner-loop nil))  ) ;; else no more
;; we're done!
       (message "No Leitner items left to learn, reset database"))
 )) ;; end outer leitner loop
)

(defun elip-learn ()
"Do some interval learning"
 (interactive)
;; try to learn old first, which cycles to new
 (setq elip-auto-learn 1)
 (unwind-protect
  (progn
    (elip-learn-old)
;; complicated decision.  go to new items 
;; if we are still in auto learn mode i.e. didn't quit
;; AND we have learned 20 or less old items, offer new items.
    (if (and (= elip-auto-learn 1) (< elip-old-cycles 2))
;; not exactly recursive, but not clean either.  A non-local goto would 
;; be nice, but how to do it?
     (elip-learn-new))
;; offer hardest items if still autolearning i.e. didn't quit somewhere
    (if (= elip-auto-learn 1)
      (progn
       (if (yes-or-no-p "Drill on hardest items? ")
        (elip-learn-flashcards))
      )
   )
  )
;; guaranteed cleanup
    (setq elip-auto-learn 0))
 (read-from-minibuffer "End of auto-learning, press ENTER.")
)

(defun elip-learn-old ()
"Learn some old ELIP items"
 (interactive)
 (setq elip-learn-more-old 1)
 (setq elip-old-cycles 0)
;; cyclic logic - allow learning all oldies if wished
 (while (= elip-learn-more-old 1)
 (progn
 (elip-check-db)
 (setq elip-flashcard-mode nil)
 (setq elip-leitner-mode nil)
 (setq elip-text-mode nil)
 (setq elip-interval-mode t)
 (setq elip-new-found 0)
 (setq elip-learn-item (make-vector elip-max-new nil))
 (maplinks-macro
;;; fish out date convert compare to current date
;;; definitely a midnight overlap problem can exist here in a rare case
;;; --bug fix-- also must not be a delayed new item
   (progn
     (setq elip-due-date 
       (record-field (link-record maplinks-link) 'elip-nextask elip-db))
     (setq elip-due-date
       (list 
         (car (cdr elip-due-date)) 
         (cdr (cdr elip-due-date))  
         (car elip-due-date)))
     (setq elip-due-date (calendar-absolute-from-gregorian elip-due-date))
;; got a due item here but must not be new
     (if (and
	   (<= elip-due-date elip-current-date)
           (not (= (record-field (link-record maplinks-link) 
				 'elip-lnew elip-db) 0)))
       (progn
           (aset elip-learn-item elip-new-found maplinks-index)
           (setq elip-new-found (+ 1 elip-new-found))))
     (if (>= elip-new-found elip-max-new)
       (maplinks-break))
   ) elip-db ) ;; maplinks
 (if (> elip-new-found 0)
   (progn
     (setq elip-learn-old-maybe (read-from-minibuffer 
       (concat "Next " (int-to-string elip-new-found) 
         " review items, press ENTER to learn or 'q' ENTER to quit. ")))
     (if (or (equal elip-learn-old-maybe "q") (equal elip-learn-old-maybe "Q"))
      (progn
       (setq elip-learn-more-old 0)
;; clear the auto learn flag - a quit is a quit is a quit
       (setq elip-auto-learn 0))
;; else - go ahead and learn
       (progn
        (elip-learn-list)
        (setq elip-old-cycles (+ 1 elip-old-cycles))
        (read-from-minibuffer "End of round, press ENTER.")
       ))
   )
;; else no more stuff
     (setq elip-learn-more-old 0)
)))
 (read-from-minibuffer "All review items complete.  Press ENTER")
;; no more old items or decided to quit
    (db-view-mode)
)

(defun elip-learn-list ()
"Learn the list of new or old items previously found."
 (elip-check-db)
;; mark the database modified immediately in case of "break out"
 (if (not elip-flashcard-mode)
  (database-set-modified-p elip-db t))
;; set current pass counter to 0  
 (setq elip-n 0)
 (while (< elip-n elip-new-found)
  (progn
   (record-set-field (link-record (database-link elip-db 
        (aref elip-learn-item elip-n))) 'elip-lmissed 0 elip-db)
   (setq elip-n (1+ elip-n))))
(setq elip-loop-flag t)
;; main loop until all questions correct
(while (equal t elip-loop-flag)
 (progn
 (setq elip-bad-item (make-vector elip-max-new nil))
 (setq elip-bad-count 0)
;; randomize if desired
 (if (equal t (database-get-local 'elip-learn-random dbc-database t))
  (progn
    (setq elip-random-array (make-vector elip-max-new 0))
    (setq elip-i 0)
    (while (< elip-i elip-new-found)
     (progn
       (aset elip-random-array elip-i (random))
       (setq elip-i (1+ elip-i))))
    (setq elip-i 0)
    (setq elip-j 0)
    (while (< elip-i elip-new-found)
     (progn
       (setq elip-j (1+ elip-i))
       (while (< elip-j elip-new-found)
         (progn
           (if (< (aref elip-random-array elip-i) 
                  (aref elip-random-array elip-j))
            (progn
              (setq elip-random-temp (aref elip-random-array elip-j))
              (setq elip-item-temp (aref elip-learn-item elip-j))
              (aset elip-random-array elip-j (aref elip-random-array elip-i))
              (aset elip-learn-item elip-j (aref elip-learn-item elip-i))
              (aset elip-random-array elip-i elip-random-temp)
	      (aset elip-learn-item elip-i elip-item-temp)))
           (setq elip-j (+ 1 elip-j)))))
        (setq elip-i (+ 1 elip-i)))
 ))
;; loop over all remaining questions
 (setq elip-n 0)
 (while (< elip-n elip-new-found)		
   (progn
    (setq elip-next-item (aref elip-learn-item elip-n))
    (setq elip-n (+ 1 elip-n))
    (setq elip-next-link (database-link elip-db elip-next-item))
    (if (not (equal nil elip-next-item))
     (progn
;; ask the question, setting many global variables in that function,
;; which is kind of bad coding
      (elip-ask-question)
;; don't record time until the answer is 'offical' to avoid problems
;; of bad stats when quitting in the middle of a question
;; and don't do any of this in flashcards mode
;; these are the stats that don't depend on right or wrong answer
;; and are set for leitner/non-leitner both
     (if (not elip-flashcard-mode)
;; first do the general stuff
       (progn
          (record-set-field (link-record elip-next-link) 'elip-ttime 
		 (+ elip-time-used (record-field (link-record elip-next-link) 
                   'elip-ttime elip-db)) elip-db)
          (record-set-field (link-record elip-next-link) 
            'elip-lscore elip-qscore elip-db)
	  (record-set-field (link-record elip-next-link) 'elip-trials
             (+ 1 (record-field (link-record elip-next-link) 
              'elip-trials elip-db)) elip-db)
	  (record-set-field (link-record elip-next-link) 'elip-tscore
	     (+ elip-qscore (record-field (link-record elip-next-link) 
               'elip-tscore elip-db)) elip-db)
          (if elip-interval-mode
           (progn
;; interval mode - question flubbed so badly we start over?  
;; set cycle back to 0, it's almost like a new question
	  (if (< elip-qscore (- elip-ok-score 1))
	      (record-set-field (link-record elip-next-link) 
		 'elip-cycle 0 elip-db))
;; if interval mode, kill the new flag whether right or wrong
		(record-set-field (link-record elip-next-link) 'elip-lnew
			1 elip-db)
           ))
;; question correct?
	  (if (>= elip-qscore elip-ok-score)
	      (progn
;; we always bump the elip-lright counter in any mode
		(record-set-field (link-record elip-next-link) 'elip-lright
		  (1+ (record-field (link-record elip-next-link) 'elip-lright
			elip-db)) elip-db)
;; change due date or cycle in interval mode
             (if elip-interval-mode
	       (progn
		(record-set-field (link-record elip-next-link) 
                   'elip-cycle (+ 1 (record-field (link-record elip-next-link)
                   'elip-cycle elip-db)) elip-db)
		(record-set-field (link-record elip-next-link) 
                   'elip-nextask (elip-find-nextask) elip-db) ))
                                  ;; end correct in interval mode
;; in leitner mode only, on correct answer in non-review mode, 
;; increment Leitner box number
   (if elip-leitner-mode
           (progn
	    (record-set-field (link-record elip-next-link) 'elip-lhole
	      (1+ (record-field (link-record elip-next-link) 'elip-lhole
	         elip-db)) elip-db)
;; if the card leaves the last box, do nothing at this point
	    )) ;; end correct in leitner mode
;; in text mode reduce the percentage factor
   (if elip-text-mode
     (progn
       (record-set-field (link-record elip-next-link) 'elip-percent 
	 (max elip-text-percent-min 
	      (- (record-field (link-record elip-next-link) 'elip-percent
			       elip-db)
		 elip-text-decrement))
			 elip-db)
;; if we reach minimum set to -1 to flag as done
         (if (<= 
   (record-field (link-record elip-next-link) 'elip-percent elip-db)
            elip-text-percent-min)
	     (record-set-field (link-record elip-next-link) 'elip-percent
		  -1 elip-db))
  )) ;; end correct in text mode
) ;; end of correct ,else
;; we missed, bump miss count in all modes
           (progn
                (record-set-field (link-record elip-next-link) 'elip-lmissed 
             (1+ (record-field (link-record elip-next-link) 
                 'elip-lmissed elip-db)) elip-db)
;; on miss in text mode, increase percentage fill, and go back all the way
;; on a flub
	  (if elip-text-mode
	      (progn
               (if (< elip-qscore (- elip-ok-score 1)) ;; back all the way
   	         (record-set-field (link-record elip-next-link) 'elip-percent
		   elip-text-percent-max elip-db) ;; else just back 1 incr.
		(record-set-field (link-record elip-next-link) 'elip-percent
		 (min elip-text-percent-max
		  (+ elip-text-decrement
		     (record-field (link-record elip-next-link) 'elip-percent
			 elip-db)) ) elip-db))
		))
;; on miss in non-review mode, push Leitner box number back to 1
;; if in Leitner mode.  modified: flub pushes back to box 1 while
;; near miss pushes back one box only
          (if elip-leitner-mode
	      (progn
               (if (< elip-qscore (- elip-ok-score 1)) ;; back all the way
   	         (record-set-field (link-record elip-next-link) 'elip-lhole 
			     1 elip-db) ;; else just back 1 box 
		(record-set-field (link-record elip-next-link) 'elip-lhole
		 (max 1
		  (1- (record-field (link-record elip-next-link) 'elip-lhole
			 elip-db)) ) elip-db))
               ))  ;; end of miss in leitner mode
;; save for another sweep only in interval mode
;; bump bad count only in interval mode
    (if elip-interval-mode
       (progn
	(aset elip-bad-item elip-bad-count elip-next-item)
	(setq elip-bad-count (1+ elip-bad-count)))) ;; end interval
   ) ;; end missed question
  ) ;; end miss/non-miss
  )
;; here IF flashcard mode - this repeats code - could be better
;; implemented by fixing outer loops but this is a quick fix
    (if (< elip-qscore elip-ok-score)
      (progn
         (aset elip-bad-item elip-bad-count elip-next-item)
         (setq elip-bad-count (1+ elip-bad-count))))
) ;; end not flashcard mode for stats  
  ;; end looping over items
    (db-commit-record)
    (db-next-record 0)
 
;; this works now, it's a bit dangerous - changes are saved
;; automatically
(if (= elip-edit-item 1)
 (progn
  (setq elip-edit-item 0)
  (db-jump-to-record elip-next-item)
  (db-edit-mode)
  (db-first-field)
  (read-from-minibuffer 
"EDIT mode: ESC-CTRL-c returns to quiz.  Press ENTER.")
  (recursive-edit)
  (db-view-mode)
  (db-commit-record)
  (db-next-record 0)
))
))
)) ;; end asking current round of items
;; did we get them all correct?
 (if (not (= 0 elip-bad-count))
;; in non interval mode the elip-bad-count is always 0
   (progn
     (setq elip-prompt-text 
        (concat "Repeating " (int-to-string elip-bad-count)
          " missed items.  Press ENTER when ready."))
     (read-from-minibuffer elip-prompt-text)
     (setq elip-learn-item elip-bad-item)
     (setq elip-new-found elip-bad-count))   ; else
     (setq elip-loop-flag nil))
 ))
   (database-set-modified-p elip-db t)
   (db-save-database)
   (db-next-record 0)

)

(defun elip-ask-question ()
"Ask and score an ELIP question."
 (elip-check-db)
  (if (get-buffer elip-local-ask-buffer)
	(kill-buffer elip-local-ask-buffer))
  (get-buffer elip-local-ask-buffer)
  (switch-to-buffer elip-local-ask-buffer)
;; Could really add some protection with more local variables here
  (delete-other-windows)
  (insert "\n**** Question ****\n\n")
;; not text mode just plain question
  (if (not elip-text-mode)
  (insert (record-field (link-record elip-next-link) 'elip-question elip-db))
;; but test mode do ellipsis thing
   (progn
     (elip-reduce-phrase 
      (record-field (link-record elip-next-link) 'elip-question elip-db)
      (record-field (link-record elip-next-link) 'elip-percent elip-db))
     (insert elip-reduced-phrase)
  ))
  (elip-check-for-code)
  (setq elip-q-start (nth 1 (current-time)))
  (setq elip-prompt-text 
    (concat (int-to-string elip-n) " of " (int-to-string elip-new-found)))
  (if elip-leitner-mode
   (setq elip-prompt-text (concat elip-prompt-text ", slot "
     (int-to-string
     (record-field (link-record elip-next-link) 'elip-lhole elip-db) ))))
  (if elip-text-mode
      (setq elip-prompt-text (concat elip-prompt-text ", "
      (int-to-string
      (record-field (link-record elip-next-link) 'elip-percent elip-db))
       "%")))
  (setq elip-prompt-text (concat elip-prompt-text
      ".  Answer and press ENTER (or 'q' ENTER to quit)"))
  (setq elip-quit-maybe (read-from-minibuffer elip-prompt-text))
  (if (or (equal "q" elip-quit-maybe) (equal "Q" elip-quit-maybe))
   (progn
    (switch-to-buffer elip-data-buffer)
    (kill-buffer elip-local-ask-buffer)        
    (database-set-modified-p elip-db t)
    (db-save-database)
    (db-next-record 0)
    (error "Quit learning session at student request, database saved")))
  (setq elip-q-stop (nth 1 (current-time)))
;; don't combine - keep measurement error as small as possible
;; but ensure 1 second 'minimum'
  (setq elip-time-used (+ 1 (- elip-q-stop elip-q-start )))
  (goto-char (point-max))
  (insert "\n\n**** Answer ****\n\n")
  (if (not elip-text-mode)
;; in non text modes just insert the answer
  (insert (record-field (link-record elip-next-link) 'elip-answer elip-db))
;; but in text mode it's the question which is the answer!
  (insert (record-field (link-record elip-next-link) 'elip-question elip-db)))
  (elip-check-for-code)
  (setq elip-qscore -1)
;; new code for editing an item in place
  (setq elip-edit-item 0)
  (while (or
              (> elip-qscore 5)
	      (< elip-qscore 0))
          (setq elip-qscore 
	      (read-from-minibuffer  "Enter score, 0 to 5, and press ENTER: "))
	      (if (or (equal elip-qscore "e") (equal elip-qscore "E"))
		    (progn
		      (read-from-minibuffer 
            "Edit mode will be entered after score is recorded.  Press ENTER.")
		      (setq elip-edit-item 1)
		      (setq elip-qscore -1)
		     )
		(setq elip-qscore (string->integer-default elip-qscore -1 ))) )
;; get out of foreign buffer at earliest moment possible
  (switch-to-buffer elip-data-buffer)
  (kill-buffer elip-local-ask-buffer)        
  (>= elip-qscore elip-ok-score)      ;; return this value
)

(defun elip-find-nextask ()
"Find the next date to ask this question"
;; This is called from a non-ELIP buffer, beware
  (setq elip-temp-cycle (record-field (link-record elip-next-link) 
    'elip-cycle elip-db))
  (setq elip-due-date elip-current-date)
;;;
;;; find date adder
;;;
;;; this algorithm can and will be tinkered with a lot
;;; it must depend on cycle but can also depend on item difficulty
;;; and whether and how many times we missed it this round
;;;
;;; it's very loosely based on the Supermemo Algorithm 2
;;; but I decided to try a few ideas out
;;;
;;; the major departure is using times correct and times wrong
;;; rather than the grades themselves.  I don't think the
;;; grades are accurate enough.
;;;
;;; as of 2003-10-21:
;;;   we start with the base adder for the cycle
;;;   if we have any misses, and cycle=0 make it 1 day
;;;   otherwise we decrease time based on difficulty factor.
;;;
;;;   for instance if up to now we have 50% accuracy on a given
;;;   item we decrease the interval by approx. 50% for the next
;;;   cycle.  this doesn't favor recent learning over total 
;;;   learning, perhaps it should, but it does mean we are 
;;;   hammering those questions that we miss the most.
;;;
;;;   if a question is 'flubbed' with a score of 0-2
;;;   (based on a passing grade of 4) we reset the cycle
;;;   to the beginning, although we still keep the rest of
;;;   the stats.  the idea is that you clearly need more
;;;   frequent repetition but the difficulty of the question
;;;   should be rated about the same
;;;
;;;   another idea is to grant a first-day exception, i.e.,
;;;   since we already force a next-day repeat on anything we
;;;   miss the first learning cycle, maybe we shouldn't count
;;;   a potentially large number of first-cycle misses, which 
;;;   will bias the repeats for a very long time.  or maybe 
;;;   we should bias in this manner.  any ideas?
;;;   what about randomization?  to spread the load should we
;;;   be doing a percentage randomization?
;;;   
 (defvar elip-cycle-days
   [4  7  12  20  30  61  92  153  276  488  731  1462  2193  4018  6574])
 (if (> elip-temp-cycle 15)
     (setq elip-temp-cycle 15))
 (setq elip-temp-cycle (- elip-temp-cycle 1))
 (setq elip-adder (aref elip-cycle-days elip-temp-cycle) )
;;
;; exceptions -- order matters!
;; difficultly factor decreases repetition interval
;;
 (setq elip-df
  (/
    (+ 1 (float elip-temp-cycle))
    (float (record-field (link-record elip-next-link) 'elip-trials elip-db))
  ))
  (setq elip-adder  (truncate (* (float elip-adder) elip-df)))
;;
;; first cycle with misses - must come last in exceptions sequence
;; calls for a next day repeat, not a 4 day repeat
;;
 (if (and
       (= 0 elip-temp-cycle)
       (> (record-field (link-record elip-next-link) 'elip-lmissed elip-db) 0))
     (setq elip-adder 1))
;; add to elip-temp-date fix format and return it
 (if (< elip-adder 1)
   (setq elip-adder 1))
 (setq elip-due-date (+ elip-due-date elip-adder))
;; we must return the EDB formatted date
 (setq elip-due-date (parse-date-string (calendar-date-string 
   (calendar-gregorian-from-absolute elip-due-date))))
)

(defun elip-make-database ( &optional elip-database-to-make)
"Create a new ELIP database."
 (interactive)
;; create from anywhere is now OK
;; provided elip.dat is first loaded
 (if (eq nil elip-database-to-make)
   (setq elip-database-to-make (read-from-minibuffer 
   "Enter one-word name for new learning database: ")))
   (setq elip-new-name elip-database-to-make)
 (setq elip-new-description
  (read-from-minibuffer "Enter a very brief description of the new database: "))
;; go to elip.dat because  we need to know path of elip shell database
 (if (eq nil (get-buffer "elip.dat"))
     (error "Database elip.dat must be loaded first with M-x db-find-file!"))
 (switch-to-buffer "elip.dat")
 (copy-file (concat elip-local-data-path "/elip.dat") 
            (concat elip-local-data-path "/" elip-new-name ".dat"))
 (copy-file (concat elip-local-data-path "/elip.dba") 
            (concat elip-local-data-path "/" elip-new-name ".dba"))
 (copy-file (concat elip-local-data-path "/elip.fmt") 
            (concat elip-local-data-path "/" elip-new-name ".fmt"))
;; now dynamic edit of format file to fix title
 (find-file (concat elip-local-data-path "/" elip-new-name ".fmt"))
 (goto-char (point-min))
 (kill-line)
 (insert "*" elip-new-description "*")
 (save-buffer)
 (kill-buffer nil)
 (switch-to-buffer "elip.dat")
;; set random or linear
;; after db-find-file some db variables are set because we're in
;; the db buffer now, as we want to be
 (db-find-file (concat elip-local-data-path "/" elip-new-name ".dat"))
 (database-set-print-name dbc-database elip-new-description)
 (if (not (yes-or-no-p "Random item study order? (usually 'yes')? "))
    (database-set-local 'elip-learn-random dbc-database nil))
 (database-set-modified-p dbc-database t)
 (db-save-database)
)

(defun elip-check-for-code ()
"In the buffer check for code to evaluate headed by ##### marker."
;;
;; Anything below a line starting with ##### is taken and evaluated
;; as Elisp.  Beware, it is easy to make mistakes here.  This however
;; makes possible graphics, sound files, and much more.
;; Not at all well tested.

;; Bad design point: this works if there is stuff in both the Q and A 
;; but only through sheer luck.  That's because we delete the stuff from 
;; the question after we use it.  Could really be done better, yah?

;; called from non-ELIP buffer

(setq elip-check-data-path elip-data-path)
(goto-char (point-min))
(if (search-forward-regexp "^#####" nil t)
 (progn
   (setq elip-save-ask-buffer (current-buffer))
   (setq elip-check-file-name
     (substring 
	 (substring (buffer-name) 1 (string-match "<" (buffer-name)))
	    0 (- (length (buffer-name)) 2)))
   (beginning-of-line)
   (next-line 1)
   (set-mark (point))
   (goto-char (point-max))
;; New improved permission to run check.  Look in ~/.eliprc for our
;; full path name with an OK or NOTOK tag.
;; Look for intern variable with special name; read if there, otherwise
;; do the whole proc.  This is so we only check once per session per file
;; for permission to run.
 (if (not (intern-soft (concat elip-check-file-name ".elisp-check")))
;; no var, do the whole works
  (progn 
    ;; create the var as nil
   (intern (concat elip-check-file-name ".elisp-check"))
   (put (intern-soft (concat elip-check-file-name ".elisp-check"))
	'elisp-check nil)
   (setq elip-full-path (concat elip-check-data-path "/" elip-check-file-name))
   (if (get-buffer ".eliprc")
	  (kill-buffer ".eliprc"))
   (if (find-file "~/.eliprc")
       (progn
	 (goto-char (point-min))
	 (if (search-forward (concat elip-full-path " OK") nil t)
	     (put (intern-soft (concat elip-check-file-name ".elisp-check"))
		  'elisp-check t)
	      ;; else check not ok
	     (progn
	       (goto-char (point-min))
	       (if (search-forward (concat elip-full-path " NOT OK") nil t)
		 (kill-buffer (current-buffer)) ;; else ask user
		 (progn
		   (if 
  	            (yes-or-no-p 
		      "Elisp code found.  Trust this database and run it? ")
		       (progn
			 (barf-if-buffer-read-only)
			 (goto-char (point-max))
			 (insert (concat elip-full-path " OK\n"))
			 (put (intern-soft 
			       (concat elip-check-file-name ".elisp-check"))
			         'elisp-check t) 
			 (save-buffer 0)
			 (kill-buffer (current-buffer)))  ;; else said no
		       (progn
			 (barf-if-buffer-read-only)
			 (goto-char (point-max)) 
			 (insert (concat elip-full-path " NOT OK\n"))
			 (save-buffer 0)
			 (kill-buffer (current-buffer)))))))))
     (error "Unable to open ~/.eliprc, cannot continue")
)))
   (switch-to-buffer elip-save-ask-buffer)
   (if (get (intern-soft (concat elip-check-file-name ".elisp-check"))
	    'elisp-check)
;; When we run asynch code, we get an extra half-window about the code,
;; and when it completes, we overwrite our message in the minibuffer
;; about answering the question.  Don't have a solution yet for this.
       (eval-region (mark) (point)))
;; don't display the code in the question/answer buffer
   (kill-region (mark) (point))
;; or the hashmarks either for that matter
   (previous-line 1)
   (kill-line)
 ))
)

(defun elip-delay() 
"Delay due date of all previously tried interval items"
 (interactive)
 (elip-check-db)
 (setq elip-delay-days	(string->integer-default
      (read-from-minibuffer 
"Enter number of days to delay due date of all old items and press ENTER: "
) 0 ))
 (if (and (> elip-delay-days 0)
   (yes-or-no-p (concat "Really delay due date of all old items by " 
                (int-to-string elip-delay-days) " days? ")))
    (maprecords-macro
     (progn
      (if (> (record-field maprecords-record 'elip-lnew elip-db) 0)
       (progn
	 (setq elip-due-date 
	 (record-field maprecords-record 'elip-nextask elip-db))
         (setq elip-due-date
         (list 
           (car (cdr elip-due-date)) 
           (cdr (cdr elip-due-date))  
           (car elip-due-date)))
         (setq elip-due-date (calendar-absolute-from-gregorian elip-due-date))
	 (setq elip-due-date (+ elip-due-date elip-delay-days))
         (setq elip-due-date (parse-date-string (calendar-date-string 
            (calendar-gregorian-from-absolute elip-due-date))))
         (record-set-field maprecords-record 'elip-nextask elip-due-date elip-db)))) elip-db)
         ;; else
         (message "Never mind, then."))
;; force redisplay and save
 (database-set-modified-p dbc-database t)
 (db-save-database)
 (db-previous-record 0)
)

(defun elip-advance() 
"Advance due date of all previously tried interval items"
 (interactive)
 (elip-check-db)
 (setq elip-delay-days	(string->integer-default
      (read-from-minibuffer 
"Enter number of days to advance due date of all old items and press ENTER: "
) 0 ))
 (if (and (> elip-delay-days 0)
   (yes-or-no-p (concat "Really advance due date of all old items by " 
                (int-to-string elip-delay-days) " days? ")))
    (maprecords-macro
     (progn
      (if (> (record-field maprecords-record 'elip-lnew elip-db) 0)
       (progn
	 (setq elip-due-date 
	 (record-field maprecords-record 'elip-nextask elip-db))
         (setq elip-due-date
         (list 
           (car (cdr elip-due-date)) 
           (cdr (cdr elip-due-date))  
           (car elip-due-date)))
         (setq elip-due-date (calendar-absolute-from-gregorian elip-due-date))
	 (setq elip-due-date (- elip-due-date elip-delay-days))
         (setq elip-due-date (parse-date-string (calendar-date-string 
            (calendar-gregorian-from-absolute elip-due-date))))
         (record-set-field maprecords-record 'elip-nextask elip-due-date elip-db)))) elip-db)
         ;; else
         (message "Never mind, then."))
;; force redisplay and save
 (database-set-modified-p dbc-database t)
 (db-save-database)
 (db-previous-record 0)
)


(defun elip-report()
"Show summary level ELIP statistics"
 (interactive)
 (elip-check-db)
  (setq elip-items-studied 0)
  (setq elip-total-attempts 0)
  (setq elip-total-right 0)
  (setq elip-sum-time 0)
  (setq elip-sum-score 0)
  (setq elip-overdue 0)
  (setq elip-due-today 0)
  (setq elip-due-tomorrow 0)
  (setq elip-new-untried 0)
  (setq elip-leitner-untried 0)
  (setq elip-leitner-complete 0)
  (setq elip-text-untried 0)
  (setq elip-text-complete 0)
  (setq elip-leitner-boxes (make-vector 25 0))
  (maprecords-macro 
   (progn
;;
;; date stuff and new item count
;; there is some repeated code here but it just seems simpler
;; --new items undone--  first leitner stuff and text stuff
     (if (= (record-field maprecords-record 'elip-lhole elip-db) 0)
       (setq elip-leitner-untried (1+ elip-leitner-untried)))
     (if (= (record-field maprecords-record 'elip-percent elip-db) 0)
	 	     (setq elip-text-untried (1+ elip-text-untried)))
;; then regular stuff --late, current, tomorrow -- but not new!
     (if (= (record-field maprecords-record 'elip-lnew elip-db) 0)
       (setq elip-new-untried (1+ elip-new-untried)) ;; else 
    (progn
     (setq elip-due-date 
        (record-field maprecords-record 'elip-nextask elip-db))
     (setq elip-due-date
       (list 
         (car (cdr elip-due-date)) 
         (cdr (cdr elip-due-date))  
         (car elip-due-date)))
     (setq elip-due-date (calendar-absolute-from-gregorian elip-due-date))
     (if (<  elip-due-date elip-current-date)
	 (setq elip-overdue (1+ elip-overdue))
         (if (= elip-due-date elip-current-date)
	     (setq elip-due-today (1+ elip-due-today))
	     (if (= elip-due-date (1+ elip-current-date))
		 (setq elip-due-tomorrow (1+ elip-due-tomorrow)))))))
;;
;; when doing total stats and the like, we
;; only bother with stuff already tried at least once 
;;
     (if (not (= 0 (record-field maprecords-record 'elip-trials elip-db)))
;        (or
;	  (not (= 0 (record-field maprecords-record 'elip-lnew elip-db)))
;	  (not (= 0 (record-field maprecords-record 'elip-lhole elip-db)))
;	  (not (= 0 (record-field maprecords-record 'elip-percent elip-db)))
     
       (progn
;; check for Leitner box
	 (setq elip-leitner-value
	       (record-field maprecords-record 'elip-lhole elip-db) )
	 (if (> elip-leitner-value 0)
	     (aset elip-leitner-boxes elip-leitner-value
		(1+ (aref elip-leitner-boxes elip-leitner-value))))
	 (if (> elip-leitner-value elip-leitner-last-box)
	     (setq elip-leitner-complete (1+ elip-leitner-complete)))
;; check for text finished
	 (if (< (record-field maprecords-record 'elip-percent elip-db)  0)
	     (setq elip-text-complete (1+ elip-text-complete)))
         (setq elip-items-studied (+ 1 elip-items-studied))
	 (setq elip-total-attempts (+ elip-total-attempts
              (record-field maprecords-record 'elip-trials elip-db)))
         (setq elip-total-right (+ elip-total-right 
              (record-field maprecords-record 'elip-lright elip-db)))
	 (setq elip-sum-time (+ elip-sum-time
	      (record-field maprecords-record 'elip-ttime elip-db)))
	 (setq elip-sum-score (+ elip-sum-score
	      (record-field maprecords-record 'elip-tscore elip-db)))
       ))
   ) elip-db  )
 (if (not (= 0 elip-items-studied))
  (progn
   (if (get-buffer elip-local-report-buffer)
       (if (not (yes-or-no-p 
	  (concat "Buffer " elip-local-report-buffer 
		  " already exists.  Overwrite? ")))
        (error "Buffer already exists and will not be overwritten")
	(kill-buffer elip-local-report-buffer)))
  (get-buffer elip-local-report-buffer)
  (switch-to-buffer elip-local-report-buffer)
  (delete-other-windows)
  (goto-char (point-min))
  (insert "\nELIP Summary Level Statistics\n\n")
  (insert "(For individual item stats, use the command elip-item-stats)\n")
  (insert "\n")
  (insert "Items in database       : ")
  (insert (int-to-string (database-no-of-records elip-db)))
  (insert "\n")
  (insert "Interval items untried  : ")
  (insert (int-to-string elip-new-untried))
  (insert "\n")
  (insert "Text items untried      : ")
  (insert (int-to-string elip-text-untried))
  (insert "\n")
  (insert "Text items complete     : ")
  (insert (int-to-string elip-text-complete))
  (insert "\n")
  (insert "Leitner items untried   : ")
  (insert (int-to-string elip-leitner-untried))
  (insert "\n")
  (insert "Leitner items complete : ")
  (insert (int-to-string elip-leitner-complete))
  (insert "\n")
  (insert "Leitner box fill       : ")
  (setq elip-leitner-n 1)
  (while (<= elip-leitner-n elip-leitner-last-box)
   (progn
    (insert (concat 
	     (int-to-string (aref elip-leitner-boxes elip-leitner-n))
	     "  "))
    (setq elip-leitner-n (1+ elip-leitner-n))))
  (insert "\n")
  (insert "Overdue items          : ")
  (insert (int-to-string elip-overdue))
  (insert "\n")
  (insert "Items due today        : ")
  (insert (int-to-string elip-due-today))
  (insert "\n")
  (insert "Items due tomorrow     : ")
  (insert (int-to-string elip-due-tomorrow))
  (insert "\n")
  (insert "Number of items studied: ")
  (insert (int-to-string elip-items-studied))
  (insert "\n")
  (insert "Total attempts         : ")
  (insert (int-to-string elip-total-attempts)) 
  (insert "\n")
  (insert "Total correct answers  : ")
  (insert (int-to-string elip-total-right))
  (insert "\n")
  (insert "Total incorrect answers: ")
  (insert (int-to-string (- elip-total-attempts elip-total-right)))
  (insert "\n")
  (insert "Percent correct        : ")
  (if (= elip-total-attempts 0)
  (insert (format "%9.0f" 0.))
  (setq elip-percent-right 
          (* 100 (/ (float elip-total-right) (float elip-total-attempts)))))
  (insert (format "%7.2f" elip-percent-right))
  (insert "\n")
  (insert "Avg. time per attempt  : ")
  (if (= elip-total-attempts 0)
  (insert (format "%9.0f" 0.))
  (insert (format "%7.2f"
	   (/ (float elip-sum-time) (float elip-total-attempts)))))
  (insert " seconds\n")
  (insert "Avg. score per attempt : ")
  (if (= elip-total-attempts 0)
  (insert (format "%9.0f" 0.))
  (insert (format "%7.2f"
	   (/ (float elip-sum-score) (float elip-total-attempts)))))
  (insert "\n")
  (insert "\nYour grade is ")
  (insert 
  (cond 
        ( (>= elip-percent-right 97)
          (setq elip-grade "A+")) 
        ( (>=  elip-percent-right 94)
          (setq elip-grade "A")) 
        ( (>=  elip-percent-right 90)
          (setq elip-grade "A-")) 
        ( (>=  elip-percent-right 87)
          (setq elip-grade "B+")) 
        ( (>=  elip-percent-right 84)
          (setq elip-grade "B")) 
        ( (>=  elip-percent-right 80)
          (setq elip-grade "B-")) 
        ( (>=  elip-percent-right 77)
          (setq elip-grade "C+")) 
        ( (>=  elip-percent-right 74)
          (setq elip-grade "C")) 
        ( (>=  elip-percent-right 70)
          (setq elip-grade "C-")) 
        ( (>=  elip-percent-right 67)
          (setq elip-grade "D+")) 
        ( (>=  elip-percent-right 64)
          (setq elip-grade "D")) 
        ( (>=  elip-percent-right 60)
          (setq elip-grade "D-"))
        (t (setq elip-grade "F")) 
  ) )
  (insert ".\n")
 ) ; else
 (progn
   (setq elip-message (concat
      (int-to-string (database-no-of-records elip-db)) 
      " items in this database; none studied yet"))
   (message elip-message)))
)

(defun elip-export (&optional elip-export-file)
"Export questions and answers only to a flat file"
(interactive)
 (elip-check-db)
 (setq elip-overwrite-on-export t)
 (setq elip-export-data-path elip-local-data-path)
 (if (eq nil elip-export-file)
   (setq elip-export-file (read-from-minibuffer "Export to file: ")))
 (if (and (file-exists-p elip-export-file)
          (not (equal "eliptemp" elip-export-file)))
   (setq elip-overwrite-on-export (yes-or-no-p "File exists, overwrite? ")))
 (if (or (not (file-writable-p elip-export-file))
          (not (equal t elip-overwrite-on-export)))
     (error "Can't, or won't, access or overwrite this file.")  ; else
     (progn
       (find-file elip-export-file)
       (setq elip-export-buffer (buffer-name))
       (kill-region (point-min)(point-max))
       (insert "Export of ELIP database ")
       (insert elip-export-data-path)
       (insert "/")
       (insert elip-data-buffer)
       (insert " on ")
       (insert (calendar-date-string (calendar-current-date)))
       (insert "\n")
       (switch-to-buffer elip-data-buffer)     
       (maprecords-macro
	(progn
	  (setq elip-export-question (record-field maprecords-record 
            'elip-question elip-db))
	  (setq elip-export-answer (record-field maprecords-record 
            'elip-answer elip-db))
	  (switch-to-buffer elip-export-buffer)
	  (goto-char (point-max))
	  (insert "\n")
	  (insert "Q. ")
	  (insert elip-export-question)
	  (insert "\nA. ")
	  (insert elip-export-answer)
	  (switch-to-buffer elip-data-buffer)) elip-db)
       (switch-to-buffer elip-export-buffer)
;; Now write the file out
       (write-file elip-export-file)
       (goto-char (point-min))
       (message "Export complete.")))
)

(defun elip-import()
"Import new learning items from a flat file"
 (interactive)
 (elip-check-db)
 (setq elip-import-file (read-from-minibuffer "Import from file: "))
 (if (not (file-readable-p elip-import-file))
     (error "Can't access this file.") ; else
     (progn
;;
;; it probably makes the most sense to insert at the very end of the file
;; this is not easy at all since all inserts are insert-before!
;; so what we do is put in all the new records, save position, go to end
;; delete the last record, go back, and yank it in front of all the 
;; new records.  ugga-bugga.
;;
       (switch-to-buffer elip-data-buffer)
       (db-last-record)
       (find-file elip-import-file)
       (setq elip-import-buffer (buffer-name)) 
       (goto-char (point-min))
       (setq elip-done-importing nil)
       (setq elip-records-imported 0)
       (while (equal nil elip-done-importing)
        (progn
;; find a question marker.  the documentation lies if it still says
;; a space is required after the Q. and A. markers at the start of a line
	  (if (not (search-forward-regexp "^Q\\." nil t))
           (setq elip-done-importing t) ;else
           (progn
;	     (forward-char 1)
	     (setq elip-mark (point))
;; a question is bounded by the answer marker
	     (if (not (search-forward-regexp "^A\\." nil t))
              (setq elip-done-importing t) ;else
;; found end of question, save it
              (progn
		(backward-char 3)
		(setq elip-question-text (buffer-substring elip-mark (point)))
;; search end of answer or EOF
		(forward-char 3)
		(setq elip-mark (point))
		(if (not (search-forward-regexp "^Q\\." nil t))
		  (progn
		    (goto-char (point-max))
		    (setq elip-answer-text 
                      (buffer-substring elip-mark (point)))) ; else
		  (progn
		    (backward-char 3)
		    (setq elip-answer-text 
                      (buffer-substring elip-mark (point)))
		    ))
;; now create the new record
		(switch-to-buffer elip-data-buffer)
		(db-add-record)
		(setq elip-records-imported (+ 1 elip-records-imported))
		(db-first-field)
		(insert elip-question-text)
		(db-next-field 1)
		(insert elip-answer-text)
		(db-next-field 1)
		(db-last-record)
		(db-first-field)
		(switch-to-buffer elip-import-buffer)
              ) ; else
             ) 
           ) ; else
          )
        )
 )) ; else
 (switch-to-buffer elip-data-buffer)
 (db-last-record)
 (if (> elip-records-imported 0)
   (progn
     (db-delete-record 1)
;; must repeat due to wrapping
     (db-last-record)
     (setq elip-backup-amount (- elip-records-imported 1))
     (if (> elip-backup-amount 0)
	 (db-previous-record elip-backup-amount))
     (db-yank-record nil)
     (db-next-record 1)
     (setq elip-import-message (concat "Import complete: " 
       (int-to-string elip-records-imported) " records."))
     (message elip-import-message)) ; else
     (message "Nothing imported."))
)) 

(defun elip-version () "Show ELIP version and date" (interactive)
;; value is set in elip.dba
 (elip-check-db)
 (message elip-version-number)
)

(defun elip-quit () 
"Sub for db-quit" (interactive)
;; sorting an elip database is a bad idea so we run a substitute function
;; the problem is that if other databases are open this will sub for it
;; so check against database-printname
 (if (equal (database-get-local 'elip-marker dbc-database t) 
	    "Emacs Learning Interval Program")
   (db-exit 1)
   (progn
      (db-quit-original)
   ))
)

(defun elip-item-stats ()
"Show detailed report for every item in database"
 (interactive)
 (elip-check-db)
  (if (get-buffer elip-local-item-buffer)
       (if (not (yes-or-no-p 
	  (concat "Buffer " elip-local-item-buffer 
		  " already exists.  Overwrite? ")))
        (error "Buffer already exists and will not be overwritten")
	(kill-buffer elip-local-item-buffer)))
  (get-buffer elip-local-item-buffer)
  (if (get-buffer elip-local-table-buffer)
       (if (not (yes-or-no-p 
	  (concat "Buffer " elip-local-table-buffer 
		  " already exists.  Overwrite? ")))
        (error "Buffer already exists and will not be overwritten")
	(kill-buffer elip-local-table-buffer)))
  (get-buffer elip-local-table-buffer)
;; Put headers in table buffer
  (switch-to-buffer elip-local-table-buffer)
  (insert
"   1         2       3    4    5      6     7      8     9      10   11  12\n")
  (insert 
" Item       Due     Tot  Tot  Tot    Pct   Tot    Avg   Tot     Avg  Ltnr Txt\n")
  (insert 
"  No       Date     Att  Rgt  Wrg    Rgt   Tim    Tim   Scr     Scr  Box  Pct\n\n")
  (setq elip-report-n 1)
  (maprecords-macro
    (progn
;; this charade is necessary because of the local variable question.
      (switch-to-buffer elip-data-buffer)
      (switch-to-buffer elip-local-item-buffer)
      (insert "====== Stats for item ")
      (insert (int-to-string elip-report-n))
      (insert " =====\n\n")
      (setq elip-due-date 
	    (record-field maprecords-record 'elip-nextask elip-db))
      (setq elip-total-attempts
	       (record-field maprecords-record 'elip-trials elip-db))
;; dual check, it isn't new for our purposes unless it has not been
;; tried either with Leitner or with LIP methods
      (if (= (record-field maprecords-record 'elip-trials elip-db) 0)
;       (and 
;         (= (record-field maprecords-record 'elip-lnew elip-db) 0)
;         (= (record-field maprecords-record 'elip-lhole elip-db) 0)
;	 (= (record-field maprecords-record 'elip-percent elip-db) 0))
;; don't futz with new item
        (insert "*** UNTRIED NEW ITEM ***\n")
;; else go for it
	  (progn
	      (setq elip-due-date 
		   (list 
		    (car (cdr elip-due-date)) 
		    (cdr (cdr elip-due-date))  
		    (car elip-due-date)))
      (setq elip-due-nums (format "%4s-%2s-%2s"
                    (substring (prin1-to-string
		     (cdr (cdr elip-due-date))) 1 5)
		    (car elip-due-date)
		    (car (cdr elip-due-date))))
      (setq elip-due-nums (db-string-substitute 32 48 elip-due-nums))
      (setq elip-due-date (calendar-date-string elip-due-date))
      (setq elip-total-right
	    (record-field maprecords-record 'elip-lright elip-db))
      (setq elip-times-missed (- elip-total-attempts elip-total-right))
      (setq elip-percent-right
	    (* 100 (/ (float elip-total-right) (float elip-total-attempts))))
      (setq elip-sum-time 
	    (record-field maprecords-record 'elip-ttime elip-db))
      (setq elip-average-time 
	    (/ (float elip-sum-time) (float elip-total-attempts)))
      (setq elip-sum-score
	    (record-field maprecords-record 'elip-tscore elip-db))
      (setq elip-average-score 
	    (/ (float elip-sum-score) (float elip-total-attempts)))
      (setq elip-leitner-position 	   
	    (record-field maprecords-record 'elip-lhole elip-db))
      (setq elip-text-percentage
	    (record-field maprecords-record 'elip-percent elip-db))
      (insert (concat "Next repetition date: " elip-due-date))
      (insert "\nTimes attempted     : ")
      (insert (int-to-string elip-total-attempts))
      (insert "\nTimes correct       : ")
      (insert (int-to-string elip-total-right))
      (insert "\nTimes missed        : ")
      (insert (int-to-string elip-times-missed))
      (insert (concat "\nPercent correct     : " 
		(format "%-5.2f" elip-percent-right)))
      (insert "\nTotal time          : ")
      (insert (concat 
	       (format "%-7d" elip-sum-time) " seconds"))
      (insert "\nAverage time        : ")
      (insert (concat (format "%-7.2f" elip-average-time) " seconds"))
      (insert "\nTotal score         : ")
      (insert (int-to-string elip-sum-score))
      (insert "\nAverage score       : ")
      (insert (format "%-7.2f" elip-average-score)) 
      (insert "\nLeitner box         : ")
      (if (> elip-leitner-position elip-leitner-last-box)
	  (insert "*Done*")
          (insert (format "%-2d" elip-leitner-position))
;; a kludge to make a 'done' marker in the table below
	  (setq elip-leitner-position 99))
      (insert "\nText percentage     : ")
      (if (< elip-text-percentage 0)
	  (insert "*Done*")
	  (insert (format "%-2d" elip-text-percentage)))
;; now build the table buffer, still old items only
      (switch-to-buffer elip-data-buffer)
      (switch-to-buffer elip-local-table-buffer)
      (insert (format
        "%4d  %12s %4d %4d %4d  %6.2f %4d %7.2f %4d %7.2f    %2d %2d\n"
      elip-report-n
      elip-due-nums
      elip-total-attempts
      elip-total-right
      elip-times-missed
      elip-percent-right
      elip-sum-time
      elip-average-time
      elip-sum-score
      elip-average-score
      elip-leitner-position
      elip-text-percentage))
 ))
;; show q and a regardless if old or new just in item buffer
      (switch-to-buffer elip-data-buffer)
      (switch-to-buffer elip-local-item-buffer)
      (insert "\n\nQuestion:\n")
      (insert (record-field maprecords-record 'elip-question elip-db))
      (insert "\nAnswer:\n")
      (insert (record-field maprecords-record 'elip-answer elip-db))
      (insert "\n\n")
      (setq elip-report-n (1+ elip-report-n))
)
   elip-db)
;; finish in item buffer
  (switch-to-buffer elip-data-buffer)
  (switch-to-buffer elip-local-table-buffer)
  (goto-char (point-min))
  (switch-to-buffer elip-data-buffer)
  (switch-to-buffer elip-local-item-buffer)
  (delete-other-windows)
  (goto-char (point-min))
)

(defun elip-debug-data ()
"Switch ELIP display to show all saved per-item stats.  Undocumented."
(interactive)
 (elip-check-db)
 (if (or (equal dbf-format-name nil)
	 (equal dbf-format-name "elip-normal-format"))
  (progn
;; if we've never created the fmt2 file do so now 
   (if (not (file-readable-p elip-fmt2-string))
     (elip-make-debug-format)     
    )
;; now switch over
    (db-change-format "elip-stats-format" elip-fmt2-string)
;; funny force of redisplay!
    (db-previous-record 0)
    (message "Per-item stats now displayed."))
  (progn
    (db-change-format "elip-normal-format" elip-fmt1-string)
    (db-previous-record 0)
    (message "Normal display format now in use.")))
)

(defun elip-reset ()
"Restart learning on this database fully or partly" 
(interactive)
 (elip-check-db)
 (setq elip-reset-mode nil)
 (while (equal nil elip-reset-mode)
 (setq elip-reset-mode 
 (read-from-minibuffer 
"Reset leitner, text, interval, all modes, or quit (ltiaq): "))
 (if (equal "l" elip-reset-mode)
   (maprecords-macro
    (record-set-field maprecords-record 'elip-lhole 0 elip-db) elip-db))
;; else ask text mode 
  (if (equal "t" elip-reset-mode)
    (maprecords-macro
     (record-set-field maprecords-record 'elip-percent 0 elip-db) elip-db))
;; else ask about interval mode
   (if (equal "i" elip-reset-mode)
     (maprecords-macro
      (progn
	(record-set-field maprecords-record 'elip-lnew 0 elip-db)
        (record-set-field maprecords-record 'elip-cycle 0 elip-db)
	(record-set-field maprecords-record 'elip-nextask
	  (parse-date-string  (calendar-date-string 
			 (calendar-current-date))) elip-db ) ) elip-db))
;; else ask about the whole works
   (if (equal "a" elip-reset-mode)
     (if (yes-or-no-p "REALLY do this? ")
      (maprecords-macro
        (elip-init-values maprecords-record elip-db)
	    elip-db)))
     ;; else junk or nil
     (setq elip-reset-mode 1)
)
;; force redisplay
 (db-previous-record 0)
)

(defun elip-end-help ()
"set condition to exit help"
   (interactive)
   (setq elip-more-help 0)
   (self-insert-and-exit)
)

(defun elip-help () "Give some ELIP help" (interactive)
;; don't really need to rebuild each time, I suppose,
;; but maybe it was changed :)
 (elip-check-db)
  (if (get-buffer "*elip.help*")
	(kill-buffer "*elip.help*"))
  (get-buffer "*elip.help*")
  (switch-to-buffer "*elip.help*")
  (delete-other-windows)
  (goto-char (point-min))
  (insert "Commands:\n")
  (insert "  elip-learn              C-cl  Do some interval learning\n")
  (insert "  elip-learn-new          C-cn  Learn new items in interval mode\n")
  (insert "  elip-learn-old          C-co  Learn 'old/due' items in interval mode\n")
  (insert "  elip-learn-leitner      C-ce  Learn Leitner flashcard style\n")
  (insert "  elip-learn-text         C-ct  Learn text memorization style\n")
  (insert "  elip-learn-flashcards   C-cf  Do a flashcard-style drill\n")
  (insert "  elip-report             C-cr  Report on summary learning stats\n")
  (insert "  elip-workload           C-cw  Report on items due by date (workload)\n")
  (insert "  elip-version            C-cz  Show ELIP version number\n")
  (insert 
"  elip-import             C-cm  Import questions/answers from flat file\n")
  (insert "  elip-export             C-cx  Export questions/answers to flat file\n")
  (insert 
"  elip-reverse            C-cv  Reverse questions/answers to/from flat files\n")
  (insert "  elip-item-stats         C-ci  Show statistics with each item\n")
  (insert "  elip-sort               C-cs  Sort an ELIP database\n")
  (insert "  elip-table-sort         C-cT  Sort an ELIP item table\n")
  (insert "  elip-shuffle            C-cS  Randomly shuffle ELIP items\n")
  (insert 
"  elip-reset                    Reset the database and restart learning\n")
  (insert "  elip-delay              C-cd  Delay due dates of all items\n")
  (insert "  elip-advance            C-ca  Advance due dates of all items\n")
  (insert 
"  elip-scan-text          C-cc  Prepare questions from marked text file\n")
  (insert "  elip-mark-area          C-c1  Mark area of interest for ellipsis questions\n")
  (insert "  elip-mark-question      C-c2  Mark text for an ellipsis question\n")
  (insert "  elip-done-marking       C-c3  Finish with an area for ellipsis questions\n")
  (insert "  elip-set-bookmark       C-cb  Set bookmark in text file\n")
  (insert "  elip-goto-bookmark      C-cj  Go to bookmark in text file\n")
  (insert "  elip-backup             C-cu  Not implemented\n")
  (insert "  elip-restore            C-cy  Not implemented\n")
  (insert "  elip-make-database      C-ck  Create a new ELIP database\n")
  (insert "  elip-dump-elisp         C-cp  Dump ELISP code in an ELIP database\n")
  (insert "  elip-quit               C-cq  Quit from ELIP database\n")
  (insert "\nScoring scale for questions:\n")
  (insert "  0  Clueless\n")
  (insert "  1  Fully wrong and not familiar\n")
  (insert "  2  Fully wrong but familiar\n")
  (insert "  3  Near miss/partly wrong but familiar\n")
  (insert "  4  Correct/hesitant\n")
  (insert "  5  Correct/quick\n")
  (goto-char (point-min))
;; Parent keybindings still apply, just don't tell anyone!
   (setq elip-help-keymap (make-sparse-keymap))
   (define-key elip-help-keymap "b" 'scroll-other-window-down)
   (define-key elip-help-keymap " " 'scroll-other-window)
   (define-key elip-help-keymap "q" 'elip-end-help)
   (define-key elip-help-keymap "\C-g" 'elip-end-help)
   (setq elip-more-help 1)
   (while (= elip-more-help 1)
       (read-from-minibuffer 
         "Spacebar scrolls down, 'b' scrolls up, 'q' quits ELIP help "
          nil elip-help-keymap))
   (kill-buffer "*elip.help*")
   (switch-to-buffer elip-data-buffer)
)

(defun elip-backup ()
 "not implemented"
 (interactive)
 (read-from-minibuffer "elip-backup not yet implemented.  Press ENTER.")
)

(defun elip-restore ()
 "not implemented"
 (interactive)
 (read-from-minibuffer "elip-restore not yet implemented.  Press ENTER.")
)


(defun elip-find-new-text-of-interest () 
"Find next text between {} markers"
;; called from non-ELIP buffer by definition

;; start at current buffer position - this is a feature, not a bug
;; tested and working, hurrah
   (if (search-forward "{{{" nil t)
     (progn 
       (setq elip-start-of-text (point))
;; search end of selected text
       (if (search-forward "}}}" nil t)
	 (progn
	   (backward-char 3)
;; save this batch of selected text
	   (setq elip-new-question 
             (buffer-substring elip-start-of-text (point))))))
  (setq elip-new-question nil))
)


(defun elip-scan-text ()
"Scan text and make up question and answer buffer"
(interactive)
;; called from non-ELIP buffer by definition

;; you may laugh when you read this code.  this is ok.  laugh if you
;; wish.  however be aware that laughing obligates you to rewrite this
;; in a better fashion, and send the rewrite to me.
 
 (if (yes-or-no-p "Is the cursor positioned at the beginning of the text to be scanned? ")
 (progn
 (setq elip-scan-input-buffer (buffer-name))
 (setq elip-scan-output-buffer (read-from-minibuffer "Output to what buffer/file? "))
 (get-buffer elip-scan-output-buffer)

;; scan and write

;; see if we have a group to work on
 (while (elip-find-new-text-of-interest)
  (progn
;; generate a question free of brackets while saving answers
	   (setq elip-clean-new-question "")
	   (setq elip-match-count 0)
	   (setq elip-match-start 0)
	   (setq elip-saved-answers (make-vector 100 ""))
;; can we find a left bracket and repeat
	   (while (setq elip-left-bracket 
              (string-match "[[[[]" elip-new-question elip-match-start))
	     (progn
;; can we find a right bracket
	       (if (setq elip-right-bracket 
                  (string-match "]]]" elip-new-question elip-left-bracket))
		   (progn
		     (setq elip-clean-new-question 
			   (concat elip-clean-new-question
			      (substring elip-new-question 
				elip-match-start elip-left-bracket)))
;; save up to the left bracket
		     (setq elip-new-answer (substring elip-new-question
                         (+ 3 elip-left-bracket) elip-right-bracket) )
;; save the answer onto the question string
		     (setq elip-clean-new-question 
                        (concat elip-clean-new-question elip-new-answer))
;; stow the answer in a list
		     (aset elip-saved-answers elip-match-count elip-new-answer)
;; bump pointer and counters
		     (setq elip-match-count (1+ elip-match-count))
		     (setq elip-match-start (+ 3 elip-right-bracket))
		     )))
       )
;; now put in the last piece of the question which follows the last brackets
	     (setq elip-clean-new-question 
		(concat elip-clean-new-question
		   (substring elip-new-question elip-match-start)))
     )
;; enter this group into the q/a buffer, fixing the question as we go
;; we do the regular q/a thing if we found at least one [] group
	   (if (> elip-match-count 0)
	    (progn
	     (switch-to-buffer elip-scan-output-buffer)
	     (goto-char (point-max))
	     (setq elip-i 0)
	     (while (< elip-i elip-match-count)  
	       (progn
		 (insert "\nQ. ")
;; now fix the question to do the ellipsis thing
   	         (setq elip-nice-answer (aref elip-saved-answers elip-i))
		 (insert 
		   (concat
		    (substring elip-clean-new-question 0
 		     (string-match elip-nice-answer elip-clean-new-question))
                    " [...] "
                    (substring elip-clean-new-question (match-end 0))))
		 (insert "\nA. ")
		 (insert elip-nice-answer)
		 (insert "\n")
		 (setq elip-i (1+ elip-i))
	    )))
;; else -- if there are no [] groups we treat it as a text group,
;; and use the whole passage as a text Q. with a blank A.
          (progn
	    (switch-to-buffer elip-scan-output-buffer)
	    (goto-char (point-max))
	    (insert "\nQ. ")
	    (insert elip-new-question)
	    (insert "\nA. \n")
         ))
	   (switch-to-buffer elip-scan-input-buffer)
  )
  (switch-to-buffer elip-scan-output-buffer)
  (goto-char (point-min))
  (message 
     "Import file constructed, edit as needed, save to disk, and import.")
))
)

(defun elip-check-db ()
"A minimal check to see if we are in the right database and buffer."
(interactive)

;; 1. Are we in a database buffer, or can we find the right one.
;; 2. Is it an ELIP database.
;; 3. Does the buffer match our idea of the current database.

(if (equal nil dbc-database)
;; see if we can figure out what database he wants anyhow
;; broken up for legibility and to account for possible <2> stuff
  (progn
    (setq elip-start-of-match
      (string-match  
       ".\\(report\\|workload\\|item\\|ask\\|table\\|dump\\)" (buffer-name)))
    (setq elip-dot-dat
      (string-match "\\.dat" (buffer-name)))
    (setq elip-first-star
      (string-match "^\\*" (buffer-name)))
    (setq elip-last-star
      (string-match "\\*$" (buffer-name)))
    (if (and 
          elip-start-of-match 
	  elip-first-star
	  elip-dot-dat
	  elip-last-star
	  (get-buffer (substring (buffer-name) 1 elip-start-of-match)))
 	  (switch-to-buffer (substring (buffer-name) 1 elip-start-of-match))
	  (not (equal nil dbc-database))
          t
          (error "You are not in an ELIP database buffer"))))
(if (not (equal (database-get-local 'elip-marker dbc-database) 
		"Emacs Learning Interval Program"))
    (error "This is not an ELIP database buffer"))
(if (not (equal (aref dbc-database 4) 
		(concat elip-local-data-path "/" 
                  (substring elip-local-data-buffer
			0 (string-match "<" elip-local-data-buffer)))))
    (error "ELIP database buffers out of sync, quit Emacs and restart"))
;; all is well, set up some stuff
 (setq elip-db dbc-database)
 (setq elip-data-buffer elip-local-data-buffer)
 (setq elip-data-path elip-local-data-path)
)

(defun elip-sort (&optional db-sort-arg1) 
"Sub for db-sort" (interactive)
 (if (equal (database-get-local 'elip-marker dbc-database t) 
	    "Emacs Learning Interval Program")
 (progn
;; these checks may be redundant but we take no prisoners
 (elip-check-db)
  (setq elip-sort-n 0)
  (maprecords-macro
   (progn
    (record-set-field maprecords-record 'elip-aux9 elip-sort-n elip-db)
    (setq elip-sort-n (1+ elip-sort-n))) elip-db)
 (database-sort dbc-database 'elip-order-sort)
 (dbf-finished-sorting))  ;; else not in ELIP so do regular sort
 (db-sort-original db-sort-arg1))
)

(defun elip-shuffle()
"Shuffle all the items"
(interactive)
 (elip-check-db)
;; Really shuffle the new items.  Shuffle everything and then
;; sort.  This brings shuffled new items to the top and puts 
;; the old items back in proper order.
 (maprecords-macro
   (record-set-field maprecords-record 'elip-aux9 (random) elip-db)
     elip-db)
 (database-sort dbc-database 'elip-shuffle-sort)
 (dbf-finished-sorting)
 (elip-sort)
)

(defun elip-reverse()
"Reverse learning items from database OR flat file to a flat file"
 (interactive)
 (setq elip-overwrite-on-export t)
 (setq elip-records-exported 0)
 (setq elip-reverse-file-mode (read-from-minibuffer 
			 "Reverse items in flat file or current database (f/c)?  "))
 (if (and (not (equal "f" elip-reverse-file-mode))
          (not (equal "F" elip-reverse-file-mode))
	  (not (equal "c" elip-reverse-file-mode))
	  (not (equal "C" elip-reverse-file-mode)))
     (error "Unknown response"))
 (if 
  (or (equal "c" elip-reverse-file-mode)(equal "C" elip-reverse-file-mode))
;; reverse current db file by exporting to temp flat file and then go ahead as below
   (progn
    (elip-export "eliptemp")
    (setq elip-reverse-file-mode "ff")
    ))
  (if (or (equal "f" elip-reverse-file-mode)(equal "F" elip-reverse-file-mode)
     (equal "ff" elip-reverse-file-mode))
  (progn
   (if (not (equal "ff" elip-reverse-file-mode))
     (setq elip-import-file (read-from-minibuffer "Reverse items in what flat file? "))
     (setq elip-import-file "eliptemp"))
   (if (not (file-readable-p elip-import-file))
     (message "Can't access this file.") ; else
     (progn
       (setq elip-reverse-file 
        (read-from-minibuffer "Export reversed items to file: "))
       (if (file-exists-p elip-reverse-file)
        (setq elip-overwrite-on-export 
	   (yes-or-no-p "File exists, overwrite? ")))
       (if (or (not (file-writable-p elip-reverse-file))
             (not (equal t elip-overwrite-on-export)))
               (error
                "Can't, or won't, access or overwrite this file.") 
         (progn
          (find-file elip-reverse-file)
	  (setq elip-export-buffer (buffer-name))
	  (kill-region (point-min)(point-max))
	  (insert "ELIP reversed questions database ")
	  (find-file elip-import-file)
	  (setq elip-import-buffer (buffer-name)) 
	  (goto-char (point-min))
	  (setq elip-done-importing nil)
	  (setq elip-records-imported 0)
	  (while (equal nil elip-done-importing)
	    (progn
	      (if (not (search-forward-regexp "^Q\." nil t))
		  (setq elip-done-importing t) ;else
		(progn
		  (setq elip-mark (point))
;; a question is bounded by the answer marker
		  (if (not (search-forward-regexp "^A\." nil t))
		      (setq elip-done-importing t) ;else
;; found end of question, save it
		    (progn
		      (backward-char 3)
		      (setq elip-question-text 
			    (buffer-substring elip-mark (point)))
;; search end of answer or EOF
		      (forward-char 3)
		      (setq elip-mark (point))
		      (if (not (search-forward-regexp "^Q\." nil t))
			  (progn
			    (goto-char (point-max))
			    (setq elip-answer-text 
				  (buffer-substring elip-mark (point)))) ; else
			(progn
			  (backward-char 3)
			  (setq elip-answer-text 
				(buffer-substring elip-mark (point)))
		        ))
;; now create the new record
		(switch-to-buffer elip-export-buffer)
		(insert "\nQ. ")
		(insert elip-answer-text)
		(insert "\nA. ")
		(insert elip-question-text)
		(insert "\n")
		(setq elip-records-exported (+ 1 elip-records-exported))
		(switch-to-buffer elip-import-buffer)
))))))

 (if (> elip-records-exported 0)
   (progn
     (switch-to-buffer elip-export-buffer)
     (delete-other-windows)
     (setq elip-export-message 
	   (concat "Generation of reversed items complete: " 
           (int-to-string elip-records-exported) " items."))
     (message elip-export-message)) ; else
     (message "Nothing exported."))
))))))

)

(defun elip-workload()
"Show report of number of items due by date"
(interactive)
 (elip-check-db)
  (elip-sort)
  (elip-collect-dates)
  (if (not (= 0 (aref elip-date-count 0)))
   (progn
   (if (get-buffer elip-local-workload-buffer)
       (if (not (yes-or-no-p 
	  (concat "Buffer " elip-local-workload-buffer 
		  " already exists.  Overwrite? ")))
        (error "Buffer already exists and will not be overwritten")
	(kill-buffer elip-local-workload-buffer)))
  (get-buffer elip-local-workload-buffer)
  (switch-to-buffer elip-local-workload-buffer)
  (delete-other-windows)
  (goto-char (point-min))
  (setq elip-date-j 0)
  (insert (format "%-30s" "Item Due Date"))
  (insert "  Item Count\n\n")
  (while (<= elip-date-j elip-date-n)
    (insert (format "%-30s" (calendar-date-string 
      (calendar-gregorian-from-absolute 
        (aref elip-date-array elip-date-j)))))
    (insert "   ")
    (insert (int-to-string (aref elip-date-count elip-date-j)))
    (insert "\n")
    (setq elip-date-j (1+ elip-date-j))
 )
;; get rid of enormous arrays
 (makunbound 'elip-date-count)
 (makunbound 'elip-date-array)
   ) ;; else all items are new
 (message "No items studied yet in this database.")
 )
)

(defun elip-collect-dates()
"Build a list and count of dates for items"
 (elip-check-db)
;; big old arrays
 (setq elip-date-array (make-vector 1000 0))
 (setq elip-date-count (make-vector 1000 0))
;; in case nothing found this must get set
 (setq elip-date-n 0)
 (maprecords-macro
;; old records only!  dates on new items don't matter here
  (if (not (= 0 (record-field maprecords-record 'elip-trials elip-db)))
   (progn
    (setq elip-temp-date (date->absolute-days 
       (record-field maprecords-record 'elip-nextask elip-db)))
    (setq elip-date-n 0)
    (setq elip-done nil)
    (while (and (not elip-done)
	       (not (= 0 (aref elip-date-array elip-date-n))))
     (if (= elip-temp-date (aref elip-date-array elip-date-n))
;; found
      (progn
       (setq elip-done t)
       (aset elip-date-count elip-date-n 
           (1+ (aref elip-date-count elip-date-n))))
;; not yet found
       (setq elip-date-n (1+ elip-date-n))))
;; did we find
   (if (not elip-done)
;; add new if not
    (progn
     (aset elip-date-array elip-date-n elip-temp-date)
     (aset elip-date-count elip-date-n 1)))
   
  ) ) elip-db )  ;; done mapping over all records

)

(defun elip-make-debug-format()
 (copy-file elip-fmt1-string elip-fmt2-string)
 (find-file elip-fmt2-string)
 (goto-char (point-max))
 (insert "\n")
 (insert "     Cycle: \\elip-cycle             Last Score: \\elip-lscore\n")
 (insert "    Trials: \\elip-trials            Total Score: \\elip-tscore\n")
 (insert "Total Time: \\elip-ttime      Misses This Cycle: \\elip-lmissed\n")
 (insert "Pigeonhole: \\elip-lhole               New Flag: \\elip-lnew\n")
 (insert "No Correct: \\elip-lright          Text Percent: \\elip-percent\n")
 (insert "      Aux5: \\elip-aux5                   Aux6: \\elip-aux6\n")
 (insert "      Aux7: \\elip-aux7                   Aux8: \\elip-aux8\n")
 (insert "      Aux9: \\elip-aux9\n")
 (save-buffer)
 (switch-to-buffer elip-data-buffer)
)

(defun elip-table-sort ()
"Sort an item stats table - crude interface"
(interactive)

;; verify the buffer name
;; but if the buffer was boogered with this could all fail
(if (not (string-match "\**\.dat\.table\*" (buffer-name)))
  (error "Doesn't appear to be an ELIP item stats table buffer"))

(goto-char (point-min))
;; this is fragile if the buffer format is changed some day
(forward-line 4)
(setq elip-table-start (point))
(goto-char (point-min))

(setq elip-sort-choice 0)
;; 1 item no
;; 2 due date
;; 3 total attempts
;; 4 total right
;; 5 total wrong
;; 6 pct right
;; 7 total time
;; 8 avg time
;; 9 total score
;; 10 avg score
(while (or (> elip-sort-choice 10)
            (< elip-sort-choice 1))
  (setq elip-sort-choice (string->integer-default 
      (read-from-minibuffer "Sort field (1-10): ") 0 )))
(if (= elip-sort-choice 2)
  (sort-fields 2 elip-table-start (point-max))  ;; else
  (sort-numeric-fields elip-sort-choice elip-table-start (point-max)))

;; reverse the region, effectively reversing the sort
;; need to not do this for item number sort!

(if (not (= 1 elip-sort-choice))
  (reverse-region elip-table-start (point-max)))

)

(defun elip-set-max-items-at-once ()
"set the maximum number of items to study at once"
 (interactive)
 (elip-check-db)
 (setq elip-temp -1)
 (while (or
	 (not (integer-or-marker-p elip-temp))
	 (< elip-temp 2)
	 (> elip-temp 50))
   (setq elip-temp (string->integer-default (read-from-minibuffer
     (concat
     "Enter max number of items to learn at once "
     "(2-50, currently " (int-to-string elip-max-new)  "): " )) -1 ) ))
 (database-set-local 'elip-save-max-new elip-db elip-temp)
 (setq elip-max-new elip-temp)
 (db-write-database-file (database-file dbc-database ) t)
)

(defun elip-after-read ()
;; stuff to run after the database is read and we are
;; sure to be in database mode
;; first set up elip keybindings 
  (elip-fix-keybindings)
;; then help about help
  (elip-tell-about-help)
)

(defun elip-fix-keybindings ()
;; have to monkey with database keybindings since
;; we can only have one major mode and we can't set
;; keys in a minor mode
;; further must define in both view and edit modes
(define-key database-view-mode-map "\C-cl" 'elip-learn)
(define-key database-edit-mode-map "\C-cl" 'elip-learn)
(define-key database-view-mode-map "\C-co" 'elip-learn-old)
(define-key database-edit-mode-map "\C-co" 'elip-learn-old)
(define-key database-view-mode-map "\C-cn" 'elip-learn-new)
(define-key database-edit-mode-map "\C-cn" 'elip-learn-new)
(define-key database-view-mode-map "\C-ce" 'elip-leitner)
(define-key database-edit-mode-map "\C-ce" 'elip-leitner)
(define-key database-view-mode-map "\C-ct" 'elip-learn-text)
(define-key database-edit-mode-map "\C-ct" 'elip-learn-text)
(define-key database-view-mode-map "\C-cf" 'elip-learn-flashcards)
(define-key database-edit-mode-map "\C-cf" 'elip-learn-flashcards)
(define-key database-view-mode-map "\C-cr" 'elip-report)
(define-key database-edit-mode-map "\C-cr" 'elip-report)
(define-key database-view-mode-map "\C-cw" 'elip-workload)
(define-key database-edit-mode-map "\C-cw" 'elip-workload)
(define-key database-view-mode-map "\C-cz" 'elip-version)
(define-key database-edit-mode-map "\C-cz" 'elip-version)
(define-key database-view-mode-map "\C-cm" 'elip-import)
(define-key database-edit-mode-map "\C-cm" 'elip-import)
(define-key database-view-mode-map "\C-cx" 'elip-export)
(define-key database-edit-mode-map "\C-cx" 'elip-export)
(define-key database-view-mode-map "\C-cv" 'elip-reverse)
(define-key database-edit-mode-map "\C-cv" 'elip-reverse)
(define-key database-view-mode-map "\C-ci" 'elip-item-stats)
(define-key database-edit-mode-map "\C-ci" 'elip-item-stats)
(define-key database-view-mode-map "\C-cu" 'elip-backup)
(define-key database-edit-mode-map "\C-cu" 'elip-backup)
(define-key database-view-mode-map "\C-cy" 'elip-restore)
(define-key database-edit-mode-map "\C-cy" 'elip-restore)
(define-key database-view-mode-map "\C-cq" 'elip-quit)
(define-key database-view-mode-map "\C-cS" 'elip-shuffle) 
(define-key database-edit-mode-map "\C-cS" 'elip-shuffle)
(define-key database-edit-mode-map "\C-cq" 'elip-quit)
(define-key database-view-mode-map "\C-cs" 'elip-sort)
(define-key database-edit-mode-map "\C-cs" 'elip-sort)
(define-key database-view-mode-map "\C-cp" 'elip-dump-elisp)
(define-key database-edit-mode-map "\C-cp" 'elip-dump-elisp)
(define-key database-view-mode-map "\C-ca" 'elip-advance)
(define-key database-edit-mode-map "\C-ca" 'elip-advance)
(define-key database-view-mode-map "\C-cd" 'elip-delay)
(define-key database-edit-mode-map "\C-cd" 'elip-delay)

;; These cannot be in the database maps because can be used
;; outside of elip buffers.
(define-key global-map "\C-ch" 'elip-help)
(define-key global-map "\C-cc" 'elip-scan-text)
(define-key global-map "\C-cj" 'elip-goto-bookmark)
(define-key global-map "\C-cb" 'elip-set-bookmark)
;; conflicts with a disabled hyperdock command, which will
;; apply to almost no one.
(define-key global-map "\C-cT" 'elip-table-sort)
(define-key global-map "\C-c1" 'elip-mark-area)
(define-key global-map "\C-c2" 'elip-mark-question)
(define-key global-map "\C-c3" 'elip-done-marking)
;; try it here
(define-key global-map "\C-ck" 'elip-make-database)
)

(defun elip-tell-about-help ()
;; this seems like a good idea yah?
  (db-write-database-file (database-file dbc-database) t )
  (message "Type 'M-x elip-help RET' or 'C-ch' for a help screen")
)

(defun elip-dump-elisp()
"Display any and all elisp code in an ELIP database"
(interactive)
 (elip-check-db)
 (setq elip-overwrite-on-dump t)
 (if (get-buffer elip-local-dump-buffer)
   (setq elip-overwrite-on-dump (yes-or-no-p "Buffer exists, overwrite? ")))
 (if (not (equal t elip-overwrite-on-dump))
     (error "Buffer exists and won't be overwritten")  ; else
     (progn
       (get-buffer elip-local-dump-buffer)
       (switch-to-buffer elip-local-dump-buffer)
       (kill-region (point-min)(point-max))
       (delete-other-windows)
       (insert "Dump of elisp code in ELIP database ")
       (insert elip-data-path)
       (insert "/")
       (insert elip-data-buffer)
       (insert "\non ")
       (insert (calendar-date-string (calendar-current-date)))
       (insert "\n")
       (setq elip-dump-n 1)
       (setq elip-elisp-exists nil)
       (maprecords-macro
	(progn
	  (setq elip-question-text (record-field maprecords-record
					  'elip-question elip-db))
	  (setq elip-answer-text (record-field maprecords-record
					  'elip-answer elip-db))
	  (if (not (equal nil
	    (setq elip-code-seek (string-match "^#####" elip-question-text))))
	      (progn
		(setq elip-elisp-exists t)
		(insert "\n **** Elisp code found in record ")
		(insert (int-to-string elip-dump-n))
		(insert " question text ****\n\n")
		(insert elip-question-text)
		(insert "\n")
		))
	  (if (not (equal nil
	    (setq elip-code-seek (string-match "^#####" elip-answer-text))))
	      (progn
		(setq elip-elisp-exists t)
		(insert "\n **** Elisp code found in record ")
		(insert (int-to-string elip-dump-n))
		(insert " answer text ****\n\n")
		(insert elip-answer-text)
		(insert "\n")
		))
     (setq elip-dump-n (1+ elip-dump-n))
     ) elip-db )
     (if (not elip-elisp-exists)
	 (insert "\nNo Elisp code in this database\n"))
))
)

(defun elip-reduce-phrase (elip-phrase elip-percent)
"Taking a phrase and a percentage value, remove words at random 
the phrase, saving a certain percentage of the words.
Percentage output is approximate."
;; uses elip-split-string, a variant of split-string
(setq elip-phrase-words (elip-split-string elip-phrase))
(setq elip-phrase-word-count (length elip-phrase-words))
(if (< elip-phrase-word-count 2)
  (error "Phrase must be at least two words long"))
;; Build half the output phrase from the front
(setq elip-reduced-phrase "")
(setq elip-phrase-word-percent
 (max 1
  (truncate (/ (* (float elip-percent) (float elip-phrase-word-count)) 
             100))))
;; do the heavy lifting in a function - random select and tag
(elip-phrase-sort)
(setq elip-word-n 0)
(while (< elip-word-n elip-phrase-word-count)
 (if (= 1 (aref elip-phrase-tag elip-word-n))
;; use this word as is
  (setq elip-reduced-phrase (concat elip-reduced-phrase 
    (nth elip-word-n elip-phrase-words)))
;; don't use word-- much harder -- replace word with right
;; number of dashes and save white space as is!
  (progn
    (setq elip-work-word (nth elip-word-n elip-phrase-words))
    (setq elip-word-length (length elip-work-word))
    (setq elip-word-i 0)
    (while (< elip-word-i elip-word-length)
      (progn
	(setq elip-character 
	      (substring elip-work-word elip-word-i (1+ elip-word-i)) ) 
;; if not a special
	(if (and  (not (equal elip-character "\n"))
		  (not (equal elip-character "\t"))
		  (not (equal elip-character "\f"))
		  (not (equal elip-character "\f"))
		  (not (equal elip-character "\v"))
		  (not (equal elip-character " ")))
;; make an underline
	    (setq elip-reduced-phrase (concat elip-reduced-phrase "_"))
;; otherwise use as is
	    (setq elip-reduced-phrase 
		  (concat elip-reduced-phrase elip-character)))
	 (setq elip-word-i (1+ elip-word-i))
	))
    )
  )
  (setq elip-word-n (1+ elip-word-n))
 )
)

(defun elip-split-string (string)
  "Splits STRING into substrings where there are matches for SEPARATORS.
   Retain line separators, which is what differs from stock split-string."
  (let ((rexp "[ \f\t\n\r\v]+")
	(start 0)
	notfirst
	(list nil))
    (while (and (string-match rexp string
			      (if (and notfirst
				       (= start (match-beginning 0))
				       (< start (length string)))
				  (1+ start) start))
		(< (match-beginning 0) (length string)))
      (setq notfirst t)
      (or (eq (match-beginning 0) 0)
	  (and (eq (match-beginning 0) (match-end 0))
	       (eq (match-beginning 0) start))
	  (setq list
;; we changed match-beginning to match-end in the next line
		(cons (substring string start (match-end 0))
		      list)))
      (setq start (match-end 0)))
    (or (eq start (length string))
	(setq list
	      (cons (substring string start)
		    list)))
    (nreverse list)))

(defun elip-phrase-sort ()
"Given a phrase broken into a list of words, pick a
percentage of those words randomly."
;; Method: assign a random number and a sequence tag to each word in
;; the list.  Sort the random numbers, carrying along the sequence tags.
;; Change the random numbers to zero/one binary go/no-go tags by simply
;; selection the percent required from the front.  Then sort back into
;; numerical order using the sequence tags, carrying along the binary
;; tags.
;; set up randomization
    (setq elip-phrase-tag (make-vector elip-phrase-word-count 0))
    (setq elip-phrase-seq (make-vector elip-phrase-word-count 0))
    (setq elip-phrase-i 0)
    (while (< elip-phrase-i elip-phrase-word-count)
      (progn
;; set numerical order
	(aset elip-phrase-seq elip-phrase-i elip-phrase-i)
;; set randoms
	(aset elip-phrase-tag elip-phrase-i (random))
	(setq elip-phrase-i (1+ elip-phrase-i))))
;; now sort by random number
    (setq elip-phrase-i 0)
    (setq elip-phrase-j 0)
    (while (< elip-phrase-i elip-phrase-word-count)
     (progn
       (setq elip-phrase-j (1+ elip-phrase-i))
       (while (< elip-phrase-j elip-phrase-word-count)
         (progn
           (if (< (aref elip-phrase-tag elip-phrase-i) 
                  (aref elip-phrase-tag elip-phrase-j))
            (progn
              (setq elip-phrase-temp (aref elip-phrase-tag elip-phrase-j))
              (aset elip-phrase-tag elip-phrase-j (aref elip-phrase-tag elip-phrase-i))
              (aset elip-phrase-tag elip-phrase-i elip-phrase-temp)
              (setq elip-phrase-temp (aref elip-phrase-seq elip-phrase-j))
              (aset elip-phrase-seq elip-phrase-j 
		    (aref elip-phrase-seq elip-phrase-i))
	      (aset elip-phrase-seq elip-phrase-i elip-phrase-temp)))
           (setq elip-phrase-j (1+ elip-phrase-j)))))
        (setq elip-phrase-i (1+ elip-phrase-i)))
;; now change random number to binary go/nogo
    (setq elip-phrase-i 0)
    (while (< elip-phrase-i elip-phrase-word-count)
      (progn
	(if (<= elip-phrase-i elip-phrase-word-percent)
	    (aset elip-phrase-tag elip-phrase-i 1)
	    (aset elip-phrase-tag elip-phrase-i 0))
	(setq elip-phrase-i (1+ elip-phrase-i))
	))
;; now sort back by seq
    (setq elip-phrase-i 0)
    (setq elip-phrase-j 0)
    (while (< elip-phrase-i elip-phrase-word-count)
     (progn
       (setq elip-phrase-j (1+ elip-phrase-i))
       (while (< elip-phrase-j elip-phrase-word-count)
         (progn
           (if (> (aref elip-phrase-seq elip-phrase-i) 
                  (aref elip-phrase-seq elip-phrase-j))
            (progn
              (setq elip-phrase-temp (aref elip-phrase-tag elip-phrase-j))
              (aset elip-phrase-tag elip-phrase-j (aref elip-phrase-tag elip-phrase-i))
              (aset elip-phrase-tag elip-phrase-i elip-phrase-temp)
              (setq elip-phrase-temp (aref elip-phrase-seq elip-phrase-j))
              (aset elip-phrase-seq elip-phrase-j 
		    (aref elip-phrase-seq elip-phrase-i))
	      (aset elip-phrase-seq elip-phrase-i elip-phrase-temp)))
           (setq elip-phrase-j (1+ elip-phrase-j)))))
        (setq elip-phrase-i (1+ elip-phrase-i)))

)

(defun elip-set-bookmark ()
  "set bookmark at current point in current file"
  (interactive)
  (setq elip-bookmark-buffer (buffer-file-name))
   (if (eq elip-bookmark-buffer nil)
       (error "Temporary buffer - cannot associate with bookmark"))
  (setq elip-bookmark-point (point))
   (if (get-buffer ".eliprc")
	  (kill-buffer ".eliprc"))
   (if (find-file "~/.eliprc")
       (progn
	 (goto-char (point-min))
	 (if (search-forward (concat elip-bookmark-buffer ".elipbmk ") nil t)
;; replace existing bookmark
	     (progn
	       (kill-line)
	       (insert (int-to-string elip-bookmark-point)))
;; create new bookmark
	     (progn
	       (goto-char (point-min))
	       (open-line 1)
	       (insert (concat elip-bookmark-buffer ".elipbmk " 
                       (int-to-string elip-bookmark-point)))
	       )
           )
	       (save-buffer 0)
	       (kill-buffer (current-buffer))
	       (message "Bookmark set")
        )
        (error "Unable to open ~/.eliprc - cannot set bookmark"))
)

(defun elip-goto-bookmark ()
  "go to bookmark in current file if it exists"
   (interactive)
   (setq elip-bookmark-point -1)
   (setq elip-bookmark-buffer (buffer-file-name))
   (if (eq elip-bookmark-buffer nil)
       (error "Temporary buffer - cannot associate with bookmark"))
   (if (get-buffer ".eliprc")
	  (kill-buffer ".eliprc"))
   (if (find-file "~/.eliprc")
       (progn
	 (goto-char (point-min))
	 (if (search-forward (concat elip-bookmark-buffer ".elipbmk ") nil t)
;; found bookmark, read it
           (progn
	       (setq elip-point (point))
               (end-of-line)
	       (setq elip-bookmark-point (string-to-int (buffer-substring elip-point (point))))  )
;; no bookmark
	       (read-from-minibuffer "No bookmark found for this file.  Press ENTER."))
	 (kill-buffer (current-buffer)))
       (read-from-minibuffer "No bookmark found for this file.  Press ENTER."))
       (if (not (= elip-bookmark-point -1))
	   (goto-char elip-bookmark-point))
)

(defun elip-mark-area ()
"mark an area of text with triple curly brackets"
   (interactive)
   (setq elip-region-beginning (region-beginning))
   (setq elip-region-end (region-end))
   (narrow-to-region elip-region-beginning elip-region-end )
   (goto-char (point-max))
   (insert "}}}")
   (goto-char (point-min))
   (insert "{{{")
)

(defun elip-mark-question ()
"mark a small section of text with triple square brackets"
   (interactive)
   (setq elip-region-beginning (region-beginning))
   (setq elip-region-end (region-end))
   (if (> elip-region-beginning elip-region-end)
     (progn 
         (setq elip-temp elip-region-end)
	 (setq elip-region-end elip-region-beginning)
	 (setq elip-region-beginning elip-temp)))
   (goto-char elip-region-beginning)
   (insert "[[[")
   (goto-char elip-region-end)
   (insert "]]]")
)

(defun elip-done-marking ()
"finish with marking questions in a region"
   (interactive)
   (goto-char (point-max))
   (widen)
)