1
0
Fork 0

feat(emacs): make grade-start featureful

Signed-off-by: Lucas Sta Maria <lucas@priime.dev>
This commit is contained in:
Lucas Sta Maria 2024-02-02 17:26:15 -05:00
parent 84ca75c356
commit afb4172ae5
No known key found for this signature in database
GPG key ID: F07FB16A826E3B47

View file

@ -11,6 +11,7 @@
(require 'elfeed) (require 'elfeed)
(require 'neotree) (require 'neotree)
(require 'copilot) (require 'copilot)
(require 'seq)
(defun config-compile () (defun config-compile ()
"(Re)compile the current Emacs configuration." "(Re)compile the current Emacs configuration."
@ -183,34 +184,71 @@
("XXXX*" . "#ffffff"))) ("XXXX*" . "#ffffff")))
;; Grading ;; Grading
(defconst grading-directory-root "pl-grading"
"The root grading directory repository.")
(defun grade-file-format (num)
"Format NUM to a file in the grading directory."
(unless (eq major-mode 'dired-mode)
(error "Must be in Dired directory"))
(let* ((dir (dired-current-directory))
(dir-files (directory-files dir))
(extension ".rkt")
(all-rkt-files (-filter (lambda (f) (string= (file-name-extension f) "rkt"))
dir-files))
(all-rkt-files+ (-map #'file-name-sans-extension all-rkt-files))
(hw-files (-filter (lambda (f) (not (zerop (string-to-number f)))) all-rkt-files+))
(hw-files+ (seq-sort-by #'length #'> hw-files))
(digits (length (car hw-files+)))
(str-format (format "%%0%dd.rkt" digits)))
(format str-format num)))
(defun grade-next (&optional inc) (defun grade-next (&optional inc)
"Go to the next homework by INC to grade." "Go to the next homework by INC to grade."
(interactive) (interactive)
(let ((inc (or inc 1)) (let ((inc (or inc 1))
(grading-directory "pl-grading")
(extension ".rkt") (extension ".rkt")
(filepath (buffer-file-name (current-buffer)))) (filepath (buffer-file-name (current-buffer))))
(if (not (and (string-match-p grading-directory filepath) (if (not (and (string-match-p grading-directory-root filepath)
(string-match-p extension filepath))) (string-match-p extension filepath)))
(message (format "not in %s!" grading-directory)) (message (format "not in %s!" grading-directory-root))
(let* ((target-directory (file-name-directory filepath)) (let* ((target-directory (file-name-directory filepath))
(filename-parts (string-split filepath "/")) (filename-parts (string-split filepath "/"))
(source-filename (-last-item filename-parts)) (source-filename (-last-item filename-parts))
(source-number-str (file-name-sans-extension source-filename)) (source-number-str (file-name-sans-extension source-filename))
(source-number (string-to-number source-number-str)) (source-number (string-to-number source-number-str))
(target-number (+ inc source-number)) (target-number (+ inc source-number))
(target-number-str (format "%02d" target-number)) (target-filename (grade-file-format target-number))
(target-filename (format "%s.rkt" target-number-str))
(target-filepath (concat target-directory target-filename))) (target-filepath (concat target-directory target-filename)))
(if (file-exists-p target-filepath) (if (file-exists-p target-filepath)
(find-file target-filepath) (find-file target-filepath)
(message (format "next grading file doesn't exist!"))))))) (message (format "next grading file doesn't exist!")))))))
(defun start-grading () (defun grade-start (&optional start)
"Start grading." "Start grading in the current directory with homework START."
(interactive) (interactive)
(keymap-global-set "C-c f" #'grade-next) (keymap-global-set "C-c f" #'grade-next)
(keymap-global-set "C-c b" (lambda () (interactive) (grade-next -1)))) (keymap-global-set "C-c b" (lambda () (interactive) (grade-next -1)))
(let* ((start (or start 1))
(dir (if (eq major-mode 'dired-mode)
(dired-current-directory)
(error "Must be in Dired directory")))
(dir-path (file-name-directory dir)))
(if (not (string-match-p grading-directory-root dir-path))
(error "Must be in subdirectory of %s" grading-directory-root)
(let ((readme-file (concat dir-path "README.md"))
(solution-file (concat dir-path "solution.rkt"))
(start-file (concat dir-path (grade-file-format start))))
(find-file start-file)
(delete-other-windows)
(split-window-right)
(split-window-right)
(balance-windows)
(windmove-right)
(find-file solution-file)
(windmove-right)
(find-file readme-file)))))
(provide 'misc) (provide 'misc)
;;; misc.el ends here ;;; misc.el ends here