;;; count.el --- Easy counting facility -*- lexical-binding: t; -*- ;; Copyright (C) 2024 Jean Sévère Durand ;; Author: Jean Sévère Durand ;; Keywords: emulations, games ;; 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 . ;;; Commentary: ;; Counting mode ;;; Code: ;;; Variables ;;;; Buffer name (defvar counting-buffer-name "*Count*" "The name of the buffer within which to count.") ;;;; Font-scaling factor (defvar counting-font-step 10 "The proportion by which the counting value font size is \ increased.") ;;;; Counted value (defvar-local count-mode-value 0 "The value of the current count.") ;;; Major mode (define-derived-mode count-mode special-mode "Count" "Major mode for counting." (count-refresh) (set 'cursor-type nil)) (let ((map count-mode-map)) (define-key map (vector 'up) #'count-up) (define-key map (vector 'down) #'count-down) (define-key map (vector ?r) #'count-refresh) (define-key map (vector ?o) #'count-reset) (define-key map (vector ?=) #'count-enlarge) (define-key map (vector ?-) #'count-shrink)) ;;; Functions to start counting ;;;; Count in an old buffer if possible (defun count-start-or-switch () "Start counting in an old buffer if possible." (interactive) (let ((buffer (get-buffer-create counting-buffer-name))) (with-current-buffer buffer (count-mode)) (switch-to-buffer buffer))) ;;;; Count in a new buffer always (defun count-start () "Start counting in a new buffer." (interactive) (let* ((name (generate-new-buffer-name counting-buffer-name)) (buffer (get-buffer-create name))) (with-current-buffer buffer (count-mode)) (switch-to-buffer buffer))) ;;; Auxiliary functions ;;;; Format the counted value (defvar text-scale-mode-step) (defun count-make-pad-string (number) "Make a padding string that centers the NUMBER." (declare (pure t) (side-effect-free t)) (let* ((number-str (format "%d" number)) (number-str-width (* (string-pixel-width number-str) ;; account for the font-size scales (expt text-scale-mode-step counting-font-step))) (space-width (string-pixel-width (string #x20))) (padding (/ (- (window-pixel-width) (* 2 space-width) number-str-width) 2.0)) (height (window-body-height nil 'remap)) (half (floor height 2))) (concat (make-string half #xa) (propertize (string #x20) 'display (list 'space :width (list padding))) number-str))) (defun count-refresh () "Refresh the counting buffer." (interactive) (cond ((derived-mode-p 'count-mode) (let ((inhibit-read-only t)) (setq text-scale-mode-amount counting-font-step) (text-scale-mode 1) (delete-region (point-min) (point-max)) (insert (count-make-pad-string count-mode-value)))) ((user-error "This function needs to be in the count-mode")))) (defun count-up (&optional arg) "Increase the count by ARG." (interactive "P") (setq arg (cond ((null arg) 1) ((prefix-numeric-value arg)))) (setq count-mode-value (+ arg count-mode-value)) (count-refresh)) (defun count-down (&optional arg) "Decrease the count by ARG." (interactive "P") (setq arg (cond ((null arg) 1) ((prefix-numeric-value arg)))) (setq count-mode-value (- count-mode-value arg)) (count-refresh)) (defun count-reset () "Reset `count-mode-value' to zero." (interactive) (setq count-mode-value 0) (count-refresh)) (defun count-enlarge (&optional arg) "Increase the font size by ARG many times. The size of one step is defined by `text-scale-mode-step'." (interactive "p") (setq arg (cond ((null arg) 1) ((prefix-numeric-value arg)))) (setq counting-font-step (+ counting-font-step arg)) (count-refresh)) (defun count-shrink (&optional arg) "Decrease the font size by ARG many times. The size of one step is defined by `text-scale-mode-step'." (interactive "p") (setq arg (cond ((null arg) 1) ((prefix-numeric-value arg)))) (setq counting-font-step (- counting-font-step arg)) (count-refresh)) (provide 'count) ;;; count.el ends here