(defsubst lastcar (lst)
(car (last lst)))
(defun jb-get-matching-name-buffers (regex)
"Return list of buffers with names matching REGEX."
(loop for buf in (buffer-list)
for name = (buffer-name buf)
if (string-match regex name)
(defun jb-get-matching-mode-buffers (regex)
"Return list of buffers with mode names matching REGEX."
(loop for buf in (buffer-list)
for modename = (symbol-name (with-current-buffer buf major-mode))
if (string-match regex modename)
(defun jb-apply-partially (fun &rest args)
"Return a function that is a partial application of FUN to ARGS.
ARGS is a list of the first N arguments to pass to FUN.
The result is a new function which does the same as FUN, except that
the first N arguments are fixed at the values with which this function
ARGS may also contain the symbols 'first 'second 'third' 'fourth 'fifth
'sixth 'seventh 'eigth 'ninth & 'tenth, which will be replaced by the
corresponding args in the call to the new function.
For example (jb-apply-partially '/ 'first 3) returns a function which divides
by three. If we set this to d3 then (d3 6) will return 2, and (d3 6 2) will return 1."
(positions '(first second third four fifth sixth seventh eight ninth tenth))
(mapcar (lambda (x) (eval `(acase x
(push it used)
(list it 'args))
(t x)))) args))
(maxpos (if used (1+ (position (lastcar used) positions)) 0))
(otherargs (if used
(mapcar (lambda (x) (list x 'args))
(set-difference (subseq positions 0 maxpos) used)))))
`(closure (t) (&rest args)
(apply ',fun ,@fixedargs ,@otherargs (subseq args ,maxpos)))))
(defmacro jb-untilnext (initform nextform &optional testfunc &rest bindings)
"Evaluate INITFORM followed by NEXTFORM repeatedly. Stop when one of them returns non-nil, and returning that value.
If TESTFUNC is supplied it should be a function that takes a single argument (the results of evaluating INITFORM or NEXTFORM),
and will be used as the stopping criterion. In this case evaluation will stop when TESTFUNC returns non-nil, but the
return value of the macro will still be the return value of INITFORM or NEXTFORM.
If BINDINGS are supplied then these will be placed in a let form wrapping the code, thus allowing for some persistence of state
between successive evaluations of NEXTFORM.
Note: you can set INITFORM to nil if you only want to evaluate a single form repeatedly."
(let ((retval (gensym)))
`(let* (,@bindings ,retval)
(or (and ,testfunc
(or (and ,initform (funcall ,testfunc ,initform) ,initform)
(while (not (funcall ,testfunc (setq ,retval ,nextform))))
(while (not (setq ,retval ,nextform)))
(defmacro jb-list-subset (indices list)
"Return elements of LIST corresponding to INDICES."
`(mapcar (lambda (i) (nth i ,list)) ,indices))
(defun jb-number-list (start end &optional length)
"Return a sequential list of numbers from START to END.
If END is nil and LENGTH is provided then return a list from START to (1- (+ START LENGTH))."
(loop for i from start to end collect i)
(loop for i from start to (1- (+ start length)) collect i)))
(defmacro* jb-read-key-menu (prompts forms &optional startstr endstr keys)
"Prompt the user for a key and return the results of evaluating the corresponding form in the list FORMS.
If the corresponding form is a symbol just return that symbol unevaluated.
If KEYS is supplied then it should be a list (of the same length as PROMPTS & FORMS) of keys to be prompted for.
Each element of KEYS should be a string or vector as returned by `read-key-sequence'.
If the KEYS list is not long enough to cover all PROMPTS, or if there are nil values in the list then any missing
values will be replaced by unused keys starting with the \"1\" key.
The prompt string for `read-key-sequence' will be formed from PROMPTS, KEYS and the optional STARTSTR and ENDSTR in
the following way:
Where K1-KN are key descriptions of the keys in KEYS, and PROMPT1-PROMPTN are the corresponding prompt strings in the
The macro arguments will be evaluated once before expanding the macro."
(with-gensyms (newprompts prompt prompts2 retval newkeys keystrs maxlen)
`(let* ((,prompts2 ,prompts)
(,newkeys (let* ((origkeys ,keys)
(uniqkeys (remove 'nil origkeys))
(mapcar (lambda (key)
(or key (progn
(setq nextkey (1+ nextkey))
(while (member (char-to-string nextkey) uniqkeys)
(setq nextkey (1+ nextkey)))
(make-list (max 0 (- (length ,prompts2) (length origkeys))) nil)))))
(,keystrs (mapcar 'key-description ,newkeys))
(,maxlen (loop for keystr in ,keystrs maximize (length keystr)))
(,newprompts (mapcar* (lambda (k p)
(let ((len (- ,maxlen (length k))))
(concat k ") " (make-string len ? ) p)))
(,prompt (concat (and ,(eval startstr) (concat ,(eval startstr) "\n"))
(mapconcat 'identity ,newprompts "\n")
(and ,(eval endstr) (concat "\n" ,(eval endstr)))))
(while (eq ,retval 'again)
(while (not (or (member key ,newkeys) (equal key " ")))
(setq key (read-key-sequence ,prompt nil t nil t)))
(if (equal key " ")
(setq ,retval (nth (position key ,newkeys :test 'equal) ,forms)))))
(if (symbolp ,retval) ,retval (eval ,retval)))))