x11-wm/stumpwm.stumpwm
1
0
Fork 0
mirror of https://github.com/stumpwm/stumpwm.git synced 2026-09-10 07:26:20 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

make stumpwm working with *print-case* :downcase

Browse source 
fix generating of generic functions and methods for class head, when `*print-case*` is configured to `:downcase`. Otherwise methods like `HEAD-X` where not defined (they where named `|HEAD-x|`, etc.)
This commit is contained in:
bymoz089 2022-09-16 23:49:31 +02:00 committed by GitHub
parent e530d43131
commit 212a259c80
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 4 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
primitives.lisp
View file

@ -673,13 +673,13 @@ upon the class and replaces it. If SUPERCLASSES is NIL then (SWM-CLASS) is used.
(macrolet ((define-head-accessor (name)
(let ((pkg (find-package :stumpwm)))
`(progn
(defgeneric ,(intern (format nil "HEAD-~A" name) pkg) (head)
(defgeneric ,(intern (format nil "HEAD-~A" (symbol-name name)) pkg) (head)
(:method ((head head))
(,(intern (format nil "FRAME-~A" name) pkg) head)))
(,(intern (format nil "FRAME-~A" (symbol-name name)) pkg) head)))
(defmethod (setf ,(intern (format nil "HEAD-~A" name) pkg))
(defmethod (setf ,(intern (format nil "HEAD-~A" (symbol-name name)) pkg))
(new (head head))
(setf (,(intern (format nil "FRAME-~A" name) pkg) head)
(setf (,(intern (format nil "FRAME-~A" (symbol-name name)) pkg) head)
new))))))
(define-head-accessor number)
(define-head-accessor x)