branch: elpa/llama
commit 3d9b59e1125e85137346b4c866e8a0a58464acb8
Author: Jonas Bernoulli <[email protected]>
Commit: Jonas Bernoulli <[email protected]>
Hide incompatible code from older compilers
---
llama-test.el | 62 +++++++++++++--------------
llama.el | 131 ++++++++++++++++++++++++++++++----------------------------
2 files changed, 98 insertions(+), 95 deletions(-)
diff --git a/llama-test.el b/llama-test.el
index a8c28d945e..1d2f46fc9c 100644
--- a/llama-test.el
+++ b/llama-test.el
@@ -439,37 +439,37 @@
;; examples where our macro expansion and our font-lock agree, but the
;; author might have intended something else.
- (with-no-warnings ; unused arguments
-
- ;; A good example of what we might not want and theoretically could
- ;; prevent. However, this can also be prevented by just not going
- ;; out of our way to wander into ambiguous territory. While not
- ;; impossible, it is unlikely that someone does this accidentally.
- (should (equal (##setq % 1)
- (lambda (%)
- (setq % 1))))
-
- ;; We have to fake `-setq' because we don't want to depend on `dash'
- ;; and because (equal (lambda () (-setq a 1)) (lambda () (-setq a 1)))
- ;; is never true because `-setq' uses `make-symbol'. Mocking that
- ;; macro does *not* affect the expansion of `##' into a `lambda'.
- (cl-macrolet ((-setq (&rest args) `'(,@args)))
- (should (equal (##-setq % 1)
- (lambda (%)
- (-setq % 1))))
- (should (equal (##-setq (%) '(1))
- (lambda ()
- (-setq (%) '(1)))))
- (should (equal (##-setq [(%)] [(1)])
- (lambda ()
- (-setq [(%)] [(1)]))))
- (should (equal (##-setq [(% %)] [(1 2)])
- (lambda (%)
- (-setq [(% %)] [(1 2)]))))
- (should (equal (##-setq [(%1)] [(1)])
- (lambda (%1)
- (-setq [(%1)] [(1)]))))))
- )
+ (static-if (>= emacs-major-version 28) ; prevent compiler warnings
+ (with-no-warnings ; unused arguments
+ ;; A good example of what we might not want and theoretically could
+ ;; prevent. However, this can also be prevented by just not going
+ ;; out of our way to wander into ambiguous territory. While not
+ ;; impossible, it is unlikely that someone does this accidentally.
+ (should (equal (##setq % 1)
+ (lambda (%)
+ (setq % 1))))
+
+ ;; We have to fake `-setq' because we don't want to depend on `dash'
+ ;; and because (equal (lambda () (-setq a 1)) (lambda () (-setq a 1)))
+ ;; is never true because `-setq' uses `make-symbol'. Mocking that
+ ;; macro does *not* affect the expansion of `##' into a `lambda'.
+ (cl-macrolet ((-setq (&rest args) `'(,@args)))
+ (should (equal (##-setq % 1)
+ (lambda (%)
+ (-setq % 1))))
+ (should (equal (##-setq (%) '(1))
+ (lambda ()
+ (-setq (%) '(1)))))
+ (should (equal (##-setq [(%)] [(1)])
+ (lambda ()
+ (-setq [(%)] [(1)]))))
+ (should (equal (##-setq [(% %)] [(1 2)])
+ (lambda (%)
+ (-setq [(% %)] [(1 2)]))))
+ (should (equal (##-setq [(%1)] [(1)])
+ (lambda (%1)
+ (-setq [(%1)] [(1)]))))))
+ ))
(ert-deftest llama-test-902-errors-second nil
(should-error (##list %2 &2))
diff --git a/llama.el b/llama.el
index 342aca97ae..b242aa79db 100644
--- a/llama.el
+++ b/llama.el
@@ -386,72 +386,75 @@ expansion, and the looks of this face should hint at
that.")
face))
(defun llama--match-and-fontify (re end)
- (and (re-search-forward re end t)
- (prog1 t
- (save-excursion
- (goto-char (match-beginning 0))
- (when-let (((save-match-data (not (nth 8 (syntax-ppss)))))
- ((fboundp 'read-positioning-symbols))
- (expr (ignore-errors
- (read-positioning-symbols (current-buffer)))))
- (put-text-property (match-beginning 0) (point)
- 'font-lock-multiline t)
- (llama--fontify (cdr expr) nil nil t))))))
+ (static-if (fboundp 'bare-symbol)
+ (and (re-search-forward re end t)
+ (prog1 t
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (when-let (((save-match-data (not (nth 8 (syntax-ppss)))))
+ (expr (ignore-errors
+ (read-positioning-symbols
(current-buffer)))))
+ (put-text-property (match-beginning 0) (point)
+ 'font-lock-multiline t)
+ (llama--fontify (cdr expr) nil nil t)))))
+ (list re end))) ; Silence compiler.
(defun llama--fontify (expr &optional fnpos backquoted top)
- (cond
- ((null expr) expr)
- ((eq (car-safe expr) 'quote))
- ((eq (ignore-errors (bare-symbol (car-safe expr))) 'quote))
- ((and (memq (ignore-errors (bare-symbol (car-safe expr)))
- (list (intern "") 'llama))
- (not top)))
- ((and backquoted (symbol-with-pos-p expr)))
- ((and backquoted
- (memq (car-safe expr)
- (list backquote-unquote-symbol
- backquote-splice-symbol)))
- (llama--fontify expr))
- ((symbol-with-pos-p expr)
- (save-match-data
- (when-let*
- ((name (symbol-name (bare-symbol expr)))
- (face (cond
- ((and (string-match
- "\\_<\\(?:\\(_\\)?%\\([1-9]\\)?\\)\\_>" name)
- (or (not fnpos) (match-end 2)))
- 'llama-mandatory-argument)
- ((and (string-match
- "\\_<\\(?:\\(_\\)?&\\([1-9*]\\)?\\)\\_>" name)
- (or (not fnpos) (match-end 2)))
- 'llama-optional-argument))))
- (when (match-end 1)
- (setq face (list 'llama-deleted-argument face)))
- (let ((beg (symbol-with-pos-pos expr)))
- (put-text-property
- beg (save-excursion (goto-char beg) (forward-symbol 1))
- 'face face)))))
- ((or (listp expr)
- (vectorp expr))
- (let* ((vectorp (vectorp expr))
- (expr (if vectorp (append expr ()) expr))
- (fnpos (and (not vectorp)
- (not backquoted)
- (ignore-errors (length expr)))))
- (catch t
- (while t
- (cond ((eq (car expr) backquote-backquote-symbol)
- (setq expr (cdr expr))
- (llama--fontify (car expr) t t))
- ((llama--fontify (car expr) fnpos backquoted)))
- (setq fnpos nil)
- (setq expr (cdr expr))
- (unless (and expr
- (listp expr)
- (not (eq (car expr) backquote-unquote-symbol)))
- (throw t nil))))
- (when expr
- (llama--fontify expr fnpos))))))
+ (static-if (fboundp 'bare-symbol)
+ (cond
+ ((null expr) expr)
+ ((eq (car-safe expr) 'quote))
+ ((eq (ignore-errors (bare-symbol (car-safe expr))) 'quote))
+ ((and (memq (ignore-errors (bare-symbol (car-safe expr)))
+ (list (intern "") 'llama))
+ (not top)))
+ ((and backquoted (symbol-with-pos-p expr)))
+ ((and backquoted
+ (memq (car-safe expr)
+ (list backquote-unquote-symbol
+ backquote-splice-symbol)))
+ (llama--fontify expr))
+ ((symbol-with-pos-p expr)
+ (save-match-data
+ (when-let*
+ ((name (symbol-name (bare-symbol expr)))
+ (face (cond
+ ((and (string-match
+ "\\_<\\(?:\\(_\\)?%\\([1-9]\\)?\\)\\_>" name)
+ (or (not fnpos) (match-end 2)))
+ 'llama-mandatory-argument)
+ ((and (string-match
+ "\\_<\\(?:\\(_\\)?&\\([1-9*]\\)?\\)\\_>" name)
+ (or (not fnpos) (match-end 2)))
+ 'llama-optional-argument))))
+ (when (match-end 1)
+ (setq face (list 'llama-deleted-argument face)))
+ (let ((beg (symbol-with-pos-pos expr)))
+ (put-text-property
+ beg (save-excursion (goto-char beg) (forward-symbol 1))
+ 'face face)))))
+ ((or (listp expr)
+ (vectorp expr))
+ (let* ((vectorp (vectorp expr))
+ (expr (if vectorp (append expr ()) expr))
+ (fnpos (and (not vectorp)
+ (not backquoted)
+ (ignore-errors (length expr)))))
+ (catch t
+ (while t
+ (cond ((eq (car expr) backquote-backquote-symbol)
+ (setq expr (cdr expr))
+ (llama--fontify (car expr) t t))
+ ((llama--fontify (car expr) fnpos backquoted)))
+ (setq fnpos nil)
+ (setq expr (cdr expr))
+ (unless (and expr
+ (listp expr)
+ (not (eq (car expr) backquote-unquote-symbol)))
+ (throw t nil))))
+ (when expr
+ (llama--fontify expr fnpos))))))
+ (list expr fnpos backquoted top)) ; Silence compiler.
(defvar llama-fontify-mode-lighter nil)
