I need some help understanding completion-at-point.
I have this minimal example, where I want to:
activate when I type "#"
search/complete on candidates car ...
... but return cdr, so result at point is, for example "#doe" (though I may need to extend this later to drop the "#" in some cases, like with LaTeX).
The actual use case is to insert a citation key in a document, but search on author, title, etc. The intention is for this to be used with solutions like corfu and company-capf.
In that code, which is a front-end to bibtex-completion like helm-bibtex and ivy-bibtex, I have a core bibtex-actions-read function based on completing-read-multiple for minibuffer completion.
With this capf, I want to use the same cached data to complete against for at-point completion.
With this test example, I get 1 and 2, which is what I want on the UI end.
(defun test-capf ()
"My capf."
(when (looking-back "#[a-zA-Z]*")
(list
(save-excursion
(backward-word)
(point))
(point)
(lambda (str pred action)
(let ((candidates '(("a title doe" . "doe")
("different title jones" . "jones")
("nothing smith" . "smith"))))
(complete-with-action action candidates str pred))))))
But how do I adapt it to this to add 3? That is, if I type "#not", corfu or company should display "nothing smith", and if I select that item, it should return "#smith" at-point.
Note: my package pretty much depends on completion-styles like orderless, so order is of course not significant.
Do I need to use an :exit-function here?
For completeness, here's the current actual function, which now says "no matches" when I try to use it.
(defun bibtex-actions-complete-key-at-point ()
"Complete citation key at point.
When inserting '#' in a buffer the capf UI will present user with
a list of entries, from which they can narrow against a string
which includes title, author, etc., and then select one. This
function will then return the key 'key', resulting in '#key' at
point."
;; FIX current function only returns "no match"
;; TODO this regex needs to adapt for mode/citation syntax
(when (looking-back "#[a-zA-Z]+" 5)
(let* ((candidates (bibtex-actions--get-candidates))
(begin (save-excursion (backward-word) (point)))
(end (point)))
(list begin end candidates :exclusive 'no
;; I believe I need an exit-function so I can insert the key instead
;; of the candidate string.
:exit-function
(lambda (chosen status)
(when (eq status 'finished)
(cdr (assoc chosen candidates))))))))
Any other tips or suggestions?
This Q&A is related, but I can't figure out how to adapt it.
Why not just keep the completion candidates in your completion table, not conses?
There are some useful wrappers in minibuffer.el around completion tables. In this case you could use completion-table-dynamic, as a wrapper to use a function as the COLLECTION argument to complete-with-action.
I think the more efficient way would just collect the cdrs of your current candidates and allow the C implementations of all-completions to find matches
(complete-with-action action (mapcar #'cdr candidates) str pred)
Or, calling a function to return current candidates
(completion-table-dynamic
(lambda (_str)
(mapcar #'cdr (my-current-candidates))))
Or, filtering in elisp
(let ((candidates '((...)))
(beg '...)
(end '...))
;; ...
(list beg end
(completion-table-dynamic
(lambda (str)
(cl-loop for (a . b) in candidates
if (string-prefix-p str a)
collect b)))))
The solution was an exit-function, with body like this:
(delete-char (- (length str)))
(insert (cdr (assoc str candidates)))))
Related
In Emacs f90 mode, there are two useful functions f90-beginning-of-block and f90-end-of-block, (bound to keys C-M-p and C-M-n,repsectively), which I often use to jump between beginning and end of code blocks (such as function/subroutine/module).
However I found there is weakness in these two functions. For example:
module a
contains
function f()
write(*,*)
end function
end module a
When placing the cursor at the beginning of module and press C-M-n, the cursor will jump to the end function line, rather than the end module a line. The correct behavior appears only after I modify the end function line to the end function f , i.e., adding back the function name. Since there are many existing codes that often omit function names at the end function, I am wondering whether there is an easy improvement to f90-end-of-block, so that it can correctly handle the above case.
The original interactive Lisp function f90-end-of-block is defined as:
(defun f90-end-of-block (&optional num)
"Move point forward to the end of the current code block.
With optional argument NUM, go forward that many balanced blocks.
If NUM is negative, go backward to the start of a block. Checks
for consistency of block types and labels (if present), and
completes outermost block if `f90-smart-end' is non-nil.
Interactively, pushes mark before moving point."
(interactive "p")
;; Can move some distance.
(if (called-interactively-p 'any) (push-mark (point) t))
(and num (< num 0) (f90-beginning-of-block (- num)))
(let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end
(case-fold-search t)
(count (or num 1))
start-list start-this start-type start-label end-type end-label)
(end-of-line) ; probably want this
(while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
(beginning-of-line)
(skip-chars-forward " \t0-9")
(cond ((or (f90-in-string) (f90-in-comment)))
((setq start-this
(or
(f90-looking-at-do)
(f90-looking-at-select-case)
(f90-looking-at-type-like)
(f90-looking-at-associate)
(f90-looking-at-critical)
(f90-looking-at-program-block-start)
(f90-looking-at-if-then)
(f90-looking-at-where-or-forall)))
(setq start-list (cons start-this start-list) ; not add-to-list!
count (1+ count)))
((looking-at (concat "end[ \t]*" f90-blocks-re
"[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?"))
(setq end-type (match-string 1)
end-label (match-string 2)
count (1- count))
;; Check any internal blocks.
(when start-list
(setq start-this (car start-list)
start-list (cdr start-list)
start-type (car start-this)
start-label (cadr start-this))
(or (f90-equal-symbols start-type end-type)
(error "End type `%s' does not match start type `%s'"
end-type start-type))
(or (f90-equal-symbols start-label end-label)
(error "End label `%s' does not match start label `%s'"
end-label start-label)))))
(end-of-line))
(if (> count 0) (error "Missing block end"))
;; Check outermost block.
(when f90-smart-end
(save-excursion
(beginning-of-line)
(skip-chars-forward " \t0-9")
(f90-match-end)))))
A quick hack is to modify the line that checks the label matching from yielding error message to just yielding a warning message:
(or (f90-equal-symbols start-label end-label)
(message "Start label `%s' does not match end label `%s'"
There is a SO user who posted this solution as an answer, but deleted the answer before I can verify the solution. The reason she/he deleted the answer may be because I commented on the answer saying that another function f90-beginning-of-subprogram can handle the case with mismatched labels. But later I found I still need the additional functionalities provided by f90-beginning-of-block, which are not provided by f90-beginning-of-subprogram.
I am supposed to write a program that gets simple user input as a string and the code supposed to writes back a response (name, are you a person etc.) The program suppose to terminate when word 'bye' is typed. The code is below:
(defun x()
(setq words "empty")
(loop while (string/= words "BYE")
(setq words (read-delimited-list #\~)
(write-line words)
(format t "ROBBIE%: Hello, who are you?")
(case (string-include "I'm" words)
(format t "ROBBIE%: Nice to see you, how are you?")
((string-include "Hi" words)
(format t "ROBBIE%: How are you?")
(or (string-include "fine" words) (string-include "person" words))
(format t "ROBBIE%: No I'm a computer")))
(format t "BYE"))
(x)
However, when I compile this on program 2 errors pop up:
Line2:3 warning: undefined variable: COMMON-LISP-USER:: WORDS
Line3:3 error: during macroexpansion of (LOOP WHILE (STRING/= WORDS "BYE") ...). Use BREAK-ON-SIGNALS to intercept.
I've done programming in python but this is extremely complicated lang for me and I need some help understanding why this isn't working? Any advice is greatly appreciated!
When you do this:
(defun x ()
(setf words "foo"))
then words is not defined. It references some global variable, and if that doesn't exist, it will create it, but possibly with some strange behaviour regarding scope and extent. This is not portable code.
In order to introduce a local variable, use let:
(defun x ()
(let ((words "foo"))
;; words is is scope here
)
;; but not here
)
Loop (in the more usual »extended« form) uses loop keywords for all its clauses. There is no implicit body. In order to do something, you might use do, which allows multiple forms to follow:
(defun x ()
(let ((words "foo"))
(loop while (string/= words "bye")
do (setf words (read-line …))
(format …))))
Case uses compile-time values to compare using eql:
(case something
(:foo (do-a-foo))
((:bar :baz) (do-a-bell))
(t (moooh)))
This doesn't work with strings, because strings are not eql unless they are the same object (i. e. they are eq). In your case, you want a cond:
(cond ((string-include-p words "Whatever")
…)
((string-include-p words "yo man")
…))
For interaction with the user, you'd maybe want to use the bidirectional *query-io* stream:
(format *query-io* "Who am I?")
and
(read-line *query-io*)
Read-line gives you strings, and seems much better suited to your task than read-delimited-list, which has other use cases.
Let me focus on aspects of your code not already covered by other solutions.
Loop
Here is your loop structure:
(let ((words "empty"))
(loop
while (string/= words "BYE")
do
(progn
(setq words (read-line)))))
First of all, after do you don't need (progn ...). You could write equally:
(let ((words "empty"))
(loop
while (string/= words "BYE")
do (setq words (read-line))))
Having to initialize words to some arbitrary value (called sometime a sentinel value) is a code smell (not always a bad thing, but there might be better alternatives). Here you can simplify the loop by using a for clause.
(loop
for words = (read-line)
while (string/= words "BYE")
do ...)
Also, you may want to use until with a string= test, this might be more readable:
(loop
for words = (read-line)
until (string= words "BYE")
do ...)
Search
You can test for string inclusion with SEARCH. Here is a little commented snippet of code to showcase how string manipulation function could work:
(defun test-I-am (input)
(let ((start (search "I'am" input)))
(when start
;; we found an occurrence at position start
;; let's find the next space character
(let ((space (position #\space input :start start)))
(when space
;; we found a space character, the name starts just after
(format nil "Hello ~a!" (subseq input (1+ space))))))))
With this simple algorithm, here is a test (e.g. in your REPL):
> (test-i-am "I'am tired")
"Hello tired!"
Replace read-delimited-list with read-line, case with cond and balance some parentheses. Here is working solution, including some function for string-inclusion:
(defun string-include (string1 string2)
(let* ((string1 (string string1)) (length1 (length string1)))
(if (zerop length1)
nil
(labels ((sub (s)
(cond
((> length1 (length s)) nil)
((string= string1 s :end2 (length string1)) string1)
(t (sub (subseq s 1))))))
(sub (string string2))))))
(defun x ()
(let ((words "empty"))
(format t "ROBBIE%: Hello, who are you?~%")
(loop while (string/= words "BYE") do
(progn
(finish-output)
(setq words (read-line))
(cond ((string-include "I'm" words)
(format t "ROBBIE%: Nice to see you, how are you?~%"))
((string-include "Hi" words)
(format t "ROBBIE%: How are you?~%"))
((or (string-include "fine" words)
(string-include "person" words))
(format t "ROBBIE%: No I'm a computer~%")))))
(format t "BYE")))
Then you just call it:
(x)
I'm reading a file char by char and constructing a list which is consist of list of letters of words. I did that but when it comes to testing it prints out NIL. Also outside of test function when i print out list, it prints nicely. What is the problem here? Is there any other meaning of LET keyword?
This is my read fucntion:
(defun read-and-parse (filename)
(with-open-file (s filename)
(let (words)
(let (letter)
(loop for c = (read-char s nil)
while c
do(when (char/= c #\Space)
(if (char/= c #\Newline) (push c letter)))
do(when (or (char= c #\Space) (char= c #\Newline) )
(push (reverse letter) words)
(setf letter '())))
(reverse words)
))))
This is test function:
(defun test_on_test_data ()
(let (doc (read-and-parse "document2.txt"))
(print doc)
))
This is input text:
hello
this is a test
You're not using let properly. The syntax is:
(let ((var1 val1)
(var2 val2)
...)
body)
If the initial value of the variable is NIL, you can abbreviate (varN nil) as just varN.
You wrote:
(let (doc
(read-and-parse "document2.txt"))
(print doc))
Based on the above, this is using the abbreviation, and it's equivalent to:
(let ((doc nil)
(read-and-parse "document2.txt"))
(print doc))
Now you can see that this binds doc to NIL, and binds the variable read-and-parse to "document2.txt". It never calls the function. The correct syntax is:
(let ((doc (read-and-parse "document2.txt")))
(print doc))
Barmar's answer is the right one. For interest, here is a version of read-and-parse which makes possibly-more-idiomatic use of loop, and also abstracts out the 'is the character white' decision since this is something which is really not usefully possible in portable CL as the standard character repertoire is absurdly poor (there's no tab for instance!). I'm sure there is some library available via Quicklisp which deals with this better than the below.
I think this is fairly readable: there's an outer loop which collects words, and an inner loop which collects characters into a word, skipping over whitespace until it finds the next word. Both use loop's collect feature to collect lists forwards. On the other hand, I feel kind of bad every time I use loop (I know there are alternatives).
By default this collects the words as lists of characters: if you tell it to it will collect them as strings.
(defun char-white-p (c)
;; Is a character white? The fallback for this is horrid, since
;; tab &c are not a standard characters. There must be a portability
;; library with a function which does this.
#+LispWorks (lw:whitespace-char-p c)
#+CCL (ccl:whitespacep c) ;?
#-(or LispWorks CCL)
(member char (load-time-value
(mapcan (lambda (n)
(let ((c (name-char n)))
(and c (list c))))
'("Space" "Newline" "Page" "Tab" "Return" "Linefeed"
;; and I am not sure about the following, but, well
"Backspace" "Rubout")))))
(defun read-and-parse (filename &key (as-strings nil))
"Parse a file into a list of words, splitting on whitespace.
By default the words are returned as lists of characters. If
AS-STRINGS is T then they are coerced to strings"
(with-open-file (s filename)
(loop for maybe-word = (loop with collecting = nil
for c = (read-char s nil)
;; carry on until we hit EOF, or we
;; hit whitespace while collecting a
;; word
until (or (not c) ;EOF
(and collecting (char-white-p c)))
;; if we're not collecting and we see
;; a non-white character, then we're
;; now collecting
when (and (not collecting) (not (char-white-p c)))
do (setf collecting t)
when collecting
collect c)
while (not (null maybe-word))
collect (if as-strings
(coerce maybe-word 'string)
maybe-word))))
I have tried in two different ways to write my function. I decided to write a small function to convert to camel case and back with this elisp string library. At first via searching I found this tutorial on replacing things at point and made this function:
; use string manipulation library to switch between camel and snake (s.el)
(defun my_test ()
"test"
(interactive)
;; get current selection or word
(let (bds p1 p2 inputStr resultStr)
;; get boundary
(if (use-region-p)
(setq bds (cons (region-beginning) (region-end) ))
(setq bds (bounds-of-thing-at-point 'word)) )
(setq p1 (car bds) )
(setq p2 (cdr bds) )
;; grab the string
(setq inputStr (buffer-substring-no-properties p1 p2) )
(setq resultStr (s-lower-camel-case inputStr))
(message inputStr)
(delete-region p1 p2 ) ; delete the region
(insert resultStr) ; insert new string
)
)
This does not modify resultStr as expected and just repasts inputStr in there.
What I don't understand about this is that when I eval (with M-:) (setq resultStr (s-lower-camel-case "other_string")) I get the expected result ("otherString")
I even tried a different (and better for my purposes) way of writing the function inspired by this SO question:
(defun change-word-at-point (fun)
(cl-destructuring-bind (beg . end)
(bounds-of-thing-at-point 'word)
(let ((str (buffer-substring-no-properties beg end)))
(delete-region beg end)
(insert (funcall fun str)))))
(defun my_test_camel ()
(interactive)
(change-word-at-point 's-lower-camel-case))
which suffers from the same problem. This makes me think that there is something wrong with the s-lower-camel-case function (or how I am calling it) but that works when called from eval as mentioned above
EDIT: modified first function to include let syntax, see comments
EDIT #2: Both of these functions work correctly, the answer has been accepted as it provides a better alternative with the information on symbol and the correct way of writing it. My problem was testing which was due to haskell-mode. New question is here
Here's an alternate definition. The comment was correct that you need to do local bindings via let. Note that this version uses the region if it's active, or else uses bounds-of-thing-at-point to get the word at point if no region is active:
(defun word-or-region-to-lcc ()
"Convert word at point (or selected region) to lower camel case."
(interactive)
(let* ((bounds (if (use-region-p)
(cons (region-beginning) (region-end))
(bounds-of-thing-at-point 'symbol)))
(text (buffer-substring-no-properties (car bounds) (cdr bounds))))
(when bounds
(delete-region (car bounds) (cdr bounds))
(insert (s-lower-camel-case text)))))
If you didn't care about the option to use region, you could bind text locally to (thing-at-point 'symbol) instead of the call to buffer-substring-no-properties.
UPDATE. It turns out you can use (thing-at-point 'symbol) rather than (thing-at-point 'word) to get the full symbol for snake case.
Code that requires break statements or continue statements in other languages can be done with block & return-from or catch & throw in Common Lisp and Emacs Lisp. Then there is code that requires redo statements, or at least best written with redo. And redo statements don't have to be about loops. How can I do redo in Lisp?
If there was a redo equivalent in Lisp, I think it would work like this: special form with-redo which takes a symbol and forms, and redo which takes a symbol. The form (with-redo 'foo BODY-FORMS...) may contain (redo 'foo) in its BODY-FORMS, and (redo 'foo) transfers control back to the beginning of BODY-FORMS.
In Common Lisp:
(tagbody
start
(do-something)
(go start))
(dotimes (i some-list)
redo
(when (some-condition-p)
(go redo))
(some-more))
Rainer's answer illustrates the use of tagbody which is probably the easiest way to implement this kind of construct (a particular kind of goto, or unconditional jump). I thought it'd be nice to point out that if you don't want to use an explicit tagbody, or an implicit tagbody provided by one of the standard constructs, you can also create a with-redo just as you suggested. The only difference in this implementation is that we won't quote the tag, since they're not evaluted in tagbody, and being consistent with the other constructs is nice too.
(defmacro with-redo (name &body body)
`(macrolet ((redo (name)
`(go ,name)))
(tagbody
,name
,#body)))
CL-USER> (let ((x 0))
(with-redo beginning
(print (incf x))
(when (< x 3)
(redo beginning))))
1
2
3
; => NIL
Now this is actually a leaky abstraction, since the body could define other labels for the implicit tagbody, and could use go instead of redo, and so on. This might be desirable; lots of the built in iteration constructs (e.g., do, do*) use an implicit tagbody, so it might be OK. But, since you're also adding your own control flow operator, redo, you might want to make sure that it can only be used with tags defined by with-redo. In fact, while Perl's redo can be used with or without a label, Ruby's redo doesn't appear to allow a label. The label-less cases allow behavior of jumping back to the innermost enclosing loop (or, in our case, the innermost with-redo). We can address the leaky abstraction, as well as the ability to nest redos at the same time.
(defmacro with-redo (&body body)
`(macrolet ((redo () `(go #1=#:hidden-label)))
(tagbody
#1#
((lambda () ,#body)))))
Here we've defined a tag for use with with-redo that other things shouldn't know about (and can't find out unless they macroexpand some with-redo forms, and we've wrapped the body in a lambda function, which means that, e.g., a symbol in the body is a form to be evaluated, not a tag for tagbody. Here's an example showing that redo jumps back to the nearest lexically enclosing with-redo:
CL-USER> (let ((i 0) (j 0))
(with-redo
(with-redo
(print (list i j))
(when (< j 2)
(incf j)
(redo)))
(when (< i 2)
(incf i)
(redo))))
(0 0)
(0 1)
(0 2)
(1 2)
(2 2)
; => NIL
Of course, since you can define with-redo on your own, you can make the decisions about which design you want to adopt. Perhaps you like the idea of redo taking no arguments (and disguising a go with a secret label, but with-redo still being an implicit tagbody so that you can define other tags and jump to them with go; you can adapt the code here to do just that, too.
Some notes on implementation
This this answer has generated a few comments, I wanted to make a couple more notes about the implementation. Implementing with-redo with labels is pretty straightfoward, and I think that all the answers posted address it; the label-less case is a bit tricker.
First, the use of a local macrolet is a convenience that will get us warnings with redo is used outside of some lexically enclosing with-redo. E.g., in SBCL:
CL-USER> (defun redo-without-with-redo ()
(redo))
; in: DEFUN REDO-WITHOUT-WITH-REDO
; (REDO)
;
; caught STYLE-WARNING:
; undefined function: REDO
Second, the use of #1=#:hidden-label and #1# means that the go tag for redoing is an uninterned symbol (which lessens the likelihood that the abstraction leaks), but also is the same symbol across expansions of with-redo. In the following snippet tag1 and tag2 are the go-tags from two different expansions of with-redo.
(let* ((exp1 (macroexpand-1 '(with-redo 1 2 3)))
(exp2 (macroexpand-1 '(with-redo a b c))))
(destructuring-bind (ml bndgs (tb tag1 &rest rest)) exp1 ; tag1 is the go-tag
(destructuring-bind (ml bndgs (tb tag2 &rest rest)) exp2
(eq tag1 tag2))))
; => T
An alternative implementation of with-redo that uses a fresh gensym for each macroexpansion does not have this guarantee. For instance, consider with-redo-gensym:
(defmacro with-redo-gensym (&body body)
(let ((tag (gensym "REDO-TAG-")))
`(macrolet ((redo () `(go ,tag)))
(tagbody
,tag
((lambda () ,#body))))))
(let* ((exp1 (macroexpand-1 '(with-redo-gensym 1 2 3)))
(exp2 (macroexpand-1 '(with-redo-gensym a b c))))
(destructuring-bind (ml bndgs (tb tag1 &rest rest)) exp1
(destructuring-bind (ml bndgs (tb tag2 &rest rest)) exp2
(eq tag1 tag2))))
; => NIL
Now, it's worth asking whether this makes a practical difference, and if so, in which cases, and is it a difference for the better or the worse? Quite frankly, I'm not entirely sure.
If you were performing some complicated code manipulation after the inner macroexpansion of an (with-redo ...) form, form1, so that (redo) has already been turned into (go #1#), it means that moving the (go #1#) into the body of another (with-redo ...) form, form2, it will still have the effect of restarting an iteration in form2. In my mind, this makes it more like a return that could be transported from a block b1 into a different block b2, with the only difference it now returns from b2 instead of b1. I think that this is desirable, since we're trying to treat label-less with-redo and redo as primitive control structures.
Update: Emacs 24.4 (soon to be released) has tagbody. cl-lib that comes with Emacs 24.4 includes cl-tagbody.
For a dialect of Lisp which doesn't have tagbody, one can still implement redo as long as the dialect has a catch/throw equivalent.
For Emacs Lisp:
;; with-redo version 0.1
(defmacro with-redo (tag &rest body)
"Eval BODY allowing jumps using `throw'.
TAG is evalled to get the tag to use; it must not be nil.
Then the BODY is executed.
Within BODY, a call to `throw' with the same TAG and a non-nil VALUE causes a jump to the beginning of BODY.
A call to `throw' with the same TAG and nil as VALUE exits BODY and this `with-redo'.
If no throw happens, `with-redo' returns the value of the last BODY form."
(declare (indent 1))
(let ((ret (make-symbol "retval")))
`(let (,ret)
(while
(catch ,tag
(setq ,ret (progn ,#body))
nil))
,ret)))
(defun redo (symbol)
(throw symbol t))
Example of use (all examples are in Emacs Lisp):
(with-redo 'question
(let ((name (read-string "What is your name? ")))
(when (equal name "")
(message "Zero length input. Please try again.")
(beep)
(sit-for 1)
(redo 'question))
name))
Same example written as a mid-test loop instead:
(require 'cl-lib)
(let (name)
(cl-loop do
(setq name (read-string "What is your name? "))
while
(equal name "")
do
(message "Zero length input. Please try again.")
(beep)
(sit-for 1))
name)
Same example written as an infinite loop with a throw instead:
(let (name)
(catch 'question
(while t
(setq name (read-string "What is your name? "))
(unless (equal name "")
(throw 'question name))
(message "Zero length input. Please try again.")
(beep)
(sit-for 1))))
Implementing with-lex-redo-anon and lex-redo, where (lex-redo) causes a jump to the beginning of body of the textually/lexically innermost with-lex-redo-anon form:
;; with-lex-redo-anon version 0.1
(require 'cl-lib)
(defmacro with-lex-redo-anon (&rest body)
"Use with `(lex-redo)'."
(let ((tag (make-symbol "lex-redo-tag"))
(ret (make-symbol "retval")))
`(cl-macrolet ((lex-redo () '(cl-return-from ,tag t)))
(let (,ret)
(while
(cl-block ,tag
(setq ,ret (progn ,#body))
nil))
,ret))))
Example test:
(let ((i 0) (j 0))
(with-lex-redo-anon
(with-lex-redo-anon
(print (list i j))
(when (< j 2)
(incf j)
(lex-redo)))
(when (< i 2)
(incf i)
(lex-redo))))
Same output as in another answer.