From 5cf1e68142e56552bd2f8660d475b9bbda73e723 Mon Sep 17 00:00:00 2001 From: Krzysztof Drewniak Date: Sun, 27 Feb 2011 17:40:57 -0600 Subject: [PATCH 1/2] Fixed various formatting issues --- asdf.lisp | 48 ++++++------ command.lisp | 41 +++++----- contrib/aumix.lisp | 8 +- contrib/battery-portable.lisp | 18 ++-- contrib/cpu.lisp | 2 +- contrib/disk.lisp | 4 +- contrib/mpd.lisp | 56 +++++++------- contrib/sbclfix.lisp | 8 +- contrib/surfraw.lisp | 6 +- contrib/window-tags.lisp | 57 ++++++++------ core.lisp | 2 +- events.lisp | 6 +- group.lisp | 44 ++++++----- head.lisp | 6 +- help.lisp | 14 ++- input.lisp | 23 +++--- keytrans.lisp | 6 +- kmap.lisp | 12 ++-- make-image.lisp.in | 16 ++-- message-window.lisp | 14 ++-- mode-line.lisp | 58 ++++++++------- primitives.lisp | 26 +++--- screen.lisp | 10 +- stumpwm.lisp | 40 +++++----- tile-group.lisp | 163 +++++++++++++++++++++-------------------- tile-window.lisp | 12 ++- user.lisp | 102 ++++++++++++++------------ window-placement.lisp | 9 +- window.lisp | 50 +++++++------ workarounds.lisp | 2 +- wrappers.lisp | 14 ++-- 31 files changed, 460 insertions(+), 417 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 80b4c41..b68fd23 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -162,8 +162,8 @@ and NIL NAME and TYPE components" (define-condition formatted-system-definition-error (system-definition-error) ((format-control :initarg :format-control :reader format-control) (format-arguments :initarg :format-arguments :reader format-arguments)) - (:report (lambda (c s) - (apply #'format s (format-control c) (format-arguments c))))) + (:report #'(lambda (c s) + (apply #'format s (format-control c) (format-arguments c))))) (define-condition circular-dependency (system-definition-error) ((components :initarg :components :reader circular-dependency-components))) @@ -182,9 +182,9 @@ and NIL NAME and TYPE components" (define-condition operation-error (error) ((component :reader error-component :initarg :component) (operation :reader error-operation :initarg :operation)) - (:report (lambda (c s) - (format s "~@" - (error-operation c) (error-component c))))) + (:report #'(lambda (c s) + (format s "~@" + (error-operation c) (error-component c))))) (define-condition compile-error (operation-error) ()) (define-condition compile-failed (compile-error) ()) (define-condition compile-warned (compile-error) ()) @@ -350,7 +350,7 @@ and NIL NAME and TYPE components" '(sysdef-central-registry-search)) (defun system-definition-pathname (system) - (some (lambda (x) (funcall x system)) + (some #'(lambda (x) (funcall x system)) *system-definition-search-functions*)) (defvar *central-registry* @@ -592,7 +592,7 @@ system.")) (defmethod component-self-dependencies ((o operation) (c component)) (let ((all-deps (component-depends-on o c))) - (remove-if-not (lambda (x) + (remove-if-not #'(lambda (x) (member (component-name c) (cdr x) :test #'string=)) all-deps))) @@ -600,10 +600,10 @@ system.")) (let ((parent (component-parent c)) (self-deps (component-self-dependencies operation c))) (if self-deps - (mapcan (lambda (dep) - (destructuring-bind (op name) dep - (output-files (make-instance op) - (find-component parent name)))) + (mapcan #'(lambda (dep) + (destructuring-bind (op name) dep + (output-files (make-instance op) + (find-component parent name)))) self-deps) ;; no previous operations needed? I guess we work with the ;; original source file, then @@ -844,10 +844,10 @@ system.")) (defmethod component-depends-on ((o load-source-op) (c component)) (let ((what-would-load-op-do (cdr (assoc 'load-op (slot-value c 'in-order-to))))) - (mapcar (lambda (dep) - (if (eq (car dep) 'load-op) - (cons 'load-source-op (cdr dep)) - dep)) + (mapcar #'(lambda (dep) + (if (eq (car dep) 'load-op) + (cons 'load-source-op (cdr dep)) + dep)) what-would-load-op-do))) (defmethod operation-done-p ((o load-source-op) (c source-file)) @@ -917,16 +917,16 @@ system.")) (return)) (retry () :report - (lambda (s) - (format s "~@" - op component))) + #'(lambda (s) + (format s "~@" + op component))) (accept () :report - (lambda (s) - (format s - "~@" - op component)) + op component)) (setf (gethash (type-of op) (component-operation-times component)) (get-universal-time)) @@ -1114,8 +1114,8 @@ Returns the new tree (which probably shares structure with the old one)" ;; this is inefficient as most of the stored ;; methods will not be for this particular gf n ;; But this is hardly performance-critical - (lambda (m) - (remove-method (symbol-function name) m)) + #'(lambda (m) + (remove-method (symbol-function name) m)) (component-inline-methods ret))) ;; clear methods, then add the new ones (setf (component-inline-methods ret) nil) diff --git a/command.lisp b/command.lisp index 07d1d60..4c9b7d4 100644 --- a/command.lisp +++ b/command.lisp @@ -53,8 +53,8 @@ (define-condition command-docstring-warning (style-warning) ((command :initarg :command)) (:report - (lambda (c s) - (format s "command ~a doesn't have a docstring" (slot-value c 'command))))) + #'(lambda (c s) + (format s "command ~a doesn't have a docstring" (slot-value c 'command))))) (defmacro defcommand (name (&rest args) (&rest interactive-args) &body body) "Create a command function and store its interactive hints in @@ -161,9 +161,9 @@ alias name for the command that is only accessible interactively." (defun dereference-command-symbol (command) "Given a string or symbol look it up in the command database and return whatever it finds: a command, an alias, or nil." - (maphash (lambda (k v) - (when (string-equal k command) - (return-from dereference-command-symbol v))) + (maphash #'(lambda (k v) + (when (string-equal k command) + (return-from dereference-command-symbol v))) *command-hash*)) (defun command-active-p (command) @@ -196,10 +196,10 @@ commands." "Return a list of all interactive commands as strings. By default only return active commands." (let (acc) - (maphash (lambda (k v) - ;; make sure its an active command - (when (get-command-structure v only-active) - (push (string-downcase k) acc))) + (maphash #'(lambda (k v) + ;; make sure its an active command + (when (get-command-structure v only-active) + (push (string-downcase k) acc))) *command-hash*) (sort acc 'string<))) @@ -219,11 +219,12 @@ only return active commands." (defun argument-pop (input) "Pop the next argument off." (unless (argument-line-end-p input) - (let* ((p1 (position-if-not (lambda (ch) - (char= ch #\Space)) + (let* ((p1 (position-if-not #'(lambda (ch) + (char= ch #\Space)) (argument-line-string input) :start (argument-line-start input))) - (p2 (or (and p1 (position #\Space (argument-line-string input) :start p1)) + (p2 (or (and p1 (position #\Space (argument-line-string input) + :start p1)) (length (argument-line-string input))))) (prog1 ;; we wanna return nil if they're the same @@ -287,8 +288,8 @@ This code creates a new type called @code{:symbol} which finds the symbol in the stumpwm package. The command @code{symbol} uses it and then describes the symbol." `(setf (gethash ,type *command-type-hash*) - (lambda (,input ,prompt) - ,@body))) + #'(lambda (,input ,prompt) + ,@body))) (define-stumpwm-type :y-or-n (input prompt) (let ((s (or (argument-pop input) @@ -436,9 +437,9 @@ then describes the symbol." (let ((arg (argument-pop input))) (if arg (or (find arg (group-frames (current-group)) - :key (lambda (f) - (string (get-frame-number-translation f))) - :test 'string=) + :key #'(lambda (f) + (string (get-frame-number-translation f))) + :test #'string=) (throw 'error "Frame not found.")) (or (choose-frame-by-number (current-group)) (throw 'error :abort))))) @@ -510,9 +511,9 @@ user aborted." ;; error actually happened. (restart-case (handler-bind - ((error (lambda (c) - (invoke-restart 'eval-command-error - (format nil "^B^1*Error In Command '^b~a^B': ^n~A~a" + ((error #'(lambda (c) + (invoke-restart 'eval-command-error + (format nil "^B^1*Error In Command '^b~a^B': ^n~A~a" cmd c (if *show-command-backtrace* (backtrace-string) "")))))) (parse-and-run-command cmd)) diff --git a/contrib/aumix.lisp b/contrib/aumix.lisp index f593ab4..eb67cbe 100644 --- a/contrib/aumix.lisp +++ b/contrib/aumix.lisp @@ -84,9 +84,11 @@ (define-stumpwm-type :mixer-channel (input prompt) (let ((n (or (argument-pop input) - (completing-read (current-screen) prompt (mapcar (lambda (sym) - (string-downcase (symbol-name (car sym)))) - *aumix-channels*))))) + (completing-read (current-screen) prompt + (mapcar #'(lambda (sym) + (string-downcase + (symbol-name (car sym)))) + *aumix-channels*))))) (intern (string-upcase n) 'keyword))) (defcommand mixer (channel opstr) ((:mixer-channel "Channel: ") (:rest "Op: ")) diff --git a/contrib/battery-portable.lisp b/contrib/battery-portable.lisp index b7b3b86..007c2a8 100644 --- a/contrib/battery-portable.lisp +++ b/contrib/battery-portable.lisp @@ -132,8 +132,8 @@ (values (parse-integer (info-value battery key)))) (defmethod all-batteries ((method procfs-method)) - (mapcar (lambda (p) - (make-instance 'procfs-battery :path p)) + (mapcar #'(lambda (p) + (make-instance 'procfs-battery :path p)) (list-directory "/proc/acpi/battery/"))) (defmethod state-of ((battery procfs-battery)) @@ -194,13 +194,13 @@ (defmethod all-batteries ((m sysfs-method)) (remove nil - (mapcar (lambda (path) - (handler-case - (when (string= "Battery" - (sysfs-field path "type")) - (make-instance 'sysfs-battery - :path path)) - (file-error () nil))) + (mapcar #'(lambda (path) + (handler-case + (when (string= "Battery" + (sysfs-field path "type")) + (make-instance 'sysfs-battery + :path path)) + (file-error () nil))) (list-directory "/sys/class/power_supply/")))) (defmethod state-of ((battery sysfs-battery)) diff --git a/contrib/cpu.lisp b/contrib/cpu.lisp index 4fb60b2..942d4dc 100644 --- a/contrib/cpu.lisp +++ b/contrib/cpu.lisp @@ -92,7 +92,7 @@ not available). Don't make calculation more than once a second." *prev-idle-cpu* idle *prev-iowait* iowait *prev-result* (list cpu-result sys-result io-result)))))) - (apply 'values *prev-result*)) + (apply #'values *prev-result*)) (defun fmt-cpu-usage (ml) "Returns a string representing current the percent of average CPU diff --git a/contrib/disk.lisp b/contrib/disk.lisp index b230545..ecc4fab 100644 --- a/contrib/disk.lisp +++ b/contrib/disk.lisp @@ -56,8 +56,8 @@ (defun disk-usage-get-field (path field-number) - (let ((usage-infos (find-if (lambda (item) - (string= (car (last item)) path)) + (let ((usage-infos (find-if #'(lambda (item) + (string= (car (last item)) path)) *disk-usage*))) (nth field-number usage-infos))) (defun disk-get-device (path) diff --git a/contrib/mpd.lisp b/contrib/mpd.lisp index 3bbb8ac..892acd9 100644 --- a/contrib/mpd.lisp +++ b/contrib/mpd.lisp @@ -148,7 +148,7 @@ (mpd-receive)) (defun mpd-format-command (fmt &rest args) - (mpd-send-command (apply 'format nil fmt args))) + (mpd-send-command (apply #'format nil fmt args))) (defun mpd-termination-p (str) (or (mpd-error-p str) @@ -443,12 +443,12 @@ Volume (nth (menu-state-selected menu) (menu-state-table menu))) (defun mpd-menu-action (action-type) - (lambda (menu) - (declare (ignore menu)) - (setf *current-menu-input* "") - (throw :menu-quit - (values action-type - (mpd-selected-item menu))))) + #'(lambda (menu) + (declare (ignore menu)) + (setf *current-menu-input* "") + (throw :menu-quit + (values action-type + (mpd-selected-item menu))))) ;; playlist navigation/edition (defvar *mpd-playlist-menu-map* nil) @@ -472,9 +472,9 @@ Volume m))) (defun mpd-uniq-and-sort-list (list criteria &optional do-sort) - (let ((lst (mapcar #'cadr (remove-if (lambda (item) - (not (equal criteria - (first item)))) + (let ((lst (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal criteria + (first item)))) list)))) (if do-sort (sort lst #'string<) @@ -710,9 +710,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-playlist () () (let* ((response (mpd-send-command "playlistinfo")) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (if (< (length result) 80) (message "Current playlist (~a): ~%^7*~{~a~%~}" @@ -733,9 +733,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-search-and-add-artist (what &optional (exact-search nil)) ((:rest "Search & add artist to playlist: ")) (let* ((response (mpd-search "artist" what exact-search)) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (mpd-add result) (if (< (length result) 80) @@ -747,9 +747,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-search-and-add-file (what &optional (exact-search nil)) ((:rest "Search & add file to playlist: ")) (let* ((response (mpd-search "file" what exact-search)) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (mpd-add result) (if (< (length result) 80) @@ -761,9 +761,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-search-and-add-title (what &optional (exact-search nil)) ((:rest "Search & add title to playlist: ")) (let* ((response (mpd-search "title" what exact-search)) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (mpd-add result) (if (< (length result) 80) @@ -775,9 +775,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-search-and-add-album (what &optional (exact-search nil)) ((:rest "Search & add album to playlist: ")) (let* ((response (mpd-search "album" what exact-search)) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (mpd-add result) (if (< (length result) 80) @@ -789,9 +789,9 @@ Passed an argument of zero and if crossfade is on, toggles crossfade off." (defcommand mpd-search-and-add-genre (what &optional (exact-search nil)) ((:rest "Search & add genre to playlist: ")) (let* ((response (mpd-search "genre" what exact-search)) - (result (mapcar #'cadr (remove-if (lambda (item) - (not (equal :file - (first item)))) + (result (mapcar #'cadr (remove-if #'(lambda (item) + (not (equal :file + (first item)))) response)))) (mpd-add result) (if (< (length result) 80) diff --git a/contrib/sbclfix.lisp b/contrib/sbclfix.lisp index e8b0a9e..6df6d92 100644 --- a/contrib/sbclfix.lisp +++ b/contrib/sbclfix.lisp @@ -52,8 +52,8 @@ "Runs the command NAME with ARGS as parameters and return everything the command has printed on stdout as string." (flet ((to-simple-strings (string-list) - (mapcar (lambda (x) - (coerce x 'simple-string)) + (mapcar #'(lambda (x) + (coerce x 'simple-string)) string-list))) (let ((simplified-args (to-simple-strings (cons name args))) (simplified-env (to-simple-strings env)) @@ -106,8 +106,8 @@ the command has printed on stdout as string." (exec-and-collect-output prog args (cons (stumpwm::screen-display-string (current-screen)) - (remove-if (lambda (str) - (string= "DISPLAY=" str :end2 (min 8 (length str)))) + (remove-if #'(lambda (str) + (string= "DISPLAY=" str :end2 (min 8 (length str)))) (sb-ext:posix-environ)))))) ;;; EOF diff --git a/contrib/surfraw.lisp b/contrib/surfraw.lisp index d91699c..7de634c 100644 --- a/contrib/surfraw.lisp +++ b/contrib/surfraw.lisp @@ -54,9 +54,9 @@ (subseq str (1+ pos))))) (defun surfraw-elvis-list () - (mapcar (lambda (x) - (mapcar (lambda (x) (string-trim '(#\Space #\Tab #\Newline) x)) - (split-by-- x))) + (mapcar #'(lambda (x) + (mapcar #'(lambda (x) (string-trim '(#\Space #\Tab #\Newline) x)) + (split-by-- x))) (cdr (split-string (run-shell-command "surfraw -elvi" :collect-output-p) '(#\Newline))))) diff --git a/contrib/window-tags.lisp b/contrib/window-tags.lisp index ca2cb73..121c690 100644 --- a/contrib/window-tags.lisp +++ b/contrib/window-tags.lisp @@ -66,12 +66,14 @@ "Remove specified or all tags" (let* ((tags (string-split-by-spaces argtags)) - (condition (if tags (lambda(x) (find x tags :test 'equalp)) (lambda (x) t)))) + (condition (if tags #'(lambda(x) (find x tags :test 'equalp)) + #'(lambda (x) t)))) (clear-tags-if condition argwin))) (defcommand clear-all-tags () () "Remove all tags and start afresh" - (mapcar (lambda(x) (clear-tags nil x)) (screen-windows (current-screen)))) + (mapcar #'(lambda (x) (clear-tags nil x)) + (screen-windows (current-screen)))) (defcommand tag-window (argtag &optional (argwin nil)) ((:rest "Tag to set: ") :rest) "Add a tag to current window" @@ -86,13 +88,13 @@ (message "Window list: ~{~%~{[ ~a ] ( ~a | ~a | ~a ) ~% ->~{~a, ~}~}~}" (mapcar - (lambda(x) - (list - (window-title x) - (window-class x) - (window-res x) - (window-role x) - (window-tags x))) + #'(lambda (x) + (list + (window-title x) + (window-class x) + (window-res x) + (window-role x) + (window-tags x))) (screen-windows (current-screen)))))) ; Selection of tags and windows by tags @@ -112,7 +114,7 @@ is implicitly assigned to every window" (let* ((tags (string-split-by-spaces argtags)) - (condition (lambda(w) (tags-from tags w))) + (condition #'(lambda (w) (tags-from tags w))) (windows (screen-windows (current-screen)))) (if without (remove-if condition windows) @@ -131,7 +133,7 @@ (find-group (current-screen) arggroup) (add-group (current-screen) arggroup)) (or arggroup (current-group))))) - (mapcar (lambda (w) (move-window-to-group w group)) windows))) + (mapcar #'(lambda (w) (move-window-to-group w group)) windows))) ; And convenient instances @@ -162,7 +164,7 @@ "Find a numeric tag, if any, and parse it" (let* ((tags (window-tags window)) - (numtag (find-if (lambda(x) (cl-ppcre:scan "^[0-9]+$" x)) tags)) + (numtag (find-if #'(lambda (x) (cl-ppcre:scan "^[0-9]+$" x)) tags)) (num (and numtag (parse-integer numtag)))) num)) @@ -172,23 +174,25 @@ ; First, assign impossible numbers. (mapcar - (lambda(x) - (setf (window-number x) -1)) + #'(lambda (x) + (setf (window-number x) -1)) (group-windows (current-group))) ; Now try to assign numbers to windows holding corresponding tags. (mapcar - (lambda (x) - (let* - ((num (window-number-from-tag x)) - (occupied (mapcar 'window-number (group-windows (current-group))))) - (if (and num (not (find num occupied))) - (setf (window-number x) num)))) - (group-windows (current-group))) + #'(lambda (x) + (let* + ((num (window-number-from-tag x)) + (occupied (mapcar #'window-number + (group-windows (current-group))))) + (if (and num (not (find num occupied))) + (setf (window-number x) num)))) + (group-windows (current-group))) ; Give up and give smallest numbers possible (repack-window-numbers (mapcar 'window-number (remove-if-not - (lambda(x) (equalp (window-number x) (window-number-from-tag x))) + #'(lambda (x) (equalp (window-number x) + (window-number-from-tag x))) (group-windows (current-group)))))) (defcommand tag-visible (&optional (argtags nil)) (:rest) @@ -196,9 +200,12 @@ in current group and only to them" (let* ( - (tags (if (or (equalp argtags "") (not argtags)) "IN-CURRENT-GROUP" argtags))) - (mapcar (lambda (x) (clear-tags tags x)) (screen-windows (current-screen))) - (mapcar (lambda (x) (tag-window tags x)) (group-windows (current-group))))) + (tags (if (or (equalp argtags "") (not argtags)) + "IN-CURRENT-GROUP" argtags))) + (mapcar #'(lambda (x) (clear-tags tags x)) + (screen-windows (current-screen))) + (mapcar #'(lambda (x) (tag-window tags x)) + (group-windows (current-group))))) (defcommand raise-tag (tag) ((:rest "Tag to pull: ")) "Make window current by tag" diff --git a/core.lisp b/core.lisp index b32dc00..0ee9500 100644 --- a/core.lisp +++ b/core.lisp @@ -49,7 +49,7 @@ (cond ((eq (xlib:keycode->keysym *display* code 0) (key-keysym key)) (values code (x11-mods key))) ((eq (xlib:keycode->keysym *display* code 1) (key-keysym key)) - (values code (apply 'xlib:make-state-mask + (values code (apply #'xlib:make-state-mask (cons :shift (xlib:make-state-keys (x11-mods key)))))) (t ;; just warn them and go ahead as scheduled diff --git a/events.lisp b/events.lisp index e23ad50..90f9a96 100644 --- a/events.lisp +++ b/events.lisp @@ -214,8 +214,8 @@ The Caller is responsible for setting up the input focus." (dformat 1 "Awaiting key ~a~%" kmaps) (let* ((key (code-state->key code state)) (key-seq (cons key key-seq)) - (bindings (mapcar (lambda (m) - (lookup-key m key)) + (bindings (mapcar #'(lambda (m) + (lookup-key m key)) (dereference-kmaps kmaps))) ;; if the first non-nil thing is another keymap, then grab ;; all the keymaps and recurse on them. If the first one is a @@ -239,7 +239,7 @@ The Caller is responsible for setting up the input focus." ((and (find key (list (kbd "?") (kbd "C-h")) :test 'equalp)) - (apply 'display-bindings-for-keymaps (reverse (cdr key-seq)) (dereference-kmaps kmaps)) + (apply #'display-bindings-for-keymaps (reverse (cdr key-seq)) (dereference-kmaps kmaps)) (values t key-seq)) (t (values nil key-seq))))) diff --git a/group.lisp b/group.lisp index 27ea95f..078add4 100644 --- a/group.lisp +++ b/group.lisp @@ -126,8 +126,8 @@ start at -1 and go down." (defun non-hidden-groups (groups) "Return only those groups that are not hidden." - (remove-if (lambda (g) - (< (group-number g) 1)) + (remove-if #'(lambda (g) + (< (group-number g) 1)) groups)) (defun netwm-group-id (group) @@ -178,12 +178,12 @@ at 0. Return a netwm compliant group id." ;; be moved. (cond ((window-modal-p window) - (mapc (lambda (w) - (really-move-window w to-group)) + (mapc #'(lambda (w) + (really-move-window w to-group)) (append (list window) (shadows-of window)))) ((modals-of window) - (mapc (lambda (w) - (move-window-to-group w to-group)) + (mapc #'(lambda (w) + (move-window-to-group w to-group)) (modals-of window))) (t (really-move-window window to-group))))) @@ -224,8 +224,8 @@ there exists one." (defun netwm-set-allowed-actions (window) (xlib:change-property (window-xwin window) :_NET_WM_ALLOWED_ACTIONS - (mapcar (lambda (a) - (xlib:intern-atom *display* a)) + (mapcar #'(lambda (a) + (xlib:intern-atom *display* a)) +netwm-allowed-actions+) :atom 32)) @@ -256,9 +256,10 @@ Groups are known as \"virtual desktops\" in the NETWM standard." ;; _NET_DESKTOP_NAMES (xlib:change-property root :_NET_DESKTOP_NAMES (let ((names (mapcan - (lambda (group) - (list (string-to-utf8 (group-name group)) - '(0))) + #'(lambda (group) + (list (string-to-utf8 + (group-name group)) + '(0))) (sort-groups screen)))) (apply #'concatenate 'list names)) :UTF8_STRING 8))) @@ -384,14 +385,15 @@ window along." (defun echo-groups (screen fmt &optional verbose (wfmt *window-format*)) "Print a list of the windows to the screen." (let* ((groups (sort-groups screen)) - (names (mapcan (lambda (g) - (list* - (format-expand *group-formatters* fmt g) - (when verbose - (mapcar (lambda (w) - (format-expand *window-formatters* - (concatenate 'string " " wfmt) - w)) + (names (mapcan #'(lambda (g) + (list* + (format-expand *group-formatters* fmt g) + (when verbose + (mapcar #'(lambda (w) + (format-expand *window-formatters* + (concatenate 'string + " " wfmt) + w)) (sort-windows g))))) (if *list-hidden-groups* groups (non-hidden-groups groups))))) (echo-string-list screen names))) @@ -423,8 +425,8 @@ the default group formatting and window formatting, respectively." for groups" (let ((group (second (select-from-menu (current-screen) - (mapcar (lambda (g) - (list (format-expand *group-formatters* fmt g) g)) + (mapcar #'(lambda (g) + (list (format-expand *group-formatters* fmt g) g)) (screen-groups (current-screen))))))) (when group (switch-to-group group)))) diff --git a/head.lisp b/head.lisp index bd4d78a..286d3f0 100644 --- a/head.lisp +++ b/head.lisp @@ -106,9 +106,9 @@ (defun head-windows (group head) "Returns a list of windows on HEAD of GROUP" (remove-if-not - (lambda (w) - (eq head (window-head w))) - (group-windows group))) + #'(lambda (w) + (eq head (window-head w))) + (groxup-windows group))) (defun frame-is-head (group frame) (< (frame-number frame) (length (group-heads group)))) diff --git a/help.lisp b/help.lisp index ade6f00..3b6e2c4 100644 --- a/help.lisp +++ b/help.lisp @@ -32,11 +32,11 @@ (let* ((rows (ceiling (length list) columns)) (data (loop for i from 0 below (length list) by rows collect (subseq list i (min (+ i rows) (length list))))) - (max (mapcar (lambda (col) - (reduce 'max col :key 'length :initial-value 0)) + (max (mapcar #'(lambda (col) + (reduce 'max col :key 'length :initial-value 0)) data)) (padstr (make-string pad :initial-element char))) - (apply 'mapcar 'concat + (apply #'mapcar #'concat ;; normalize width (loop for i in data @@ -53,8 +53,12 @@ (defun display-bindings-for-keymaps (key-seq &rest keymaps) (let* ((screen (current-screen)) - (data (mapcan (lambda (map) - (mapcar (lambda (b) (format nil "^5*~5a^n ~a" (print-key (binding-key b)) (binding-command b))) (kmap-bindings map))) + (data (mapcan #'(lambda (map) + (mapcar #'(lambda (b) + (format nil "^5*~5a^n ~a" + (print-key (binding-key b)) + (binding-command b))) + (kmap-bindings map))) keymaps)) (cols (ceiling (1+ (length data)) (truncate (- (head-height (current-head)) (* 2 (screen-msg-border-width screen))) diff --git a/input.lisp b/input.lisp index 9b3dcd9..7feae3e 100644 --- a/input.lisp +++ b/input.lisp @@ -143,16 +143,16 @@ (declare (ignore display)) (case event-key ((or :key-release :key-press) - (apply 'input-handle-key-press-event event-slots)) + (apply #'input-handle-key-press-event event-slots)) (t nil))) (defun read-key-or-selection-handle-event (&rest event-slots &key display event-key &allow-other-keys) (declare (ignore display)) (case event-key ((or :key-release :key-press) - (apply 'input-handle-key-press-event event-slots)) + (apply #'input-handle-key-press-event event-slots)) (:selection-notify - (apply 'input-handle-selection-event event-slots)) + (apply #'input-handle-selection-event event-slots)) (t nil))) (defun read-key () @@ -382,13 +382,13 @@ functions are passed this structure as their first argument." (and (symbolp completions) (fboundp completions))) (funcall completions str) - (remove-if-not (lambda (elt) - (when (listp elt) - (setf elt (car elt))) - (and (<= (length str) (length elt)) - (string= str elt - :end1 (length str) - :end2 (length str)))) + (remove-if-not #'(lambda (elt) + (when (listp elt) + (setf elt (car elt))) + (and (<= (length str) (length elt)) + (string= str elt + :end1 (length str) + :end2 (length str)))) completions))) (defun input-complete (input direction) @@ -649,7 +649,8 @@ input (pressing Return), nil otherwise." (defun mod->string (state) "Convert a stump modifier list to a string" (let ((alist '((:alt . "A-") (:meta . "M-") (:hyper . "H-") (:super . "S-")))) - (apply #'concatenate 'string (mapcar (lambda (x) (cdr (assoc x alist))) state)))) + (apply #'concatenate 'string + (mapcar #'(lambda (x) (cdr (assoc x alist))) state)))) ;; (defun keycode->string (code state) ;; (concatenate 'string (mod->string state) diff --git a/keytrans.lisp b/keytrans.lisp index e0e8071..82dbab1 100644 --- a/keytrans.lisp +++ b/keytrans.lisp @@ -42,9 +42,9 @@ names." value)) (defun keysym-name->stumpwm-name (keysym-name) - (maphash (lambda (k v) - (when (equal v keysym-name) - (return-from keysym-name->stumpwm-name k))) + (maphash #'(lambda (k v) + (when (equal v keysym-name) + (return-from keysym-name->stumpwm-name k))) *stumpwm-name->keysym-name-translations*)) (defun stumpwm-name->keysym (stumpwm-name) diff --git a/kmap.lisp b/kmap.lisp index 936f15f..5d83998 100644 --- a/kmap.lisp +++ b/kmap.lisp @@ -98,7 +98,7 @@ the time these just gets in the way." (when (key-super key) (setf mods (append (modifiers-super *modifiers*) mods))) (when with-numlock (setf mods (append (modifiers-numlock *modifiers*) mods))) (when with-capslock (push :lock mods)) - (apply 'xlib:make-state-mask mods))) + (apply #'xlib:make-state-mask mods))) (defun report-kbd-parse-error (c stream) (format stream "Failed to parse key string: ~s" (slot-value c 'string))) @@ -133,7 +133,7 @@ kbd-parse if the key failed to parse." (mods (parse-mods string (if p (1+ p) 0))) (keysym (stumpwm-name->keysym (subseq string (if p (1+ p) 0))))) (if keysym - (apply 'make-key :keysym keysym mods) + (apply #'make-key :keysym keysym mods) (signal 'kbd-parse-error :string string)))) (defun parse-key-seq (keys) @@ -227,10 +227,10 @@ Now when you type C-t C-z, you'll see the text ``Zzzzz...'' pop up." (kmap-symbol-p x))) (defun dereference-kmaps (kmaps) - (mapcar (lambda (m) - (if (kmap-symbol-p m) - (symbol-value m) - m)) + (mapcar #'(lambda (m) + (if (kmap-symbol-p m) + (symbol-value m) + m)) kmaps)) (defun search-kmap (command keymap &key (test 'equal)) diff --git a/make-image.lisp.in b/make-image.lisp.in index 809619a..793179a 100644 --- a/make-image.lisp.in +++ b/make-image.lisp.in @@ -6,11 +6,11 @@ #+sbcl (progn (load "stumpwm.asd") - (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) + (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)) ;;; CLISP @@ -26,9 +26,9 @@ (asdf:oos 'asdf:load-op 'stumpwm)) #+clisp (progn - (ext:saveinitmem "stumpwm" :init-function (lambda () - (stumpwm:stumpwm) - (ext:quit)) + (ext:saveinitmem "stumpwm" :init-function #'(lambda () + (stumpwm:stumpwm) + (ext:quit)) :executable t :keep-global-handlers t :norc t :documentation "The StumpWM Executable")) diff --git a/message-window.lisp b/message-window.lisp index 360cbcf..4a80b87 100644 --- a/message-window.lisp +++ b/message-window.lisp @@ -198,11 +198,13 @@ function expects to be wrapped in a with-state for win." (let ((*record-last-msg-override* t) (*ignore-echo-timeout* t)) (dformat 5 "Redrawing message window!~%") - (apply 'echo-string-list screen (screen-current-msg screen) (screen-current-msg-highlights screen)))) + (apply #'echo-string-list screen (screen-current-msg screen) + (screen-current-msg-highlights screen)))) (defun echo-nth-last-message (screen n) (let ((*record-last-msg-override* t)) - (apply 'echo-string-list screen (nth n (screen-last-msg screen)) (nth n (screen-last-msg-highlights screen))))) + (apply #'echo-string-list screen (nth n (screen-last-msg screen)) + (nth n (screen-last-msg-highlights screen))))) (defun echo-string-list (screen strings &rest highlights) "Draw each string in l in the screen's message window. HIGHLIGHT is @@ -226,7 +228,7 @@ function expects to be wrapped in a with-state for win." (push-last-message screen strings highlights) (xlib:display-finish-output *display*) (dformat 5 "Outputting a message:~%~{ ~a~%~}" strings) - (apply 'run-hook-with-args *message-hook* strings))) + (apply #'run-hook-with-args *message-hook* strings))) (defun echo-string (screen msg) "Display @var{string} in the message bar on @var{screen}. You almost always want to use @command{message}." @@ -234,7 +236,7 @@ function expects to be wrapped in a with-state for win." (defun message (fmt &rest args) "run FMT and ARGS through `format' and echo the result to the current screen." - (echo-string (current-screen) (apply 'format nil fmt args))) + (echo-string (current-screen) (apply #'format nil fmt args))) (defun err (fmt &rest args) @@ -243,13 +245,13 @@ current screen along with a backtrace. For careful study, the message does not time out." (let ((*suppress-echo-timeout* t)) (echo-string (current-screen) - (concat (apply 'format nil fmt args) + (concat (apply #'format nil fmt args) (backtrace-string))))) (defun message-no-timeout (fmt &rest args) "Like message, but the window doesn't disappear after a few seconds." (let ((*suppress-echo-timeout* t)) - (apply 'message fmt args))) + (apply #'message fmt args))) ;;; Commands diff --git a/mode-line.lisp b/mode-line.lisp index f82d165..5e422b2 100644 --- a/mode-line.lisp +++ b/mode-line.lisp @@ -148,27 +148,28 @@ timer.") (defun fmt-urgent-window-list (ml) "Using *window-format*, return a 1 line list of the urgent windows, space seperated." (format nil "~{~a~^ ~}" - (mapcar (lambda (w) - (let ((str (format-expand *window-formatters* *window-format* w))) - (if (eq w (current-window)) - (fmt-highlight str) - str))) + (mapcar #'(lambda (w) + (let ((str (format-expand *window-formatters* *window-format* w))) + (if (eq w (current-window)) + (fmt-highlight str) + str))) (screen-urgent-windows (mode-line-screen ml))))) (defun fmt-window-list (ml) "Using *window-format*, return a 1 line list of the windows, space seperated." (format nil "~{~a~^ ~}" - (mapcar (lambda (w) (format-expand *window-formatters* *window-format* w)) + (mapcar #'(lambda (w) (format-expand *window-formatters* + *window-format* w)) (sort-windows (mode-line-current-group ml))))) (defun fmt-group-list (ml) "Given a group list all the groups in the group's screen." (format nil "~{~a~^ ~}" - (mapcar (lambda (w) - (let* ((str (format-expand *group-formatters* *group-format* w))) - (if (eq w (current-group)) - (fmt-highlight str) - str))) + (mapcar #'(lambda (w) + (let* ((str (format-expand *group-formatters* *group-format* w))) + (if (eq w (current-group)) + (fmt-highlight str) + str))) (sort-groups (group-screen (mode-line-current-group ml)))))) (defun fmt-head (ml) @@ -183,12 +184,13 @@ timer.") (defun fmt-head-window-list (ml) "Using *window-format*, return a 1 line list of the windows, space seperated." (format nil "~{~a~^ ~}" - (mapcar (lambda (w) - (let ((str (format-expand *window-formatters* *window-format* w))) - (if (eq w (current-window)) - (fmt-highlight str) - str))) - (sort1 (head-windows (mode-line-current-group ml) (mode-line-head ml)) + (mapcar #'(lambda (w) + (let ((str (format-expand *window-formatters* *window-format* w))) + (if (eq w (current-window)) + (fmt-highlight str) + str))) + (sort1 (head-windows (mode-line-current-group ml) + (mode-line-head ml)) #'< :key #'window-number)))) (defun fmt-hidden (s) @@ -202,12 +204,12 @@ fmt-highlight. Any non-visible windows are colored the (let* ((all (head-windows (mode-line-current-group ml) (mode-line-head ml))) (non-top (set-difference all (top-windows)))) (format nil "~{~a~^ ~}" - (mapcar (lambda (w) - (let ((str (format-expand *window-formatters* - *window-format* w))) - (cond ((eq w (current-window)) (fmt-highlight str)) - ((find w non-top) (fmt-hidden str)) - (t str)))) + (mapcar #'(lambda (w) + (let ((str (format-expand *window-formatters* + *window-format* w))) + (cond ((eq w (current-window)) (fmt-highlight str)) + ((find w non-top) (fmt-hidden str)) + (t str)))) (sort1 all #'< :key #'window-number))))) (defun fmt-modeline-time (ml) @@ -316,7 +318,7 @@ critical." (defgeneric mode-line-format-elt (elt)) (defmethod mode-line-format-elt ((elt string)) - (apply 'format-expand *current-mode-line-formatters* elt + (apply #'format-expand *current-mode-line-formatters* elt *current-mode-line-formatter-args*)) (defmethod mode-line-format-elt ((elt symbol)) @@ -334,7 +336,7 @@ critical." (defmethod mode-line-format-elt ((elt list)) (etypecase (first elt) ((or string list) - (apply 'concatenate 'string + (apply #'concatenate #'string (mapcar 'mode-line-format-elt elt))) (symbol (mode-line-format-elt @@ -433,9 +435,9 @@ critical." (defun update-mode-line-position (ml x y) (let ((head ;; Find the appropriate head - (find-if (lambda (h) (and (= x (head-x h)) - (>= y (head-y h)) - (< y (+ (head-y h) (head-height h))))) + (find-if #'(lambda (h) (and (= x (head-x h)) + (>= y (head-y h)) + (< y (+ (head-y h) (head-height h))))) (screen-heads (mode-line-screen ml))))) (when (or (not head) (not (eq (head-mode-line head) ml))) diff --git a/primitives.lisp b/primitives.lisp index 10ca8df..b9c89b9 100644 --- a/primitives.lisp +++ b/primitives.lisp @@ -513,9 +513,9 @@ chosen, resignal the error." `(handler-bind ((warning #'muffle-warning) ((or serious-condition error) - (lambda (,c) - (restarts-menu ,c) - (signal ,c)))) + #'(lambda (,c) + (restarts-menu ,c) + (signal ,c)))) ,@body))) ;;; Hook functionality @@ -559,7 +559,7 @@ display a message whenever you switch frames: (defun sort1 (list sort-fn &rest keys &key &allow-other-keys) "Return a sorted copy of list." (let ((copy (copy-list list))) - (apply 'sort copy sort-fn keys))) + (apply #'sort copy sort-fn keys))) (defun mapcar-hash (fn hash) "Just like maphash except it accumulates the result in a list." @@ -575,8 +575,8 @@ look for a free number in the negative direction. anything else means positive direction." (let* ((dirfn (if (eq dir :negative) '> '<)) ;; sort it and crop numbers below/above min depending on dir - (nums (sort (remove-if (lambda (n) - (funcall dirfn n min)) + (nums (sort (remove-if #'(lambda (n) + (funcall dirfn n min)) l) dirfn)) (max (car (last nums))) (inc (if (eq dir :negative) -1 1)) @@ -665,10 +665,10 @@ output directly to a file.") (multiple-value-bind (sec m h) (decode-universal-time (get-universal-time)) (format *debug-stream* "~2,'0d:~2,'0d:~2,'0d " h m sec)) ;; strip out non base-char chars quick-n-dirty like - (write-string (map 'string (lambda (ch) - (if (typep ch 'standard-char) - ch #\?)) - (apply 'format nil fmt args)) + (write-string (map 'string #'(lambda (ch) + (if (typep ch 'standard-char) + ch #\?)) + (apply #'format nil fmt args)) *debug-stream*))) (defvar *redirect-stream* nil @@ -858,8 +858,8 @@ raise/map denial messages will be seen.") (or (eq deny-list t) (and (listp deny-list) - (find-if (lambda (props) - (apply 'window-matches-properties-p window props)) + (find-if #'(lambda (props) + (apply #'window-matches-properties-p window props)) deny-list) t))) @@ -933,7 +933,7 @@ stumpwm symbols. Setting this variable anywhere but in your rc file will have no effect.") (defun concat (&rest strings) - (apply 'concatenate 'string strings)) + (apply #'concatenate 'string strings)) (defvar *window-placement-rules* '() "List of rules governing window placement. Use define-frame-preference to diff --git a/screen.lisp b/screen.lisp index 92782e2..c23c410 100644 --- a/screen.lisp +++ b/screen.lisp @@ -86,12 +86,12 @@ identity with a range check." (defun find-screen (root) "Return the screen containing the root window." - (find-if (lambda (s) - (xlib:window-equal (screen-root s) root)) + (find-if #'(lambda (s) + (xlib:window-equal (screen-root s) root)) *screen-list*)) (defun screen-windows (screen) - (mapcan (lambda (g) (copy-list (group-windows g))) (screen-groups screen))) + (mapcan #'(lambda (g) (copy-list (group-windows g))) (screen-groups screen))) @@ -337,8 +337,8 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK." (root (xlib:screen-root screen-number))) ;; _NET_SUPPORTED (xlib:change-property root :_NET_SUPPORTED - (mapcar (lambda (a) - (xlib:intern-atom *display* a)) + (mapcar #'(lambda (a) + (xlib:intern-atom *display* a)) (append +netwm-supported+ (mapcar #'car +netwm-window-types+))) :atom 32) diff --git a/stumpwm.lisp b/stumpwm.lisp index a356e12..5d47496 100644 --- a/stumpwm.lisp +++ b/stumpwm.lisp @@ -64,7 +64,7 @@ loaded. When CATCH-ERRORS is nil, errors are left to be handled further up. " (asynchronous (message "Caught Asynchronous X Error: ~s ~s" error-key key-vals)) (t - (apply 'error error-key :display display :error-key error-key key-vals)))) + (apply #'error error-key :display display :error-key error-key key-vals)))) ;;; Timers @@ -102,8 +102,8 @@ The action is to call FUNCTION with arguments ARGS." (defun sort-timers (timers) "Return a new list of timers sorted by time to time out." (sort (copy-list timers) - (lambda (a b) - (< (timer-time a) (timer-time b))))) + #'(lambda (a b) + (< (timer-time a) (timer-time b))))) (defun run-expired-timers (timers) "Return a new list of valid timers and run the timer functions @@ -143,25 +143,25 @@ of those expired." (loop (run-hook *internal-loop-hook*) (handler-bind - ((xlib:lookup-error (lambda (c) - (if (lookup-error-recoverable-p) - (recover-from-lookup-error) - (error c)))) + ((xlib:lookup-error #'(lambda (c) + (if (lookup-error-recoverable-p) + (recover-from-lookup-error) + (error c)))) (warning #'muffle-warning) ((or serious-condition error) - (lambda (c) - (run-hook *top-level-error-hook*) - (perform-top-level-error-action c))) + #'(lambda (c) + (run-hook *top-level-error-hook*) + (perform-top-level-error-action c))) (t - (lambda (c) - ;; some other wacko condition was raised so first try - ;; what we can to keep going. - (cond ((find-restart 'muffle-warning) - (muffle-warning)) - ((find-restart 'continue) - (continue))) - ;; and if that fails treat it like a top level error. - (perform-top-level-error-action c)))) + #'(lambda (c) + ;; some other wacko condition was raised so first try + ;; what we can to keep going. + (cond ((find-restart 'muffle-warning) + (muffle-warning)) + ((find-restart 'continue) + (continue))) + ;; and if that fails treat it like a top level error. + (perform-top-level-error-action c)))) ;; Note: process-event appears to hang for an unknown ;; reason. This is why it is passed a timeout in hopes that ;; this will keep it from hanging. @@ -261,7 +261,7 @@ of those expired." ;; we need to jump out of the event loop in order to hup ;; the process because otherwise we get errors. ((eq ret :hup-process) - (apply 'execv (first (argv)) (argv))) + (apply #'execv (first (argv)) (argv))) ((eq ret :restart)) (t ;; the number is the unix return code diff --git a/tile-group.lisp b/tile-group.lisp index 415c4c4..06ac88e 100644 --- a/tile-group.lisp +++ b/tile-group.lisp @@ -318,11 +318,11 @@ T (default) then also focus the frame." (show-frame-outline group)))) (defun frame-windows (group f) - (remove-if-not (lambda (w) (eq (window-frame w) f)) + (remove-if-not #'(lambda (w) (eq (window-frame w) f)) (group-windows group))) (defun frame-sort-windows (group f) - (remove-if-not (lambda (w) (eq (window-frame w) f)) + (remove-if-not #'(lambda (w) (eq (window-frame w) f)) (sort-windows group))) (defun copy-frame-tree (tree) @@ -397,8 +397,8 @@ T (default) then also focus the frame." (if (eq leaf tree) (funcall fn leaf) tree)) - (t (mapcar (lambda (sib) - (funcall-on-leaf sib leaf fn)) + (t (mapcar #'(lambda (sib) + (funcall-on-leaf sib leaf fn)) tree)))) (defun funcall-on-node (tree fn match) @@ -406,14 +406,14 @@ T (default) then also focus the frame." (if (funcall match tree) (funcall fn tree) (cond ((atom tree) tree) - (t (mapcar (lambda (sib) - (funcall-on-node sib fn match)) + (t (mapcar #'(lambda (sib) + (funcall-on-node sib fn match)) tree))))) (defun replace-frame-in-tree (tree f &rest frames) - (funcall-on-leaf tree f (lambda (f) - (declare (ignore f)) - frames))) + (funcall-on-leaf tree f #'(lambda (f) + (declare (ignore f)) + frames))) (defun sibling-internal (tree leaf fn) "helper for next-sibling and prev-sibling." @@ -423,8 +423,8 @@ T (default) then also focus the frame." (pick (car (if (null rest) (funcall fn tree) rest)))) (unless (eq pick leaf) pick))) - (t (find-if (lambda (x) - (sibling-internal x leaf fn)) + (t (find-if #'(lambda (x) + (sibling-internal x leaf fn)) tree)))) (defun next-sibling (tree leaf) @@ -445,9 +445,9 @@ leaf is the most right/below of its siblings." (defun migrate-frame-windows (group src dest) "Migrate all windows in SRC frame to DEST frame." - (mapc (lambda (w) - (when (eq (window-frame w) src) - (setf (window-frame w) dest))) + (mapc #'(lambda (w) + (when (eq (window-frame w) src) + (setf (window-frame w) dest))) (group-windows group))) (defun tree-accum-fn (tree acc fn) @@ -455,14 +455,14 @@ leaf is the most right/below of its siblings." (cond ((null tree) nil) ((atom tree) (funcall fn tree)) - (t (apply acc (mapcar (lambda (x) (tree-accum-fn x acc fn)) tree))))) + (t (apply acc (mapcar #'(lambda (x) (tree-accum-fn x acc fn)) tree))))) (defun tree-iterate (tree fn) "Call FN on every leaf in TREE" (cond ((null tree) nil) ((atom tree) (funcall fn tree)) - (t (mapc (lambda (x) (tree-iterate x fn)) tree)))) + (t (mapc #'(lambda (x) (tree-iterate x fn)) tree)))) (defun tree-x (tree) (tree-accum-fn tree 'min 'frame-x)) @@ -501,7 +501,7 @@ leaf is the most right/below of its siblings." "Return a leaf of the tree. Use this when you need a leaf but you don't care which one." (tree-accum-fn top - (lambda (&rest siblings) + #'(lambda (&rest siblings) (car siblings)) #'identity)) @@ -525,9 +525,9 @@ you don't care which one." (defun offset-tree (tree x y) "move the screen's frames around." - (tree-iterate tree (lambda (frame) - (incf (frame-x frame) x) - (incf (frame-y frame) y)))) + (tree-iterate tree #'(lambda (frame) + (incf (frame-x frame) x) + (incf (frame-y frame) y)))) (defun offset-tree-dir (tree amount dir) (ecase dir @@ -566,7 +566,7 @@ you don't care which one." (amt-list (loop for i in children for old-sz = (funcall sz-fn i) collect (floor (* amount old-sz) total))) - (remainder (- amount (apply '+ amt-list))) + (remainder (- amount (apply #'+ amt-list))) (ofs 0)) ;; spread the remainder out as evenly as possible (assert (< remainder (length amt-list))) @@ -612,11 +612,15 @@ LEAF. Return tree with leaf removed." (ty (tree-y tree)) (wf (/ w tw)) (hf (/ h th))) - (tree-iterate tree (lambda (f) - (setf (frame-height f) (round (* (frame-height f) hf)) - (frame-y f) (+ (round (* (- (frame-y f) ty) hf)) y) - (frame-width f) (round (* (frame-width f) wf)) - (frame-x f) (+ (round (* (- (frame-x f) tx) wf)) x)))) + (tree-iterate tree #'(lambda (f) + (setf (frame-height f) + (round (* (frame-height f) hf)) + (frame-y f) + (+ (round (* (- (frame-y f) ty) hf)) y) + (frame-width f) + (round (* (frame-width f) wf)) + (frame-x f) + (+ (round (* (- (frame-x f) tx) wf)) x)))) (dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree) (tree-height tree)))) (defun remove-frame (tree leaf) @@ -625,24 +629,24 @@ one." (cond ((atom tree) tree) ((find leaf tree) (join-subtrees tree leaf)) - (t (mapcar (lambda (sib) - (remove-frame sib leaf)) + (t (mapcar #'(lambda (sib) + (remove-frame sib leaf)) tree)))) (defun sync-frame-windows (group frame) "synchronize windows attached to FRAME." - (mapc (lambda (w) - (when (eq (window-frame w) frame) - (dformat 3 "maximizing ~S~%" w) - (maximize-window w))) + (mapc #'(lambda (w) + (when (eq (window-frame w) frame) + (dformat 3 "maximizing ~S~%" w) + (maximize-window w))) (group-windows group))) (defun sync-all-frame-windows (group) "synchronize all frames in GROUP." (let ((tree (tile-group-frame-tree group))) (tree-iterate tree - (lambda (f) - (sync-frame-windows group f))))) + #'(lambda (f) + (sync-frame-windows group f))))) (defun sync-head-frame-windows (group head) "synchronize all frames in GROUP and HEAD." @@ -652,9 +656,9 @@ one." (defun offset-frames (group x y) "move the screen's frames around." (let ((tree (tile-group-frame-tree group))) - (tree-iterate tree (lambda (frame) - (incf (frame-x frame) x) - (incf (frame-y frame) y))))) + (tree-iterate tree #'(lambda (frame) + (incf (frame-x frame) x) + (incf (frame-y frame) y))))) (defun resize-frame (group frame amount dim) "Resize FRAME by AMOUNT in DIM dimension, DIM can be @@ -732,10 +736,10 @@ either :width or :height" (:height (if lastp :bottom :top)))) (unless (and *resize-hides-windows* (eq *top-map* *resize-map*)) (tree-iterate to-resize - (lambda (leaf) - (sync-frame-windows group leaf))) + #'(lambda (leaf) + (sync-frame-windows group leaf))) (tree-iterate to-shrink - (lambda (leaf) + #'(lambda (leaf) (sync-frame-windows group leaf))))))))) (defun balance-frames-internal (group tree) @@ -759,8 +763,8 @@ depending on the tree's split direction." do (expand-tree i ofs side) (offset-tree-dir i totalofs side) - (tree-iterate i (lambda (leaf) - (sync-frame-windows group leaf)))))) + (tree-iterate i #'(lambda (leaf) + (sync-frame-windows group leaf)))))) (defun split-frame (group how &optional (ratio 1/2)) "Split the current frame into 2 frames. Return new frame number, if @@ -781,13 +785,13 @@ depending on the tree's split direction." (if (atom (tile-group-frame-head group head)) (list f1 f2) (funcall-on-node (tile-group-frame-head group head) - (lambda (tree) - (if (eq (tree-split-type tree) how) - (list-splice-replace frame tree f1 f2) - (substitute (list f1 f2) frame tree))) - (lambda (tree) - (unless (atom tree) - (find frame tree)))))) + #'(lambda (tree) + (if (eq (tree-split-type tree) how) + (list-splice-replace frame tree f1 f2) + (substitute (list f1 f2) frame tree))) + #'(lambda (tree) + (unless (atom tree) + (find frame tree)))))) (migrate-frame-windows group frame f1) (choose-new-frame-window f2 group) (if (eq (tile-group-current-frame group) @@ -829,8 +833,8 @@ depending on the tree's split direction." (clear-frame-outlines group) (dolist (h (if head (list head) (group-heads group))) (draw-frame-outline group h nil t) - (tree-iterate (tile-group-frame-head group h) (lambda (f) - (draw-frame-outline group f t nil))))) + (tree-iterate (tile-group-frame-head group h) + #'(lambda (f) (draw-frame-outline group f t nil))))) (defun clear-frame-outlines (group) "Clear the outlines drawn with DRAW-FRAME-OUTLINES." @@ -840,23 +844,23 @@ depending on the tree's split direction." "Draw the number of each frame in its corner. Return the list of windows used to draw the numbers in. The caller must destroy them." (let ((screen (group-screen group))) - (mapcar (lambda (f) - (let ((w (xlib:create-window - :parent (screen-root screen) - :x (frame-x f) :y (frame-display-y group f) :width 1 :height 1 - :background (screen-fg-color screen) - :border (screen-border-color screen) - :border-width 1 - :event-mask '()))) - (xlib:map-window w) - (setf (xlib:window-priority w) :above) - (echo-in-window w (screen-font screen) - (screen-fg-color screen) - (screen-bg-color screen) - (string (get-frame-number-translation f))) - (xlib:display-finish-output *display*) - (dformat 3 "mapped ~S~%" (frame-number f)) - w)) + (mapcar #'(lambda (f) + (let ((w (xlib:create-window + :parent (screen-root screen) + :x (frame-x f) :y (frame-display-y group f) :width 1 :height 1 + :background (screen-fg-color screen) + :border (screen-border-color screen) + :border-width 1 + :event-mask '()))) + (xlib:map-window w) + (setf (xlib:window-priority w) :above) + (echo-in-window w (screen-font screen) + (screen-fg-color screen) + (screen-bg-color screen) + (string (get-frame-number-translation f))) + (xlib:display-finish-output *display*) + (dformat 3 "mapped ~S~%" (frame-number f)) + w)) (group-frames group)))) (defmacro save-frame-excursion (&body body) @@ -898,7 +902,7 @@ space." ;; grab a leaf of the siblings. The siblings doesn't have to be ;; a frame. (l (tree-accum-fn s - (lambda (&rest siblings) + #'(lambda (&rest siblings) (car siblings)) #'identity))) ;; Only remove the current frame if it has a sibling @@ -920,8 +924,8 @@ space." (when (eq frame current) (setf (tile-group-current-frame group) l)) (tree-iterate tree - (lambda (leaf) - (sync-frame-windows group leaf))) + #'(lambda (leaf) + (sync-frame-windows group leaf))) (frame-raise-window group l (frame-window l) nil) (when (frame-window l) (update-decoration (frame-window l))) @@ -940,11 +944,12 @@ space." (if (atom (tile-group-frame-head group head)) (message "There's only one frame.") (progn - (mapc (lambda (w) - ;; windows in other frames disappear - (unless (eq (window-frame w) (tile-group-current-frame group)) - (hide-window w)) - (setf (window-frame w) frame)) + (mapc #'(lambda (w) + ;; windows in other frames disappear + (unless (eq (window-frame w) + (tile-group-current-frame group)) + (hide-window w)) + (setf (window-frame w) frame)) (head-windows group head)) (setf (frame-window frame) win (tile-group-frame-head group head) frame @@ -964,9 +969,9 @@ space." (tile-group-current-frame group)))) (when sib (focus-frame group (tree-accum-fn sib - (lambda (x y) - (declare (ignore y)) - x) + #'(lambda (x y) + (declare (ignore y)) + x) 'identity)) (show-frame-indicator group)))) diff --git a/tile-window.lisp b/tile-window.lisp index b95576a..5cfdb98 100644 --- a/tile-window.lisp +++ b/tile-window.lisp @@ -267,7 +267,9 @@ frame." (defun other-hidden-window (group) "Return the last window that was accessed and that is hidden." - (let ((wins (remove-if (lambda (w) (eq (frame-window (window-frame w)) w)) (group-windows group)))) + (let ((wins (remove-if #'(lambda (w) + (eq (frame-window (window-frame w)) w)) + (group-windows group)))) (first wins))) (defun pull-other-hidden-window (group) @@ -291,12 +293,16 @@ current frame and raise it." (defcommand (pull-hidden-next tile-group) () () "Pull the next hidden window into the current frame." (let ((group (current-group))) - (focus-forward group (sort-windows group) t (lambda (w) (not (eq (frame-window (window-frame w)) w)))))) + (focus-forward + group (sort-windows group) t + #'(lambda (w) (not (eq (frame-window (window-frame w)) w)))))) (defcommand (pull-hidden-previous tile-group) () () "Pull the next hidden window into the current frame." (let ((group (current-group))) - (focus-forward group (nreverse (sort-windows group)) t (lambda (w) (not (eq (frame-window (window-frame w)) w)))))) + (focus-forward + group (nreverse (sort-windows group)) t + #'(lambda (w) (not (eq (frame-window (window-frame w)) w)))))) (defcommand (pull-hidden-other tile-group) () () "Pull the last focused, hidden window into the current frame." diff --git a/user.lisp b/user.lisp index e9ca71c..5be9aa6 100644 --- a/user.lisp +++ b/user.lisp @@ -37,31 +37,32 @@ "Display a menu with the active restarts and let the user pick one. Error is the error being recovered from. If the user aborts the menu, the error is re-signalled." - (let ((restart (select-from-menu (current-screen) - (mapcar (lambda (r) - (list (format nil "[~a] ~a" - (restart-name r) - (substitute #\Space - #\Newline - (write-to-string r :escape nil))) - r)) - ;; a crusty way to get only - ;; the restarts from - ;; stumpwm's top-level - ;; restart inward. - (reverse (member 'top-level - (reverse (compute-restarts)) - :key 'restart-name))) - (format nil "Error: ~a" - (substitute #\Space - #\Newline - (write-to-string err :escape nil)))))) + (let ((restart (select-from-menu + (current-screen) + (mapcar #'(lambda (r) + (list (format nil "[~a] ~a" + (restart-name r) + (substitute #\Space + #\Newline + (write-to-string r :escape nil))) + r)) + ;; a crusty way to get only + ;; the restarts from + ;; stumpwm's top-level + ;; restart inward. + (reverse (member 'top-level + (reverse (compute-restarts)) + :key 'restart-name))) + (format nil "Error: ~a" + (substitute #\Space + #\Newline + (write-to-string err :escape nil)))))) (when restart (invoke-restart (second restart))))) (defun banish-pointer (&optional (where *banish-pointer-to*)) "Move the pointer to the lower right corner of the head, or - WHEREever (one of :screen :head :frame or :window)" + WHEREever (one of :screen :head :frame or :window)" (let* ((screen (current-screen)) (group (current-group)) (head (current-head)) @@ -139,9 +140,9 @@ seperated by a colon." (defun rehash (&optional (paths (mapcar 'parse-namestring (split-string (getenv "PATH") ":")))) "Update the cache of programs in the path stored in @var{*programs-list*} when needed." - (let ((dates (mapcar (lambda (p) - (when (probe-path p) - (portable-file-write-date p))) + (let ((dates (mapcar #'(lambda (p) + (when (probe-path p) + (portable-file-write-date p))) paths))) (finish-output) (unless (and *path-cache* @@ -247,13 +248,13 @@ number, with group being more significant (think radix sort)." *screen-list* (list (current-screen)))) (winlist (if all-groups - (mapcan (lambda (s) (screen-windows s)) screens) + (mapcan #'(lambda (s) (screen-windows s)) screens) (group-windows (current-group)))) - (matches (remove-if-not (lambda (w) - (apply 'window-matches-properties-p w props)) + (matches (remove-if-not #'(lambda (w) + (apply #'window-matches-properties-p w props)) winlist))) (stable-sort (sort matches #'< :key #'window-number) - #'< :key (lambda (w) (group-number (window-group w)))))) + #'< :key #'(lambda (w) (group-number (window-group w)))))) (defun run-or-raise (cmd props &optional (all-groups *run-or-raise-all-groups*) (all-screens *run-or-raise-all-screens*)) "Run the shell command, @var{cmd}, unless an existing window @@ -378,23 +379,30 @@ like xprop." (screen-root (current-screen))))) (loop for i in (xlib:list-properties win) collect i - collect (multiple-value-bind (values type) - (xlib:get-property win i) - (case type - (:wm_state (format nil "~{~a~^, ~}" - (loop for v in values - collect (case v (0 "Iconic") (1 "Normal") (2 "Withdrawn") (t "Unknown"))))) - (:window i) - ;; _NET_WM_ICON is huuuuuge - (:cardinal (if (> (length values) 20) - (format nil "~{~d~^, ~}..." (subseq values 0 15)) - (format nil "~{~d~^, ~}" values))) - (:atom (format nil "~{~a~^, ~}" - (mapcar (lambda (v) (xlib:atom-name *display* v)) values))) - (:string (format nil "~{~s~^, ~}" - (mapcar (lambda (x) (coerce (mapcar 'xlib:card8->char x) 'string)) - (split-seq values '(0))))) - (:utf8_string (format nil "~{~s~^, ~}" - (mapcar 'utf8-to-string - (split-seq values '(0))))) - (t values))))))) + collect + (multiple-value-bind (values type) + (xlib:get-property win i) + (case type + (:wm_state (format nil "~{~a~^, ~}" + (loop for v in values + collect (case v + (0 "Iconic") (1 "Normal") + (2 "Withdrawn") + (t "Unknown"))))) + (:window i) + ;; _NET_WM_ICON is huuuuuge + (:cardinal (if (> (length values) 20) + (format nil "~{~d~^, ~}..." (subseq values 0 15)) + (format nil "~{~d~^, ~}" values))) + (:atom (format nil "~{~a~^, ~}" + (mapcar #'(lambda (v) (xlib:atom-name *display* v)) + values))) + (:string (format nil "~{~s~^, ~}" + (mapcar #'(lambda (x) + (coerce (mapcar 'xlib:card8->char x) + 'string)) + (split-seq values '(0))))) + (:utf8_string (format nil "~{~s~^, ~}" + (mapcar 'utf8-to-string + (split-seq values '(0))))) + (t values))))))) diff --git a/window-placement.lisp b/window-placement.lisp index aa776b5..e04a244 100644 --- a/window-placement.lisp +++ b/window-placement.lisp @@ -165,12 +165,13 @@ housekeeping." (and (> (length frames) 1) (tile-group-last-frame group))) (:unfocused - (find-if (lambda (f) - (not (eq f (tile-group-current-frame group)))) + (find-if #'(lambda (f) + (not (eq f + (tile-group-current-frame group)))) frames)) (:empty - (find-if (lambda (f) - (null (frame-window f))) + (find-if #'(lambda (f) + (null (frame-window f))) frames)) (:choice ;; Transient windows sometimes specify a location diff --git a/window.lisp b/window.lisp index 0774e9b..6e7a153 100644 --- a/window.lisp +++ b/window.lisp @@ -214,7 +214,7 @@ _NET_WM_STATE_DEMANDS_ATTENTION set" (remove-if-not 'window-transient-p (copy-list windows))) (defun all-windows () - (mapcan (lambda (s) (copy-list (screen-windows s))) *screen-list*)) + (mapcan #'(lambda (s) (copy-list (screen-windows s))) *screen-list*)) (defun visible-windows () "Return a list of visible windows (on all screens)" @@ -468,10 +468,10 @@ right_start_y, right_end_y, top_start_x, top_end_x, bottom_start_x and bottom_end_x." (let ((net-wm-strut-partial (xlib:get-property win :_NET_WM_STRUT_PARTIAL))) (if (= (length net-wm-strut-partial) 12) - (apply 'values net-wm-strut-partial) + (apply #'values net-wm-strut-partial) (let ((net-wm-strut (xlib:get-property win :_NET_WM_STRUT))) (if (= (length net-wm-strut) 4) - (apply 'values (concatenate 'list net-wm-strut + (apply #'values (concatenate 'list net-wm-strut (list 0 (screen-height screen) 0 (screen-height screen) 0 (screen-width screen) @@ -585,8 +585,9 @@ and bottom_end_x." (dformat 3 "Using window stacking: ~{~X ~}~%" stacking) ;; sort by _NET_CLIENT_LIST_STACKING (setf children (stable-sort children #'< :key - (lambda (xwin) - (or (position (xlib:drawable-id xwin) stacking :test #'=) 0))))) + #'(lambda (xwin) + (or (position (xlib:drawable-id xwin) + stacking :test #'=) 0))))) (dolist (win children) (let ((map-state (xlib:window-map-state win)) (wm-state (xwin-state win))) @@ -687,7 +688,7 @@ needed." (reparent-window screen window) (netwm-set-allowed-actions window) (let ((placement-data (place-window screen window))) - (apply 'group-add-window (window-group window) window placement-data) + (apply #'group-add-window (window-group window) window placement-data) ;; If the placement rule matched then either the window's group ;; is the current group or the rule's :lock attribute was ;; on. Either way the window's group should become the current @@ -696,7 +697,7 @@ needed." (if (getf placement-data :raise) (switch-to-group (window-group window)) (message "Placing window ~a in group ~a" (window-name window) (group-name (window-group window)))) - (apply 'run-hook-with-args *place-window-hook* window (window-group window) placement-data))) + (apply #'run-hook-with-args *place-window-hook* window (window-group window) placement-data))) ;; must call this after the group slot is set for the window. (grab-keys-on-window window) ;; quite often the modeline displays the window list, so update it @@ -835,8 +836,9 @@ needed." @var{fmt} argument specifies the window formatting used. Returns the window selected." (second (select-from-menu (current-screen) - (mapcar (lambda (w) - (list (format-expand *window-formatters* fmt w) w)) + (mapcar #'(lambda (w) + (list (format-expand + *window-formatters* fmt w) w)) windows)))) ;;; Window commands @@ -957,19 +959,19 @@ override the default window formatting." (defcommand window-send-string (string &optional (window (current-window))) ((:rest "Insert: ")) "Send the string of characters to the current window as if they'd been typed." (when window - (map nil (lambda (ch) - ;; exploit the fact that keysyms for ascii characters - ;; are the same as their ascii value. - (let ((sym (cond ((<= 32 (char-code ch) 127) - (char-code ch)) - ((char= ch #\Tab) - (stumpwm-name->keysym "TAB")) - ((char= ch #\Newline) - (stumpwm-name->keysym "RET")) - (t nil)))) - (when sym - (send-fake-key window - (make-key :keysym sym))))) + (map nil #'(lambda (ch) + ;; exploit the fact that keysyms for ascii characters + ;; are the same as their ascii value. + (let ((sym (cond ((<= 32 (char-code ch) 127) + (char-code ch)) + ((char= ch #\Tab) + (stumpwm-name->keysym "TAB")) + ((char= ch #\Newline) + (stumpwm-name->keysym "RET")) + (t nil)))) + (when sym + (send-fake-key window + (make-key :keysym sym))))) string))) (defcommand-alias insert window-send-string) @@ -995,8 +997,8 @@ override the default window formatting." be used to override the default window formatting." (let* ((wins (sort1 windows '< :key 'window-number)) (highlight (position (group-current-window group) wins)) - (names (mapcar (lambda (w) - (format-expand *window-formatters* fmt w)) wins))) + (names (mapcar #'(lambda (w) + (format-expand *window-formatters* fmt w)) wins))) (if (null wins) (echo-string (group-screen group) "No Managed Windows") (echo-string-list (group-screen group) names highlight)))) diff --git a/workarounds.lisp b/workarounds.lisp index c3c2f80..6ad23bb 100644 --- a/workarounds.lisp +++ b/workarounds.lisp @@ -92,7 +92,7 @@ #+clisp (when (fboundp '%gcontext-key->mask) -(defmacro WITH-GCONTEXT ((gcontext &rest options) &body body) +(defmacro with-gcontext ((gcontext &rest options) &body body) (let ((saved (gensym)) (gcon (gensym)) (g0 (gensym)) (g1 (gensym)) (comps 0) (setf-forms nil) diff --git a/wrappers.lisp b/wrappers.lisp index b7e0567..c26a7fa 100644 --- a/wrappers.lisp +++ b/wrappers.lisp @@ -46,10 +46,10 @@ (list (cons "DISPLAY" (screen-display-string (current-screen))))) opts) #+ccl - (ccl:run-program prog (mapcar (lambda (s) - (if (simple-string-p s) - s - (coerce s 'simple-string))) + (ccl:run-program prog (mapcar #'(lambda (s) + (if (simple-string-p s) + s + (coerce s 'simple-string))) args) :wait wait :output (if output output t) :error t) #+clisp @@ -94,9 +94,9 @@ (let ((env (sb-ext:posix-environ))) (when (current-screen) (setf env (cons (screen-display-string (current-screen) t) - (remove-if (lambda (str) - (string= "DISPLAY=" str - :end2 (min 8 (length str)))) + (remove-if #'(lambda (str) + (string= "DISPLAY=" str + :end2 (min 8 (length str)))) env)))) (apply #'sb-ext:run-program prog args :output (if output output t) :error t :wait wait :environment env opts)) -- 1.7.1