- (flet ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
- (at (tag) (save-excursion (eq tag (read buffer))))
- (to-eol () (buffer-substring-no-properties
- (point) (progn (forward-line 1)
- (1- (point)))))
- (to-semi () (setq b (point)
- e (progn (search-forward ";")
- (1- (point)))))
- (to-one@ () (setq @-holes nil
- b (progn (search-forward "@") (point))
- e (progn (while (and (search-forward "@")
- (= ?@ (char-after))
- (progn
- (push (point) @-holes)
- (forward-char 1)
- (push (point) @-holes))))
- (1- (point)))))
- (tok+val (set-b+e name &optional proc)
- (unless (eq name (setq tok (read buffer)))
- (error "Missing `%s' while parsing %s" name context))
- (sw)
- (funcall set-b+e)
- (cons tok (if proc
- (funcall proc)
- (buffer-substring-no-properties b e))))
- (k-semi (name &optional proc) (tok+val 'to-semi name proc))
- (gather () (let ((pairs `(,e ,@@-holes ,b))
- acc)
- (while pairs
- (push (buffer-substring-no-properties
- (cadr pairs) (car pairs))
- acc)
- (setq pairs (cddr pairs)))
- (apply 'concat acc)))
- (k-one@ (name &optional later) (tok+val 'to-one@ name
- (if later
- (lambda () t)
- 'gather))))
+ (cl-flet*
+ ((sw () (skip-chars-forward " \t\n")) ; i.e., `[:space:]'
+ (at (tag) (save-excursion (eq tag (read buffer))))
+ (to-eol () (buffer-substring-no-properties
+ (point) (progn (forward-line 1)
+ (1- (point)))))
+ (to-semi () (setq b (point)
+ e (progn (search-forward ";")
+ (1- (point)))))
+ (to-one@ () (setq @-holes nil
+ b (progn (search-forward "@") (point))
+ e (progn (while (and (search-forward "@")
+ (= ?@ (char-after))
+ (progn
+ (push (point) @-holes)
+ (forward-char 1)
+ (push (point) @-holes))))
+ (1- (point)))))
+ (tok+val (set-b+e name &optional proc)
+ (unless (eq name (setq tok (read buffer)))
+ (error "Missing `%s' while parsing %s" name context))
+ (sw)
+ (funcall set-b+e)
+ (cons tok (if proc
+ (funcall proc)
+ (buffer-substring-no-properties b e))))
+ (k-semi (name &optional proc) (tok+val #'to-semi name proc))
+ (gather () (let ((pairs `(,e ,@@-holes ,b))
+ acc)
+ (while pairs
+ (push (buffer-substring-no-properties
+ (cadr pairs) (car pairs))
+ acc)
+ (setq pairs (cddr pairs)))
+ (apply 'concat acc)))
+ (k-one@ (name &optional later) (tok+val #'to-one@ name
+ (if later
+ (lambda () t)
+ #'gather))))