Merge pull request #2970 from ccqpein/master

Patch the lisp syntax

CHANGELOG.md

@@ -37,6 +37,7 @@
 - Display which theme is the default one in basic output (no colors), see #2937 (@sblondon)
 - Display which theme is the default one in colored output, see #2838 (@sblondon)
 - Add aarch64-apple-darwin ("Apple Silicon") binary tarballs to releases, see #2967 (@someposer)
+- Update the Lisp syntax, see #2970 (@ccqpein)
 
 ## Syntaxes
 

tests/syntax-tests/highlighted/Lisp/utils.lisp

@@ -1,80 +1,80 @@
-(cl:defpackage :chillax.utils
+(cl:defpackage :chillax.utils
-  (:use :cl :alexandria)
+  (:use :cl :alexandria)
-  (:export
+  (:export
-   :fun :mkhash :hashget :strcat :dequote :at))
+   :fun :mkhash :hashget :strcat :dequote :at))
-(in-package :chillax.utils)
+(in-package :chillax.utils)
 
-;;; Functions
+;;; Functions
-(defmacro fun (&body body)
+(defmacro fun (&body body)
   "This macro puts the FUN back in FUNCTION."
-  `(lambda (&optional _) (declare (ignorable _)) ,@body))
+  `(lambda (&optional _) (declare (ignorable _)) ,@body))
 
-;;; Hash tables
+;;; Hash tables
-(defun mkhash (&rest keys-and-values &aux (table (make-hash-table :test #'equal)))
+(defun mkhash (&rest keys-and-values &aux (table (make-hash-table :test #'equal)))
   "Convenience function for `literal' hash table definition."
-  (loop for (key val) on keys-and-values by #'cddr do (setf (gethash key table) val)
+  (loop for (key val) on keys-and-values by #'cddr do (setf (gethash key table) val)
-     finally (return table)))
+     finally (return table)))
 
-(defun hashget (hash &rest keys)
+(defun hashget (hash &rest keys)
   "Convenience function for recursively accessing hash tables."
-  (reduce (lambda (h k) (gethash k h)) keys :initial-value hash))
+  (reduce (lambda (h k) (gethash k h)) keys :initial-value hash))
 
-(define-compiler-macro hashget (hash &rest keys)
+(define-compiler-macro hashget (hash &rest keys)
-  (if (null keys) hash
+  (if (null keys) hash
-      (let ((hash-sym (make-symbol "HASH"))
+      (let ((hash-sym (make-symbol "HASH"))
-            (key-syms (loop for i below (length keys)
+            (key-syms (loop for i below (length keys)
-                         collect (make-symbol (format nil "~:@(~:R~)-KEY" i)))))
+                         collect (make-symbol (format nil "~:@(~:R~)-KEY" i)))))
-        `(let ((,hash-sym ,hash)
+        `(let ((,hash-sym ,hash)
-               ,@(loop for key in keys for sym in key-syms
+               ,@(loop for key in keys for sym in key-syms
-                    collect `(,sym ,key)))
+                    collect `(,sym ,key)))
-           ,(reduce (lambda (hash key) `(gethash ,key ,hash))
+           ,(reduce (lambda (hash key) `(gethash ,key ,hash))
-                    key-syms :initial-value hash-sym)))))
+                    key-syms :initial-value hash-sym)))))
 
-(defun (setf hashget) (new-value hash key &rest more-keys)
+(defun (setf hashget) (new-value hash key &rest more-keys)
   "Uses the last key given to hashget to insert NEW-VALUE into the hash table
 returned by the second-to-last key.
 tl;dr: DWIM SETF function for HASHGET."
-  (if more-keys
+  (if more-keys
-      (setf (gethash (car (last more-keys))
+      (setf (gethash (car (last more-keys))
-                     (apply #'hashget hash key (butlast more-keys)))
+                     (apply #'hashget hash key (butlast more-keys)))
-            new-value)
+            new-value)
-      (setf (gethash key hash) new-value)))
+      (setf (gethash key hash) new-value)))
 
-;;; Strings
+;;; Strings
-(defun strcat (string &rest more-strings)
+(defun strcat (string &rest more-strings)
-  (apply #'concatenate 'string string more-strings))
+  (apply #'concatenate 'string string more-strings))
 
-(defun dequote (string)
+(defun dequote (string)
-  (let ((len (length string)))
+  (let ((len (length string)))
-    (if (and (> len 1) (starts-with #\" string) (ends-with #\" string))
+    (if (and (> len 1) (starts-with #\" string) (ends-with #\" string))
-      (subseq string 1 (- len 1))
+      (subseq string 1 (- len 1))
-      string)))
+      string)))
 
-;;;
+;;;
-;;; At
+;;; At
-;;;
+;;;
-(defgeneric at (doc &rest keys))
+(defgeneric at (doc &rest keys))
-(defgeneric (setf at) (new-value doc key &rest more-keys))
+(defgeneric (setf at) (new-value doc key &rest more-keys))
 
-(defmethod at ((doc hash-table) &rest keys)
+(defmethod at ((doc hash-table) &rest keys)
-  (apply #'hashget doc keys))
+  (apply #'hashget doc keys))
-(defmethod (setf at) (new-value (doc hash-table) key &rest more-keys)
+(defmethod (setf at) (new-value (doc hash-table) key &rest more-keys)
-  (apply #'(setf hashget) new-value doc key more-keys))
+  (apply #'(setf hashget) new-value doc key more-keys))
 
-(defmethod at ((doc list) &rest keys)
+(defmethod at ((doc list) &rest keys)
-  (reduce (lambda (alist key)
+  (reduce (lambda (alist key)
-            (cdr (assoc key alist :test #'equal)))
+            (cdr (assoc key alist :test #'equal)))
-          keys :initial-value doc))
+          keys :initial-value doc))
-(defmethod (setf at) (new-value (doc list) key &rest more-keys)
+(defmethod (setf at) (new-value (doc list) key &rest more-keys)
-  (if more-keys
+  (if more-keys
-      (setf (cdr (assoc (car (last more-keys))
+      (setf (cdr (assoc (car (last more-keys))
-                        (apply #'at doc key (butlast more-keys))
+                        (apply #'at doc key (butlast more-keys))
-                        :test #'equal))
+                        :test #'equal))
-            new-value)
+            new-value)
-      (setf (cdr (assoc key doc :test #'equal)) new-value)))
+      (setf (cdr (assoc key doc :test #'equal)) new-value)))
 
-;; A playful alias.
+;; A playful alias.
-(defun @ (doc &rest keys)
+(defun @ (doc &rest keys)
-  (apply #'at doc keys))
+  (apply #'at doc keys))
-(defun (setf @) (new-value doc key &rest more-keys)
+(defun (setf @) (new-value doc key &rest more-keys)
-  (apply #'(setf at) new-value doc key more-keys))
+  (apply #'(setf at) new-value doc key more-keys))