Don't explain, show me examples! A tour of the catch/throw pattern in the Emacs source code
Do you want to expand your Elisp toolbox?
For instance, in the following snippet, in a catch block:
we define a local list
then we loop forever (
(while t ...)),
in this loop we generate a random (integer) number between
if this number is not equal to
1, we add it to the list
land we repeat,
and if it is equal to
1, the throw statement transfers the control to the enclosing catch with the tag
:one(we leave out the
whileloop and also the
letblock) which returns immediately the builded list
l(last argument of the throw statement).
(catch :one (let (l) (while t (setq k (random 10)) (if (/= k 1) (push k l) (throw :one l))))) ;; (5 3 8 8 0 3) ;; these are pseudo-random numbers that depend on the seed ;; used by `random' on your running Emacs, so evaluting the ;; preceding form can return something different on your machine.
Handmade examples are effective for discovering new things or remembering the syntax of known things.
But when we have to write programs that solve "real" problems, having already been exposed to REAL WORLD examples is a competitive advantage.
Indeed, REAL WORLD examples often provide "standard methods" to implement specific actions/tasks in given "environments".
In this post, we first present some handmade examples of the
catch/throw pattern and then we look at REAL WORLD examples of the
catch/throw pattern that we find in Emacs source code.
The catch/throw pattern: handmade examples
Most control constructs affect only the flow of control within the construct itself. The function ‘throw’ is the exception to this rule of normal program execution: it performs a nonlocal exit on request. (There are other exceptions, but they are for error handling only.) ‘throw’ is used inside a ‘catch’, and jumps back to that ‘catch’.
Let's see how with the following examples.
We don't provide any explanation hoping that the evaluations in comments show how the flow of control has been modified.
Note that if you read this post inside Emacs with org-mode, you can
C-c ' (org-edit-special by default) in the source block to
open a dedicated
emacs-lisp buffer where you can modify and evaluate
the examples the way you want as much as you need to be confident
about catch and throw.
(catch :foo 'evaluated (throw :foo (+ 2 2)) 'not-evaluated) ; 4 (catch :foo (let ((a-value (+ 3 3))) 'evaluated (throw :foo a-value) 'not-evaluated)) ; 6 (catch 'foo 'evaluated (throw 'foo 'from-throw) 'not-evaluated) ; from-throw (let ((tag-catch 'foo) (tag-throw 'foo)) (catch tag-catch 'evaluated (throw tag-throw 'from-throw) 'not-evaluated)) ; from-throw (catch 'foo 'evaluated-1 (when nil (throw 'foo 'from-throw)) 'evaluated-2) ; evaluated-2 ;; nested `catch' (catch 'foo 'evaluated-1 (catch 'bar 'evaluated-2 (throw 'foo 'from-throw) 'not-evaluated) 'not-evaluated) ; from-throw (catch 'foo 'evaluated-1 (catch 'bar 'evaluated-2 (throw 'bar 'from-throw) 'not-evaluated) 'evaluated-3) ; evaluated-3 ;; `throw' called from another function (let ((f-throw (lambda (x) (throw :foo x)))) (catch :foo (funcall f-throw :bar))) ; :bar ;; raise an error (catch 'foo 'evaluated (throw 'bar t) 'not-evaluated) ; error: (no-catch bar t)
The catch/throw pattern: real world examples
There are more than 1000 catch blocks in Emacs source code.
Let's pick some of them that seems to represent in some way the "common" usage of catch blocks.
Almost all those catch blocks follow the same structure:
enter in a catch block,
loop (either by iterating on a structure or by "traversing" a buffer),
for each iteration test something and decide if iterate or throw,
Sometimes, we want to loop over a list and if some "conditions" are verified for an item, we want to return without looping over the rest of the list.
(catch :tag (dolist (...) ... (when some-condition-is-true (throw :tag 'some-value))) ...)
We encounter this pattern in the function
emacs-lock--exit-locked-buffer that returns the first exit-locked
buffer found in the list of all live buffers
(defun emacs-lock--exit-locked-buffer () "Return the first exit-locked buffer found." (save-current-buffer (catch :found (dolist (buffer (buffer-list)) (set-buffer buffer) (unless (or (emacs-lock--can-auto-unlock 'exit) (memq emacs-lock-mode '(nil kill))) (throw :found buffer))) nil)))
We also encounter this pattern in the function
that handles delete-frame events from the X server. This function
looks for a "valid frame" (among other stuff being different from the
frame where the X event occured) in the list of frames returned by
(frame-list) in order to decide if it is safe to delete the frame
where the X event occured with delete-frame or if it is better to call
the function save-buffers-kill-emacs:
(defun handle-delete-frame (event) "Handle delete-frame events from the X server." (interactive "e") (let* ((frame (posn-window (event-start event)))) (if (catch 'other-frame (dolist (frame-1 (frame-list)) ;; A valid "other" frame is visible, has its `delete-before' ;; parameter unset and is not a child frame. (when (and (not (eq frame-1 frame)) (frame-visible-p frame-1) (not (frame-parent frame-1)) (not (frame-parameter frame-1 'delete-before))) (throw 'other-frame t)))) (delete-frame frame t) ;; xxx says it is ok to ask questions before terminating. (save-buffers-kill-emacs))))
Now, let's have a look on the function newsticker--icon-read. This function is defined in the file lisp/net/newsticker.el part of the package lisp/net/newsticker.el which is from its description section:
... an "Atom aggregator", "RSS reader", "RSS aggregator", and "Feed Reader".
We did not choose this function for the service it provides to the package lisp/net/newsticker.el but because it is an interesting example dealing with two types of "controlled" nonlocal exits:
This function can be seen as a direct application of the material in the info node (elisp#Nonlocal Exits).
The function newsticker--icon-read takes an icon name as input, try to create and return an Emacs image for that icon looking for the image from the disk in the user newsticker directory, and if it can't (because it doesn't exist or it fails at creating the corresponding image) it returns a default image provided by Emacs distribution:
(defun newsticker--icon-read (feed-name-symbol) "Read the cached icon for FEED-NAME-SYMBOL from disk. Return the image." (catch 'icon (when (file-exists-p (newsticker--icons-dir)) (dolist (file (directory-files (newsticker--icons-dir) t (concat (symbol-name feed-name-symbol) "\\..*"))) (condition-case error-data (throw 'icon (create-image file (and (fboundp 'imagemagick-types) (imagemagick-types) 'imagemagick) nil :ascent 'center :max-width 16 :max-height 16)) (error (message "Error: cannot create icon for %s: %s" feed-name-symbol error-data))))) ;; Fallback: default icon. (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center)))))
Leaving out the details of this function, we can extract a simplified scheme, that says:
in a catch block, if the directory
dirdoesn't exist, return a default image, if it exists loop over all the files in the directory
in the loop, for each file try to create an image using that file, if it fails, log the error in the message buffer, if it succeeds, throw to the catch for the tag
iconand return the created image from the catch:
(catch 'icon (when (file-exists-p dir) (dolist (file (directory-files dir)) (condition-case err (throw 'icon (create-image file ...)) (error (message "%s: %s" file err))))) (find-image ...))
In Org related packages, a technique used to find something in the buffer is to:
search in the buffer some part that match some regexp (with re-search-forward),
when we find that part, extract the information available at point (specifically we get it with org-element-at-point),
check some conditions on the element we've parsed,
depending on the result of the previous check, we continue the search in the buffer or we throw and return some result.
This technique can be done with some code similar to this snippet:
(let ((case-fold-search t) (re ...)) (catch :tag (while (re-search-forward re nil t) (let ((element (org-element-at-point))) (when ... (throw :tag ...))))))
We reproduce below the source code of org-babel-find-named-result which also uses that technique but enclosed in a save-excursion that saves the point and current buffer, executes what's in the body and restores those things:
(defun org-babel-find-named-result (name) "Find a named result. Return the location of the result named NAME in the current buffer or nil if no such result exists." (save-excursion (goto-char (point-min)) (let ((case-fold-search t) (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$" org-babel-results-keyword (regexp-quote name)))) (catch :found (while (re-search-forward re nil t) (let ((element (org-element-at-point))) (when (or (eq (org-element-type element) 'keyword) (< (point) (org-element-property :post-affiliated element))) (throw :found (line-beginning-position)))))))))
WE ARE DONE!!!