;;; -*- emacs-lisp -*-
;;; 
;;; This file contains functions for manipulating/marking assignments

;;; Desired functionality:
;;; * Insert/edit comments -- Done
;;; * Insert/edit global comments
;;; * Save semi-marked file 
;;; * diff file against original
;;; * Insert/edit final marks -- Done
;;; * Commit changes

;;; also:
;;; * get a list of all projects that you need to mark
;;; * see what marks people got
;;; * See what you have already marked

;;; --- helper functions ---

;;; A comment looks like:
;;;                     ^        
;;; + ========================================== +
;;; +                                            +
;;; ...                                        ...
;;; +                                            +
;;; + ========================================== +
;;; 
;;; Note the lack of line numbers

;; Configuration options

(defvar cm-comment-width 60
  "Width of comment text")

(defvar cm-hide-line-numbers t
  "Whether line numbers are hidden.")

(defvar cm-standard-comments-alist '()
  "Maps comment tags to comments.")

(defvar cm-standard-comments-history '()
  "History for standard comments.")
 
(defvar cm-comment-pointer-regexp "^[ ]*\\^$"
  "Comment regexp delimiting the start of a comment region")

(defvar cm-comment-start-regexp "^[ ]*[+] =+ [+]"
  "Comment regexp delimiting the start of a comment region")

(defvar cm-comment-middle-regexp "^[ ]*[+] \\(.*[^[:space:]]?\\)[ ]*[+]$"
  "Comment regexp delimiting the middle of a comment region")

(defvar cm-comment-end-regexp "^[ ]*[+] =+ [+]$"
  "Comment regexp delimiting the start of a comment region")

(defvar cm-perfmark-regexp "^!!perfmark.*[ \t]+\\([0-9]*\\)/\\([0-9]*\\)$"
  "Regexp describing the perfmark line.")

(defvar cm-automark-fail-regexp "^Test *[0-9]* (\\([0-9]*\\))[\t]*[^!]*\\(!!FAILed.*\\)$"
  "Regexp for a line containing an automark failure.")

(defvar cm-automark-pass-regexp "^Test *[0-9]* (\\([0-9]*\\))[\t]*[^!]*\\(!!PASSed.*\\)$"
  "Regexp for a line containing an automark pass.")

 ;;; -rw-r-----    1 cs3231   cs3231       3220 May 23 11:49 kern/include/thread.h
(defvar cm-filename-regexp "^=+\n.* \\([^[:space:]]*\\)\n=+"
  "Regexp for a file banner.")

;;          Performance and Correctness ..  (9)	____
(defvar cm-mark-regexp "^.* (\\([0-9]+\\))\t\\([0-9.]+\\|____\\|\.\\)$"
  "Regexp for a mark entry.")

(defvar cm-font-lock-keywords c-font-lock-keywords
  "Keywords for font-lock mode.")

(defun cm-comment-helper-p (re)
  (save-excursion
    (save-restriction
      (widen)
      (beginning-of-line)
      (looking-at re))))

(defun cm-comment-pointer-p ()
  "Whether or not current line is a comment pointer"
  (cm-comment-helper-p cm-comment-pointer-regexp))

(defun cm-comment-start-p ()
  "Whether or not current line starts a comment"
  (cm-comment-helper-p cm-comment-start-regexp))

(defun cm-comment-middle-p ()
  "Whether or not current line is in the middle of a comment"
  (cm-comment-helper-p cm-comment-middle-regexp))

(defun cm-comment-end-p ()
  "Whether or not current line ends a comment"
  (cm-comment-helper-p cm-comment-end-regexp))

(defun cm-in-comment-p ()
  "Whether or not arg is in a valid comment"
  (or (cm-comment-pointer-p) (cm-comment-start-p) (cm-comment-middle-p) (cm-comment-end-p)))

 ;;; Assumes we are in a comment or at the pointer already
(defun cm-goto-pointer ()
  "Moves point to the first line of the comment"
  (cond ((cm-comment-pointer-p) (re-search-forward cm-comment-pointer-regexp))
	(t (re-search-backward cm-comment-pointer-regexp)))
  (beginning-of-line)
  (re-search-forward "\\^")
  (goto-char (- (point) 1))
  )

 ;;; Assumes we are in a comment or at the pointer already
(defun cm-goto-start ()
  "Moves point to the end of the comment"
  (cm-goto-pointer)
  (forward-line 1))

 ;;; Assumes we are in a comment or at the pointer already
(defun cm-goto-end ()
  "Moves point to the end of the comment"
  (when (cm-comment-pointer-p)
    (forward-line 2))
  (cond ((cm-comment-end-p) (end-of-line))
	(t (re-search-forward cm-comment-end-regexp)))
  (forward-line 2))

(defun cm-comment-pointer ()
  "Returns the character this comment is pointing to"
  (save-excursion
    (cm-goto-pointer)))

(defun cm-do-insert-line (width offset start-marker end-marker line)
  (insert (make-string offset ?\ ) start-marker)
  (insert line)
  (let* ((delta (- width (length line)))
	 (spaces (if (> delta 0) delta 0)))
    (insert (make-string spaces ?\ ) end-marker)))

(defun cm-line-sizes (lines)
  (mapcar 'length lines))

(defun cm-do-insert-comment (position lines)
  "Inserts comment pointing at marker"
  (goto-char position)
  (let* ((inhibit-read-only t)
	 (delta (current-column))
	 (width (+ (eval (cons 'max (cm-line-sizes lines))) 1))
	 (offset (if (> delta width)
		     (+ (- delta width) 3)
		   1)))
    (end-of-line)
    (insert "\n" (make-string delta ?\ ) "^\n"
	    (make-string offset ?\ ) "+ " (make-string (- width 1)  ?=) " +\n")

    (mapcar (lambda (a) (cm-do-insert-line width offset  "+ " "+\n" a))
	    lines)

    (insert (make-string offset ?\ ) "+ " (make-string (- width 1)  ?=) " +\n")))

(defun cm-do-replace-or-insert (lines marker)
  (let ((buffer (current-buffer)))
    (switch-to-buffer (marker-buffer marker))
    (save-excursion
      (goto-char (marker-position marker))
      (if (cm-in-comment-p)
	  (progn
	    (save-excursion 
	      (cm-goto-pointer)
	      (setq marker
		    (let ((column (current-column)))
		      (forward-line -1)
		      (move-to-column column)
		      (point-marker))))
	    (cm-delete-comment)))

      (cm-do-insert-comment (marker-position marker) lines))))

(defun cm-delete-comment ()
  (interactive)
  (let ((inhibit-read-only t))
    (save-excursion
      (let ((inhibit-read-only t))
	(cm-goto-pointer)
	(beginning-of-line)
	(let ((start (point)))
	  (cm-goto-end)
	  (delete-region start (point)))))))

;;; Functions for dealing with standard comments
(defun cm-read-tag ()
  (list (completing-read "Comment: " cm-standard-comments-alist nil t nil 'cm-standard-comments-history)))

(defun cm-insert-standard-comment (tag)
  (interactive (cm-read-tag))
  (let ((cell (assoc tag cm-standard-comments-alist)))
    (when cell
      (cm-do-replace-or-insert (cdr cell)  (point-marker)))))

;;; General function for comments
(defun cm-done-with-buffer ()
  (interactive)
  (goto-char (point-min))
  (let ((lines (cm-get-buffer-lines))
	(buffer (current-buffer)))
    (apply cm-comment-function lines cm-comment-args)
    (switch-to-buffer buffer)
    (delete-windows-on buffer)
    (kill-buffer buffer)))

(defun cm-open-buffer (function lines &rest args)
  (save-excursion
    (let ((buffer (generate-new-buffer (concat (buffer-name) "-comment")))
	  (old-buffer (current-buffer))
	  (marker (point-marker)))

      (switch-to-buffer-other-window buffer)

      (mapcar (lambda (a) (cm-do-insert-line 0 0 "" "\n" a))
	      lines)

      (make-local-variable 'cm-comment-args)
      (make-local-variable 'cm-comment-function)
      
      (setq cm-comment-args args)
      (setq cm-comment-function function)

      (local-set-key "\C-c\C-c" 'cm-done-with-buffer)
      (message "C-c C-c when finished")
      )))

(defun cm-open-comment-buffer (lines)
  (cm-open-buffer 'cm-do-replace-or-insert lines (point-marker)))

(defun cm-add-comment-to-alist (tag lines)
  (setq cm-standard-comments-alist 
	(cons (cons tag lines) cm-standard-comments-alist)))
  
(defun cm-do-add-standard-comment (lines)
  (let ((tag (read-string "Comment tag: ")))
    (when (not (equal tag ""))
      ;; Update standard comment file 
      (with-current-buffer
	  (get-buffer-create "*standard-comments*")
	(insert "(cm-add-comment-to-alist " (prin1-to-string tag) " '" (prin1-to-string lines) ")\n" ))
      (cm-add-comment-to-alist tag lines))))

(defun cm-open-standard-comment-buffer (lines)
  (cm-open-buffer 'cm-do-add-standard-comment lines))

(defun cm-add-standard-comment ()
  "Insert or edit the comment at the point and insert into the standard comments."
  (interactive)
  (cm-open-standard-comment-buffer 
   (cond ((not (cm-in-comment-p)) nil)
	 (t (progn (cm-goto-start) 
		   (cm-do-extract-comment-lines))))))

;;; Functions for dealing with comment buffer
(defun cm-get-buffer-lines ()
  "Get the index of lines in the current buffer"
  (cond ((= (point) (point-max)) nil)
	(t (let ((pt (point)))
	     (end-of-line)
	     (cons (buffer-substring pt (point)) 
		   (progn (forward-line)
			  (cm-get-buffer-lines)))))))

(defun cm-do-extract-comment-lines ()
  (forward-line)
  (cond ((looking-at cm-comment-end-regexp) nil)
	((looking-at cm-comment-middle-regexp) 
	 (cons (match-string 1)
	       (cm-do-extract-comment-lines)))
	 (t nil)))

(defun cm-insert-edit-comment ()
  "Insert or edit the comment at the point"
  (interactive)
  (cm-open-comment-buffer 
   (cond ((not (cm-in-comment-p)) nil)
	 (t (progn (cm-goto-start) 
		   (cm-do-extract-comment-lines))))))


(defun cm-extract-all-comments ()
  "Extracts all comments in this file to a new buffer"
  (interactive)
  (switch-to-buffer-other-window
   (let ((buffer  (generate-new-buffer (concat (buffer-name) "-comments"))))
     (save-excursion
       (goto-char (point-min))
       (while (re-search-forward cm-comment-pointer-regexp nil t)
	 (forward-line)
	 (let ((lines (cm-do-extract-comment-lines))
	       (current-buffer (current-buffer)))
	   (with-current-buffer buffer
	     (mapcar (lambda (a) (cm-do-insert-line 0 0 "" "\n" a)) 
		     lines)))))
     buffer)))


 ;;; Automark stuff

(defun cm-make-in-range (bottom number top)
  (cond ((< number bottom)  0)
	((> number top) top)
	(t number)))

(defun cm-update-perfmark (delta)
  (save-match-data 
    (goto-char (point-min))
    (re-search-forward cm-perfmark-regexp)
    (let* ((mark (string-to-number (match-string 1)))
	   (max-mark (string-to-number (match-string 2)))
	   (upd-mark (+ delta mark))
	   (inhibit-read-only t))
      (replace-match (number-to-string (cm-make-in-range 0 upd-mark max-mark))
				       nil nil nil 1))))

;; Adjusts automark on current line to fail
(defun cm-automark-line-to-fail (&optional comment)
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at cm-automark-pass-regexp)
	(let ((inhibit-read-only t))
	  (replace-match "!!FAILed (-\\1) <= Adjusted by marker"
			 t nil nil 2)
	  (cm-update-perfmark (- 0 (string-to-number (match-string 1)))))
      (message "This line doesn't contain a passed autotest!"))))

;; Adjusts automark on current line to pass
(defun cm-automark-line-to-pass (&optional comment)
  (interactive)
  (save-excursion
    (beginning-of-line)
    (if (looking-at cm-automark-fail-regexp)
	(let ((inhibit-read-only t))
	  (replace-match "!!PASSed <= Adjusted by marker"
			 t nil nil 2)
	  (cm-update-perfmark (string-to-number (match-string 1))))
      (message "This line doesn't contain a failed autotest!"))))

 ;;; Mark stuff
(defun cm-in-marktab ()
  (save-excursion
    (save-match-data
      (re-search-backward "^!!")
      (looking-at "^!!marktab"))))

(defun cm-read-mark ()
  (save-excursion
    (beginning-of-line)
    (list 
     (if (and
	  (cm-in-marktab)
	  (looking-at cm-mark-regexp))
	 (read-string (concat "Mark (max. " (match-string 1) "): "))
       (progn (message "Not on a valid mark line!") "")))))

(defun cm-adjust-mark-on-line (mark)
  "Adjust the mark on the current line"
  (interactive (cm-read-mark))
  (save-excursion
    (beginning-of-line)
    (when (and (not (equal  "" mark))
	       (string-match "^[.0-9]+$" mark)
	       (looking-at cm-mark-regexp))
      (let ((max-mark (string-to-number (match-string 1)))
	    (value (string-to-number mark))
	    (inhibit-read-only t))
	(cond ((or (< value 0) (> value max-mark))
	       (message "Not in range!"))
	      (t (replace-match mark nil nil nil 2)))))))

(defun cm-next-file ()
  (interactive)
  (re-search-forward cm-filename-regexp nil t))

(defun cm-make-lines-invisible ()
  (interactive)
  (save-excursion
    (while (looking-at "^ *[0-9]+\t")
      (beginning-of-line)
      (let* ((start (match-beginning 0))
	     (end (match-end 0))
	     (overlay (make-overlay start end)))
	(overlay-put overlay  'invisible 'cm-line-numbers)
	(overlay-put overlay  'intangible 'cm-line-numbers)
	(overlay-put overlay  'priority 1)
	(forward-line)))))

(defun cm-make-crs-invisible ()
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "\\(\r\\)" nil t)
      (let* ((start (match-beginning 0))
	     (end (match-end 0))
	     (overlay (make-overlay start end)))
	(overlay-put overlay  'invisible 'cm-carriage-returns)
	(overlay-put overlay  'intangible 'cm-carriage-returns)
	(overlay-put overlay  'priority 1)))))
      

(defun cm-symname (name)
  (concat "cm-" name))

(defun cm-make-file-invisible ()
  (interactive)
  (save-excursion
    (re-search-backward cm-filename-regexp)
    (goto-char (+ (match-end 0) 1))
    (let ((symname (intern (cm-symname (match-string-no-properties 1))))
	  (start (point)))
      (add-to-invisibility-spec symname)
      (forward-line)
      (re-search-forward "^=====\\|!!section")
      (beginning-of-line)
      (let* ((end (point))
	     (overlay (make-overlay start end)))
	(overlay-put overlay  'invisible symname)
	(overlay-put overlay  'intangible symname)
	(overlay-put overlay  'priority 2)))))

(defun cm-make-file-visible ()
  (interactive)
  (re-search-backward cm-filename-regexp)
  (let ((symname (intern-soft (cm-symname (match-string-no-properties 1)))))
    (when symname
      (remove-from-invisibility-spec symname))))

;;; Mode stuff
(defun cm-undo ()
  (interactive)
  (let ((inhibit-read-only t))
    (undo)))

(defun cm-saved-filename (name)
  (concat name ".xpend"))

(defun cm-saved-filename-p (name)
  (save-match-data
    (string-match ".*\.xpend$" name)))

(defun cm-saved-file-exists-p (name)
  (file-exists-p (cm-saved-filename name)))

(defun cm-output-time-marking ()
  (let* ((now (current-time))
	 (high-now (car now))
	 (low-now (cadr now))
	 (high-then (car cm-time-started))
	 (low-then (cadr cm-time-started))
	 (time  (+ (* (- high-now high-then) 65536) 
		   (- low-now low-then)))
	 (output (concat (buffer-name) " " 
			 (number-to-string (/ time 60)) " minutes " 
			 (number-to-string (mod time 60)) " seconds")))
    (with-current-buffer
	(get-buffer-create "*marking-times*")
      (message output)
      (insert (concat output "\n")))))


;;; dired support

(defun cse-mark-mode ()
  (interactive)
  ;; Check file hasn't already been marked
  (when (and (not (cm-saved-filename-p (buffer-file-name)))
	     (cm-saved-file-exists-p (buffer-file-name)))
    (when (y-or-n-p "Marked file exists --- edit instead? ")
      (let ((buffer (find-file-noselect (cm-saved-filename (buffer-file-name))))
	    (old-buffer (current-buffer)))
	(switch-to-buffer buffer)
	(kill-buffer old-buffer))))

  ;; Write the file to .xpend
  (add-hook 'local-write-file-hooks (lambda ()
				      (unless (cm-saved-filename-p (buffer-file-name))
					(set-visited-file-name (concat  (buffer-file-name) ".xpend")))))

  ;; Record time spend marking this assignment
  (make-local-variable 'cm-time-started)
  (setq cm-time-started (current-time))
  
  (make-local-variable 'kill-buffer-hook)
  (add-hook 'kill-buffer-hook 'cm-output-time-marking)
  (setq buffer-read-only t)

;; This looks ugly with the comments and slows it down ... :(
  (add-to-invisibility-spec 'cm-carriage-returns)

;;   (save-excursion 
;;     (when cm-hide-line-numbers
;;       (add-to-invisibility-spec 'cm-line-numbers)
;;       (while (cm-next-file)
;; 	(forward-line 2)
;; 	(cm-make-lines-invisible))))

  ;; Font-lock mode stuff
;;  (make-local-variable 'font-lock-defaults)
;;  (setq font-lock-defaults 
;;	'((c-font-lock-keywords c-font-lock-keywords-1
;;				c-font-lock-keywords-2 c-font-lock-keywords-3)
;;	  nil nil ((?_ . "w")) beginning-of-defun
;;	  (font-lock-mark-block-function . mark-defun)))

  ;; Standard comments
  ;;(make-local-variable 'cm-last-standard-comment)

  (local-set-key "\C-_" 'cm-undo)

  ;; inserting/editing/deleting comments
  (local-set-key "\C-cc" 'cm-insert-edit-comment)
  (local-set-key "\C-cd" 'cm-delete-comment)
  
  ;; standard comments
  (local-set-key "\C-cs" 'cm-insert-standard-comment)
  (local-set-key "\C-cS" 'cm-add-standard-comment)

  (local-set-key "\C-cn" 'cm-next-file)
  (local-set-key "\C-cm" 'cm-adjust-mark-on-line)
  (local-set-key "\C-cp" 'cm-automark-line-to-pass)
  (local-set-key "\C-cf" 'cm-automark-line-to-fail)
  (local-set-key "\C-c\C-v" 'cm-extract-all-comments)
  (local-set-key "\C-c\C-h" 'cm-make-file-invisible)
  
  )

;;;(provide 'cse-mark-mode)