A simple minor mode for Google Code Jam and similar programming competitions

competition.el

;;; A simple minor mode for programming competitions. -*- lexical-binding: t -*-

;; competition.el 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.

;; Improvement ideas:
;;
;; * Add a keybinding that will prompt for a test name, e.g. `A-small', then
;;   open `test/A-small.in' and `test/A-small.out' in two windows.
;;
;; * Add a keybinding that will prompt for the name of an existing test, e.g.
;;   `A-small', then run the program with `test/A-small.in' as the input.
;;
;;   When the program finishes, if there's a `test/A-small.out', it will be
;;   compared with the program output and a message will be displayed in the
;;   minibuffer, e.g. "Output correct (time 0:12, RSS 51 MB)" or "Outputs differ
;;   from line 25 (time 0:12, RSS 51 MB)". If there's no file with the expected
;;   output, the actual output will simply be displayed in a window.
;;
;; * Add a test runner that will create a window with a report, e.g.:
;;     my-test... skipped (no associated output)
;;     A-small... OK (time 0:12, RSS 51 MB)
;;     A-large... outputs differ from line 501, see the windows below
;;                (time 0:54, RSS 257 MB)

(defvar competition-directory nil
  "Directory of the current competition.")

(defvar competition-template
  (expand-file-name "~/Programming/Competitive programming/Templates/C++")
  "Directory that's the template for every new solution.")

(defun competition-cheatsheet ()
  "Show message with a cheatsheet of keybindings."
  (interactive)
  (message
   "%s"
   (replace-regexp-in-string
    "\\[\\([a-zA-Z0-9]\\)\\]"
    (lambda (match)
      (propertize (match-string 1 match) 'face '(:box t)))
    (concat
     "This [c]heatsheet\n"
     "[g]o to problem or create it\n"
     "Choose competition [d]irectory, [r]eset it\n"
     "Run the current solution [i]nteractively"))))

(defun competition--find-file-in-directory (directory)
  (if ido-mode
      (ido-find-file-in-dir directory)
    (let ((default-directory (file-name-as-directory directory)))
      (call-interactively #'find-file))))

(defun competition--read-directory (prompt &optional start-directory)
  (if ido-mode
      (ido-read-directory-name prompt start-directory)
    (read-directory-name prompt start-directory)))

(defun competition--merge-directories
    (directory newname &optional ok-if-already-exists)
  "A simplified `copy-directory' that lets the caller decide what
to do when a file already exists:

If OK-IF-EXISTS is nil, we signal `file-already-exists'.
If it's 'ignore, we skip the file. If it's a number, we request
confirmation from the user. Any other value means to overwrite
the existing file."
  (when (file-in-directory-p newname directory)
    (error "Cannot copy `%s' into its subdirectory `%s'"
           directory newname))
  (setq directory (directory-file-name (expand-file-name directory))
        newname (directory-file-name (expand-file-name newname)))
  (when (not (file-directory-p newname))
    (make-directory newname t))
  (dolist (file
           (directory-files directory 'full
                            directory-files-no-dot-files-regexp))
    (let ((target (expand-file-name (file-name-nondirectory file) newname))
          (filetype (car (file-attributes file))))
      (cond
       ((eq filetype t) ; Directory but not a symlink.
        (competition--merge-directories file target ok-if-already-exists))
       ((and (eq ok-if-already-exists 'ignore) (file-exists-p target))
        nil)
       ((stringp filetype) ; Symbolic link.
        (make-symbolic-link filetype target ok-if-already-exists))
       ((copy-file file target ok-if-already-exists)))))
  (when-let ((modes (file-modes directory)))
    (set-file-modes newname modes)))

(defun competition-choose-competition-directory ()
  (interactive)
  (setq competition-directory
        (competition--read-directory "Competition directory: ")))

(defun competition-reset ()
  (interactive)
  (setq competition-directory nil))

(defun competition--ask-for-missing-settings ()
  (unless competition-directory
    (call-interactively #'competition-choose-competition-directory)))

(defun competition-go-to-problem-create (&optional arg)
  "Ask for a competition problem's directory. If it doesn't
exist, create it from a template. Then, open its main.cpp.

With prefix ARG, copy files from template even when the directory
already exists."
  (interactive "P")
  (competition--ask-for-missing-settings)
  (let ((problem-directory
         (competition--read-directory
          "Problem directory: " competition-directory)))
    (when (or (not (file-exists-p problem-directory)) arg)
      (competition--merge-directories competition-template problem-directory 0))
    (let ((enable-local-variables :all)) ; Assume that the files are trusted.
      (find-file (expand-file-name "main.cpp" problem-directory)))
    (when (and (fboundp #'lsp) (or (not (boundp 'lsp-mode)) (not lsp-mode)))
      (require 'lsp-mode)
      (lsp-workspace-folders-add problem-directory) ; Set the LSP project root.
      (call-interactively #'lsp))))

(defun competition--run (program-and-args)
  (let ((buffer (get-buffer-create "*Competition solution*")))
    (with-current-buffer buffer
      (erase-buffer)
      (comint-mode)
      (compilation-shell-minor-mode)
      (insert (format "Running through `time`: %s\n\n"
                      (mapconcat #'shell-quote-argument program-and-args " "))))
    (let* ((time-temp-file (make-temp-file "emacs-competition-"))
           (time-args
            (append (list "--quiet" (concat "--output=" time-temp-file)
                          "--format=time %E, RSS %M kB"
                          "--")
                    program-and-args))
           (_ (comint-exec buffer (car program-and-args) "time" nil time-args))
           (process (get-buffer-process buffer)))
      (process-put process 'time-temp-file time-temp-file)
      (process-put process 'old-sentinel (process-sentinel process))
      (set-process-sentinel process #'competition--sentinel)
      (display-buffer buffer))))

(defun competition--upcase-first-letter (str)
  (concat (upcase (substring str 0 1)) (substring str 1)))

(defun competition--sentinel (process _output)
  (when-let ((old-sentinel (process-get process 'old-sentinel)))
    (funcall old-sentinel process _output))
  (unless (process-live-p process)
    (let* ((time-temp-file (process-get process 'time-temp-file))
           (time-output
            (with-temp-buffer
              (insert-file-contents time-temp-file)
              (goto-char (point-max))
              (delete-char -1) ; Delete trailing newline.
              (buffer-string)))
           (buffer (process-buffer process)))
      (delete-file time-temp-file)
      (when (buffer-live-p buffer)
        (with-current-buffer buffer
          (insert (competition--upcase-first-letter time-output) "\n")))
      (message "Solution exited with status %d, %s"
               (process-exit-status process)
               time-output))))

(defun competition-run-interactive ()
  "Run the current solution, interactively accepting input."
  (interactive)
  (competition--run '("make" "run")))

;;;###autoload
(define-minor-mode competition-mode
  "Helper for Google Code Jam and similar programming competitions."
  :lighter " Comp"
  :global t
  :keymap
  (let ((map (make-sparse-keymap))
        (prefix-map (make-sparse-keymap)))

    (bind-key "c" #'competition-cheatsheet prefix-map)

    (bind-key "g" #'competition-go-to-problem-create prefix-map)

    (bind-key "d" #'competition-choose-competition-directory prefix-map)
    (bind-key "r" #'competition-reset prefix-map)

    (bind-key "i" #'competition-run-interactive prefix-map)

    (bind-key "C-c p" prefix-map map)
    (bind-key "C-c C-p" prefix-map map) ; In case I hold down Control too long.
    map))

(provide 'competition)