Categories: geek » emacs » elisp

RSS - Atom - Subscribe via email

Making highlight-sexp follow modus-themes-toggle

| elisp, emacs

[2023-01-27 Fri] Prot just added a modus-themes-get-color-value function. Yay! Also, it turns out that I need to update the overlay in all the buffers.

I'm experimenting with using the highlight-sexp minor mode to highlight my current s-expression, since I sometimes get confused about what I'm modifying with smartparens. The highlight-sexp background colour is hardcoded in the variable hl-sexp-background-color, and will probably look terrible if you use a light background. I wanted it to adapt when I use modus-themes-toggle. Here's how that works:

(use-package highlight-sexp
  :quelpa
  (highlight-sexp :repo "daimrod/highlight-sexp" :fetcher github :version original)
  :hook
  (emacs-lisp-mode . highlight-sexp-mode)
  :config
  (defun my-hl-sexp-update-overlay ()
    (when (overlayp hl-sexp-overlay)
      (overlay-put
       hl-sexp-overlay
       'face
       `(:background        
         ,(if (fboundp 'modus-themes-get-color-value)
              (modus-themes-get-color-value 'bg-inactive)
            (car
             (assoc-default
              'bg-inactive
              (modus-themes--current-theme-palette))))))))
  (defun my-hl-sexp-update-all-overlays ()
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (when highlight-sexp-mode
          (my-hl-sexp-update-overlay)))))
  (advice-add 'hl-sexp-create-overlay :after 'my-hl-sexp-update-overlay)
  (advice-add 'modus-themes-toggle :after 'my-hl-sexp-update-all-overlays))

This is what it looks like:

highlight-sexp.gif
Figure 1: Animation of highlight-sexp toggling along with modus-themes-toggle
This is part of my Emacs configuration.

Coverage reporting in Emacs with Buttercup, Undercover, Coverage, and a Makefile

| emacs, elisp, subed

One of the things that I always wanted to get back to was the practice of having good test coverage. That way, I can have all these tests catch me in case I break something in my sleep-deprived late-night hacking sessions, and I can see where I may have missed a spot.

Fortunately, subed-mode included lots of tests using the Buttercup testing framework. They look like this:

(describe "SRT"
  (describe "Getting"
    (describe "the subtitle ID"
      (it "returns the subtitle ID if it can be found."
        (with-temp-srt-buffer
         (insert mock-srt-data)
         (subed-jump-to-subtitle-text 2)
         (expect (subed-subtitle-id) :to-equal 2)))
      (it "returns nil if no subtitle ID can be found."
        (with-temp-srt-buffer
         (expect (subed-subtitle-id) :to-equal nil))))
    ...))

and I can run them with make test, which the Makefile defines as emacs -batch -f package-initialize -L . -f buttercup-run-discover.

I don't have Cask set up for subed. I should probably learn how to use Cask. In the meantime, I needed to figure out how to get my Makefile to get the buttercup tests to capture the coverage data and report it in a nice way.

It turns out that the undercover coverage recording library works well with buttercup. It took me a little fiddling (and some reference to undercover.el-buttercup-integration-example) to figure out exactly how to invoke it so that undercover instrumented libraries that I was loading, since the subed files were in one subdirectory and the tests were in another. This is what I eventually came up with for tests/undercover-init.el:

(add-to-list 'load-path "./subed")
(when (require 'undercover nil t)
  (undercover "./subed/*.el" (:report-format 'simplecov) (:send-report nil)))

Then the tests files could start with:

(load-file "./tests/undercover-init.el")
(require 'subed-srt)

and my Makefile target for running tests with coverage reporting could be:

test-coverage:
	mkdir -p coverage
	UNDERCOVER_FORCE=true emacs -batch -L . -f package-initialize -f buttercup-run-discover

Displaying the coverage information in code buffers was easy with the coverage package. It looks in the git root directory for the coverage results, so I didn't need to tell it where the results were. This is what it looks like:

2022-01-02-19-00-28.svg

There are a few other options for displaying coverage info. cov uses the fringe and coverlay focuses on highlighting missed lines.

So now I can actually see how things are going, and I can start writing tests for some of those gaps. At some point I may even do the badge thing mentioned in my blog post from 2015 on continuous integration and code coverage for Emacs packages. There are a lot of things I'm slowly remembering how to do… =)

Defining generic and mode-specific Emacs Lisp functions with cl-defmethod

| emacs, elisp, subed

2022-01-27: Added example function description.
2022-01-02: Changed quote to function in the defalias.

I recently took over the maintenance of subed, an Emacs mode for editing subtitles. One of the things on my TODO list was to figure out how to handle generic and format-specific functions instead of relying on defalias. For example, there are SubRip files (.srt), WebVTT files (.vtt), and Advanced SubStation Alpha (.ass). I also want to add support for Audacity labels and other formats.

There are some functions that will work across all of them once you have the appropriate format-specific functions in place, and there are some functions that have to be very different depending on the format that you're working with. Now, how do you do those things in Emacs Lisp? There are several ways of making general functions and specific functions.

For example, the forward-paragraph and backward-paragraph commands use variables to figure out the paragraph separators, so buffer-local variables can change the behaviour.

However, I needed a bit more than regular expressions. An approach taken in some packages like smartparens is to have buffer-local variables have the actual functions to be called, like sp-forward-bound-fn and sp-backward-bound-fn.

(defvar-local sp-forward-bound-fn nil
  "Function to restrict the forward search")

(defun sp--get-forward-bound ()
  "Get the bound to limit the forward search for looking for pairs.
If it returns nil, the original bound passed to the search
function will be considered."
  (and sp-forward-bound-fn (funcall sp-forward-bound-fn)))

Since there were so many functions, I figured that might be a little bit unwieldy. In Org mode, custom export backends are structs that have an alist that maps the different types of things to the functions that will be called, overriding the functions that are defined in the parent export backend.

(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
          (:copier nil))
  name parent transcoders options filters blocks menu)

(defun org-export-get-all-transcoders (backend)
  "Return full translation table for BACKEND.

BACKEND is an export back-end, as return by, e.g,,
`org-export-create-backend'.  Return value is an alist where
keys are element or object types, as symbols, and values are
transcoders.

Unlike to `org-export-backend-transcoders', this function
also returns transcoders inherited from parent back-ends,
if any."
  (when (symbolp backend) (setq backend (org-export-get-backend backend)))
  (when backend
    (let ((transcoders (org-export-backend-transcoders backend))
          parent)
      (while (setq parent (org-export-backend-parent backend))
        (setq backend (org-export-get-backend parent))
        (setq transcoders
              (append transcoders (org-export-backend-transcoders backend))))
      transcoders)))

The export code looked a little bit complicated, though. I wanted to see if there was a different way of doing things, and I came across cl-defmethod. Actually, the first time I tried to implement this, I was focused on the fact that cl-defmethod could call different things depending on the class that you give it. So initially I had created a couple of classes: subed-backend class, and then subclasses such as subed-vtt-backend. This allowed me to store the backend as a buffer-local variable and differentiate based on that.

(require 'eieio)

(defclass subed-backend ()
  ((regexp-timestamp :initarg :regexp-timestamp
                     :initform ""
                     :type string
                     :custom string
                     :documentation "Regexp matching a timestamp.")
   (regexp-separator :initarg :regexp-separator
                     :initform ""
                     :type string
                     :custom string
                     :documentation "Regexp matching the separator between subtitles."))
  "A class for data and functions specific to a subtitle format.")

(defclass subed-vtt-backend (subed-backend) nil
  "A class for WebVTT subtitle files.")

(cl-defmethod subed--timestamp-to-msecs ((backend subed-vtt-backend) time-string)
  "Find HH:MM:SS,MS pattern in TIME-STRING and convert it to milliseconds.
Return nil if TIME-STRING doesn't match the pattern.
Use the format-specific function for BACKEND."
  (save-match-data
    (when (string-match (oref backend regexp-timestamp) time-string)
      (let ((hours (string-to-number (match-string 1 time-string)))
            (mins  (string-to-number (match-string 2 time-string)))
            (secs  (string-to-number (match-string 3 time-string)))
            (msecs (string-to-number (subed--right-pad (match-string 4 time-string) 3 ?0))))
        (+ (* (truncate hours) 3600000)
           (* (truncate mins) 60000)
           (* (truncate secs) 1000)
           (truncate msecs))))))

Then I found out that you can use major-mode as a context specifier for cl-defmethod, so you can call different specific functions depending on the major mode that your buffer is in. It doesn't seem to be mentioned in the elisp manual, so at some point I should figure out how to suggest mentioning it. Anyway, now I have some functions that get called if the buffer is in subed-vtt-mode and some functions that get called if the buffer is in subed-srt-mode.

The catch is that cl-defmethod can't define interactive functions. So if I'm defining a command, an interactive function that can be called with M-x, then I will need to have a regular function that calls the function defined with cl-defmethod. This resulted in a bit of duplicated code, so I have a macro that defines the method and then defines the possibly interactive command that calls that method. I didn't want to think about whether something was interactive or not, so my macro just always creates those two functions. One is a cl-defmethod that I can override for a specific major mode, and one is the function that actually calls it, which may may not be interactive. It doesn't handle &rest args, but I don't have any in subed.el at this time.

(defmacro subed-define-generic-function (name args &rest body)
  "Declare an object method and provide the old way of calling it."
  (declare (indent 2))
  (let (is-interactive
        doc)
    (when (stringp (car body))
      (setq doc (pop body)))
    (setq is-interactive (eq (caar body) 'interactive))
    `(progn
       (cl-defgeneric ,(intern (concat "subed--" (symbol-name name)))
           ,args
         ,doc
         ,@(if is-interactive
               (cdr body)
             body))
       ,(if is-interactive
            `(defun ,(intern (concat "subed-" (symbol-name name))) ,args
               ,(concat doc "\n\nThis function calls the generic function `"
                        (concat "subed--" (symbol-name name)) "' for the actual implementation.")
               ,(car body)
               (,(intern (concat "subed--" (symbol-name name)))
                ,@(delq nil (mapcar (lambda (a)
                                      (unless (string-match "^&" (symbol-name a))
                                        a))
                                    args))))
          `(defalias (quote ,(intern (concat "subed-" (symbol-name name))))
             (function ,(intern (concat "subed--" (symbol-name name))))
             ,doc)))))

For example, the function:

(subed-define-generic-function timestamp-to-msecs (time-string)
  "Find timestamp pattern in TIME-STRING and convert it to milliseconds.
Return nil if TIME-STRING doesn't match the pattern.")

expands to:

(progn
  (cl-defgeneric subed--timestamp-to-msecs
      (time-string)
    "Find timestamp pattern in TIME-STRING and convert it to milliseconds.
Return nil if TIME-STRING doesn't match the pattern.")
  (defalias 'subed-timestamp-to-msecs 'subed--timestamp-to-msecs "Find timestamp pattern in TIME-STRING and convert it to milliseconds.
Return nil if TIME-STRING doesn't match the pattern."))

and the interactive command defined with:

(subed-define-generic-function forward-subtitle-end ()
  "Move point to end of next subtitle.
Return point or nil if there is no next subtitle."
  (interactive)
  (when (subed-forward-subtitle-id)
    (subed-jump-to-subtitle-end)))

expands to:

(progn
  (cl-defgeneric subed--forward-subtitle-end nil "Move point to end of next subtitle.
Return point or nil if there is no next subtitle."
                 (when
                     (subed-forward-subtitle-id)
                   (subed-jump-to-subtitle-end)))
  (defun subed-forward-subtitle-end nil "Move point to end of next subtitle.
Return point or nil if there is no next subtitle.

This function calls the generic function `subed--forward-subtitle-end' for the actual implementation."
         (interactive)
         (subed--forward-subtitle-end)))

Then I can define a specific one with:

(cl-defmethod subed--timestamp-to-msecs (time-string &context (major-mode subed-srt-mode))
  "Find HH:MM:SS,MS pattern in TIME-STRING and convert it to milliseconds.
Return nil if TIME-STRING doesn't match the pattern.
Use the format-specific function for MAJOR-MODE."
  (save-match-data
    (when (string-match subed--regexp-timestamp time-string)
      (let ((hours (string-to-number (match-string 1 time-string)))
            (mins  (string-to-number (match-string 2 time-string)))
            (secs  (string-to-number (match-string 3 time-string)))
            (msecs (string-to-number (subed--right-pad (match-string 4 time-string) 3 ?0))))
        (+ (* (truncate hours) 3600000)
           (* (truncate mins) 60000)
           (* (truncate secs) 1000)
           (truncate msecs))))))

The upside is that it's easy to either override or extend a function's behavior. For example, after I sort subtitles, I want to renumber them if I'm in an SRT buffer because SRT subtitles have numeric IDs. This doesn't happen in any of the other modes. So I can just define that this bit of code runs after the regular code that runs.

(cl-defmethod subed--sort :after (&context (major-mode subed-srt-mode))
  "Renumber after sorting. Format-specific for MAJOR-MODE."
  (subed-srt--regenerate-ids))

The downside is that going to the function's definition and stepping through it is a little more complicated because it's hidden behind this macro and the cl-defmethod infrastructure. I think that if you describe-function the right function, the internal version with the --, then it will list the different implementations of it. I added a note to the regular function's docstring to make it a little easier.

Here's what M-x describe-function subed-forward-subtitle-end looks like:

describe-function.svg

Figure 1: Describing a generic function

I'm going to give this derived-mode branch a try for a little while by subtitling some more EmacsConf talks before I merge it into the main branch. This is my first time working with cl-defmethod, and it looks pretty interesting.

Emacs: Making a hydra cheatsheet for Lispy

| emacs, elisp

I wanted to get the hang of Lispy thanks to Leo Vivier's presentation at EmacsSF, but there are a lot of keyboard shortcuts to explore. In Karl Voit's demo of Org Mode at GLT21, he showed how he uses Hydra to make cheat sheets. That makes perfect sense, of course, as Hydra can display text and allow you to run commands while the text is displayed. I wanted to make a Hydra that would show me categorized commands to make it easier to look up and eventually remember them. I also wanted to skip the commands that I already knew or that I didn't want to focus on just yet.

Fortunately, the function reference had a link to the Org file used to generate it. I copied the tables, merged them together, named them with #+NAME: bindings, replaced the links with plain text, and added a third column with the category I wanted to put commands into.

#bindings
key function column
< lispy-barf  
A lispy-beginning-of-defun  
j lispy-down  
Z lispy-edebug-stop  
B lispy-ediff-regions  
G lispy-goto-local  
h lispy-left  
N lispy-narrow  
y lispy-occur  
o lispy-other-mode  
J lispy-outline-next  
K lispy-outline-prev  
P lispy-paste  
l lispy-right  
I lispy-shifttab  
> lispy-slurp  
SPC lispy-space  
xB lispy-store-region-and-buffer  
u lispy-undo  
k lispy-up  
v lispy-view  
V lispy-visit  
W lispy-widen  
D pop-tag-mark  
x see  
L unbound  
U unbound  
X unbound  
Y unbound  
H lispy-ace-symbol-replace Edit
c lispy-clone Edit
C lispy-convolute Edit
n lispy-new-copy Edit
O lispy-oneline Edit
r lispy-raise Edit
R lispy-raise-some Edit
\ lispy-splice Edit
S lispy-stringify Edit
i lispy-tab Edit
xj lispy-debug-step-in Eval
xe lispy-edebug Eval
xT lispy-ert Eval
e lispy-eval Eval
E lispy-eval-and-insert Eval
xr lispy-eval-and-replace Eval
p lispy-eval-other-window Eval
q lispy-ace-paren Move
z lispy-knight Move
s lispy-move-down Move
w lispy-move-up Move
t lispy-teleport Move
Q lispy-ace-char Nav
lispy-ace-subword Nav
a lispy-ace-symbol Nav
b lispy-back Nav
d lispy-different Nav
f lispy-flow Nav
F lispy-follow Nav
g lispy-goto Nav
xb lispy-bind-variable Refactor
xf lispy-flatten Refactor
xc lispy-to-cond Refactor
xd lispy-to-defun Refactor
xi lispy-to-ifs Refactor
xl lispy-to-lambda Refactor
xu lispy-unbind-variable Refactor
M lispy-multiline Other
xh lispy-describe Other
m lispy-mark-list Other

I wrote this Emacs Lisp code with the header arguments #+begin_src emacs-lisp :var bindings=bindings :colnames yes:

(eval
 (append
  '(defhydra my/lispy-cheat-sheet (:hint nil :foreign-keys run)
     ("<f14>" nil :exit t))
  (cl-loop for x in bindings
           unless (string= "" (elt x 2))
           collect
           (list (car x)
                 (intern (elt x 1))
                 (when (string-match "lispy-\\(?:eval-\\)?\\(.+\\)"
                                     (elt x 1))
                   (match-string 1 (elt x 1)))
                 :column
                 (elt x 2)))))
(with-eval-after-load "lispy"
  (define-key lispy-mode-map (kbd "<f14>") 'my/lispy-cheat-sheet/body))

Here's the result:

Screenshot_20210413_002503.png

Figure 1: Hydra-based cheat sheet

I'm experimenting with having my Windows key be F14 if tapped and Super_L if held down. I use KDE, so I disabled the Applications shortcut with:

kwriteconfig5 --file ~/.config/kwinrc --group ModifierOnlyShortcuts --key Meta ""
qdbus org.kde.KWin /KWin reconfigure

and then used xcape -e 'Super_L=F14' to make it work.

Looking forward to getting the hang of this!

This is part of my Emacs configuration.

Org Mode: Inserting a function definition

| emacs, org, elisp

While nudging jcs to add a definition of jcs-insert-url to the blog post about Making Things Easier, I realized it might be handy to have a quick function for inserting a function definition without thinking about where it's defined. This tries to use the definition from the source, and it can fall back to using the stored function definition if necessary. There's probably a better way to do this, but this was small and fun to write. =)

Naturally, I used it to insert itself:

(defun my/org-insert-defun (function)
  "Inserts an Org source block with the definition for FUNCTION."
  (interactive (find-function-read))
  (let* ((buffer-point (condition-case nil (find-definition-noselect function nil) (error nil)))
         (new-buf (car buffer-point))
         (new-point (cdr buffer-point))
         definition)
    (if buffer-point        
      (with-current-buffer new-buf ;; Try to get original definition
        (save-excursion
          (goto-char new-point)
          (setq definition (buffer-substring-no-properties (point) (save-excursion (end-of-defun) (point))))))
      ;; Fallback: Print function definition
      (setq definition (concat (prin1-to-string (symbol-function function)) "\n")))
    (insert "#+begin_src emacs-lisp\n" definition "#+end_src\n")))

Using your own Emacs Lisp functions in Org Mode table calculations: easier dosage totals

Posted: - Modified: | emacs, org, elisp

UPDATE 2015-06-17: In the comments below, Will points out that if you use proper dates ([yyyy-mm-dd] instead of yyyy-mm-dd), Org will do the date arithmetic for you. Neato! Here’s what Will said:

Hi Sacha. Did you know you can do date arithmetic directly on org’s inactive or active timestamps? It can even give you an answer in fractional days if the time of day is different in the two timestamps:

| Start                  | End                    | Interval |
|------------------------+------------------------+----------|
| [2015-06-16 Tue]       | [2015-06-23 Tue]       |        7 |
| <2015-06-13 Sat>       | <2015-06-15 Mon>       |        2 |
| [2015-06-10 Wed 20:00] | [2015-06-17 Wed 08:00] |      6.5 |
#+TBLFM: $3=$2 - $1 

Here’s my previous convoluted way of doing things… =)
—-

I recently wrote about calculating how many doses you need to buy using an Org Mode table. On reflection, it’s easier and more flexible to do that calculation using an Emacs Lisp function instead of writing a function that processes and outputs entire tables.

First, we define a function that calculates the number of days between two dates, including the dates given. I put this in my Emacs config.

(defun my/org-days-between (start end)
  "Number of days between START and END.
This includes START and END."
  (1+ (- (calendar-absolute-from-gregorian (org-date-to-gregorian end))
         (calendar-absolute-from-gregorian (org-date-to-gregorian start)))))

Here’s the revised table. I moved the “Needed” column to the left of the medication type because this makes it much easier to read and confirm.

| Needed | Type         | Per day |      Start |        End | Stock |
|--------+--------------+---------+------------+------------+-------|
|     30 | Medication A |       2 | 2015-06-16 | 2015-06-30 |     0 |
|      2 | Medication B |     0.1 | 2015-06-16 | 2015-06-30 |   0.2 |
#+TBLFM: @2$1..@>$1='(ceiling (- (* (my/org-days-between $4 $5) (string-to-number $3)) (string-to-number $6)))

C-c C-c on the #+TBLFM: line updates the values in column 1.

@2$1..@>$1 means the cells from the second row (@2) to the last row (@>) in the first column ($1).  '  tells Org to evaluate the following expression as Emacs Lisp, substituting the values as specified ($4 is the fourth column’s value, etc.).

The table formula calculates the value of the first column (Needed) based on how many you need per day, the dates given (inclusive), and how much you already have in stock. It rounds numbers up by using the ceiling function.

Because this equation uses the values from each row, the start and end date must be filled in for all rows. To quickly duplicate values downwards, set org-table-copy-increment to nil, then use S-return (shift-return) in the table cell you want to copy. Keep typing S-return to copy more.

This treats the calculation inputs as strings, so I used string-to-number to convert some of them to numbers for multiplication and subtraction. If you were only dealing with numbers, you can convert them automatically by using the ;N flag, like this:

| Needed | Type         | Per day | Days | Stock |
|--------+--------------+---------+------+-------|
|      6 | Medication A |       2 |    3 |     0 |
|      1 | Medication B |     0.1 |    3 |   0.2 |
#+TBLFM: @2$1..@>$1='(ceiling (- (* $3 $4) $5)));N

Continuous integration and code coverage for Emacs packages with Travis and Coveralls

Posted: - Modified: | emacs, elisp

Do you maintain an Emacs package hosted on Github? Would you like to get those confidence-building, bragging-rights-granting, other-developers-inspiring build: passing and coverage: 100% badges into your README file?

It turns out that this is pretty easy with ERT, Cask, Travis CI, undercover.el, and Coveralls.io.

  1. Log on to Travis and enable continuous integration for your repository.
  2. Log on to Coveralls.io and enable coverage testing for your repository.
  3. Set up a git branch, since you'll probably be making lots of small commits while you smooth out the testing workflow.
  4. Define your tests with ERT. See https://github.com/abo-abo/tiny/blob/master/tiny-test.el for an example. For undercover support, you'll want to include something like:
    (when (require 'undercover nil t)
      (undercover "tiny.el"))
    
  5. Define your dependencies with Cask. Include undercover. For example, here's a simple Cask file:
    (source gnu)
    (source melpa)
    
    (development
      (depends-on "undercover"))
    
  6. Add a .travis.yml that specifies how to test your package on Travis. For example, see this .travis.yml and Makefile.
  7. Commit and push.
  8. Check your repository status in Travis to see if it ran properly.
  9. Check your coverage status in Coveralls.io to see if it displayed properly.
  10. Get the badge code from Travis and Coveralls, and add them to your README (probably using Markdown). You can get the badge code from Travis by clicking on your build status badge next to your repository name. Coveralls has prominent instructions for getting your badge. Yay!

Incidentally, if you want to see your test coverage locally, you can (require 'testcover) and then use testcover-this-defun or testcover-start to instrument the macros and functions for coverage. Run your tests, then use testcover-mark-all to look at the results. See the documentation in testcover.el to find out what the coloured overlays mean. Edebug has a test coverage tool too, so you can explore that one if you prefer it.

Additional notes on testing:

Resources:

View or add comments (Disqus), or e-mail me at sacha@sachachua.com