;;; grading.el --- For easily grading                -*- lexical-binding: t; -*-

;; Copyright (C) 2021  李俊緯

;; Author: 李俊緯 <mmemmew@gmail.com>
;; Keywords: convenience, matching, local, files

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This is to aid me in grading the students' test papers conveniently.

;;; Code:

;;;###autoload
(defvar grading-papers-dir nil
  "The directory that contains the test papers of students.")

;;;###autoload
(defvar grading-scores-dir nil
  "The directory that contains the scores of students.")

;;;###autoload
(defvar grading-current-paper nil
  "The name of the student that is currently being graded.")

;;;###autoload
(defvar grading-student-list nil
  "The list of all students' names.")

;;;###autoload
(defconst grading-ext-regexp (rx (or "pdf" "jpg" "jpeg" "png"))
  "The regular expression that matches the test papers.")

;;;###autoload
(defvar grading-retrieve-name-function #'grading-retrieve-name-default-function
  "The function that retrieves the name of the student.
It takes one argument, which is the name of the file, and should
return the name of the student.")

;;;###autoload
(defun grading-retrieve-name-default-function (file-name)
  "The default function to retrieve the name of the student.
See `grading-retrieve-name-function' for details."
  (cond ((or (not (stringp file-name))
             (string-empty-p file-name))
         (user-error "Invalid file name: %S" file-name)))
  (let* ((first-char (aref file-name 0))
         (cjkp
          (let ((name (get-char-code-property first-char 'name))
                (decomposition
                 (get-char-code-property first-char 'decomposition)))
            (or (and
                 (stringp name)
                 (string-match (rx-to-string '(seq bos "CJK"))
                               name))
                (eq (car decomposition) 'wide)))))
    (cond
     (cjkp (substring-no-properties file-name 0 3))
     ((file-name-base file-name)))))

;;;###autoload
(defun grading-start ()
  "Start grading the papers."
  (interactive)
  (grading-preprocess)
  (cond ((null grading-current-paper)
         (setq grading-current-paper (cons (car grading-student-list) 0))))
  (grading-display))

(defvar grading-map (make-keymap "Grading")
  "The keymap for use in `grading-minor-mode'.")

(define-key grading-map (vector 13) #'grading-grading)
(define-key grading-map (vector ?n) #'grading-next)
(define-key grading-map (vector ?p) #'grading-previous)
(define-key grading-map (vector ?\M-n) #'pdf-view-next-page-command)
(define-key grading-map (vector ?\M-p) #'pdf-view-previous-page-command)
(define-key grading-map (vector 'tab) #'grading-show)
(define-key grading-map (vector ?J) #'grading-jump)
(define-key grading-map (vector ?q) #'grading-quit)

;;;###autoload
(define-minor-mode grading-minor-mode
  "The minor mode for grading."
  :lighter "Gra"
  :keymap grading-map
  :init-value nil)

(autoload #'durand-delete-dups
  (expand-file-name "common.el" user-emacs-directory))

;;;###autoload
(defun grading-preprocess ()
  "Prepare some environments.
Store the name of every student to `grading-student-list'."
  (let* ((files (directory-files
                 grading-papers-dir nil
                 (concat grading-ext-regexp "$") t))
         (names (mapcar grading-retrieve-name-function files)))
    (setq grading-student-list
          (durand-delete-dups names :test #'string=))))

;;;###autoload
(defun grading-display ()
  "Display the current paper."
  (cond ((null grading-current-paper)
         (grading-preprocess)
         (setq grading-current-paper
               (cons (car grading-student-list) 0))))
  (let* ((student-papers (grading-find-student-papers
                          (car grading-current-paper)))
         (student-paper (nth (cdr grading-current-paper)
                             student-papers))
         (buffer (find-file-noselect
                  (expand-file-name student-paper
                                    grading-papers-dir))))
    (display-buffer buffer
                    '((display-buffer-in-tab
                       durand-display-in-one-window)
                      (tab-name . "grading")))
    (with-current-buffer buffer
      (rename-buffer (car grading-current-paper))
      (grading-minor-mode 1))))

;;;###autoload
(defun grading-grading ()
  "Give grades to the current paper."
  (interactive)
  (cond ((and (file-exists-p grading-scores-dir)
              (file-directory-p grading-scores-dir)))
        ((make-directory grading-scores-dir)))
  (let ((grade-file-name (expand-file-name
                          (concat (car grading-current-paper) ".tex")
                          grading-scores-dir)))
    (display-buffer (find-file-noselect grade-file-name)
                    '((display-buffer-at-bottom)
                      (window-height . 0.5)))
    (select-window
     (get-buffer-window (get-file-buffer grade-file-name)))))

;;;###autoload
(defun grading-show ()
  "Show the currently grading paper."
  (interactive)
  (message
   (format "Number: %d\n\
Students remaining: %d"
           (cdr grading-current-paper)
           (length
            (cdr
             (durand-member
              (car grading-current-paper)
              grading-student-list))))))

;;;###autoload
(defvar grading-student-history nil
  "This records the students that were chosen in
  `grading-jump'.")

;;;###autoload
(defun grading-jump (&optional arg)
  "Jump to a student's paper."
  (interactive "P")
  (cond
   ((and arg (numberp arg))
    (setq arg (mod arg (length grading-student-list)))
    (setq grading-current-paper
          (cons (nth (1- arg) grading-student-list) 0)))
   (t
    (let* ((student (completing-read "Jump to student: "
                                     grading-student-list nil t nil
                                     'grading-student-history)))
      (setq grading-current-paper
            (cons student 0)))))
  (grading-display))

;;;###autoload
(defun grading-next ()
  "Go to the next paper to be graded."
  (interactive)
  (kill-buffer (car grading-current-paper))
  (let ((len (grading-find-length-of-student (car grading-current-paper))))
    (cond ((null grading-current-paper)
           (setq grading-current-paper
                 (cons (car grading-student-list)
                       0))))
    (cond ((>= (1+ (cdr grading-current-paper))
               len)
           (cond
            ((cdr (member (car grading-current-paper)
                          grading-student-list))
             (setq grading-current-paper
                   (cons (cadr (member (car grading-current-paper)
                                       grading-student-list))
                         0)))
            ((message "The last student!"))))
          ((setq grading-current-paper
                 (cons (car grading-current-paper)
                       (1+ (cdr grading-current-paper)))))))
  (grading-display))

;;;###autoload
(defun grading-find-student-papers (student)
  "Return all papers of STUDENT."
  (directory-files grading-papers-dir
                   nil (concat "^" student ".*"
                               grading-ext-regexp)))

;;;###autoload
(defun grading-find-length-of-student (student)
  "Find the number of papers of STUDENT."
  (length (grading-find-student-papers student)))

;;;###autoload
(defun grading-previous ()
  "Go to the previous paper to be graded."
  (interactive)
  (kill-buffer (car grading-current-paper))
  (cond ((null grading-current-paper)
         (setq grading-current-paper
               (cons (car grading-student-list)
                     0))))
  (let* ((grading-student-list (reverse grading-student-list)))
    (cond ((= (cdr grading-current-paper) 0)
           (cond
            ((cdr (member (car grading-current-paper)
                          grading-student-list))
             (setq grading-current-paper
                   (cons (cadr (member (car grading-current-paper)
                                       grading-student-list))
                         (1-
                          (grading-find-length-of-student
                           (cadr (member (car grading-current-paper)
                                         grading-student-list)))))))
            ((message "The first student!"))))
          ((setq grading-current-paper
                 (cons (car grading-current-paper)
                       (1- (cdr grading-current-paper)))))))
  (grading-display))

;;;###autoload
(defun grading-quit ()
  "Quit grading."
  (interactive)
  (quit-window)
  (cond
   ((tab-bar--tab-index-by-name "grading")
    (tab-bar-close-tab
     (1+ (tab-bar--tab-index-by-name "grading"))))))

(provide 'grading)
;;; grading.el ends here