Blog

For the English part of the blog, see Content AND Presentation.

2026-01-19 Toy train timetable clock

My son loves trains. Once in a while, we’re playing with electric toy trains. Sometimes this means just having them move around and use switches to change their routes, and sometimes it means building two or more stations and moving actual (toy) people and (toy) wares between stations.

Recently, we came up with an idea to level up our game. Why not create an actual (toy) timetable and start and stop trains at the right moment? Very soon, a serious limitation revealed itself. When the (real) time needed to move from station A to station B is less than a minute, the timetable starts to look a bit funny: departure at 13:37 and arrival at 13:38 is pretty weird. Also, a real train timetable “repeats itself” with a 24-hour period, but we need a much shorter period for playing. (We solved it by only having times modulo 10 minutes, but that meant that we only could have about 3–4 routes in one 10-minute period.)

The solution to this seems obvious: we need a “toy clock” to show “toy time”, with two important features: the “toy time” should be much faster than real time, and we should be able to set the “toy time” to any time we want.

Me being me, I decided to write a simple application for that. I guess most people would use JavaScript and make it a very simple, front-end only web app. Me being me, I decided to code it in Emacs Lisp.

The actual implementation is quite simple, with about 75 lines of code. An important part is handling the window displaying the time; I made an effort to center the clock both horizontally and vertically in the buffer. That was a bit tricky because I wanted to display both the real time (with a normal face) at the top, and the “toy time” at the center with a much bigger face. That meant using window-body-height with the pixelwise parameter set to t, and taking font heights into consideration. Also, I learned about the window-max-chars-per-line function, which allows to find out how many characters can be displayed in a line in a given window with a given face. The code works pretty well, with some minor limitations – for example, if more than one window shows the buffer with the clock, one of them may look bad.

Another problem I had to solve was how to make the clock update automatically. Of course, that meant using timers, but it took me a few iterations to decide, for example, how to start the clock or how to handle the situation when the user deletes the window with the clock. For now, I decided to use switch-to-buffer and delete-other-windows, which is not very elegant, but makes sense UI-wise, and to cancel the timer if the user kills the clock buffer or even deletes its window.

Anyway, here is the code. I have some ideas for some new cool features, but this works well enough to have some fun already!

;;; toy-train-timetable.el --- Toy train timetable   -*- lexical-binding: t; -*-

;; Copyright (C) 2026  Marcin Borkowski

;; Author:  Marcin Borkowski <mbork@mbork.pl>
;; Keywords: 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 <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This is a simple clock showing accelerated time for the purpose of
;; playing with toy trains and creating a timetable for them.  By
;; default, the "toy time" is four times faster than real time.

;;; Code:

(defvar ttt-start-real-time nil
  "Real time when the clock starts.")

(defvar ttt-start-toy-time nil
  "Toy time when the clock starts.")

(defface ttt-face '((t :height 8.0))
  "The height of the clock face.")

(defcustom ttt-toy-time-speed 4
  "Speed of the play time.
The default of 4 means 4 play seconds pass in 1 real second.")

(defcustom ttt-update-interval 15
  "The interval (in seconds play time) between clock updates.")

(defun ttt-compute-time (time)
  "Compute the play time given real time TIME."
  (time-add
   ttt-start-toy-time
   (seconds-to-time
    (* (time-to-seconds (time-subtract time ttt-start-real-time))
       ttt-toy-time-speed))))

(defvar ttt-refresh-timer nil
  "Timer used to refresh the timetable buffer.")

(defvar ttt-buffer-name " *Toy Train Timetable*"
  "Name of the timetable buffer.")

(defun ttt-refresh ()
  "Refresh the timetable buffer."
  (if-let* ((ttt-buffer (get-buffer ttt-buffer-name))
            (ttt-window (get-buffer-window ttt-buffer t)))
      (with-current-buffer ttt-buffer
        (with-selected-window ttt-window
          (let* ((inhibit-read-only t)
                 (height (window-body-height nil t))
                 (default-font-height (default-font-height))
                 (ttt-font-height (window-font-height nil 'ttt-face))
                 (vertical-padding
                  (/ (- height ttt-font-height default-font-height)
                     default-font-height
                     2))
                 (width (window-max-chars-per-line nil 'ttt-face))
                 (horizontal-padding (/ (- width 8) 2)))
            (erase-buffer)
            (insert (format-time-string " %T")
                    (make-string (max 0 vertical-padding) ?\n)
                    (propertize
                     (concat
                      (make-string (max 0 horizontal-padding) ?\s)
                      (format-time-string
                       "%T" (ttt-compute-time (current-time))))
                     'face 'ttt-face)
                    "\n")))
        (goto-char (point-min)))
    (when (timerp ttt-refresh-timer)
      (cancel-timer ttt-refresh-timer))))

(defun toy-train-timetable (real-start-time play-start-time)
  "Create a toy train timetable buffer and start the mode."
  (interactive (list
                (org-read-date t t nil "Real start time? ")
                (org-read-date t t nil "Play start time? ")))
  (setq ttt-start-real-time real-start-time)
  (setq ttt-start-toy-time play-start-time)
  (switch-to-buffer (get-buffer-create ttt-buffer-name))
  (delete-other-windows)
  (special-mode)
  (when (timerp ttt-refresh-timer)
    (cancel-timer ttt-refresh-timer))
  (setq ttt-refresh-timer
        (run-with-timer
         t
         (/ ttt-update-interval ttt-toy-time-speed 1.0)
         #'ttt-refresh)))

(provide 'toy-train-timetable)
;;; toy-train-timetable.el ends here

CategoryEnglish, CategoryBlog, CategoryEmacs

Comments on this page

2026-01-12 Making fill-paragraph more flexible

I wrote recently about fill-paragraph-semlf and how I moved to it entirely with M-q. It quickly turned out that it wasn’t the best idea. Sometimes I want to be able to fill the paragraph in the old way, too. I figured that the best way to do it is to make M-q do that when pressed for the second time.

Now, there is the unfill package maintained by Steve Purcell, which introduces the unfill-toggle function. Binding it to M-q makes it alternate between filling and “unfilling” the paragraph (that is, turning it to one long line) when pressed more than one time. What I want is something even better – to have three options, semantic filling, unfilling and filling “normally”.

I think the simplest way to to achieve that is to introduce a global variable to keep the last operation performed by M-q in, much like what C-l (recenter-top-bottom) does.

(require 'cl-lib)

(defvar fill-paragraph-state nil
  "The way the paragraph was filled the last time.")

;; From https://github.com/purcell/unfill/blob/master/unfill.el#L39
(defun unfill-paragraph ()
  "Replace newline chars in current paragraph by single spaces.
This command does the inverse of `fill-paragraph'."
  (interactive)
  (let ((fill-column most-positive-fixnum))
    (call-interactively 'fill-paragraph)))

(defun fill-paragraph-rotate ()
  "Fill the current paragraph in one of three ways.
First, it fills the paragraph semantically, then, unfills it, and
finally, fills it in the traditional way."
  (interactive)
  (unless (eq last-command this-command)
    (setq fill-paragraph-state nil))
  (let (deactivate-mark)
    (cl-case fill-paragraph-state
      ('fill-paragraph-semlf
       (call-interactively 'unfill-paragraph)
       (setq fill-paragraph-state 'unfill-paragraph))
      ('unfill-paragraph
       (call-interactively 'fill-paragraph)
       (setq fill-paragraph-state 'fill-paragraph))
      (t
       (call-interactively 'fill-paragraph-semlf)
       (setq fill-paragraph-state 'fill-paragraph-semlf)))))

As you can see, the code is pretty simple. If the last command is not fill-paragraph-rotate, the state of the three-way toggle is reset, and then we perform the fill depending on how it was performed the last time.

One minor problem with this function is that in some modes, semantic filling just doesn’t work. For example, as I mentioned before, AUCTeX sets fill-paragraph-function to LaTeX-fill-paragraph, which apparently overrides fill-region-as-paragraph-function. This means that “traditional” and “semantic” filling does exactly the same thing in AUCTeX buffers. I could utilize fill-paragraph-function instead of fill-region-as-paragraph-function, but I don’t see the point. I don’t write in (La)TeX that often nowadays, and I can live without semantic filling in (La)TeX buffers. On the other hand, if I were still doing a lot of (La)TeX, I would probably do something about it. Semantic filling is especially valuable in LaTeX, where many people may collaborate on a plain text document written (mostly) in a natural language. Thing is, LaTeX-fill-paragraph seems extremely complex, and I don’t really want to invest a lot of time in a feature I would hardly ever need. Instead, I decided to suggest such a feature to AUCTeX developers.

Anyway, that’s it for today. Happy writing in Emacs!

CategoryEnglish, CategoryBlog, CategoryEmacs, CategoryTeX

Comments on this page

2026-01-05 Magit and new branch length

Like many Emacsers, I am a heavy Magit user. If you use Magit, I don’t need to tell you how great it is; if you don’t, I suggest you do yourself a favor and try it out.

That doesn’t mean that Magit is ideal, though. It has some issues, though usually very minor ones. Today I’d like to write about something which is definitely not a “Magit issue”, but rather something I personally miss in it.

When I start working on a feature, I create a branch for it. Usually this means pressing b c (magit-branch-and-checkout). Magit then asks me for the branch’s name. I like my branches to have short names (not more than 32 characters). When I see that the name I’ve typed seems long, I can press C-x h M-= (that is, mark-whole-buffer and count-words-region) and see how many characters I’ve typed. I’d prefer, however, to be shown that length while I type.

This turned out to be a bit more complex than I thought it would be. First of all, when you make a mistake while working on functions you have put into post-command-hook, you might make your Emacs unresponsive. (This is exactly what happened to me while working on this very feature. From then on, I experimented with this code in a separate Emacs instance.) Second, it is easy to write a function which shows the length of the minibuffer, suitable to include in post-command-hook, but it’s less obvious how to include it there. My first idea was to add an :around advice to magit-read-string to add that function before calling magit-read-string and remove it afterwards – but this didn’t help when I pressed C-g while typing the new branch name and the code after the invocation of magit-read-string was skipped. After some experiments (and a short chat with an LLM, I have to admit) I think I found a working (though not exactly elegant) solution. Emacs has two hooks which can help with minibuffer shenanigans: minibuffer-setup-hook and minibuffer-exit-hook. They are run when entering and exiting the minibuffer, and the crucial part is that minibuffer-exit-hook is run even when the user exits the minibuffer via C-g.

So, what I decided to do was to set up hooks within hooks. First of all, I defined a simple function which echoes the number of characters in the minibuffer, using the minibuffer-contents function. Then, I created two functions, magit-branch-length--minibuffer-setup-length and magit-branch-length--minibuffer-exit-length, which (respectively) adds and removes the previously defined echoing function from post-command-hook. These functions are supposed to be added to the minibuffer hooks I mentioned above. Then I advised the magit-read-string function so that before it’s run, my hook-adding-hooks are added where they should be. In my previous attempt, I used an :around advice combinator so that these hooks would be removed after exiting magit-read-string, but that didn’t work – the removing code was skipped when I pressed C-g while entering the branch name. So, I defined one more function, whose sole purpose is to remove all minibuffer hooks, and put it in the minibuffer-exit-hook, too. (Of course, it also removes itself from that hooks.) That way, all my code gets properly removed from all hooks when I exit the minibuffer (in any way).

And that was quite a mouthful, right? I suspect there is some easier method to achieve my goal, so if you know one, please do let me know. In the meantime, I’m using this code (and I’m quite happy about having it!), and remembering the hook trickery I devised for this feature in case I need it again some day.

(defun minibuffer-show-length ()
  "Show the length of minibuffer contents using `minibuffer-message'."
  (minibuffer-message "%d characters" (length (minibuffer-contents))))

(defun magit-branch-length--magit-read-string-before (&rest args)
  "Setup the minibuffer so that its length will be shown.
Make it so only the next time the minibuffer is used."
  (add-hook 'minibuffer-setup-hook
            #'magit-branch-length--minibuffer-setup-length)
  (add-hook 'minibuffer-exit-hook
            #'magit-branch-length--minibuffer-exit-length)
  (add-hook 'minibuffer-exit-hook
            #'magit-branch-length--remove-minibuffer-hooks))

(defun magit-branch-length--minibuffer-setup-length ()
  "Add `minibuffer-show-length' to `post-command-hook'."
  (add-hook 'post-command-hook #'minibuffer-show-length nil t))

(defun magit-branch-length--minibuffer-exit-length ()
  "Remove `minibuffer-show-length' from `post-command-hook'."
  (remove-hook 'post-command-hook #'minibuffer-show-length))

(defun magit-branch-length--remove-minibuffer-hooks ()
  "Remove functions added to the minibuffer setup and exit hooks."
  (remove-hook 'minibuffer-setup-hook
               #'magit-branch-length--minibuffer-setup-length)
  (remove-hook 'minibuffer-exit-hook
               #'magit-branch-length--minibuffer-exit-length)
  (remove-hook 'minibuffer-exit-hook
               #'magit-branch-length--remove-minibuffer-hooks))

(advice-add 'magit-read-string
            :before
            #'magit-branch-length--magit-read-string-before)

CategoryEnglish, CategoryBlog, CategoryEmacs

Comments on this page

More...