;;; 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

(defun grading-help ()
  "Help set things up."
  (interactive)
  (setq grading-papers-dir default-directory)
  (setq grading-scores-dir
        (expand-file-name
         "grades"
         (file-name-directory
          (directory-file-name
           default-directory))))
  (grading-preprocess)
  (setq grading-current-paper (cons (car grading-student-list) 0)))
(defun grading-merge ()
  "Merge the grading with the student paper."
  (interactive)
  (let ((result-dir
         (expand-file-name
          "results"
          (file-name-directory
           (directory-file-name
            grading-scores-dir)))))
    (mapc
     (lambda (name)
       (let ((student-paper
              (directory-files
               grading-papers-dir t
               (rx-to-string bos (eval name) (1+ any) ".pdf" eos) t 1)
              ;; (expand-file-name
              ;;  (concat name ".pdf")
              ;;  grading-papers-dir)
              )
             (grade-paper
              (expand-file-name
               (concat name ".pdf")
               grading-scores-dir))
             (result-paper
              (expand-file-name
               (concat name ".pdf")
               result-dir)))
         (cond
          ((= (length student-paper) 1)
           (setq student-paper (car student-paper)))
          ((user-error "Cannot find paper for %s" name)))
         (cond
          ((and (file-exists-p grade-paper)
                (not (file-exists-p result-paper)))
           (start-process
            (format "merge-%s" name)
            (get-buffer-create
             (format "*grading-merge %s*" name))
            "gs"
            "-sDEVICE=pdfwrite" "-dCompatibilityLevel=1.4"
            "-dPDFSETTINGS=/default" "-dNOPAUSE" "-dQUIET" "-dBATCH"
            "-dDetectDuplicateImages" "-dCompressFonts=true" "-r150"
            (format "-sOutputFile=%s" result-paper)
            student-paper grade-paper result-paper)))))
     grading-student-list)))