;; -*- Mode:Emacs-Lisp -*-				    
;; gradebook.el -- major mode for keeping a simple plain-text gradebook
;; Version: 0.1
;; Author: Hans Halvorson (www.princeton.edu/~hhalvors)
;; Time-stamp: <2006-12-20 05:39:14 hhalvors>

;; gradebook-mode allows you to do calculations (arbitrary elisp
;; functions) on columns and insert the result in a new column.  It
;; also allows you to do functions whose argument is a list
;; (e.g. median, mean, mode) on the rows, and insert the result as a
;; new row.  I use it to keep a gradebook, but in theory it could be
;; used for any numeric data.  It does not have anything close to the
;; functionality of a full-blown spreadsheet mode (e.g. ses.el), but
;; it has the advantage that your data is kept in plain unformatted
;; text.
;;
;; Here is what the gradebook buffer might look like:
;;
;; [--begin buffer--]
;;            hw1     hw2     hw3     mt	
;;
;; Key        24      40      35      16        
;;
;; Kurt       24      40      34      16	
;;
;; Derek      24      39      29      15	
;;
;; Hoyt       23      27      35      15.5      
;;
;;
;;
;; (compute-grades "hw-avg" '(/ 3 (+ hw1 hw2 hw3)))
;;
;; [--end buffer--]
;;
;; You must manually create the row names.  Leave at least one empty
;; line above the row names for the column headings.  You do not have
;; to separate the lines with spaces, but it's easier to read if you
;; do.  There are two functions for addings columns, and one function
;; for adding rows:
;;
;; 1. The function "enter-grades" lets you input a column of "atomic"
;; grades, i.e. grades that are not calculated from other grades.  It
;; will ask for a column name.  Then it ask for the student names (the
;; names that label the rows); pressing TAB will autocomplete the
;; names.  Then it will ask for the grade.  It will exit after all
;; students have been assigned a grade, or you can press "C-g" to exit
;; the process.
;;
;; 2. The function "compute-grades" lets you compute a new column from
;; other columns.  It takes two arguments: the first is a string to
;; name the column, and the second is a a formula whose only free
;; variables are the column names.  (Sorry, no recursive formulas
;; allowed!)  (Note, the free variables should be symbols, not
;; strings, as in "(/ hw2 0.40)".)  By the way, if your formula
;; contains no decimal numbers, and the input numbers are not
;; decimals, then the output will be an integer -- this is just a
;; feature of emacs-lisp.  If you want to see decimals, then just make
;; sure that the formula has decimal numbers, e.g. use "(/ hw1 2.0)"
;; rather than "(/ hw1 2)"; then everything is converting to floats.
;;
;; 3. The function "make-row-from-function" lets you compute a new row
;; from the existing rows.  In this case, the function should take a
;; list as an argument.  For example, you could use the function "(/
;; (apply '+ list) (length list))" to get the average of the rows.
;;
;; If at any time you manually add a new row, you should do "M-x
;; get-row-names" to refresh the list "row-names".
;;
;; Two cautions: 1. You must use monospaced fonts, or everything will
;; look like crap.  2. You must use these functions while in
;; "gradebook-mode", more particularly while using the syntax table
;; from gradebook-mode.  In the calculation function, we use
;; "number-at-point" (from thingatpt.el) which does not see decimals
;; when in some modes (e.g. text mode).


(require 'thingatpt)

;; with the text-mode syntax table, the "number-at-point" function
;; does not recognize floating point numbers (decimals).  So, we use
;; the following modification to the syntax table.

(defvar gradebook-mode-syntax-table
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?. "_   " table)
    table))

;; run get-col-names and get-row-names upon startup

(defun gradebook-mode()
   (interactive)
   (setq major-mode 'gradebook-mode)
   (setq mode-name "Gradebook")
   (setq column-number-mode t)
   (set-syntax-table gradebook-mode-syntax-table)
   (get-col-names)
   (get-row-names))


(defgroup gradebook nil
  "Trivial spreadsheet functions."
  )

;; I originally intended for the gradebook table to begin at the
;; beginning of the buffer (so that the column headings are on the
;; first line).  But this can easily be changed by customizing the
;; grade-table-begin variable

(defcustom grade-table-begin 1
  "*Line on which the column headings can be found."
  :group 'gradebook)

;; the get-row-names function grabs the row names and numbers by
;; searching forward according to grade-row-regexp.  But sometimes we
;; might want text futher down in the buffer that matches the regexp,
;; but that is not a row name. To deal with this, set grade-table-end
;; to some value that occurs before the text that you want to ignore.

(defcustom grade-table-end 'point-max
  "*Where to stop looking for gradebook rows."
  :group 'gradebook)


;; col name regexp

(defcustom grade-col-regexp " [a-z0-9]+"
  "*The regular expression that is used to identify columns.
This regexp must uniquely identify the columns among the strings
on the first line of the gradebook file.  The column numbers are
then set to the first character in each string that matches this
regexp."
  :group 'gradebook)

;; row name regexp

(defcustom grade-row-regexp "^[A-Z]+"
  "*The regular expression that is used to identify rows.  The
default is an alphabetic string that starts a line."
  :group 'gradebook)

;; how many spaces between columns?

(defcustom grade-col-width 6
  "*The distance from the beginning of one column to the beginning of the next."
  :group 'gradebook)

(defcustom grade-key-name "Key"
  "*The name of the row that contains the total possible points for each assignment or exam."
  :group 'gradebook)

;; on to the functions

(defun get-col-names ()
  "Make an alist of column titles and numbers; use
grade-col-regexp to identify column names."
  (interactive)
  (setq col-names '())
  (save-excursion
  (goto-char (point-min))
  (forward-line)
  (let ((my-bound (point)))
  (goto-char (point-min))
  (while (re-search-forward grade-col-regexp my-bound t)
    (goto-char (+ 1 (match-beginning 0)))
        ;; remove whitespace from assignment names
    (add-to-list 'col-names (cons (intern (replace-regexp-in-string "[ ]+" "" (match-string-no-properties 0))) (current-column)))))
  (setq col-names (reverse col-names)))
)

(defun get-row-names ()
  "Make an alist of row titles and numbers; use grade-row-regexp
to identify row names."
  (interactive)
  (setq row-names '())
  (save-excursion
    (goto-char (point-min))
  (while (re-search-forward "^[A-Z]+" nil t)
    (add-to-list 'row-names (cons (match-string-no-properties 0) (line-number-at-pos))))
  (setq row-names (reverse row-names))))

;; auxiliary function: remove element from list

(defun grd-remove-element (element list)
       "Remove elements from list, if it occurs."
       (cond
        ((not list) nil)
        ((eq element (car list))
	 (grd-remove-element element (cdr list)))
        (t (cons (car list) (grd-remove-element element (cdr list))))))

;; there are two ways to add columns 
;; 1. add manually = enter-grades
;; 2. compute from previous columns and some formula whose variables
;; are column labels = compute-grades

(defun enter-grades (title)
  (interactive "MColumn name: ")
  (save-excursion 
    (goto-char (point-min))
    ;; the new column should be col-width spaces to the right of the
    ;; greater of (1) the longest row name, (2) the rightmost of the
    ;; previously entered columns
    (let* ((max-row-name (apply 'max (mapcar 'length (mapcar 'car row-names))))
	   (new-col 
	    (+ grade-col-width 
	       (or (cdr (car (reverse col-names))) max-row-name))))
      ;; go to one place before new column, because we will insert one white space
      (move-to-column (- new-col 1) t)
      ;; add one white space before title
      (insert (concat " " title))
      (let ((studs row-names))
	(while studs
	  (let ((stud-name (completing-read "Student name: " studs)))
	    (goto-line (cdr (assoc stud-name studs)))
	    (move-to-column new-col t)
	    (insert (read-from-minibuffer "Grade: "))
	    (setq studs (grd-remove-element (assoc stud-name studs) studs)))))))
  (get-col-names))


(defun compute-grades (column-name formula)
;; column-name is a string that names the column, and formula is a
;; sexp that contains a formula whose only free variables are column
;; names
  "Compute a column as a function of other columns."
  (save-excursion
        (let* ((max-row-name (apply 'max (mapcar 'length (mapcar 'car row-names))))
	       (new-col 
		(+ grade-col-width 
		   (or (cdr (car (reverse col-names))) max-row-name))))
      (goto-char (point-min))
      ; one character before new column
      (move-to-column (- new-col 1) t)
      ; add one white space before the column name, so we can match the regexp
      (insert (concat " " column-name))
      (setq goo-lines (mapcar 'cdr row-names))
      (while goo-lines
	  (setq current-line (car goo-lines))
	  (goto-line current-line)
	  (move-to-column new-col t)
	  ; (insert (number-to-string (formula-on-line formula current-line)))
	  (insert (format "%.4g" (formula-on-line formula (car goo-lines))))
	  (setq goo-lines (cdr goo-lines)))))
  (get-col-names))


(defun formula-on-line (formula line-number)
  "Given a formula whose free variables are column names, and a
line-number, substitute the corresponding values in the formula."
  (bind-vars-by-line line-number)
  (eval formula))

;; TO DO: fix so that these bindings are not permanent and global!!

(defun bind-vars-by-line (line-number)
  "Binds column name symbols to numbers that occur on
line-number."
  (save-excursion
  (goto-line line-number)
  (let ((foobar col-names))
    (while foobar
      (move-to-column (cdr (car foobar)))
      (set (car (car foobar)) (number-at-point))
      (setq foobar (cdr foobar))))))

;; the use of the 'number-at-point' function from 'thing-at-point.el'
;; depends on the buffer syntax table.  For example, in text mode, it
;; thinks that a number before a decimal is a complete sexp (that's
;; bad, because then our functions cannot see floating point numbers),
;; whereas in emacs lisp mode, it treats the entire number as the
;; sexp.  For example, if in text-mode you put the cursor on the "9"
;; in "98.5" and eval (number-at-point), it returns 98.  If you are in
;; emacs-lisp-mode, it returns 98.5.


(defun make-row-from-function (row-name function)
  "Compute a new row by applying a function."
  ;; the function must be one that can take an arbitrary number of arguments, e.g. '+
  (interactive)
  (save-excursion
  (let ((last-row-number (apply 'max (mapcar 'cdr row-names))))
    (goto-line (+ 1 last-row-number)))
  (insert (concat "\n" row-name))
  ;; remove from row list any row whose title is the string kept in grade-key-name
  (let ((reduced-row-list (grd-remove-element (assoc grade-key-name row-names) row-names))
	(my-columns (mapcar 'cdr col-names)))
    (while my-columns
      (move-to-column (car my-columns) t)
      (insert (format "%.4g" (function-on-column function (car my-columns) (mapcar 'cdr reduced-row-list))))
      (setq my-columns (cdr my-columns))))))


(defun function-on-column (function col-num row-list)
  "Apply FUNCTION to numbers in a column."
  ;; the function must be one that takes lists as its argument
  ;;
  ;; we can define such a function from, say, + by using 
  ;; (defun adder (list) (apply '+ list))
  (save-excursion
    (let ((num-list (make-number-list col-num row-list)))
      (if num-list
	  (funcall function num-list)
	(message "Did not find any numbers in the column.")))))


(defun make-number-list (col-num row-list)
  "Grab numbers from COL-NUM that occur on the rows in ROW-LIST."
  (save-excursion
    (let ((num-list '()))
      (while row-list
	(goto-line (car row-list))
	(move-to-column col-num)
	;; don't use 'add-to-list', that is like set theoretic union
	; (add-to-list 'num-list (cons (car row-list) (number-at-point)))
	(setq num-list (cons (number-at-point) num-list))
	(setq row-list (cdr row-list)))
    num-list)))

;; auxiliary function

(defun grd-list-memb (number list)
  (car (nthcdr number list)))

(provide 'gradebook)

;; gradebook.el ends here