diff --git a/options.lisp b/options.lisp new file mode 100644 index 0000000..fc3a062 --- /dev/null +++ b/options.lisp @@ -0,0 +1,60 @@ +;; Copyright (C) 2003-2008 Shawn Betts +;; +;; This file is part of stumpwm. +;; +;; stumpwm is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; stumpwm is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this software; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;; Boston, MA 02111-1307 USA + +;; Commentary: +;; +;; Options and option parsing code +;; +;; Code: + +(in-package :stumpwm) + +(defvar *options* nil "The structure that holds the results of the parsing of the command-line options") + +(defclass options () + ((help :initform nil) (version :initform nil) (replace :initform nil))) + +(let ((options-list + ;; Each element of this list is of the form + ;; (option-symbol help-text &rest text-to-match) + '((help "Show this help text and exit." "--help" "-h") + (version "Print the version of the program and exit." "--version" "-v") + (replace "Replace any window manager already running." "--replace")))) + + (defun parse-options (args) + (let ((struct (make-instance 'options))) + (loop for i in args do + (loop for (symbol help . matches) in options-list do + (when (member i matches :test #'string=) + (setf (slot-value struct symbol) t)))) + struct)) + + (defun show-help (&optional (stream t)) + (apply #'concatenate 'string + (loop for (symbol help . matches) in options-list collect + (format stream "~{~a~^, ~}~20,1T~a~%" matches help))))) + +(defun get-option (option &optional (struct *options*)) + ;; Fallback in the event of code that fires off early [not needed any more] + ;; (when (not struct) + ;; (setf struct (parse-options (argv)))) + (slot-value struct option)) + +(defvar *help-text* :autogenerates-for-the-docs + (format nil "@address@hidden verbatim~%" (show-help nil))) diff --git a/screen.lisp b/screen.lisp index 92782e2..e74cb71 100644 --- a/screen.lisp +++ b/screen.lisp @@ -432,7 +432,8 @@ FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK." :number 1 :name *default-group-name*))) ;; Create our screen structure - ;; The focus window is mapped at all times + ;; The focus window is mapped at all time + (replace-wm screen-number focus-window) (xlib:map-window focus-window) (xlib:map-window key-window) (setf (screen-number screen) screen-number diff --git a/stumpwm.asd b/stumpwm.asd index 9bb3cf8..75870ad 100644 --- a/stumpwm.asd +++ b/stumpwm.asd @@ -47,6 +47,7 @@ (:file "bindings") (:file "events") (:file "help") + (:file "options") (:file "fdump") (:file "time") (:file "mode-line") diff --git a/stumpwm.lisp b/stumpwm.lisp index a356e12..e0024bd 100644 --- a/stumpwm.lisp +++ b/stumpwm.lisp @@ -24,13 +24,17 @@ (in-package :stumpwm) (export '(cancel-timer - run-with-timer - stumpwm - timer-p)) + run-with-timer + stumpwm + timer-p + *version*)) ;;; Main +;; Defining *version* here to avoid warnings +(defvar *version* nil) + (defun load-rc-file (&optional (catch-errors t)) "Load the user's .stumpwmrc file or the system wide one if that doesn't exist. Returns a values list: whether the file loaded (t if no @@ -57,9 +61,7 @@ loaded. When CATCH-ERRORS is nil, errors are left to be handled further up. " ((and asynchronous (find error-key '(xlib:window-error xlib:drawable-error xlib:match-error))) (dformat 4 "Ignoring error: ~s~%" error-key)) - ((eq error-key 'xlib:access-error) - (write-line "Another window manager is running.") - (throw :top-level :quit)) + ((eq error-key 'xlib:access-error) t) ;; all other asynchronous errors are printed. (asynchronous (message "Caught Asynchronous X Error: ~s ~s" error-key key-vals)) @@ -183,20 +185,70 @@ of those expired." (defun parse-display-string (display) "Parse an X11 DISPLAY string and return the host and display from it." (ppcre:register-groups-bind (protocol host ('parse-integer display screen)) - ("^(?:(.*?)/)?(.*?)?:(\\d+)(?:\\.(\\d+))?" display :sharedp t) + ("^(?:(.*?)/)?(.*?)?:(\\d+)(?:\\.(\\d+))?" display :sharedp t) (values ;; clx doesn't like (vector character *) (coerce (or host "") - '(simple-array character (*))) + '(simple-array character (*))) display screen (cond (protocol - (intern1 protocol :keyword)) - ((or (string= host "") - (string-equal host "unix")) - :local) - (t :internet))))) + (intern1 protocol :keyword)) + ((or (string= host "") + (string-equal host "unix")) + :local) + (t :internet))))) + +(defun handle-options () + (setf *options* (parse-options (argv))) + (let ((option (or (and (get-option 'help) 'help) + (and (get-option 'version) 'version)))) + (when option + (case option + ('help (show-help)) + ('version (format t *version*))) + (throw :top-level :quit)))) + +(defun replace-wm (num focus-window) + "Replace the currently running window manager, if any." + (let* ((wm-atom-name (format nil "WM_S~d" num)) + (wm-atom (xlib:intern-atom *display* wm-atom-name)) + (wm-atom-owner (xlib:selection-owner *display* wm-atom-name)) + (error-p nil) (timestamp (get-universal-time))) + (when (and wm-atom-owner + (xlib:window-equal wm-atom-owner focus-window)) + (setf wm-atom-owner nil)) + (when wm-atom-owner + (unless (get-option 'replace) + (format t "Another window manager is already running") + (throw :top-level :quit)) + (block error-catch + (handler-bind ((error #'(lambda () + (setf error-p t) (return-from error-catch)))) + (setf (xlib:window-event-mask wm-atom-owner) + (xlib:make-event-mask :structure-notify)) + (xlib:display-finish-output *display*))) + (when error-p (setf wm-atom-owner nil)) + (xlib:set-selection-owner *display* wm-atom-name focus-window timestamp) + (unless (xlib:window-equal focus-window + (xlib:selection-owner *display* wm-atom-name)) + (write-line "Couldn't become the new window manager.") + (throw :top-level :quit))) + (xlib:display-finish-output *display*) + (send-client-message (xlib:screen-root num) :manager timestamp + (xlib:intern-atom *display* wm-atom-name)) + ;;Wait for the current WM to die + (when wm-atom-owner + (block wm-loop + (xlib:event-cond + (*display* :timeout 20) + (:destroy-notify (window) + (if (xlib:window-equal window wm-atom-owner) + (return-from wm-loop) nil))) + (write-line "The WM has not exited after 20 seconds. Bailing.") + (throw :top-level :quit))))) (defun stumpwm-internal (display-str) + (handle-options) ;;get --help and --version out of the way now (multiple-value-bind (host display screen protocol) (parse-display-string display-str) (declare (ignore screen)) (setf *display* (xlib:open-display host :display display :protocol protocol) diff --git a/stumpwm.texi.in b/stumpwm.texi.in index 4b6cdd1..75cb89a 100644 --- a/stumpwm.texi.in +++ b/stumpwm.texi.in @@ -83,7 +83,8 @@ This document explains how to use The Stump Window Manager. @end ifinfo @menu -* Introduction:: +* Introduction:: +* Command-Line Options:: * Key Bindings:: * Commands:: * Message and Input Bar:: @@ -112,6 +113,10 @@ Introduction * Interacting with the Lisp process:: * Contact the StumpWM developers:: +Command-Line Options + +* List of Command-Line Options:: + Key Bindings * List of Default Keybindings:: @@ -168,7 +173,7 @@ Hacking @end detailmenu @end menu address@hidden Introduction, Key Bindings, Top, Top address@hidden Introduction, Command-Line Options, Top, Top @chapter Introduction StumpWM is an X11 window manager written entirely in Common Lisp. Its user interface goals are similar to ratpoison's but with an emphasis on @@ -304,7 +309,23 @@ is restricted to subscribers to keep spam out of the archives. The StumpWM IRC channel can be found on Freenode at @uref{irc://irc.freenode.net/#stumpwm, @code{#stumpwm}}. address@hidden Key Bindings, Commands, Introduction, Top address@hidden Command-Line Options, Key Bindings, Introduction, Top address@hidden Command-Line Options +StummpWM currently has very few command-line options. Please note that +to prevent option parsing by lisp, the sequence @code{--} must be on the +command line before the usage of the options @code{--help} and address@hidden + address@hidden +* List of Command-Line Options:: address@hidden menu + address@hidden List of Command-Line Options, , Command-Line Options, Command-Line Options address@hidden List of Command-Line Options +This is all the docs we have for now. +### *help-text* + address@hidden Key Bindings, Commands, Command-Line Options, Top @chapter Key Bindings StumpWM is controlled entirely by keystrokes and Lisp commands. It mimics GNU Screen's keyboard handling. StumpWM's default prefix key is @@ -402,6 +423,10 @@ Prompt for a shell command to run via @file{/bin/sh}. All output is discarded. If the screen is split into multiple frames, one split will be undone. If there is only one split, the effect will be the same as @kbd{C-t Q}. address@hidden C-t C-t C-L +End the stumpwm process, logging you out, after prompting to check if +you are sure you would like to do that. + @item C-t o @itemx C-t TAB If the screen is split into multiple frames, focus shifts to the diff --git a/window.lisp b/window.lisp index 18eac4e..a9f79e9 100644 --- a/window.lisp +++ b/window.lisp @@ -59,6 +59,8 @@ (plist :initarg :plist :accessor window-plist) (fullscreen :initform nil :accessor window-fullscreen))) +(defmethod window-xwin ((window xlib:window)) window) + (defmethod print-object ((object window) stream) (format stream "#S(~a ~s #x~x)" (type-of object) (window-name object) (window-id object)))