| 1 | ;;; llama.el --- Compact syntax for short lambda -*- lexical-binding:t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2020-2026 Jonas Bernoulli |
| 4 | |
| 5 | ;; Author: Jonas Bernoulli <emacs.llama@jonas.bernoulli.dev> |
| 6 | ;; Homepage: https://github.com/tarsius/llama |
| 7 | ;; Keywords: extensions |
| 8 | |
| 9 | ;; Package-Version: 20261001.1538 |
| 10 | ;; Package-Revision: 6850d0c91b62 |
| 11 | ;; Package-Requires: ( |
| 12 | ;; (emacs "28.1") |
| 13 | ;; (compat "31.1")) |
| 14 | |
| 15 | ;; SPDX-License-Identifier: GPL-3.0-or-later |
| 16 | |
| 17 | ;; This file is free software: you can redistribute it and/or modify |
| 18 | ;; it under the terms of the GNU General Public License as published |
| 19 | ;; by the Free Software Foundation, either version 3 of the License, |
| 20 | ;; or (at your option) any later version. |
| 21 | ;; |
| 22 | ;; This file is distributed in the hope that it will be useful, |
| 23 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 24 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 25 | ;; GNU General Public License for more details. |
| 26 | ;; |
| 27 | ;; You should have received a copy of the GNU General Public License |
| 28 | ;; along with this file. If not, see <https://www.gnu.org/licenses/>. |
| 29 | |
| 30 | ;;; Commentary: |
| 31 | |
| 32 | ;; This package implements a macro named `##', which provides a compact way |
| 33 | ;; to write short `lambda' expressions. |
| 34 | |
| 35 | ;; The signature of the macro is (## FN &rest BODY) and it expands to a |
| 36 | ;; `lambda' expression, which calls the function FN with the arguments BODY |
| 37 | ;; and returns the value of that. The arguments of the `lambda' expression |
| 38 | ;; are derived from symbols found in BODY. |
| 39 | |
| 40 | ;; Each symbol from `%1' through `%9', which appears in an unquoted part |
| 41 | ;; of BODY, specifies a mandatory argument. Each symbol from `&1' through |
| 42 | ;; `&9', which appears in an unquoted part of BODY, specifies an optional |
| 43 | ;; argument. The symbol `&*' specifies extra (`&rest') arguments. |
| 44 | |
| 45 | ;; The shorter symbol `%' can be used instead of `%1', but using both in |
| 46 | ;; the same expression is not allowed. Likewise `&' can be used instead |
| 47 | ;; of `&1'. These shorthands are not recognized in function position. |
| 48 | |
| 49 | ;; To support binding forms that use a vector as VARLIST (such as `-let' |
| 50 | ;; from the `dash' package), argument symbols are also detected inside of |
| 51 | ;; vectors. |
| 52 | |
| 53 | ;; The space between `##' and FN can be omitted because `##' is read-syntax |
| 54 | ;; for the symbol whose name is the empty string. If you prefer you can |
| 55 | ;; place a space there anyway, and if you prefer to not use this somewhat |
| 56 | ;; magical symbol at all, you can instead use the alternative name `llama'. |
| 57 | |
| 58 | ;; Instead of: |
| 59 | ;; |
| 60 | ;; (lambda (a &optional _ c &rest d) |
| 61 | ;; (foo a (bar c) d)) |
| 62 | ;; |
| 63 | ;; you can use this macro and write: |
| 64 | ;; |
| 65 | ;; (##foo %1 (bar &3) &*) |
| 66 | ;; |
| 67 | ;; which expands to: |
| 68 | ;; |
| 69 | ;; (lambda (%1 &optional _&2 &3 &rest &*) |
| 70 | ;; (foo %1 (bar &3) &*)) |
| 71 | |
| 72 | ;; Unused trailing arguments and mandatory unused arguments at the border |
| 73 | ;; between mandatory and optional arguments are also supported: |
| 74 | ;; |
| 75 | ;; (##list %1 _%3 &5 _&6) |
| 76 | ;; |
| 77 | ;; becomes: |
| 78 | ;; |
| 79 | ;; (lambda (%1 _%2 _%3 &optional _&4 &5 _&6) |
| 80 | ;; (list %1 &5)) |
| 81 | ;; |
| 82 | ;; Note how `_%3' and `_&6' are removed from the body, because their names |
| 83 | ;; begin with an underscore. Also note that `_&4' is optional, unlike the |
| 84 | ;; explicitly specified `_%3'. |
| 85 | |
| 86 | ;; Consider enabling `llama-fontify-mode' to highlight `##' and its |
| 87 | ;; special arguments. |
| 88 | |
| 89 | ;;; Code: |
| 90 | |
| 91 | (require 'compat) |
| 92 | |
| 93 | ;;;###autoload |
| 94 | (defmacro llama (fn &rest body) |
| 95 | "Expand to a `lambda' expression that wraps around FN and BODY. |
| 96 | |
| 97 | This macro provides a compact way to write short `lambda' expressions. |
| 98 | It expands to a `lambda' expression, which calls the function FN with |
| 99 | arguments BODY and returns its value. The arguments of the `lambda' |
| 100 | expression are derived from symbols found in BODY. |
| 101 | |
| 102 | Each symbol from `%1' through `%9', which appears in an unquoted part |
| 103 | of BODY, specifies a mandatory argument. Each symbol from `&1' through |
| 104 | `&9', which appears in an unquoted part of BODY, specifies an optional |
| 105 | argument. The symbol `&*' specifies extra (`&rest') arguments. |
| 106 | |
| 107 | The shorter symbol `%' can be used instead of `%1', but using both in |
| 108 | the same expression is not allowed. Likewise `&' can be used instead |
| 109 | of `&1'. These shorthands are not recognized in function position. |
| 110 | |
| 111 | To support binding forms that use a vector as VARLIST (such as `-let' |
| 112 | from the `dash' package), argument symbols are also detected inside of |
| 113 | vectors. |
| 114 | |
| 115 | The space between `##' and FN can be omitted because `##' is read-syntax |
| 116 | for the symbol whose name is the empty string. If you prefer you can |
| 117 | place a space there anyway, and if you prefer to not use this somewhat |
| 118 | magical symbol at all, you can instead use the alternative name `llama'. |
| 119 | |
| 120 | Instead of: |
| 121 | |
| 122 | (lambda (a &optional _ c &rest d) |
| 123 | (foo a (bar c) d)) |
| 124 | |
| 125 | you can use this macro and write: |
| 126 | |
| 127 | (##foo %1 (bar &3) &*) |
| 128 | |
| 129 | which expands to: |
| 130 | |
| 131 | (lambda (%1 &optional _&2 &3 &rest &*) |
| 132 | (foo %1 (bar &3) &*)) |
| 133 | |
| 134 | Unused trailing arguments and mandatory unused arguments at the border |
| 135 | between mandatory and optional arguments are also supported: |
| 136 | |
| 137 | (##list %1 _%3 &5 _&6) |
| 138 | |
| 139 | becomes: |
| 140 | |
| 141 | (lambda (%1 _%2 _%3 &optional _&4 &5 _&6) |
| 142 | (list %1 &5)) |
| 143 | |
| 144 | Note how `_%3' and `_&6' are removed from the body, because their names |
| 145 | begin with an underscore. Also note that `_&4' is optional, unlike the |
| 146 | explicitly specified `_%3'. |
| 147 | |
| 148 | Consider enabling `llama-fontify-mode' to highlight `##' and its |
| 149 | special arguments." |
| 150 | (cond ((symbolp fn)) |
| 151 | ((and (eq (car-safe fn) backquote-backquote-symbol) |
| 152 | (not body)) |
| 153 | (setq body (cdr fn)) |
| 154 | (setq fn backquote-backquote-symbol)) |
| 155 | ((signal 'wrong-type-argument |
| 156 | (list 'symbolp backquote-backquote-symbol fn)))) |
| 157 | (let* ((args (make-vector 10 nil)) |
| 158 | (body (cdr (llama--collect (cons fn body) args))) |
| 159 | (rest (aref args 0)) |
| 160 | (args (nreverse (cdr (append args nil)))) |
| 161 | (args (progn (while (and args (null (car args))) |
| 162 | (setq args (cdr args))) |
| 163 | args)) |
| 164 | (pos (length args)) |
| 165 | (opt nil) |
| 166 | (args (mapcar |
| 167 | (lambda (arg) |
| 168 | (if arg |
| 169 | (setq opt (string-match-p "\\`_?&" (symbol-name arg))) |
| 170 | (setq arg (intern (format "_%c%s" (if opt ?& ?%) pos)))) |
| 171 | (setq pos (1- pos)) |
| 172 | arg) |
| 173 | args)) |
| 174 | (opt nil) |
| 175 | (args (mapcar |
| 176 | (lambda (symbol) |
| 177 | (cond |
| 178 | ((string-match-p "\\`_?%" (symbol-name symbol)) |
| 179 | (when opt |
| 180 | (error "`%s' cannot follow optional arguments" symbol)) |
| 181 | (list symbol)) |
| 182 | (opt |
| 183 | (list symbol)) |
| 184 | ((setq opt t) |
| 185 | (list '&optional symbol)))) |
| 186 | (nreverse args)))) |
| 187 | `(lambda |
| 188 | (,@(apply #'nconc args) |
| 189 | ,@(and rest (list '&rest rest))) |
| 190 | (,fn ,@body)))) |
| 191 | |
| 192 | (defalias (intern "") 'llama) |
| 193 | (defalias '\#\# 'llama) |
| 194 | |
| 195 | (defconst llama--unused-argument (make-symbol "llama--unused-argument")) |
| 196 | |
| 197 | (defun llama--collect (expr args &optional fnpos backquoted unquote) |
| 198 | (cond |
| 199 | ((memq (car-safe expr) (list (intern "") 'llama 'quote)) expr) |
| 200 | ((and backquoted (symbolp expr)) expr) |
| 201 | ((and backquoted |
| 202 | (memq (car-safe expr) |
| 203 | (list backquote-unquote-symbol |
| 204 | backquote-splice-symbol))) |
| 205 | (list (car expr) |
| 206 | (llama--collect (cadr expr) args nil nil t))) |
| 207 | ((memq (car-safe expr) |
| 208 | (list backquote-backquote-symbol |
| 209 | backquote-splice-symbol)) |
| 210 | (list (car expr) |
| 211 | (llama--collect (cadr expr) args nil t))) |
| 212 | ((symbolp expr) |
| 213 | (let ((name (symbol-name expr))) |
| 214 | (save-match-data |
| 215 | (cond |
| 216 | ((string-match "\\`\\(_\\)?[%&]\\([1-9*]\\)?\\'" name) |
| 217 | (let* ((pos (match-string 2 name)) |
| 218 | (pos (cond ((equal pos "*") 0) |
| 219 | ((not pos) 1) |
| 220 | ((string-to-number pos)))) |
| 221 | (sym (aref args pos))) |
| 222 | (unless (and fnpos (not unquote) (memq expr '(% &))) |
| 223 | (when (and sym (not (equal expr sym))) |
| 224 | (error "`%s' and `%s' are mutually exclusive" sym expr)) |
| 225 | (aset args pos expr))) |
| 226 | (if (match-string 1 name) |
| 227 | llama--unused-argument |
| 228 | expr)) |
| 229 | (expr))))) |
| 230 | ((or (listp expr) |
| 231 | (vectorp expr)) |
| 232 | (let* ((vectorp (vectorp expr)) |
| 233 | (expr (if vectorp (append expr ()) expr)) |
| 234 | (fnpos (and (not vectorp) |
| 235 | (not backquoted) |
| 236 | (ignore-errors (length expr)))) ;proper-list-p |
| 237 | (ret ())) |
| 238 | (catch t |
| 239 | (while t |
| 240 | (let ((elt (llama--collect (car expr) args fnpos backquoted))) |
| 241 | (unless (eq elt llama--unused-argument) |
| 242 | (push elt ret))) |
| 243 | (setq fnpos nil) |
| 244 | (setq expr (cdr expr)) |
| 245 | (unless (and expr |
| 246 | (listp expr) |
| 247 | (not (eq (car expr) backquote-unquote-symbol))) |
| 248 | (throw t nil)))) |
| 249 | (setq ret (nreverse ret)) |
| 250 | (when expr |
| 251 | (setcdr (last ret) (llama--collect expr args nil backquoted))) |
| 252 | (if vectorp (vconcat ret) ret))) |
| 253 | (expr))) |
| 254 | |
| 255 | ;;; Completion |
| 256 | |
| 257 | (define-advice elisp--expect-function-p (:around (fn pos) llama) |
| 258 | "Support function completion directly following `##'." |
| 259 | (or (and (eq (char-before pos) ?#) |
| 260 | (eq (char-before (- pos 1)) ?#)) |
| 261 | (and (eq (char-before pos) ?\s) |
| 262 | (eq (char-before (- pos 1)) ?#) |
| 263 | (eq (char-before (- pos 2)) ?#)) |
| 264 | (funcall fn pos))) |
| 265 | |
| 266 | (define-advice all-completions (:around (fn str table &rest rest) llama) |
| 267 | "Remove empty symbol from completion results if originating from `llama'. |
| 268 | |
| 269 | `##' is the notation for the symbol whose name is the empty string. |
| 270 | (intern \"\") => ## |
| 271 | (symbol-name \\='##) => \"\" |
| 272 | |
| 273 | The `llama' package uses `##' as the name of a macro, which allows |
| 274 | it to be used akin to syntax, without actually being new syntax. |
| 275 | \(`describe-function' won't let you select `##', but because that is an |
| 276 | alias for `llama', you can access the documentation under that name.) |
| 277 | |
| 278 | This advice prevents the empty string from being offered as a completion |
| 279 | candidate when `obarray' or a completion table that internally uses |
| 280 | that is used as TABLE." |
| 281 | (let ((result (apply fn str table rest))) |
| 282 | (if (and (eq obarray table) (equal str "")) |
| 283 | (delete "" result) |
| 284 | result))) |
| 285 | |
| 286 | ;;; Fontification |
| 287 | |
| 288 | (defgroup llama () |
| 289 | "Compact syntax for short lambda." |
| 290 | :group 'extensions |
| 291 | :group 'faces |
| 292 | :group 'lisp) |
| 293 | |
| 294 | (defface llama-\#\#-macro '((t :inherit font-lock-function-call-face)) |
| 295 | "Face used for the name of the `##' macro.") |
| 296 | |
| 297 | (defface llama-llama-macro '((t :inherit font-lock-keyword-face)) |
| 298 | "Face used for the name of the `llama' macro.") |
| 299 | |
| 300 | (defface llama-mandatory-argument '((t :inherit font-lock-variable-use-face)) |
| 301 | "Face used for mandatory arguments `%1' through `%9' and `%'.") |
| 302 | |
| 303 | (defface llama-optional-argument '((t :inherit font-lock-type-face)) |
| 304 | "Face used for optional arguments `&1' through `&9', `&' and `&*'.") |
| 305 | |
| 306 | (defface llama-deleted-argument |
| 307 | '((((supports :box t)) |
| 308 | :box (:line-width (-1 . -1) :color "red" :style nil)) |
| 309 | (((supports :underline t)) |
| 310 | :underline "red") |
| 311 | (t |
| 312 | :inherit font-lock-warning-face)) |
| 313 | "Face used for deleted arguments `_%1'...`_%9', `_&1'...`_&9' and `_&*'. |
| 314 | This face is used in addition to one of llama's other argument faces. |
| 315 | Unlike implicit unused arguments (which do not appear in the function |
| 316 | body), these arguments are deleted from the function body during macro |
| 317 | expansion, and the looks of this face should hint at that.") |
| 318 | |
| 319 | (defconst llama-font-lock-keywords-28 |
| 320 | '(("(\\(##\\)" 1 'llama-\#\#-macro) |
| 321 | ("(\\(llama\\)\\_>" 1 'llama-llama-macro) |
| 322 | ("\\_<\\(?:_?%[1-9]?\\)\\_>" |
| 323 | 0 (llama--maybe-face 'llama-mandatory-argument)) |
| 324 | ("\\_<\\(?:_?&[1-9*]?\\)\\_>" |
| 325 | 0 (llama--maybe-face 'llama-optional-argument)) |
| 326 | ("\\_<\\(?:_\\(?:%[1-9]?\\|&[1-9*]?\\)\\)\\_>" |
| 327 | 0 'llama-deleted-argument prepend))) |
| 328 | |
| 329 | (defconst llama-font-lock-keywords-29 |
| 330 | `(("\\_<\\(&[1-9*]?\\)\\_>" 1 'default) |
| 331 | (,(apply-partially #'llama--match-and-fontify "(\\(##\\)") |
| 332 | 1 'llama-\#\#-macro) |
| 333 | (,(apply-partially #'llama--match-and-fontify "(\\(llama\\_>\\)") |
| 334 | 1 'llama-llama-macro))) |
| 335 | |
| 336 | (defvar llama-font-lock-keywords |
| 337 | (if (fboundp 'read-positioning-symbols) |
| 338 | llama-font-lock-keywords-29 |
| 339 | llama-font-lock-keywords-28)) |
| 340 | |
| 341 | (defun llama--maybe-face (face) |
| 342 | (and (not (and (member (match-string 0) '("%" "&")) |
| 343 | (and-let* ((beg (ignore-errors |
| 344 | (scan-lists (match-beginning 0) -1 1)))) |
| 345 | (string-match-p "\\`\\(##\\|llama\\_>\\)?[\s\t\n\r]*\\'" |
| 346 | (buffer-substring-no-properties |
| 347 | (1+ beg) (match-beginning 0)))))) |
| 348 | face)) |
| 349 | |
| 350 | (defun llama--match-and-fontify (re end) |
| 351 | (static-if (fboundp 'bare-symbol) |
| 352 | (and (re-search-forward re end t) |
| 353 | (prog1 t |
| 354 | (save-excursion |
| 355 | (goto-char (match-beginning 0)) |
| 356 | (when-let* |
| 357 | ((_(save-match-data (not (nth 8 (syntax-ppss))))) |
| 358 | (expr (ignore-errors |
| 359 | (read-positioning-symbols (current-buffer))))) |
| 360 | (put-text-property (match-beginning 0) (point) |
| 361 | 'font-lock-multiline t) |
| 362 | (llama--fontify (cdr expr) nil nil t))))) |
| 363 | (progn re end nil))) ; Silence compiler. |
| 364 | |
| 365 | (defun llama--fontify (expr &optional fnpos backquoted top) |
| 366 | (static-if (fboundp 'bare-symbol) |
| 367 | (cond |
| 368 | ((null expr) expr) |
| 369 | ((eq (car-safe expr) 'quote)) |
| 370 | ((eq (ignore-errors (bare-symbol (car-safe expr))) 'quote)) |
| 371 | ((and (memq (ignore-errors (bare-symbol (car-safe expr))) |
| 372 | (list (intern "") 'llama)) |
| 373 | (not top))) |
| 374 | ((and backquoted (symbol-with-pos-p expr))) |
| 375 | ((and backquoted |
| 376 | (memq (car-safe expr) |
| 377 | (list backquote-unquote-symbol |
| 378 | backquote-splice-symbol))) |
| 379 | (llama--fontify expr)) |
| 380 | ((symbol-with-pos-p expr) |
| 381 | (save-match-data |
| 382 | (when-let* |
| 383 | ((name (symbol-name (bare-symbol expr))) |
| 384 | (face (cond |
| 385 | ((and (string-match |
| 386 | "\\_<\\(?:\\(_\\)?%\\([1-9]\\)?\\)\\_>" name) |
| 387 | (or (not fnpos) (match-end 2))) |
| 388 | 'llama-mandatory-argument) |
| 389 | ((and (string-match |
| 390 | "\\_<\\(?:\\(_\\)?&\\([1-9*]\\)?\\)\\_>" name) |
| 391 | (or (not fnpos) (match-end 2))) |
| 392 | 'llama-optional-argument)))) |
| 393 | (when (match-end 1) |
| 394 | (setq face (list 'llama-deleted-argument face))) |
| 395 | (let ((beg (symbol-with-pos-pos expr))) |
| 396 | (put-text-property |
| 397 | beg (save-excursion (goto-char beg) (forward-symbol 1)) |
| 398 | 'face face))))) |
| 399 | ((or (listp expr) |
| 400 | (vectorp expr)) |
| 401 | (let* ((vectorp (vectorp expr)) |
| 402 | (expr (if vectorp (append expr ()) expr)) |
| 403 | (fnpos (and (not vectorp) |
| 404 | (not backquoted) |
| 405 | (ignore-errors (length expr))))) |
| 406 | (catch t |
| 407 | (while t |
| 408 | (cond ((eq (car expr) backquote-backquote-symbol) |
| 409 | (setq expr (cdr expr)) |
| 410 | (llama--fontify (car expr) t t)) |
| 411 | ((llama--fontify (car expr) fnpos backquoted))) |
| 412 | (setq fnpos nil) |
| 413 | (setq expr (cdr expr)) |
| 414 | (unless (and expr |
| 415 | (listp expr) |
| 416 | (not (eq (car expr) backquote-unquote-symbol))) |
| 417 | (throw t nil)))) |
| 418 | (when expr |
| 419 | (llama--fontify expr fnpos)))))) |
| 420 | (and expr fnpos backquoted top nil)) ; Silence compiler. |
| 421 | |
| 422 | (defvar llama-fontify-mode-lighter nil) |
| 423 | |
| 424 | ;;;###autoload |
| 425 | (define-minor-mode llama-fontify-mode |
| 426 | "In Emacs Lisp mode, highlight the `##' macro and its special arguments." |
| 427 | :lighter llama-fontify-mode-lighter |
| 428 | :global t |
| 429 | (cond |
| 430 | (llama-fontify-mode |
| 431 | (advice-add 'lisp--el-match-keyword :override |
| 432 | #'lisp--el-match-keyword@llama '((depth . -80))) |
| 433 | (advice-add 'elisp-mode-syntax-propertize :override |
| 434 | #'elisp-mode-syntax-propertize@llama) |
| 435 | (add-hook 'emacs-lisp-mode-hook #'llama--add-font-lock-keywords)) |
| 436 | (t |
| 437 | (advice-remove 'lisp--el-match-keyword |
| 438 | #'lisp--el-match-keyword@llama) |
| 439 | (advice-remove 'elisp-mode-syntax-propertize |
| 440 | #'elisp-mode-syntax-propertize@llama) |
| 441 | (remove-hook 'emacs-lisp-mode-hook #'llama--add-font-lock-keywords))) |
| 442 | (dolist (buffer (buffer-list)) |
| 443 | (with-current-buffer buffer |
| 444 | (when (derived-mode-p 'emacs-lisp-mode) |
| 445 | (if llama-fontify-mode |
| 446 | (font-lock-add-keywords nil llama-font-lock-keywords) |
| 447 | (font-lock-remove-keywords nil llama-font-lock-keywords)) |
| 448 | (font-lock-flush))))) |
| 449 | |
| 450 | (defun llama--add-font-lock-keywords () |
| 451 | (font-lock-add-keywords nil llama-font-lock-keywords)) |
| 452 | |
| 453 | (defun lisp--el-match-keyword@llama (limit) |
| 454 | "Highlight symbols following \"(##\" the same as if they followed \"(\"." |
| 455 | (catch 'found |
| 456 | (while (re-search-forward |
| 457 | (concat "(\\(?:## ?\\)?\\(" |
| 458 | (static-if (get 'lisp-mode-symbol 'rx-definition) ;>= 29.1 |
| 459 | (rx lisp-mode-symbol) |
| 460 | lisp-mode-symbol-regexp) |
| 461 | "\\)\\_>") |
| 462 | limit t) |
| 463 | (let ((sym (static-if (fboundp 'shorthands-intern-soft) ;~= 32.0.50 |
| 464 | (shorthands-intern-soft (match-string 1)) |
| 465 | (intern-soft (match-string 1))))) |
| 466 | (when (and (or (special-form-p sym) |
| 467 | (macrop sym) |
| 468 | (get sym 'font-lock-keyword)) ;~= 32.0.50 and morlock |
| 469 | (not (get sym 'no-font-lock-keyword)) |
| 470 | (lisp--el-funcall-position-p (match-beginning 0))) |
| 471 | (throw 'found t)))))) |
| 472 | |
| 473 | (defun elisp-mode-syntax-propertize@llama (start end) |
| 474 | ;; Synced with Emacs up to 6b9510d94f814cacf43793dce76250b5f7e6f64a. |
| 475 | "Highlight `##' as the symbol which it is." |
| 476 | (goto-char start) |
| 477 | (let ((case-fold-search nil)) |
| 478 | (funcall |
| 479 | (syntax-propertize-rules |
| 480 | ;; Empty symbol. |
| 481 | ;; {{ Comment out to prevent the `##' from becoming part of |
| 482 | ;; the following symbol when there is no space in between. |
| 483 | ;; ("##" (0 (unless (nth 8 (syntax-ppss)) |
| 484 | ;; (string-to-syntax "_")))) |
| 485 | ;; }} |
| 486 | ;; {{ As for other symbols, use `font-lock-constant-face' in |
| 487 | ;; docstrings and comments. |
| 488 | ("##" (0 (when (nth 8 (syntax-ppss)) |
| 489 | (string-to-syntax "_")))) |
| 490 | ;; }} |
| 491 | ;; {{ Preserve this part, even though it is absent from |
| 492 | ;; this function in 29.1; backporting it by association. |
| 493 | ;; Prevent the @ from becoming part of a following symbol. |
| 494 | (",@" (0 (unless (nth 8 (syntax-ppss)) |
| 495 | (string-to-syntax "'")))) |
| 496 | ;; }} |
| 497 | ;; Unicode character names. (The longest name is 88 characters |
| 498 | ;; long.) |
| 499 | ("\\?\\\\N{[-A-Za-z0-9 ]\\{,100\\}}" |
| 500 | (0 (unless (nth 8 (syntax-ppss)) |
| 501 | (string-to-syntax "_")))) |
| 502 | ((rx "#" (or (seq (group-n 1 "&" (+ digit)) ?\") ; Bool-vector. |
| 503 | (seq (group-n 1 "s") "(") ; Record. |
| 504 | (seq (group-n 1 (+ "^")) "["))) ; Char-table. |
| 505 | (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) |
| 506 | (string-to-syntax "'"))))) |
| 507 | start end))) |
| 508 | |
| 509 | ;;; Partial applications |
| 510 | |
| 511 | (defun llama--left-apply-partially (fn &rest args) |
| 512 | "Return a function that is a partial application of FN to ARGS. |
| 513 | |
| 514 | ARGS is a list of the first N arguments to pass to FN. The result |
| 515 | is a new function which does the same as FN, except that the first N |
| 516 | arguments are fixed at the values with which this function was called. |
| 517 | |
| 518 | See also `llama--right-apply-partially', which instead fixes the last |
| 519 | N arguments. |
| 520 | |
| 521 | These functions are intended to be used using the names `partial' and |
| 522 | `rpartial'. To be able to use these shorthands in a file, you must set |
| 523 | the file-local value of `read-symbols-shorthands'. For an example see |
| 524 | the end of file \"llama.el\". |
| 525 | |
| 526 | This is an alternative to `apply-partially', whose name is too long." |
| 527 | (declare (pure t) (side-effect-free error-free)) |
| 528 | (lambda (&rest args2) |
| 529 | (apply fn (append args args2)))) |
| 530 | |
| 531 | (defun llama--right-apply-partially (fn &rest args) |
| 532 | "Return a function that is a right partial application of FN to ARGS. |
| 533 | |
| 534 | ARGS is a list of the last N arguments to pass to FN. The result |
| 535 | is a new function which does the same as FN, except that the last N |
| 536 | arguments are fixed at the values with which this function was called. |
| 537 | |
| 538 | See also `llama--left-apply-partially', which instead fixes the first |
| 539 | N arguments. |
| 540 | |
| 541 | These functions are intended to be used using the names `rpartial' and |
| 542 | `partial'. To be able to use these shorthands in a file, you must set |
| 543 | the file-local value of `read-symbols-shorthands'. For an example see |
| 544 | the end of file \"llama.el\"." |
| 545 | (declare (pure t) (side-effect-free error-free)) |
| 546 | (lambda (&rest args2) |
| 547 | (apply fn (append args2 args)))) |
| 548 | |
| 549 | ;; An example of how one would use these functions: |
| 550 | ;; |
| 551 | ;; (list (funcall (partial (lambda (a b) (list a b)) 'fixed) 'after) |
| 552 | ;; (funcall (rpartial (lambda (a b) (list a b)) 'fixed) 'before)) |
| 553 | |
| 554 | ;; An example of the configuration that is necessary to enable this: |
| 555 | ;; |
| 556 | ;; Local Variables: |
| 557 | ;; indent-tabs-mode: nil |
| 558 | ;; read-symbol-shorthands: ( |
| 559 | ;; ("partial" . "llama--left-apply-partially") |
| 560 | ;; ("rpartial" . "llama--right-apply-partially")) |
| 561 | ;; End: |
| 562 | ;; |
| 563 | ;; Do not set `read-symbol-shorthands' in the ".dir-locals.el" |
| 564 | ;; file, because that does not work for uncompiled libraries. |
| 565 | |
| 566 | (provide 'llama) |
| 567 | |
| 568 | ;;; llama.el ends here |