Remove conditionals for non sbcl common lisp implementations

events.lisp

@@ -289,7 +289,7 @@ chunks."
             (screen-last-msg-highlights screen) '())
       (eval-command cmd)
       (xlib:change-property win :stumpwm_command_result
-                            (string-to-bytes (format nil "~{~{~a~%~}~}" (nreverse (screen-last-msg screen))))
+                            (sb-ext:string-to-octets (format nil "~{~{~a~%~}~}" (nreverse (screen-last-msg screen))))
                             :string 8)
       (setf (screen-last-msg screen) msgs
             (screen-last-msg-highlights screen) hlts))

group.lisp

@@ -328,7 +328,9 @@ Groups are known as \"virtual desktops\" in the NETWM standard."
     (xlib:change-property root :_NET_DESKTOP_NAMES
                           (let ((names (mapcan
                                         (lambda (group)
-                                          (list (string-to-utf8 (group-name group))
+                                          (list (sb-ext:string-to-octets
+                                                 (group-name group)
+                                                 :external-format :utf-8)
                                                 '(0)))
                                         (sort-groups screen))))
                             (apply #'concatenate 'list names))

load-stumpwm.lisp.in

@@ -1,30 +1,10 @@
 (in-package #:cl-user)
 
-#-(or sbcl clisp ccl ecl lispworks6)
+#-sbcl
 (error "This lisp implementation is not supported.")
 
 (require 'asdf)
 
-#+lispworks
-(progn
-  (setf *compile-print* 1)
-  (toggle-source-debugging t)
-  (lw:set-default-character-element-type 'lw:simple-char)
-
-  (unless
-      (dolist (install-path
-               '("quicklisp" ".quicklisp"))
-        (let ((quicklisp-init
-                (merge-pathnames (make-pathname :directory `(:relative ,install-path)
-                                                :name "setup.lisp")
-                                 (user-homedir-pathname))))
-          (when (probe-file quicklisp-init)
-            (load quicklisp-init)
-            (return t))))
-
-    (error "Quicklisp must be installed in order to build StumpWM with ~S."
-           (lisp-implementation-type))))
-
 (asdf:initialize-source-registry
  '(:source-registry
    (:directory "@STUMPWM_ASDF_DIR@")

make-image.lisp.in

@@ -2,7 +2,7 @@
 
 (load "load-stumpwm.lisp")
 
-#-ecl (stumpwm:set-module-dir "@MODULE_DIR@")
+(stumpwm:set-module-dir "@MODULE_DIR@")
 
 (when (uiop:version<= "3.1.5" (asdf:asdf-version))
   ;; We register StumpWM and its dependencies as immutable, to stop ASDF from
@@ -11,47 +11,10 @@
   (dolist (system-name (uiop:symbol-call '#:asdf '#:system-depends-on (asdf:find-system :stumpwm)))
     (uiop:symbol-call '#:asdf '#:register-immutable-system system-name)))
 
-#+sbcl
 (sb-ext:save-lisp-and-die "stumpwm" :toplevel (lambda ()
                                                 ;; asdf requires sbcl_home to be set, so set it to the value when the image was built
                                                 (sb-posix:putenv (format nil "SBCL_HOME=~A" #.(sb-ext:posix-getenv "SBCL_HOME")))
                                                 (stumpwm:stumpwm)
                                                 0)
                                     :executable t
                                     :purify t)
-
-#+clisp
-(ext:saveinitmem "stumpwm" :init-function (lambda ()
-                                            (stumpwm:stumpwm)
-                                            (ext:quit))
-                 :executable t :keep-global-handlers t :norc t :documentation "The StumpWM Executable")
-
-#+ccl
-(ccl:save-application "stumpwm" :prepend-kernel t :toplevel-function #'stumpwm:stumpwm)
-
-#+ecl
-(asdf:make-build 'stumpwm :type :program :monolithic t
-                 :move-here "."
-                 :name-suffix ""
-                 :epilogue-code '(progn
-                                  (stumpwm:set-module-dir "@MODULE_DIR@")
-                                  (stumpwm:stumpwm)))
-
-;;; if you want to save an image
-#+(and lispworks (not lispworks-personal-edition))
-(hcl:save-image "stumpwm"
-                :multiprocessing t
-                :environment nil
-                :load-init-files t
-                :restart-function (compile nil
-                                           #'(lambda ()
-                                               (stumpwm:stumpwm)
-                                               (lw:quit :status 0))))
-;;; if you want to save a standalone executable
-#+(and nil lispworks (not lispworks-personal-edition))
-(lw:deliver #'stumpwm:stumpwm "stumpwm" 0
-            :interface nil
-            :multiprocessing t
-            :keep-pretty-printer t)
-#+(and lispworks lispworks-personal-edition)
-(warn "StumpWM can be saved as an image only in LispWorks Pro/Enterprise editions.")

manual.lisp

@@ -25,7 +25,7 @@
 
 (in-package #:stumpwm)
 
-#+sbcl (require :sb-introspect)
+(require :sb-introspect)
 
 ;; handy for figuring out which symbol is borking the documentation
 (defun dprint (sym)
@@ -45,11 +45,7 @@
                                     (*print-pretty* nil))
                                 (format s "@defun {~a} ~{~a~^ ~}~%~a~&@end defun~%~%"
                                         name
-                                        #+sbcl (sb-introspect:function-lambda-list fn)
-                                        #+clisp (ext:arglist fn)
-                                        #+ccl (ccl:arglist fn)
-                                        #+lispworks (lw:function-lambda-list fn)
-                                        #- (or sbcl clisp ccl lispworks) '("(Check the code for args list)")
+                                        (sb-introspect:function-lambda-list fn)
                                         (documentation fn 'function))
                                 t)))
 
@@ -60,21 +56,8 @@
                                      (*print-pretty* nil))
                                 (format s "@defmac {~a} ~{~a~^ ~}~%~a~&@end defmac~%~%"
                                         name
-                                        #+sbcl (sb-introspect:function-lambda-list (macro-function symbol))
-                                        #+clisp (ext:arglist symbol)
-                                        #+ccl (ccl:arglist symbol)
-                                        #+lispworks (lw:function-lambda-list symbol)
-                                        #- (or sbcl clisp ccl lispworks) '("(Check the code for args list)")
-                                        ;;; FIXME: when clisp compiles
-                                        ;;; a macro it discards the
-                                        ;;; documentation string! So
-                                        ;;; unless when generating the
-                                        ;;; manual for clisp, it is
-                                        ;;; loaded and not compiled
-                                        ;;; this will return NIL.
-                                        #+clisp (or (documentation symbol 'function)
-                                                    "Due to a bug in clisp, macro function documentation is not generated. Try building the manual using sbcl.")
-                                        #-clisp (documentation symbol 'function))
+                                        (sb-introspect:function-lambda-list (macro-function symbol))
+                                        (documentation symbol 'function))
                                 t)))
 
 (defun generate-variable-doc (s line)
@@ -99,11 +82,7 @@
                               (let ((cmd (symbol-function (find-symbol (string-upcase name) :stumpwm))))
                                 (format s "@deffn {Command} ~a ~{~a~^ ~}~%~a~&@end deffn~%~%"
                                         name
-                                        #+sbcl (sb-introspect:function-lambda-list cmd)
-                                        #+clisp (ext:arglist cmd)
-                                        #+ccl (ccl:arglist cmd)
-                                        #+lispworks (lw:function-lambda-list cmd)
-                                        #- (or sbcl clisp ccl lispworks) '("(Check the code for args list)")
+                                        (sb-introspect:function-lambda-list cmd)
                                         (documentation cmd 'function))
                                 t)))
 

pathnames.lisp

@@ -70,45 +70,19 @@ form."
 the directory named by the non-wild pathname designator DIRNAME."
   (when (wild-pathname-p dirname)
     (error "Can only make wildcard directories from non-wildcard directories."))
-  (make-pathname :name #-:cormanlisp :wild #+:cormanlisp "*"
-                 :type #-(or :clisp :cormanlisp) :wild
-                       #+:clisp nil
-                       #+:cormanlisp "*"
+  (make-pathname :name :wild
+                 :type :wild
                  :defaults (pathname-as-directory dirname)))
-#+:clisp
-(defun clisp-subdirectories-wildcard (wildcard)
-  "Creates a wild pathname specifically for CLISP such that
-sub-directories are returned by DIRECTORY."
-  (make-pathname :directory (append (pathname-directory wildcard)
-                                    (list :wild))
-                 :name nil
-                 :type nil
-                 :defaults wildcard))
 
 (defun list-directory (dirname)
   "Returns a fresh list of pathnames corresponding to the truenames of
 all files within the directory named by the non-wild pathname
 designator DIRNAME.  The pathnames of sub-directories are returned in
 directory form - see PATHNAME-AS-DIRECTORY."
   (when (wild-pathname-p dirname)
-    (error "Can only list concrete directory names."))
-  #+:ecl 
-  (let ((dir (pathname-as-directory dirname)))
-    (concatenate 'list
-                 (directory (merge-pathnames (pathname "*/") dir))
-                 (directory (merge-pathnames (pathname "*.*") dir))))
-  #-:ecl 
+    (error "Can only list concrete directory names.")) 
   (let ((wildcard (directory-wildcard dirname)))
-    #+:abcl (system::list-directory dirname)
-    #+(or :sbcl :cmu :scl :lispworks) (directory wildcard)
-    #+(or :openmcl :digitool) (directory wildcard :directories t)
-    #+:allegro (directory wildcard :directories-are-files nil)
-    #+:clisp (nconc (directory wildcard :if-does-not-exist :keep)
-                    (directory (clisp-subdirectories-wildcard wildcard)))
-    #+:cormanlisp (nconc (directory wildcard)
-                         (cl::directory-subdirs dirname)))
-  #-(or :sbcl :cmu :scl :lispworks :openmcl :allegro :clisp :cormanlisp :ecl :abcl :digitool)
-  (error "LIST-DIRECTORY not implemented"))
+ (directory wildcard)))
 (defun list-directory-recursive (dirname &optional flatten-p)
   "Returns a list of pathnames corresponding to the truenames all
   files within the directory and in any subdirectories.  If

primitives.lisp

@@ -25,8 +25,6 @@
 
 (in-package :stumpwm)
 
-#+ecl (require "clx")
-
 (export '(*suppress-abort-messages*
           *suppress-frame-indicator*
           *suppress-window-placement-indicator*
@@ -171,13 +169,6 @@
           stumpwm-warning))
 
 
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;; Currently we only support pause-less CALL-IN-MAIN-THREAD for
-  ;; SBCL, since it requires the new io-loop.
-  #+sbcl
-  (pushnew :call-in-main-thread *features*))
-
 ;;; Message Timer
 (defvar *suppress-abort-messages* nil
   "Suppress abort message when non-nil.")

selection.lisp

@@ -56,7 +56,10 @@
      (xlib:change-property requestor property (getf *x-selection* selection)
                            :string 8 :mode :replace :transform #'xlib:char->card8))
     (:utf8_string
-     (xlib:change-property requestor property (string-to-utf8 (getf *x-selection* selection)) target 8 :mode :replace))
+     (xlib:change-property requestor property (sb-ext:string-to-octets
+                                               (getf *x-selection* selection)
+                                               :external-format :utf-8)
+                           target 8 :mode :replace))
     ;; we don't know how to handle anything else
     (t
      (setf property nil)))

stumpwm.asd

@@ -13,10 +13,11 @@
   :description "A tiling, keyboard driven window manager"
   :serial t
   :depends-on (#:alexandria
-               :cl-ppcre #-cmu :clx #+sbcl :sb-posix)
+               #:cl-ppcre
+               #:clx
+               #:sb-posix)
   :components ((:file "package")
                (:file "primitives")
-               (:file "workarounds")
                (:file "wrappers")
                (:file "pathnames")
                (:file "font-rendering")

stumpwm.lisp

@@ -109,11 +109,7 @@ The action is to call FUNCTION with arguments ARGS."
     (labels ((append-to-list ()
                (sb-thread:with-mutex (*timer-list-lock*)
                  (setf *timer-list* (merge 'list *timer-list* (list timer) #'< :key #'timer-time)))))
-      ;; If CALL-IN-MAIN-THREAD is supported, the timer should be scheduled in the main thread.
-      #+call-in-main-thread
       (call-in-main-thread #'append-to-list)
-      #-call-in-main-thread
-      (append-to-list)
       timer)))
 
 (defun cancel-timer (timer)
@@ -240,12 +236,6 @@ The action is to call FUNCTION with arguments ARGS."
     (dolist (event (reverse events))
       (funcall event))))
 
-#+ccl
-(defmethod io-channel-ioport (io-loop (channel ccl::fd-binary-input-stream))
-  (declare (ignore io-loop))
-  (ccl::stream-device channel :input))
-
-#+call-in-main-thread
 (defun call-in-main-thread (fn)
   (cond (*in-main-thread*
          (funcall fn))
@@ -260,12 +250,6 @@ The action is to call FUNCTION with arguments ARGS."
            (write-byte 0 out)
            (finish-output out)))))
 
-#-call-in-main-thread
-(defun call-in-main-thread (fn)
-  (if *in-main-thread*
-      (funcall fn)
-      (run-with-timer 0 nil fn)))
-
 (defclass display-channel ()
   ((display :initarg :display)))
 
@@ -299,7 +283,6 @@ The action is to call FUNCTION with arguments ARGS."
 
          ;; If we have no implementation for the current CL, then
          ;; don't register the channel.
-         #+call-in-main-thread
          (multiple-value-bind (in out)
              (open-pipe)
            (let ((channel (make-instance 'request-channel :in in :out out)))

stumpwm.texi.in

@@ -2329,9 +2329,6 @@ figure out how to do it in the other distribution and write a
 statement like this:
 
 @example
-#+clisp
-(your-clisp-code)
-#+sbcl
 (your-sbcl-code)
 @end example