pax_global_header00006660000000000000000000000064124270231710014511gustar00rootroot0000000000000052 comment=c4ed8f2e04e5e52c0a4cacabc25ece661c4394cf stumpwm-0.9.9/000077500000000000000000000000001242702317100132445ustar00rootroot00000000000000stumpwm-0.9.9/.dir-locals.el000066400000000000000000000001211242702317100156670ustar00rootroot00000000000000((nil . ((indent-tabs-mode . nil))) (makefile-mode . ((indent-tabs-mode . t)))) stumpwm-0.9.9/.gitattributes000066400000000000000000000000211242702317100161300ustar00rootroot00000000000000*.lisp diff=lisp stumpwm-0.9.9/.gitignore000066400000000000000000000003711242702317100152350ustar00rootroot00000000000000*.fas *.lib *.fasl *.a *.o *.*fasl *.*fsl *~ *.swp \#*# configure config.log config.status autom4te.cache Makefile stumpwm stumpwm.info TAGS make-image.lisp load-stumpwm.lisp version.lisp stumpwm-*.tgz stumpwm-*.tgz.sig .dotest patches stumpwm.texi stumpwm-0.9.9/.travis.yml000066400000000000000000000007561242702317100153650ustar00rootroot00000000000000language: lisp env: matrix: - LISP=sbcl - LISP=ccl - LISP=clisp # - LISP=ecl install: - sudo apt-get install texinfo - if [ -x ./install.sh ] && head -2 ./install.sh | grep '^#cl-travis' > /dev/null; then ./install.sh; else curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | sh; fi - cl-launch -i '(ql:quickload "clx")' -i '(ql:quickload "cl-ppcre")' before_script: - ./autogen.sh - ./configure script: - make stumpwm-0.9.9/AUTHORS000066400000000000000000000047211242702317100143200ustar00rootroot00000000000000The Stump Window Manager Authors -------------------------------- Shawn Betts sabetts at gmail com Ryan M. Golbeck rmgolbeck at uwaterloo ca Manuel Giraud manuel.giraud at univ-nantes fr Andreas Scholta andreas.scholta at gmail com Philippe Brochard hocwp at free fr Matthew Kennedy mkennedy at gentoo org Phil Gregory phil_g at pobox com Jeremy Hankins nowan at nowan org Martin Bishop martinbishop at bellsouth net David Hansen david.hansen at gmx net Gwern Branwen gwern0 at gmail com Jay Belanger belanger at truman edu Magnus Henoch mange at freemail hu Johannes Weiner Luca Capello luca at pca it Luigi Panzeri James Wright james at chumsley org Jonathan Liles wantingwaiting at users sf net Istvan Marko mi-stump at kismala com Tassilo Horn tassilo at member dot fsf dot org Morgan Veyret patzy at appart kicks-ass net Antonis Antoniadis cereal.killer.rules at gmail com Jeronimo Pellegrini j_p at aleph0 info James Wright james at chumsley org Vitaly Mayatskikh v.mayatskih at gmail com Ivy Foster ivy dot foster at gmail dot com Matt Shen synmantics at gmail com Patrick Pippen dabittweiler at gmail com Lionel Flandrin simias.n at gmail com Greg Pfeil greg at technomadic org Ian Ross Ian.Ross at bristol ac uk John Li jli at circularly org Jonathan Moore Liles wantingwaiting at users sf net Julian Stecklina js at alien8 de Scott Wolchok swolchok at umich edu Trent W. Buck trentbuck at gmail com Xan Lopez xan at gnome org Fredrik Tolf fredrik at dolda2000 com John Fremlin john at fremlin org Philip Fominykh philip at glyf org Michael Raskin 38a938c2 at rambler ru Ben Spencer dangerous.ben at gmail com Dirk Sondermann ds-stumpwm at dyximaq de Rupert Swarbrick rswarbrick at googlemail com David Vazquez davazp at es gnu org Antti Nykanen aon at iki.fi Friedrich Delgado Friedrichs friedel at nomaden org Egon Hyszczak gone404 at gmail com TC-Rucho tc.rucho at gmail com Raffael Mancini raffael.mancini at hcl-club lu Adlai Chandrasekhar munchking at gmail com Nils Anspach idnkmn at googlemail.com Krzysztof Drewniak krzysdrewniak at gmail com Josh Elsasser josh at elsasser org Matt Spear batman900 at gmail com David Bjergaard dbjergaard at gmail com Joram Schrijver i at joram io stumpwm-0.9.9/COPYING000066400000000000000000000432541242702317100143070ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program 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 of the License, or (at your option) any later version. This program 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 program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. stumpwm-0.9.9/HACKING000066400000000000000000000000401242702317100142250ustar00rootroot00000000000000See the StumpWM Texinfo manual. stumpwm-0.9.9/Makefile.in000066400000000000000000000067761242702317100153310ustar00rootroot00000000000000LISP=@LISP_PROGRAM@ clisp_BUILDOPTS=-K base -on-error exit < ./make-image.lisp sbcl_BUILDOPTS=--load ./make-image.lisp ccl_BUILDOPTS=--load ./make-image.lisp ecl_BUILDOPTS=-shell ./make-image.lisp lw_BUILDOPTS=-build ./make-image.lisp clisp_INFOOPTS=-K base -on-error exit -x "(load (compile-file \"load-stumpwm.lisp\")) (load (compile-file \"manual.lisp\")) (stumpwm::generate-manual) (ext:exit)" sbcl_INFOOPTS=--eval "(progn (load \"load-stumpwm.lisp\") (load \"manual.lisp\"))" --eval "(progn (stumpwm::generate-manual) (sb-ext:quit))" ccl_INFOOPTS=--eval "(load \"load-stumpwm.lisp\")" --load manual.lisp --eval "(progn (stumpwm::generate-manual) (quit))" ecl_INFOOPTS=-eval "(progn (load \"load-stumpwm.lisp\") (load \"manual.lisp\"))" -eval "(progn (stumpwm::generate-manual) (ext:quit))" lw_INFOOPTS=-eval "(progn (load \"load-stumpwm.lisp\") (load \"manual.lisp\"))" -eval "(progn (stumpwm::generate-manual) (lw:quit))" datarootdir = @datarootdir@ prefix=@prefix@ exec_prefix= @exec_prefix@ bindir=@bindir@ infodir=@infodir@ # You shouldn't have to edit past this # This is copied from the .asd file. It'd be nice to have the list in # one place, but oh well. FILES=stumpwm.asd package.lisp primitives.lisp wrappers.lisp \ pathnames.lisp keysyms.lisp keytrans.lisp kmap.lisp input.lisp \ core.lisp command.lisp menu.lisp screen.lisp head.lisp group.lisp \ window.lisp floating-group.lisp tile-window.lisp window-placement.lisp \ message-window.lisp selection.lisp user.lisp iresize.lisp \ bindings.lisp events.lisp help.lisp fdump.lisp mode-line.lisp \ time.lisp color.lisp module.lisp stumpwm.lisp version.lisp all: stumpwm stumpwm.info stumpwm.info: stumpwm.texi makeinfo stumpwm.texi # FIXME: This rule is too hardcoded stumpwm.texi: stumpwm.texi.in $(LISP) $(@LISP@_INFOOPTS) stumpwm: $(FILES) $(LISP) $(@LISP@_BUILDOPTS) release: git tag -a -m "version @PACKAGE_VERSION@" @PACKAGE_VERSION@ git archive --format=tar --prefix=stumpwm-@PACKAGE_VERSION@/ HEAD > stumpwm-@PACKAGE_VERSION@.tar tar xf stumpwm-@PACKAGE_VERSION@.tar cd stumpwm-@PACKAGE_VERSION@ && tar zxf @PPCRE_PATH@/../cl-ppcre.tar.gz && mv cl-ppcre-* cl-ppcre git log > stumpwm-@PACKAGE_VERSION@/ChangeLog cp configure stumpwm-@PACKAGE_VERSION@/ tar zcf stumpwm-@PACKAGE_VERSION@.tgz stumpwm-@PACKAGE_VERSION@ rm -fr stumpwm-@PACKAGE_VERSION@/ stumpwm-@PACKAGE_VERSION@.tar upload-release: gpg -b stumpwm-@PACKAGE_VERSION@.tgz scp stumpwm-@PACKAGE_VERSION@.tgz stumpwm-@PACKAGE_VERSION@.tgz.sig sabetts@dl.sv.nongnu.org:/releases/stumpwm/ ( echo rm stumpwm-latest.tgz.sig && echo rm stumpwm-latest.tgz && echo ln stumpwm-@PACKAGE_VERSION@.tgz stumpwm-latest.tgz && echo ln stumpwm-@PACKAGE_VERSION@.tgz.sig stumpwm-latest.tgz.sig ) | sftp -b - sabetts@dl.sv.nongnu.org:/releases/stumpwm/ clean: rm -f *.fasl *.fas *.lib *.*fsl rm -f *.log *.fns *.fn *.aux *.cp *.ky *.log *.toc *.pg *.tp *.vr *.vrs rm -f stumpwm stumpwm.texi stumpwm.info install: stumpwm.info stumpwm test -z "$(destdir)$(bindir)" || mkdir -p "$(destdir)$(bindir)" install -m 755 stumpwm "$(destdir)$(bindir)" test -z "$(destdir)$(infodir)" || mkdir -p "$(destdir)$(infodir)" install -m 644 stumpwm.info "$(destdir)$(infodir)" install-info --info-dir="$(destdir)$(infodir)" "$(destdir)$(infodir)/stumpwm.info" install-modules: git clone https://github.com/stumpwm/stumpwm-contrib.git ~/.stumpwm.d/modules uninstall: rm "$(destdir)$(bindir)/stumpwm" install-info --info-dir="$(destdir)$(infodir)" --remove "$(destdir)$(infodir)/stumpwm.info" rm "$(destdir)$(infodir)/stumpwm.info" # End of file stumpwm-0.9.9/NEWS000066400000000000000000000127251242702317100137520ustar00rootroot00000000000000-*- outline -*- This file documents user visible changes between versions of StumpWM * Changes since 0.9.6 ** in float mode windows can be resized with the middle mouse button ** support for CCL added ** support for ECL added * Changes since 0.9.5 ** add frame-windowlist command ** add run-or-pull command ** add refresh and redisplay commands ** use ppcre for window placement rule matching ** add fmt-head-window-list colors hidden windows ** new contrib modules time.lisp, disk.lisp, sbclfix.lisp, net.lisp, mem.lisp, maildir.lisp, window-tags.lisp ** add automatic group creation/restoration ** add restart-hard command ** rename soft-restart to restart-soft ** new commands refresh and redisplay ** new command list-window-properties ** AltGr works ** new top/root keymaps The *root-map* keymap and *top-map* have been split into several based on what group it applies to, tiling, floating, both. ** new floating group StumpWM now has a floating window group mode. * Changes since 0.9.4.1 ** new module, aumix.lisp ** new command, repack-window-numbers ** new module, productivity.lisp ** _NET_FRAME_EXTENTS property is set on client windows ** define-key acts like undefine-key when nil is passed as the command ** new command, show-window-properties ** select-from-menu lets you type regex to match an item ** new commands, gnext-with-window and gprev-with-window ** run-or-raise now cycles through matching windows ** new function add-screen-mode-line-formatter ** new module wifi.lisp ** new module battery-portable.lisp >>>>>>> master:NEWS ** new command load-module ** added install/uninstall Makefile rules ** added info command ** added g{next,prev}-with-window commands ** added show-window-properties command * Changes since 0.9.3 ** new %interactivep% variable see defcommand in the manual. ** The default package is now stumpwm-user stumpwm-user imports all exported stumpwm symbols. ** the pixmap error plaguing some users has been fixed If you are running sbcl, you need do nothing. If you're using clisp, ensure the version is 2.46 or later. ** New macro defprogram-shortcut * Changes since 0.9.2 ** C-t bindings moved to C-t C- To pull a window by number you now have to hold down Control. Just pressing the number now selects the window by number in its frame. ** new commands modifiers and copy-last-message ** new command grouplist and binding C-t g " ** New keybinding C-t h c bound to describe-command ** spelling mistake fixed One global variable was changed. *new-window-prefered-frame* is now called *new-window-preferred-frame*. ** new variable *window-border-style* ** new command exchange-windows ** new command type :direction ** define-stumpwm-command is deprecated Use defcommand instead ** pull-window-by-number arguments are reversed ** renumber function's arguments are reversed ** C-h lists keybindings too In any keymap C-h and ? will list the keybindings. ** New command bind Hang a key binding off the escape key. ** C-t TAB changed to fnext Maintain compatibility with the screen binding. * Changes since 0.9.1 ** key grab handling top level key binding are now grabbed "asynchronously." This should eliminate the keyboard freezes some have experiences. ** New command emacs ** AltGr modifier should be recognized now ** new command grename * Changes since 0.0.6 These changes are probably incomplete ** added color codes to message windows. ** added XRandR dynamic rotate/resize support ** added external panel/dock support ** added fullscren support ** added new rat focus models ** Xinerama support ** support hidden groups ** added frame save and restore ** added rule based window placement ** stumpwm now handles window roles ** move-focus now uses a heuristic to find the 'best' frame to focus ** format-time-string Now takes an optional format string as an argument! ** more netwm compliance stumpwm now exports its groups as netwm desktops. ** new var *default-package* This decides what package the eval command reads and executes things in. ** new var *new-window-prefered-frame* It controls what frame a new window appears in. ** "help" command prints bindings in columns And it doesn't timeout. ** new variable *suppress-abort-messages* Suppress abort message when non-nil. ** configure script Now you can use it to select a lisp and point the makefile to the location of your lisp. ** new command gmerge ** startup message configurable with *startup-message*. ** format string arguments can be cropped In the windows command, %20t will crop the window's title to 20 characters. This numeric prefix works for all % arguments. ** _NET_CLIENT_LIST works which means wmctl -l returns useful info. ** stumpwm executables the Makefile can now generate executables for sbcl and clisp. Edit the Makefile to choose you lisp. ** New global *new-frame-action* ** New commands describe-key, describe-variable, describe-function, where-is ** New prefix map *help-map* ** New command, title, bound to C-t A title sets the window's name. ** errors while reloading stumpwm A restarts menu now appears that allows you to select a restart, if you want. ** new function restarts-menu ** modeline update timer set to 60s by default. ** timers see run-with-timer and cancel-timer ** improved frame splitting, resizing and removing ** *run-or-raise-all-groups* variable * Changes since 0.0.5 ** quit command * Changes since 0.0.3 ** Frame support StumpWM now sports basic frame support. No resizing yet. * Changes since 0.0.2 * Changes since 0.0.1 stumpwm-0.9.9/README.md000066400000000000000000000136151242702317100145310ustar00rootroot00000000000000![](http://www.kenanb.com/static/img/stumpwm-logo/stumpwm-logo-stripe.png) # The Stump Window Manager ![](https://travis-ci.org/stumpwm/stumpwm.svg) Stumpwm is a window manager written entirely in Common Lisp. It attempts to be highly customizable while relying entirely on the keyboard for input. You will not find buttons, icons, title bars, tool bars, or any of the other conventional GUI widgets. These design decisions reflect the growing popularity of productive, customizable lisp based systems. ## Philosophy Stumpwm is a "everything-and-the-kitchen-sink WM" or "the emacs of WMs." **StumpWM:Windows::Emacs:Text** * StumpWM is * Hackable * A tileable window manager * Includes support for floats * Written in Common Lisp * Compatible with many lisp distributions * A Superior window managing experience * StumpWM is *not* * Minimalist * Narrow Scope * Configured by editing the source directly * A full blown desktop environment If you want a minimalist tiling window manager, then StumpWM is *not* what you're looking for. The code base is ~15k sloc, the binaries produced are ~60mb. StumpWM manages windows the way emacs manages buffers, or the way screen manages terminals. If you want a flexible, customizable, hackable desktop experience, look no further. # Build & Start Stumpwm ## Prerequisites * a common lisp distribution. sbcl, clisp, ccl and ecl all work (ecl must have been built with clx support, must use version >= 13.5.1 [see here for discussion](https://github.com/sabetts/stumpwm/issues/55)). * quicklisp (for obtaining the following dependencies, not needed if you use your distribution's package manager.) * clx * cl-ppcre * cl-xembed The recommended way to install the dependencies is using Quicklisp. Follow the instructions at http://www.quicklisp.org/ to install it. In short: ``` $ curl -O http://beta.quicklisp.org/quicklisp.lisp ``` ``` $ sbcl --load quicklisp.lisp ``` Or insert your favorite lisp distribution (clisp, ccl or ecl). Then at the REPL: ```lisp (quicklisp-quickstart:install) ``` Make sure you have added it to your lisp init file using: ```lisp (ql:add-to-init-file) ``` Then, in a repl: ```lisp (ql:quickload "clx") (ql:quickload "cl-ppcre") ``` ## Building Building stumpwm from git requires that you build the configure script: ``` autoconf ``` If there's already a configure script then just run it. ``` ./configure ``` By default stumpwm selects sbcl. If you have multiple lisps installed, you can explicitly select clisp, ccl, or ecl like so: ``` ./configure --with-lisp=clisp ``` If your lisps are in strange places you may need to tell the script where to find them: ``` ./configure --with-sbcl=/home/sabetts/opt/bin/sbcl ./configure --with-clisp=/usr/local/downstairs/to/the/left/clisp ``` Now build it: ``` make ``` If all goes well, you should have a stumpwm binary now. You can run the binary from where it is or install it, along with the .info documentation, with: ``` make install ``` Now that you have a binary, call it from your ~/.xinitrc file: ``` echo /path/to/stumpwm >> ~/.xinitrc startx ``` Hopefully that will put you in X running stumpwm! See [StartUp on the wiki](https://github.com/sabetts/stumpwm/wiki/StartUp) for more examples. ## Requirements for multiple monitor setups For stumpwm to work as intended with multiple monitors setups the `xdpyinfo` utility is needed. # Contributing Pull requests are always welcome! Here are some guidelines to ensure that your contribution gets merged in a timely manner: * Do's * Add your name to the list of AUTHORS with your pull request. * Preserve comments or docstrings explaining what code does, and update them if your patch changes them in a significant way * Try to follow an "80 column rule." The current code base does not follow this all the time, so don't use it as an example * [Use lisp idioms](http://people.ace.ed.ac.uk/staff/medward2/class/moz/cm/doc/contrib/lispstyle.html) * If you are working on a major change to the internals, keep us informed on stumpwm-devel! Also, it will probably help if the changes are made and the incrementally applied to the codebase in order to avoid introducing show-stopping bugs. * Do not's * Include emacs local variables * Change whitespace * Write lots of code without supporting comments/documentation * Delete comments or docstrings (yes this is a duplicate of above!) * Export symbols from packages that aren't widely useful (many times a little more thought will reveal how to implement your internal change without having to export/break encapsulation) * Make stylistic changes that suit your coding style/way of thinking Our wiki has fallen into disarray/disrepair, but it is shaping up. If you aren't a lisp hacker, you can contribute in the form of documenting and organizing the wiki. There's a lot of information floating around, if you find it where you didn't expect it, move or link to it in a more logical place. # CCL And Virtual Memory On 64bit platforms, CCL reserves a "very large" amount of virtual memory. If this bothers you for some reason, you can pass the -R or --heap-reserve option to the binary in your ~/.xinitrc file. See http://ccl.clozure.com/manual/chapter15.1.html for an explanation. # Help There's a texinfo manual, stumpwm.texi. The build scripts generate an info file you can read in emacs or with the `info' program. The manual for the latest git version (may be slightly out of date) is available to read online at: [The Manual](https://stumpwm.github.io/) And, as in emacs, you can always do "C-t h v,f,k,c,w" for docstrings of Variable,Functions,Keys,Commands, and Where-is respectively. For other stuff (tips tricks and examples) visit the [stumpwm wiki](https://github.com/stumpwm/stumpwm/wiki) There's a #stumpwm channel on irc.freenode.net, too. Finally, there's our mailing list (click to sign up) [stumpwm-devel@nongnu.org](https://lists.nongnu.org/mailman/listinfo/stumpwm-devel). stumpwm-0.9.9/autogen.sh000077500000000000000000000000651242702317100152460ustar00rootroot00000000000000#!/bin/sh # generate the configure script autoconf stumpwm-0.9.9/bindings.lisp000066400000000000000000000215271242702317100157410ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; define standard key bindings ;; ;; Code: (in-package #:stumpwm) (export '(*groups-map* *movement-map* *help-map* set-prefix-key)) (defvar *escape-key* (kbd "C-t") "The escape key. Any keymap that wants to hang off the escape key should use this specific key struct instead of creating their own C-t.") (defvar *escape-fake-key* (kbd "t") "The binding that sends the fake escape key to the current window.") (defvar *groups-map* nil "The keymap that group related key bindings sit on. It is bound to @kbd{C-t g} by default.") (defvar *exchange-window-map* nil "The keymap that exchange-window key bindings sit on. It is bound to @kbd{C-t x} by default.") (defvar *help-map* nil "Help related bindings hang from this keymap") (defvar *group-top-maps* '((tile-group *tile-group-top-map*) (float-group *float-group-top-map*) (group *group-top-map*)) "An alist of the top level maps for each group type. For a given group, all maps whose type matches the given group are active. So for a tile-group, both the group map and tile-group map are active. Order is important. Each map is seached in the order they appear in the list (inactive maps being skipped). In general the order should go from most specific groups to most general groups.") (defvar *group-top-map* nil) (defvar *group-root-map* nil) (defvar *tile-group-top-map* nil) (defvar *tile-group-root-map* nil) (defvar *float-group-top-map* nil) (defvar *float-group-root-map* nil) ;; Do it this way so its easier to wipe the map and get a clean one. (defmacro fill-keymap (map &rest bindings) `(unless ,map (setf ,map (let ((m (make-sparse-keymap))) ,@(loop for i = bindings then (cddr i) while i collect `(define-key m ,(first i) ,(second i))) m)))) (fill-keymap *top-map* *escape-key* '*root-map*) (fill-keymap *root-map* (kbd "c") "exec xterm" (kbd "C-c") "exec xterm" (kbd "e") "emacs" (kbd "C-e") "emacs" (kbd "b") "banish" (kbd "C-b") "banish" (kbd "a") "time" (kbd "C-a") "time" (kbd "!") "exec" (kbd "C-g") "abort" *escape-fake-key* "send-escape" (kbd ";") "colon" (kbd ":") "eval" (kbd "v") "version" (kbd "m") "lastmsg" (kbd "C-m") "lastmsg" (kbd "G") "vgroups" (kbd "g") '*groups-map* (kbd "x") '*exchange-window-map* (kbd "F1") "gselect 1" (kbd "F2") "gselect 2" (kbd "F3") "gselect 3" (kbd "F4") "gselect 4" (kbd "F5") "gselect 5" (kbd "F6") "gselect 6" (kbd "F7") "gselect 7" (kbd "F8") "gselect 8" (kbd "F9") "gselect 9" (kbd "F10") "gselect 10" (kbd "h") '*help-map*) (fill-keymap *group-top-map* *escape-key* '*group-root-map*) (fill-keymap *group-root-map* (kbd "C-u") "next-urgent" (kbd "w") "windows" (kbd "C-w") "windows" (kbd "k") "delete" (kbd "C-k") "delete" (kbd "K") "kill" (kbd "'") "select" (kbd "\"") "windowlist" (kbd "0") "select-window-by-number 0" (kbd "1") "select-window-by-number 1" (kbd "2") "select-window-by-number 2" (kbd "3") "select-window-by-number 3" (kbd "4") "select-window-by-number 4" (kbd "5") "select-window-by-number 5" (kbd "6") "select-window-by-number 6" (kbd "7") "select-window-by-number 7" (kbd "8") "select-window-by-number 8" (kbd "9") "select-window-by-number 9" (kbd "C-N") "number" (kbd "#") "mark" (kbd "F11") "fullscreen" (kbd "A") "title" (kbd "i") "info") (fill-keymap *tile-group-top-map* *escape-key* '*tile-group-root-map*) (fill-keymap *tile-group-root-map* (kbd "n") "pull-hidden-next" (kbd "C-n") "pull-hidden-next" (kbd "M-n") "next" (kbd "C-M-n") "next-in-frame" (kbd "SPC") "pull-hidden-next" (kbd "C-SPC") "pull-hidden-next" (kbd "p") "pull-hidden-previous" (kbd "C-p") "pull-hidden-previous" (kbd "M-p") "prev" (kbd "C-M-p") "prev-in-frame" (kbd "W") "place-existing-windows" *escape-key* "pull-hidden-other" (kbd "M-t") "other-in-frame" (kbd "C-0") "pull 0" (kbd "C-1") "pull 1" (kbd "C-2") "pull 2" (kbd "C-3") "pull 3" (kbd "C-4") "pull 4" (kbd "C-5") "pull 5" (kbd "C-6") "pull 6" (kbd "C-7") "pull 7" (kbd "C-8") "pull 8" (kbd "C-9") "pull 9" (kbd "R") "remove" (kbd "s") "vsplit" (kbd "S") "hsplit" (kbd "r") "iresize" (kbd "o") "fnext" (kbd "TAB") "fnext" (kbd "M-TAB") "fother" (kbd "f") "fselect" (kbd "F") "curframe" (kbd "-") "fclear" (kbd "Q") "only" (kbd "Up") "move-focus up" (kbd "Down") "move-focus down" (kbd "Left") "move-focus left" (kbd "Right") "move-focus right" (kbd "M-Up") "move-window up" (kbd "M-Down") "move-window down" (kbd "M-Left") "move-window left" (kbd "M-Right") "move-window right" (kbd "+") "balance-frames" (kbd "l") "redisplay" (kbd "C-l") "redisplay") (fill-keymap *float-group-top-map*) (fill-keymap *float-group-root-map*) (fill-keymap *groups-map* (kbd "g") "groups" (kbd "c") "gnew" (kbd "n") "gnext" (kbd "C-n") "gnext" (kbd "SPC") "gnext" (kbd "C-SPC") "gnext" (kbd "N") "gnext-with-window" (kbd "p") "gprev" (kbd "C-p") "gprev" (kbd "P") "gprev-with-window" (kbd "o") "gother" (kbd "'") "gselect" (kbd "\"") "grouplist" (kbd "m") "gmove" (kbd "M") "gmove-marked" (kbd "k") "gkill" (kbd "A") "grename" (kbd "r") "grename" (kbd "1") "gselect 1" (kbd "2") "gselect 2" (kbd "3") "gselect 3" (kbd "4") "gselect 4" (kbd "5") "gselect 5" (kbd "6") "gselect 6" (kbd "7") "gselect 7" (kbd "8") "gselect 8" (kbd "9") "gselect 9" (kbd "0") "gselect 10") (fill-keymap *exchange-window-map* (kbd "Up") "exchange-direction up" (kbd "Down") "exchange-direction down" (kbd "Left") "exchange-direction left" (kbd "Right") "exchange-direction right" (kbd "p") "exchange-direction up" (kbd "n") "exchange-direction down" (kbd "b") "exchange-direction left" (kbd "f") "exchange-direction right" (kbd "k") "exchange-direction up" (kbd "j") "exchange-direction down" (kbd "l") "exchange-direction left" (kbd "h") "exchange-direction right") (fill-keymap *help-map* (kbd "v") "describe-variable" (kbd "f") "describe-function" (kbd "k") "describe-key" (kbd "c") "describe-command" (kbd "w") "where-is") (defcommand command-mode () () "Command mode allows you to type ratpoison commands without needing the @key{C-t} prefix. Keys not bound in StumpWM will still get sent to the current window. To exit command mode, type @key{C-g}." (run-hook *command-mode-start-hook*) (push-top-map *root-map*)) (defcommand set-prefix-key (key) ((:key "Key: ")) "Change the stumpwm prefix key to KEY. @example \(stumpwm:set-prefix-key (stumpwm:kbd \"C-M-H-s-z\")) @end example This will change the prefix key to @key{Control} + @key{Meta} + @key{Hyper} + @key{Super} + the @key{z} key. By most standards, a terrible prefix key but it makes a great example." (check-type key key) (copy-key-into key *escape-key*) ;; if the escape key has no modifiers then disable the fake key by ;; giving it keysym -1, an impossible value. Otherwise you have 2 ;; identical bindings and the one that appears first in the list ;; will be matched. (copy-key-into (make-key :keysym (if (key-mods-p *escape-key*) (key-keysym key) -1)) *escape-fake-key*) (sync-keys)) (defcommand-alias escape set-prefix-key) (defcommand bind (key command) ((:string "Key Chord: ") (:rest "Command: ")) "Hang a key binding off the escape key." (define-key *root-map* (kbd key) command)) (defcommand send-escape () () "Send the escape key to the current window." (send-meta-key (current-screen) *escape-key*)) stumpwm-0.9.9/color.lisp000066400000000000000000000375401242702317100152640ustar00rootroot00000000000000;; Copyright (C) 2007-2008 Jonathan Moore Liles ;; Copyright (C) 2014 Joram Schrijver ;; ;; 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, see ;; . ;; Commentary: ;; ;; A change in color, or presentation in general, is started by a ^. If that ;; ^ is followed by a single number, that's taken as the index into the color ;; map to be set as the foreground color. If the ^ is followed by two numbers, ;; the first is taken as the index of the foreground color, and the second as ;; the index of the background color. Either of those can also be *, which ;; means the value should be set to default. ;; ;; ^n resets the foreground and background color back to default. ;; ^A B turns bright colors on, and b turns them off. ;; ^R turns reverse colors on and r turns them off. ;; ^[ pushes the current settings onto the color stack. The current settings ;; remain unchanged. ;; ^] pops color settings off the stack. ;; ^> aligns the rest of the string to the right of the window. ;; ^f switches to the font at index n in the screen's font stack. ;; ^^ prints a regular caret ;; ^( &rest arguments) allows for more complicated color settings: ;; can be one of :fg, :bg, :reverse, :bright, :push, :pop, :font ;; and :>. ;; The arguments for each modifier differ: ;; - :fg and :bg take a color as an argument, which can either be a numeric ;; index into the color map or a hexadecimal color in the form of "#fff" ;; or "#ffffff". ;; - :reverse and :bright take either t or nil as an argument. T enables ;; the setting and nil disables it. ;; - :push and :pop take no arguments. :push pushes the current settings onto ;; the color stack, leaving the current settings intact. :pop pops color ;; settings off the stack, updating the current settings. ;; - :font takes an integer that represents an index into the screen's list ;; of fonts, or, possibly, a literal font object that can immediately be ;; used. In a string you'll probably only want to specify an integer. ;; - :> takes no arguments. It triggers right-alignment for the rest of the ;; line. (in-package :stumpwm) (export '(*colors* update-color-map adjust-color update-screen-color-context lookup-color)) (defvar *colors* '("black" "red" "green" "yellow" "blue" "magenta" "cyan" "white") "Eight colors by default. You can redefine these to whatever you like and then call (update-color-map).") (defun adjust-color (color amt) (labels ((max-min (x y) (max 0 (min 1 (+ x y))))) (setf (xlib:color-red color) (max-min (xlib:color-red color) amt) (xlib:color-green color) (max-min (xlib:color-green color) amt) (xlib:color-blue color) (max-min (xlib:color-blue color) amt)))) (defun hex-to-xlib-color (color) (if (= 4 (length color)) (let ((red (/ (parse-integer (subseq color 1 2) :radix 16) 255.0)) (green (/ (parse-integer (subseq color 2 3) :radix 16) 255.0)) (blue (/ (parse-integer (subseq color 3 4) :radix 16) 255.0))) (xlib:make-color :red (+ red (* 16 red)) :green (+ green (* 16 green)) :blue (+ blue (* 16 blue)))) (let ((red (/ (parse-integer (subseq color 1 3) :radix 16) 255.0)) (green (/ (parse-integer (subseq color 3 5) :radix 16) 255.0)) (blue (/ (parse-integer (subseq color 5 7) :radix 16) 255.0))) (xlib:make-color :red red :green green :blue blue)))) (defun lookup-color (screen color) (cond ((typep color 'xlib:color) color) ((and (stringp color) (or (= 7 (length color)) (= 4 (length color))) (char= #\# (elt color 0))) (hex-to-xlib-color color)) (t (xlib:lookup-color (xlib:screen-default-colormap (screen-number screen)) color)))) (defun alloc-color (screen color) (let ((colormap (xlib:screen-default-colormap (screen-number screen)))) (cond ((typep color 'xlib:color) (xlib:alloc-color colormap color)) (t (xlib:alloc-color colormap (lookup-color screen color)))))) ;; Normal colors are dimmed and bright colors are intensified in order ;; to more closely resemble the VGA pallet. (defun update-color-map (screen) "Read *colors* and cache their pixel colors for use when rendering colored text." (labels ((map-colors (amt) (loop for c in *colors* as color = (lookup-color screen c) do (adjust-color color amt) collect (alloc-color screen color)))) (setf (screen-color-map-normal screen) (apply #'vector (map-colors -0.25)) (screen-color-map-bright screen) (apply #'vector (map-colors 0.25))))) (defun update-screen-color-context (screen) (let* ((cc (screen-message-cc screen)) (bright (lookup-color screen *text-color*))) (setf (ccontext-default-fg cc) (screen-fg-color screen) (ccontext-default-bg cc) (screen-bg-color screen)) (adjust-color bright 0.25) (setf (ccontext-default-bright cc) (alloc-color screen bright)))) ;;; Parser for color strings (defun parse-color (color) "Parse a possible colorcode into a list of the appropriate modifiers. If COLOR isn't a colorcode a list containing COLOR is returned." (if (and (> (length color) 1) (char= (char color 0) #\^)) (let ((foreground (char color 1)) (background (if (> (length color) 2) (char color 2) :reset))) (case foreground ;; Normalize colors (#\n '((:bg :reset) (:fg :reset) (:reverse nil))) (#\R '((:reverse t))) (#\r '((:reverse nil))) (#\B '((:bright t))) (#\b '((:bright nil))) (#\[ '((:push))) (#\] '((:pop))) (#\> '((:>))) (#\f `((:font ,(or (parse-integer (string background) :junk-allowed t) 0)))) (#\^ '("^")) (#\( (list (read-from-string (subseq color 1)))) ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\*) `((:bg ,(or (parse-integer (string background) :junk-allowed t) :reset)) (:fg ,(or (parse-integer (string foreground) :junk-allowed t) :reset)) (:reverse nil))))) (list color))) ; this isn't a colorcode (defun parse-color-string (string) "Parse a color-coded string into a list of strings and color modifiers" (let ((substrings (remove-if (lambda (str) (zerop (length str))) (ppcre:split "(\\^[nrRbB>\\[\\]^]|\\^[0-9*]{1,2}|\\^f[0-9]|\\^\\(.*?\\))" string :with-registers-p t)))) (loop for substring in substrings append (parse-color substring)))) (defun uncolorify (string) "Remove any color markup in STRING" (format nil "~{~a~}" (remove-if-not 'stringp (parse-color-string string)))) ;;; Color modifiers and rendering code (defun find-color (color default cc &aux (screen (ccontext-screen cc))) (cond ((or (null color) (eq :reset color)) default) ((integerp color) (svref (if (ccontext-brightp cc) (screen-color-map-bright screen) (screen-color-map-normal screen)) color)) (t (alloc-color screen color)))) (defun find-font (cc specified-font &aux (font (or specified-font 0))) (if (integerp font) (nth font (screen-fonts (ccontext-screen cc))) font)) (defgeneric apply-color (ccontext modifier &rest arguments)) (defmethod apply-color ((cc ccontext) (modifier (eql :fg)) &rest args) (setf (ccontext-fg cc) (first args)) (let* ((gcontext (ccontext-gc cc)) (specified-color (first args)) (color (find-color specified-color (if (ccontext-brightp cc) (ccontext-default-bright cc) (ccontext-default-fg cc)) cc))) (if (ccontext-reversep cc) (setf (xlib:gcontext-background gcontext) color) (setf (xlib:gcontext-foreground gcontext) color)))) (defmethod apply-color ((cc ccontext) (modifier (eql :bg)) &rest args) (setf (ccontext-bg cc) (first args)) (let* ((gcontext (ccontext-gc cc)) (specified-color (first args)) (color (find-color specified-color (ccontext-default-bg cc) cc))) (if (ccontext-reversep cc) (setf (xlib:gcontext-foreground gcontext) color) (setf (xlib:gcontext-background gcontext) color)))) (defmethod apply-color ((cc ccontext) (modifier (eql :reverse)) &rest args) (setf (ccontext-reversep cc) (first args)) (let ((fg (ccontext-fg cc)) (bg (ccontext-bg cc))) (apply-color cc :fg fg) (apply-color cc :bg bg))) (defmethod apply-color ((cc ccontext) (modifier (eql :bright)) &rest args) (setf (ccontext-brightp cc) (first args)) (let ((fg (ccontext-fg cc)) (bg (ccontext-bg cc))) (apply-color cc :fg fg) (apply-color cc :bg bg))) (defmethod apply-color ((cc ccontext) (modifier (eql :push)) &rest args) (declare (ignore args)) (push (list (ccontext-fg cc) (ccontext-bg cc) (ccontext-brightp cc) (ccontext-reversep cc) (ccontext-font cc)) (ccontext-color-stack cc))) (defmethod apply-color ((cc ccontext) (modifier (eql :pop)) &rest args) (declare (ignore args)) (let ((values (pop (ccontext-color-stack cc)))) (apply-color cc :fg (first values)) (apply-color cc :bg (second values)) (apply-color cc :bright (third values)) (apply-color cc :reverse (fourth values)) (apply-color cc :font (fifth values)))) (defmethod apply-color ((cc ccontext) (modifier (eql :font)) &rest args) (let ((font (or (first args) 0))) (setf (ccontext-font cc) (find-font cc font)))) (defmethod apply-color ((cc ccontext) (modifier (eql :>)) &rest args) ;; This is a special case in RENDER-STRING and is thus only called when not ;; rendering. Since it doesn't otherwise have any effects, we just ignore it. (declare (ignore cc modifier args))) (defun max-font-height (parts cc) "Return the biggest font height for all of the fonts occurring in PARTS in the form of (:FONT ...) modifiers." (font-height (cons (ccontext-font cc) (loop for part in parts if (and (listp part) (eq :font (first part))) collect (find-font cc (second part)))))) (defun reset-color-context (cc) (apply-color cc :fg) (apply-color cc :bright) (apply-color cc :bg) (apply-color cc :reverse) (apply-color cc :font)) (defun rendered-string-size (string-or-parts cc &optional (resetp t)) "Return the width and height needed to render STRING-OR-PARTS, a single-line string." (let* ((parts (if (stringp string-or-parts) (parse-color-string string-or-parts) string-or-parts)) (height (max-font-height parts cc)) (width 0)) (loop for part in parts if (stringp part) do (incf width (text-line-width (ccontext-font cc) part :translate #'translate-id)) else do (apply #'apply-color cc (first part) (rest part))) (if resetp (reset-color-context cc)) (values width height))) (defun rendered-size (strings cc) "Return the width and height needed to render STRINGS" (loop for string in strings for (width line-height) = (multiple-value-list (rendered-string-size string cc nil)) maximizing width into max-width summing line-height into height finally (progn (reset-color-context cc) (return (values max-width height))))) (defun render-string (string-or-parts cc x y &aux (draw-x x)) "Renders STRING-OR-PARTS to the pixmap in CC. Returns the height and width of the rendered line as two values. The returned width is the value of X plus the rendered width." (let* ((parts (if (stringp string-or-parts) (parse-color-string string-or-parts) string-or-parts)) (height (max-font-height parts cc))) (loop for (part . rest) on parts for font-height-difference = (- height (font-height (ccontext-font cc))) for y-to-center = (floor (/ font-height-difference 2)) if (stringp part) do (draw-image-glyphs (ccontext-px cc) (ccontext-gc cc) (ccontext-font cc) draw-x (+ y y-to-center (font-ascent (ccontext-font cc))) part :translate #'translate-id :size 16) and do (incf draw-x (text-line-width (ccontext-font cc) part :translate #'translate-id)) else do (if (eq :> (first part)) (progn (render-string rest cc (- (xlib:drawable-width (ccontext-px cc)) x (rendered-string-size rest cc)) y) (loop-finish)) (apply #'apply-color cc (first part) (rest part)))) (values height draw-x))) (defun render-strings (screen cc padx pady strings highlights) (let* ((gc (ccontext-gc cc)) (xwin (ccontext-win cc)) (px (ccontext-px cc)) (strings (mapcar (lambda (string) (if (stringp string) (parse-color-string string) string)) strings)) (y 0)) ;; Create a new pixmap if there isn't one or if it doesn't match the ;; window (when (or (not px) (/= (xlib:drawable-width px) (xlib:drawable-width xwin)) (/= (xlib:drawable-height px) (xlib:drawable-height xwin))) (if px (xlib:free-pixmap px)) (setf px (xlib:create-pixmap :drawable xwin :width (xlib:drawable-width xwin) :height (xlib:drawable-height xwin) :depth (xlib:drawable-depth xwin)) (ccontext-px cc) px)) ;; Clear the background (xlib:with-gcontext (gc :foreground (xlib:gcontext-background gc)) (xlib:draw-rectangle px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) t)) (loop for parts in strings for row from 0 to (length strings) for line-height = (render-string parts cc (+ padx 0) (+ pady y)) when (find row highlights :test 'eql) do (invert-rect screen px 0 (+ pady y) (xlib:drawable-width px) line-height) do (incf y line-height)) (xlib:copy-area px gc 0 0 (xlib:drawable-width px) (xlib:drawable-height px) xwin 0 0) (reset-color-context cc) (values))) stumpwm-0.9.9/command.lisp000066400000000000000000000512651242702317100155640ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; implementation of commands ;; ;; Code: (in-package #:stumpwm) (export '(argument-line-end-p argument-pop argument-pop-or-read argument-pop-rest define-stumpwm-command defcommand defcommand-alias define-stumpwm-type run-commands %interactivep%)) (defstruct command-alias from to) (defstruct command name class args) (defvar *command-hash* (make-hash-table :test 'eq) "A list of interactive stumpwm commands.") (defvar *max-command-alias-depth* 10 "") ;; XXX: I'd like to just use straight warn, but sbcl drops to the ;; debugger when compiling so i've made a style warning instead ;; -sabetts (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))))) (defmacro defcommand (name (&rest args) (&rest interactive-args) &body body) "Create a command function and store its interactive hints in *command-hash*. The local variable %interactivep% can be used to check if the command was called interactively. If it is non-NIL then it was called from a keybinding or from the colon command. The NAME argument can be a string, or a list of two symbols. If the latter, the first symbol names the command, and the second indicates the type of group under which this command will be usable. Currently, tile-group and floating-group are the two possible values. INTERACTIVE-ARGS is a list of the following form: ((TYPE PROMPT) (TYPE PROMPT) ...) each element in INTERACTIVE-ARGS declares the type and prompt for the command's arguments. TYPE can be one of the following: @table @var @item :y-or-n A yes or no question returning T or NIL. @item :variable A lisp variable @item :function A lisp function @item :command A stumpwm command as a string. @item :key-seq A key sequence starting from *TOP-MAP* @item :window-number An existing window number @item :number An integer number @item :string A string @item :key A single key chord @item :window-name An existing window's name @item :direction A direction symbol. One of :UP :DOWN :LEFT :RIGHT @item :gravity A gravity symbol. One of :center :top :right :bottom :left :top-right :top-left :bottom-right :bottom-left @item :group An existing group @item :frame A frame @item :shell A shell command @item :rest The rest of the input yes to be parsed. @item :module An existing stumpwm module @end table Note that new argument types can be created with DEFINE-STUMPWM-TYPE. PROMPT can be string. In this case, if the corresponding argument is missing from an interactive call, stumpwm will use prompt for its value using PROMPT. If PROMPT is missing or nil, then the argument is considered an optional interactive argument and is not prompted for when missing. Alternatively, instead of specifying nil for PROMPT or leaving it out, an element can just be the argument type." (check-type name (or symbol list)) (let ((docstring (if (stringp (first body)) (first body) (warn (make-condition 'command-docstring-warning :command name)))) (body (if (stringp (first body)) (cdr body) body)) (name (if (atom name) name (first name))) (group (if (atom name) t (second name)))) `(progn (defun ,name ,args ,docstring (let ((%interactivep% *interactivep*) (*interactivep* nil)) (declare (ignorable %interactivep%)) ,@body)) (export ',name) (setf (gethash ',name *command-hash*) (make-command :name ',name :class ',group :args ',interactive-args))))) (defmacro define-stumpwm-command (name (&rest args) &body body) "Deprecated. use `defcommand' instead." (check-type name string) (setf name (intern1 name)) `(progn (defun ,name ,(mapcar 'car args) ,@body) (setf (gethash ',name *command-hash*) (make-command :name ',name :args ',(mapcar 'rest args))))) (defmacro defcommand-alias (alias original) "Since interactive commands are functions and can conflict with package symbols. But for backwards compatibility this macro creates an alias name for the command that is only accessible interactively." `(setf (gethash ',alias *command-hash*) (make-command-alias :from ',alias :to ',original))) (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))) *command-hash*)) (defun command-active-p (command) (typep (current-group) (command-class command)) ;; TODO: minor modes ) (defun get-command-structure (command &optional (only-active t)) "Return the command structure for COMMAND. COMMAND can be a string, symbol, command, or command-alias. By default only search active commands." (declare (type (or string symbol command command-alias) command)) (when (or (stringp command) (symbolp command)) (setf command (dereference-command-symbol command))) (when (command-alias-p command) (setf command (loop for c = (gethash (command-alias-to command) *command-hash*) then (gethash (command-alias-to c) *command-hash*) for depth from 1 until (or (null c) (command-p c)) when (> depth *max-command-alias-depth*) do (error "Maximum command alias depth exceded") finally (return c)))) (when (and command (or (not only-active) (command-active-p command))) command)) (defun all-commands (&optional (only-active t)) "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))) *command-hash*) (sort acc 'string<))) ;;; command arguments (defstruct argument-line string start) (defvar *command-type-hash* (make-hash-table) "A hash table of types and functions to deal with these types.") (defun argument-line-end-p (input) "Return T if we're outta arguments from the input line." (>= (argument-line-start input) (length (argument-line-string input)))) (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)) (argument-line-string input) :start (argument-line-start input))) (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 (unless (= p1 p2) (subseq (argument-line-string input) p1 p2)) (setf (argument-line-start input) (1+ p2)))))) (defun argument-pop-or-read (input prompt &optional completions) (or (argument-pop input) (if completions (completing-read (current-screen) prompt completions) (read-one-line (current-screen) prompt)) (throw 'error :abort))) (defun argument-pop-rest (input) "Return the remainder of the argument text." (unless (argument-line-end-p input) (prog1 (subseq (argument-line-string input) (argument-line-start input)) (setf (argument-line-start input) (length (argument-line-string input)))))) (defun argument-pop-rest-or-read (input prompt &optional completions) (or (argument-pop-rest input) (if completions (completing-read (current-screen) prompt completions) (read-one-line (current-screen) prompt)) (throw 'error :abort))) (defmacro define-stumpwm-type (type (input prompt) &body body) "Create a new type that can be used for command arguments. @var{type} can be any symbol. When @var{body} is evaluated @var{input} is bound to the argument-line. It is passed to @code{argument-pop}, @code{argument-pop-rest}, etc. @var{prompt} is the prompt that should be used when prompting the user for the argument. @example \(define-stumpwm-type :symbol (input prompt) (or (find-symbol (string-upcase (or (argument-pop input) ;; Whitespace messes up find-symbol. (string-trim \" \" (completing-read (current-screen) prompt ;; find all symbols in the ;; stumpwm package. (let (acc) (do-symbols (s (find-package \"STUMPWM\")) (push (string-downcase (symbol-name s)) acc)) acc))) (throw 'error \"Abort.\"))) \"STUMPWM\") (throw 'error \"Symbol not in STUMPWM package\"))) \(defcommand \"symbol\" (sym) ((:symbol \"Pick a symbol: \")) (message \"~a\" (with-output-to-string (s) (describe sym s)))) @end example 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))) (define-stumpwm-type :y-or-n (input prompt) (let ((s (or (argument-pop input) (read-one-line (current-screen) (concat prompt "(y/n): "))))) (when s (values (list (equal s "y")))))) (defun lookup-symbol (string) ;; FIXME: should we really use string-upcase? (let* ((ofs (split-string string ":")) (pkg (if (> (length ofs) 1) (find-package (string-upcase (pop ofs))) *package*)) (var (string-upcase (pop ofs))) (ret (find-symbol var pkg))) (when (plusp (length ofs)) (throw 'error "Too many :'s")) (if ret (values ret pkg var) (throw 'error (format nil "No such symbol: ~a::~a." (package-name pkg) var))))) (define-stumpwm-type :variable (input prompt) (lookup-symbol (argument-pop-or-read input prompt))) (define-stumpwm-type :function (input prompt) (multiple-value-bind (sym pkg var) (lookup-symbol (argument-pop-or-read input prompt)) (if (symbol-function sym) (symbol-function sym) (throw 'error (format nil "the symbol ~a::~a has no function." (package-name pkg) var))))) (define-stumpwm-type :command (input prompt) (or (argument-pop input) (completing-read (current-screen) prompt (all-commands)))) (define-stumpwm-type :key-seq (input prompt) (labels ((update (seq) (message "~a: ~{~a ~}" prompt (mapcar 'print-key (reverse seq))))) (let ((rest (argument-pop-rest input))) (or (and rest (parse-key-seq rest)) ;; read a key sequence from the user (with-focus (screen-key-window (current-screen)) (message "~a" prompt) (nreverse (second (multiple-value-list (read-from-keymap (top-maps) #'update))))))))) (define-stumpwm-type :window-number (input prompt) (let ((n (or (argument-pop input) (completing-read (current-screen) prompt (mapcar 'window-map-number (group-windows (current-group))))))) (when n (let ((win (find n (group-windows (current-group)) :test #'string= :key #'window-map-number))) (if win (window-number win) (throw 'error "No Such Window.")))))) (define-stumpwm-type :number (input prompt) (let ((n (or (argument-pop input) (read-one-line (current-screen) prompt)))) (when n (handler-case (parse-integer n) (parse-error (c) (declare (ignore c)) (throw 'error "Number required.")))))) (define-stumpwm-type :string (input prompt) (or (argument-pop input) (read-one-line (current-screen) prompt))) (define-stumpwm-type :password (input prompt) (or (argument-pop input) (read-one-line (current-screen) prompt :password t))) (define-stumpwm-type :key (input prompt) (let ((s (or (argument-pop input) (read-one-line (current-screen) prompt)))) (when s (kbd s)))) (define-stumpwm-type :window-name (input prompt) (or (argument-pop input) (completing-read (current-screen) prompt (mapcar 'window-name (group-windows (current-group)))))) (define-stumpwm-type :direction (input prompt) (let* ((values '(("up" :up) ("down" :down) ("left" :left) ("right" :right))) (dir (second (assoc (argument-pop-or-read input prompt values) values :test 'string-equal)))) (or dir (throw 'error "No matching direction.")))) (define-stumpwm-type :gravity (input prompt) "Set the current window's gravity." (let* ((values '(("center" :center) ("top" :top) ("right" :right) ("bottom" :bottom) ("left" :left) ("top-right" :top-right) ("top-left" :top-left) ("bottom-right" :bottom-right) ("bottom-left" :bottom-left))) (gravity (second (assoc (argument-pop-or-read input prompt values) values :test 'string-equal)))) (or gravity (throw 'error "No matching gravity.")))) (defun select-group (screen query) "Attempt to match string QUERY against group number or partial name." (labels ((match-num (grp) (string-equal (group-map-number grp) query)) (match-whole (grp) (string-equal (group-name grp) query)) (match-partial (grp) (let* ((end (min (length (group-name grp)) (length query)))) (string-equal (group-name grp) query :end1 end :end2 end)))) (when query (or (find-if #'match-num (screen-groups screen)) (find-if #'match-whole (screen-groups screen)) (find-if #'match-partial (screen-groups screen)))))) (define-stumpwm-type :group (input prompt) (let ((match (select-group (current-screen) (or (argument-pop input) (completing-read (current-screen) prompt (mapcar 'group-name (screen-groups (current-screen)))))))) (or match (throw 'error "No Such Group.")))) (define-stumpwm-type :frame (input prompt) (declare (ignore prompt)) (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=) (throw 'error "Frame not found.")) (or (choose-frame-by-number (current-group)) (throw 'error :abort))))) (define-stumpwm-type :shell (input prompt) (or (argument-pop-rest input) (completing-read (current-screen) prompt 'complete-program))) (define-stumpwm-type :rest (input prompt) (or (argument-pop-rest input) (read-one-line (current-screen) prompt))) ;;; (defun call-interactively (command &optional (input "")) "Parse the command's arguments from input given the command's argument specifications then execute it. Returns a string or nil if user aborted." (declare (type (or string symbol) command) (type (or string argument-line) input)) ;; Catch parse errors (catch 'error (let* ((arg-line (if (stringp input) (make-argument-line :string input :start 0) input)) (cmd-data (or (get-command-structure command) (throw 'error (format nil "Command '~a' not found." command)))) (arg-specs (command-args cmd-data)) (args (loop for spec in arg-specs collect (let* ((type (if (listp spec) (first spec) spec)) (prompt (when (listp spec) (second spec))) (fn (gethash type *command-type-hash*))) (unless fn (throw 'error (format nil "Bad argument type: ~s" type))) ;; If the prompt is NIL then it's ;; considered an optional argument and ;; we shouldn't prompt for it if the ;; arg line is empty. (if (and (null prompt) (argument-line-end-p arg-line)) (loop-finish) (funcall fn arg-line prompt)))))) ;; Did the whole string get parsed? (unless (or (argument-line-end-p arg-line) (position-if 'alphanumericp (argument-line-string arg-line) :start (argument-line-start arg-line))) (throw 'error (format nil "Trailing garbage: ~{~A~^ ~}" (subseq (argument-line-string arg-line) (argument-line-start arg-line))))) ;; Success (prog1 (apply (command-name cmd-data) args) (setf *last-command* command))))) (defun eval-command (cmd &optional interactivep) "exec cmd and echo the result." (labels ((parse-and-run-command (input) (let* ((arg-line (make-argument-line :string input :start 0)) (cmd (argument-pop arg-line))) (let ((*interactivep* interactivep)) (call-interactively cmd arg-line))))) (multiple-value-bind (result error-p) ;; this fancy footwork lets us grab the backtrace from where the ;; 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" cmd c (if *show-command-backtrace* (backtrace-string) "")))))) (parse-and-run-command cmd)) (eval-command-error (err-text) :interactive (lambda () nil) (values err-text t))) ;; interactive commands update the modeline (update-all-mode-lines) (cond ((stringp result) (if error-p (message-no-timeout "~a" result) (message "~a" result))) ((eq result :abort) (unless *suppress-abort-messages* (message "Abort."))))))) (defun run-commands (&rest commands) "Run each stumpwm command in sequence. This could be used if you're used to ratpoison's rc file and you just want to run commands or don't know lisp very well. One might put the following in one's rc file: @example \(stumpwm:run-commands \"escape C-z\" \"exec firefox\" \"split\") @end example" (loop for i in commands do (eval-command i))) (defcommand colon (&optional initial-input) (:rest) "Read a command from the user. @var{initial-text} is optional. When supplied, the text will appear in the prompt." (let ((cmd (completing-read (current-screen) ": " (all-commands) :initial-input (or initial-input "")))) (unless cmd (throw 'error :abort)) (when (plusp (length cmd)) (eval-command cmd t)))) stumpwm-0.9.9/configure.ac000066400000000000000000000061251242702317100155360ustar00rootroot00000000000000# -*- Autoconf -*- # Process this file with autoconf to produce a configure script. AC_PREREQ(2.59) AC_INIT(Stump Window Manager, esyscmd(grep :version stumpwm.asd | cut -d\" -f2 | tr -d \\n), sabetts@gmail.com) AC_SUBST(MODULE_DIR) AC_SUBST(LISP_PROGRAM) AC_SUBST(LISP) AC_SUBST(STUMPWM_ASDF_DIR) # Checks for programs. AC_ARG_WITH(lisp, [ --with-lisp=IMPL use the specified lisp (sbcl, clisp, ccl or ecl)], LISP=$withval, LISP="any") AC_ARG_WITH(sbcl, [ --with-sbcl=PATH specify location of sbcl], SBCL_PATH=$withval, SBCL_PATH="") AC_ARG_WITH(clisp, [ --with-clisp=PATH specify location of clisp], CLISP_PATH=$withval, CLISP_PATH="") AC_ARG_WITH(ccl, [ --with-ccl=PATH specify location of ccl], CCL_PATH=$withval, CCL_PATH="") AC_ARG_WITH(ecl, [ --with-ecl=PATH specify location of ecl], ECL_PATH=$withval, ECL_PATH="") AC_ARG_WITH(lw, [ --with-lw=PATH specify location of lispworks], LW_PATH=$withval, LW_PATH="") AC_ARG_WITH(module-dir, [ --with-module-dir=PATH specify location of contrib modules], MODULE_DIR=$withval, MODULE_DIR="${HOME}/.stumpwm.d/modules") STUMPWM_ASDF_DIR="`pwd`" if test -x "$SBCL_PATH"; then SBCL=$SBCL_PATH AC_MSG_CHECKING([for sbcl]) AC_MSG_RESULT($SBCL) else AC_PATH_PROG([SBCL], sbcl,"") fi if test -x "$CLISP_PATH"; then CLISP=$CLISP_PATH AC_MSG_CHECKING([for clisp]) AC_MSG_RESULT($CLISP) else AC_PATH_PROG([CLISP],clisp,"") fi if test -x "$CCL_PATH"; then CCL=$CCL_PATH AC_MSG_CHECKING([for ccl]) AC_MSG_RESULT($CCL) else AC_PATH_PROG([CCL],ccl,"") fi if test -x "$ECL_PATH"; then ECL=$ECL_PATH AC_MSG_CHECKING([for ecl]) AC_MSG_RESULT($ECL) else AC_PATH_PROG([ECL], ecl,"") fi if test -x "$LW_PATH"; then LW=$LW_PATH AC_MSG_CHECKING([for lispworks]) AC_MSG_RESULT($LW) else AC_PATH_PROG([LW], lw,"") fi if test "x$LISP" = "xany"; then if test "$SBCL"; then LISP=sbcl elif test "$CLISP"; then LISP=clisp elif test "$CCL"; then LISP=ccl elif test "$ECL"; then LISP=ecl elif test "$LW"; then LISP=lw fi fi if test "x$LISP" = "xsbcl"; then LISP_PROGRAM=$SBCL elif test "x$LISP" = "xclisp"; then LISP_PROGRAM=$CLISP elif test "x$LISP" = "xccl"; then LISP_PROGRAM=$CCL elif test "x$LISP" = "xecl"; then LISP_PROGRAM=$ECL elif test "x$LISP" = "xlw"; then LISP_PROGRAM=$LW fi if test "x$LISP_PROGRAM" = "x"; then AC_MSG_ERROR([*** No lisp is available.]) fi AC_MSG_NOTICE([Using $LISP at $LISP_PROGRAM]) # check for makeinfo AC_CHECK_PROG(MAKEINFO,makeinfo,yes,no) if test "$MAKEINFO" = "no"; then AC_MSG_ERROR([Please install makeinfo for the manual.]) fi AC_CHECK_PROG(XDPYINFO,xdpyinfo,yes,no) if test "$XDPINFO" = "no"; then AC_MSG_WARN([xdpyinfo is needed for xinerama support.]) fi # Checks for libraries. # Checks for header files. # Checks for typedefs, structures, and compiler characteristics. # Checks for library functions. AC_OUTPUT(Makefile) AC_OUTPUT(make-image.lisp) AC_OUTPUT(load-stumpwm.lisp) stumpwm-0.9.9/core.lisp000066400000000000000000000135061242702317100150720ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; This file contains core functionality including functions on ;; windows, screens, and events. ;; ;; Code: (in-package :stumpwm) ;; Wow, is there an easier way to do this? (defmacro def-thing-attr-macro (thing hash-slot) (let ((attr (gensym "ATTR")) (obj (gensym "METAOBJ")) (val (gensym "METAVAL"))) `(defmacro ,(intern1 (format nil "DEF-~a-ATTR" thing)) (,attr) "Create a new attribute and corresponding get/set functions." (let ((,obj (gensym "OBJ")) (,val (gensym "VAL"))) `(progn (defun ,(intern1 (format nil ,(format nil "~a-~~a" thing) ,attr)) (,,obj) (gethash ,,attr (,(quote ,hash-slot) ,,obj))) (defun (setf ,(intern1 (format nil ,(format nil "~a-~~a" thing) ,attr))) (,,val ,,obj) (setf (gethash ,,attr (,(quote ,hash-slot) ,,obj))) ,,val)))))) ;;; keyboard helper functions (defun key-to-keycode+state (key) (let ((code (xlib:keysym->keycodes *display* (key-keysym key)))) (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 (cons :shift (xlib:make-state-keys (x11-mods key)))))) (t ;; just warn them and go ahead as scheduled (warn "Don't know how to encode ~s" key) (values code (x11-mods key)))))) (defun send-fake-key (win key) "Send a fake key press event to win." (multiple-value-bind (code state) (key-to-keycode+state key) (xlib:send-event (window-xwin win) :key-press (xlib:make-event-mask :key-press) :display *display* :root (screen-root (window-screen win)) ;; Apparently we need these in here, though they ;; make no sense for a key event. :x 0 :y 0 :root-x 0 :root-y 0 :window (window-xwin win) :event-window (window-xwin win) :code code :state state))) (defun send-fake-click (win button) "Send a fake click (button press + button release) to win." (cond #+clx-ext-test ((xlib:query-extension *display* "XTEST") (xtest:fake-button-event *display* button t) (xtest:fake-button-event *display* button nil)) (t (multiple-value-bind (x y) (xlib:query-pointer (window-xwin win)) (multiple-value-bind (rx ry) (xlib:query-pointer (screen-root (window-screen win))) (xlib:send-event (window-xwin win) :button-press (xlib:make-event-mask :button-press) :display *display* :root (screen-root (window-screen win)) :window (window-xwin win) :event-window (window-xwin win) :code button :state 0 :x x :y y :root-x rx :root-y ry :same-screen-p t) (xlib:send-event (window-xwin win) :button-release (xlib:make-event-mask :button-release) :display *display* :root (screen-root (window-screen win)) :window (window-xwin win) :event-window (window-xwin win) :code button :state #x100 :x x :y y :root-x rx :root-y ry :same-screen-p t)))))) ;;; Pointer helper functions (defun grab-pointer (screen) "Grab the pointer and set the pointer shape." (incf *grab-pointer-count*) (let* ((cursor-font (xlib:open-font *display* *grab-pointer-font*)) (cursor (xlib:create-glyph-cursor :source-font cursor-font :source-char *grab-pointer-character* :mask-font cursor-font :mask-char *grab-pointer-character-mask* :foreground *grab-pointer-foreground* :background *grab-pointer-background*))) (xlib:grab-pointer (screen-root screen) nil :owner-p nil :cursor cursor))) (defun ungrab-pointer () "Remove the grab on the cursor and restore the cursor shape." (when (> *grab-pointer-count* 0) (decf *grab-pointer-count*)) (when (eq *grab-pointer-count* 0) (xlib:ungrab-pointer *display*) (xlib:display-finish-output *display*))) (defun grab-keyboard (xwin) (let ((ret (xlib:grab-keyboard xwin :owner-p nil :sync-keyboard-p nil :sync-pointer-p nil))) (dformat 5 "vvv Grab keyboard: ~s~%" ret) ret)) (defun ungrab-keyboard () (let ((ret (xlib:ungrab-keyboard *display*))) (dformat 5 "^^^ Ungrab keyboard: ~s~%" ret) ret)) (defun warp-pointer (screen x y) "Move the pointer to the specified location." (let ((root (screen-root screen))) (xlib:warp-pointer root x y))) (defun warp-pointer-relative (dx dy) "Move the pointer by DX and DY relative to the current location." (xlib:warp-pointer-relative *display* dx dy)) stumpwm-0.9.9/events.lisp000066400000000000000000000700441242702317100154460ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Event handling. ;; ;; Code: (in-package #:stumpwm) ;;; Event handler functions (defparameter *event-fn-table* (make-hash-table) "A hash of event types to functions") (defvar *current-event-time* nil) (defmacro define-stump-event-handler (event keys &body body) (let ((fn-name (gensym)) (event-slots (gensym))) `(labels ((,fn-name (&rest ,event-slots &key ,@keys &allow-other-keys) (declare (ignore ,event-slots)) ,@body)) (setf (gethash ,event *event-fn-table*) #',fn-name)))) ;(define-stump-event-handler :map-notify (event-window window override-redirect-p) ; ) (defun handle-mode-line-window (xwin x y width height) (declare (ignore width)) (let ((ml (find-mode-line-window xwin))) (when ml (setf (xlib:drawable-height xwin) height) (update-mode-line-position ml x y) (resize-mode-line ml) (sync-mode-line ml)))) (defun handle-unmanaged-window (xwin x y width height border-width value-mask) "Call this function for windows that stumpwm isn't managing. Basically just give the window what it wants." (labels ((has-x (mask) (= 1 (logand mask 1))) (has-y (mask) (= 2 (logand mask 2))) (has-w (mask) (= 4 (logand mask 4))) (has-h (mask) (= 8 (logand mask 8))) (has-bw (mask) (= 16 (logand mask 16))) ;; (has-stackmode (mask) (= 64 (logand mask 64))) ) (xlib:with-state (xwin) (when (has-x value-mask) (setf (xlib:drawable-x xwin) x)) (when (has-y value-mask) (setf (xlib:drawable-y xwin) y)) (when (has-h value-mask) (setf (xlib:drawable-height xwin) height)) (when (has-w value-mask) (setf (xlib:drawable-width xwin) width)) (when (has-bw value-mask) (setf (xlib:drawable-border-width xwin) border-width))))) (defun update-configuration (win) ;; Send a synthetic configure-notify event so that the window ;; knows where it is onscreen. (xwin-send-configuration-notify (window-xwin win) (xlib:drawable-x (window-parent win)) (xlib:drawable-y (window-parent win)) (window-width win) (window-height win) 0)) (define-stump-event-handler :configure-request (stack-mode #|parent|# window #|above-sibling|# x y width height border-width value-mask) (labels ((has-x () (= 1 (logand value-mask 1))) (has-y () (= 2 (logand value-mask 2))) (has-w () (= 4 (logand value-mask 4))) (has-h () (= 8 (logand value-mask 8))) (has-stackmode () (= 64 (logand value-mask 64)))) ;; Grant the configure request but then maximize the window after the granting. (dformat 3 "CONFIGURE REQUEST ~@{~S ~}~%" stack-mode window x y width height border-width value-mask) (let ((win (find-window window))) (cond (win (when (or (has-w) (has-h) (has-stackmode)) ;; FIXME: I don't know why we need to clear the urgency bit ;; here, but the old code would anytime a resize or raise ;; request came in, so keep doing it. -sabetts (when (window-urgent-p win) (window-clear-urgency win))) (when (or (has-x) (has-y)) (group-move-request (window-group win) win x y :parent)) (when (or (has-w) (has-h)) (group-resize-request (window-group win) win width height)) (when (has-stackmode) (group-raise-request (window-group win) win stack-mode)) ;; Just to be on the safe side, hit the client with a fake ;; configure event. The ICCCM says we have to do this at ;; certain times; exactly when, I've sorta forgotten. (update-configuration win)) ((handle-mode-line-window win x y width height)) (t (handle-unmanaged-window window x y width height border-width value-mask)))))) (define-stump-event-handler :configure-notify (stack-mode #|parent|# window #|above-sibling|# x y width height border-width value-mask) (dformat 4 "CONFIGURE NOTIFY ~@{~S ~}~%" stack-mode window x y width height border-width value-mask) (let ((screen (find-screen window))) (when screen (let ((old-heads (copy-list (screen-heads screen)))) (setf (screen-heads screen) nil) (let ((new-heads (make-screen-heads screen (screen-root screen)))) (setf (screen-heads screen) old-heads) (cond ((equalp old-heads new-heads) (dformat 3 "Bogus configure-notify on root window of ~S~%" screen) t) (t (dformat 1 "Updating Xinerama configuration for ~S.~%" screen) (if new-heads (head-force-refresh screen new-heads) (dformat 1 "Invalid configuration! ~S~%" new-heads))))))))) (define-stump-event-handler :map-request (parent send-event-p window) (unless send-event-p ;; This assumes parent is a root window and it should be. (dformat 3 "map request: ~a ~a ~a~%" window parent (find-window window)) (let ((screen (find-screen parent)) (win (find-window window)) (wwin (find-withdrawn-window window))) ;; only absorb it if it's not already managed (it could be iconic) (cond (win (dformat 1 "map request for mapped window ~a~%" win)) ((eq (xwin-type window) :dock) (when wwin (setf screen (window-screen wwin))) (dformat 1 "window is dock-type. attempting to place in mode-line.") (place-mode-line-window screen window) ;; Some panels are broken and only set the dock type after they map and withdraw. (when wwin (setf (screen-withdrawn-windows screen) (delete wwin (screen-withdrawn-windows screen)))) t) (wwin (restore-window wwin)) ((xlib:get-property window :_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR) ;; Do nothing if this is a systray window (the system tray ;; will handle it, if there is one, and, if there isn't the ;; user doesn't want this popping up as a managed window ;; anyway. t) (t (let ((window (process-mapped-window screen window))) (group-raise-request (window-group window) window :map))))))) (define-stump-event-handler :unmap-notify (send-event-p event-window window #|configure-p|#) ;; There are two kinds of unmap notify events: the straight up ;; ones where event-window and window are the same, and ;; substructure unmap events when the event-window is the parent ;; of window. (dformat 2 "UNMAP: ~s ~s ~a~%" send-event-p (not (xlib:window-equal event-window window)) (find-window window)) (unless (and (not send-event-p) (not (xlib:window-equal event-window window))) (let ((window (find-window window))) ;; if we can't find the window then there's nothing we need to ;; do. (when window (if (plusp (window-unmap-ignores window)) (progn (dformat 3 "decrement ignores! ~d~%" (window-unmap-ignores window)) (decf (window-unmap-ignores window))) (withdraw-window window)))))) ;;(define-stump-event-handler :create-notify (#|window parent x y width height border-width|# override-redirect-p)) ;; (unless (or override-redirect-p ;; (internal-window-p (window-screen window) window)) ;; (process-new-window (window-screen window) window)) ;; (run-hook-with-args *new-window-hook* window))) (define-stump-event-handler :destroy-notify (send-event-p event-window window) (unless (or send-event-p (xlib:window-equal event-window window)) ;; Ignore structure destroy notifies and only ;; use substructure destroy notifiers. This way ;; event-window is the window's parent. (let ((win (or (find-window window) (find-withdrawn-window window)))) (if win (destroy-window win) (progn (let ((ml (find-mode-line-window window))) (when ml (destroy-mode-line-window ml)))))))) (defun read-from-keymap (kmaps &optional update-fn) "Read a sequence of keys from the user, guided by the keymaps, KMAPS and return the binding or nil if the user hit an unbound sequence. The Caller is responsible for setting up the input focus." (let* ((code-state (read-key-no-modifiers)) (code (car code-state)) (state (cdr code-state))) (handle-keymap kmaps code state nil nil update-fn))) (defun handle-keymap (kmaps code state key-seq grab update-fn) "Find the command mapped to the (code state) and return it." ;; KMAPS is a list of keymaps that may match the user's key sequence. (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)) (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 ;; command, then we're done. (match (find-if-not 'null bindings))) (dformat 1 "key-press: ~S ~S ~S~%" key state match) (run-hook-with-args *key-press-hook* key key-seq match) (when update-fn (funcall update-fn key-seq)) (cond ((kmap-or-kmap-symbol-p match) (when grab (grab-pointer (current-screen))) (let* ((code-state (read-key-no-modifiers)) (code (car code-state)) (state (cdr code-state))) (unwind-protect (handle-keymap (remove-if-not 'kmap-or-kmap-symbol-p bindings) code state key-seq nil update-fn) (when grab (ungrab-pointer))))) (match (values match key-seq)) ((and (find key (list (kbd "?") (kbd "C-h")) :test 'equalp)) (apply 'display-bindings-for-keymaps (reverse (cdr key-seq)) (dereference-kmaps kmaps)) (values t key-seq)) (t (values nil key-seq))))) (defun top-maps (&optional (group (current-group))) "Return all top level keymaps that are active." (append ;; The plain jane top map is first because that's where users are ;; going to throw in their universally accessible customizations ;; which we don't want groups or minor modes shadowing them. (list '*top-map*) ;; TODO: Minor Mode maps go here ;; lastly, group maps. Last because minor modes should be able to ;; shadow a group's default bindings. (loop for i in *group-top-maps* when (typep group (first i)) collect (second i)))) (define-stump-event-handler :key-press (code state #|window|#) (labels ((get-cmd (code state) (with-focus (screen-key-window (current-screen)) (handle-keymap (top-maps) code state nil t nil)))) (unwind-protect ;; modifiers can sneak in with a race condition. so avoid that. (unless (is-modifier code) (multiple-value-bind (cmd key-seq) (get-cmd code state) (cond ((eq cmd t)) (cmd (unmap-message-window (current-screen)) (eval-command cmd t) t) (t (message "~{~a ~}not bound." (mapcar 'print-key (nreverse key-seq)))))))))) (defun bytes-to-window (bytes) "A sick hack to assemble 4 bytes into a 32 bit number. This is because ratpoison sends the rp_command_request window in 8 byte chunks." (+ (first bytes) (ash (second bytes) 8) (ash (third bytes) 16) (ash (fourth bytes) 24))) (defun handle-rp-commands (root) "Handle a ratpoison style command request." (labels ((one-cmd () (multiple-value-bind (win type format bytes-after) (xlib:get-property root :rp_command_request :end 4 :delete-p t) (declare (ignore type format)) (setf win (xlib::lookup-window *display* (bytes-to-window win))) (when (xlib:window-p win) (let* ((data (xlib:get-property win :rp_command)) (interactive-p (car data)) (cmd (map 'string 'code-char (nbutlast (cdr data))))) (declare (ignore interactive-p)) (eval-command cmd) (xlib:change-property win :rp_command_result (map 'list 'char-code "0TODO") :string 8) (xlib:display-finish-output *display*))) bytes-after))) (loop while (> (one-cmd) 0)))) (defun handle-stumpwm-commands (root) "Handle a StumpWM style command request." (let* ((win root) (screen (find-screen root)) (data (xlib:get-property win :stumpwm_command :delete-p t)) (cmd (bytes-to-string data))) (let ((msgs (screen-last-msg screen)) (hlts (screen-last-msg-highlights screen)) (*executing-stumpwm-command* t)) (setf (screen-last-msg screen) '() (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)))) :string 8) (setf (screen-last-msg screen) msgs (screen-last-msg-highlights screen) hlts)) (xlib:display-finish-output *display*))) (defun maybe-set-urgency (window) (when (and (window-urgent-p window) (not (find window (screen-urgent-windows (window-screen window))))) (when (register-urgent-window window) (run-hook-with-args *urgent-window-hook* window)))) (defun safe-atom-name (n) "Return the name of the atom with atom-id N or nil if there isn't one." (handler-case (xlib:atom-name *display* n) (xlib:atom-error () nil))) (defun safe-bytes-to-atoms (list) "Return a list of atoms from list. Any number that cannot be converted to an atom is removed." (loop for p in list when (typep p '(unsigned-byte 29)) collect (safe-atom-name p))) (defun update-window-properties (window atom) (case atom (:wm_name (setf (window-title window) (xwin-name (window-xwin window))) ;; Let the mode line know about the new name. (update-all-mode-lines)) (:wm_normal_hints (setf (window-normal-hints window) (get-normalized-normal-hints (window-xwin window)) (window-type window) (xwin-type (window-xwin window))) (dformat 4 "new hints: ~s~%" (window-normal-hints window)) (window-sync window :normal-hints)) (:wm_hints (maybe-set-urgency window)) (:wm_class (setf (window-class window) (xwin-class (window-xwin window)) (window-res window) (xwin-res-name (window-xwin window)))) (:wm_window_role (setf (window-role window) (xwin-role (window-xwin window)))) (:wm_transient_for (setf (window-type window) (xwin-type (window-xwin window))) (window-sync window :type)) (:_NET_WM_STATE ;; Some clients put really big numbers in the list causing ;; atom-name to fail, so filter out anything that can't be ;; converted into an atom. (dolist (p (safe-bytes-to-atoms (xlib:get-property (window-xwin window) :_NET_WM_STATE))) (case p (:_NET_WM_STATE_FULLSCREEN ;; Client is broken and sets this property itself instead of sending a ;; client request to the root window. Try to make do. ;; FIXME: what about when properties are REMOVED? (update-fullscreen window 1))))))) (define-stump-event-handler :property-notify (window atom state) (dformat 2 "property notify ~s ~s ~s~%" window atom state) (case atom (:rp_command_request ;; we will only find the screen if window is a root window, which ;; is the only place we listen for ratpoison commands. (let* ((screen (find-screen window))) (when (and (eq state :new-value) screen) (handle-rp-commands window)))) (:stumpwm_command ;; RP commands are too weird and problematic, KISS. (let* ((screen (find-screen window))) (when (and (eq state :new-value) screen) (handle-stumpwm-commands window)))) (t (let ((window (find-window window))) (when window (update-window-properties window atom)))))) (define-stump-event-handler :mapping-notify (request start count) ;; We could be a bit more intelligent about when to update the ;; modifier map, but I don't think it really matters. (xlib:mapping-notify *display* request start count) (update-modifier-map) (sync-keys)) (define-stump-event-handler :selection-request (requestor property selection target time) (send-selection requestor property selection target time)) (define-stump-event-handler :selection-clear (selection) (setf (getf *x-selection* selection) nil)) (defun find-message-window-screen (win) "Return the screen, if any, that message window WIN belongs." (dolist (screen *screen-list*) (when (xlib:window-equal (screen-message-window screen) win) (return screen)))) (defun draw-cross (screen window x y width height) (xlib:draw-line window (screen-frame-outline-gc screen) x y width height t) (xlib:draw-line window (screen-frame-outline-gc screen) x (+ y height) (+ x width) y)) (define-stump-event-handler :exposure (window x y width height count) (let (screen ml) (when (zerop count) (cond ((setf screen (find-screen window)) ;; root exposed (group-root-exposure (screen-current-group screen))) ((setf screen (find-message-window-screen window)) ;; message window exposed (if (plusp (screen-ignore-msg-expose screen)) (decf (screen-ignore-msg-expose screen)) (redraw-current-message screen))) ((setf ml (find-mode-line-window window)) (setf screen (mode-line-screen ml)) (redraw-mode-line ml t))) ;; Show the area. (when (and *debug-expose-events* screen) (draw-cross screen window x y width height))))) (define-stump-event-handler :reparent-notify (window parent) (let ((win (find-window window))) (when (and win (not (xlib:window-equal parent (window-parent win)))) ;; reparent it back (unless (eq (xlib:window-map-state (window-xwin win)) :unmapped) (incf (window-unmap-ignores win))) (xlib:reparent-window (window-xwin win) (window-parent win) 0 0)))) ;;; Fullscreen functions (defun activate-fullscreen (window) (dformat 2 "client requests to go fullscreen~%") (add-wm-state (window-xwin window) :_NET_WM_STATE_FULLSCREEN) (setf (window-fullscreen window) t) (focus-window window)) (defun deactivate-fullscreen (window) (setf (window-fullscreen window) nil) (dformat 2 "client requests to leave fullscreen~%") (remove-wm-state (window-xwin window) :_NET_WM_STATE_FULLSCREEN) (update-decoration window) (update-mode-lines (current-screen))) (defun update-fullscreen (window action) (let ((fullscreen-p (window-fullscreen window))) (case action (0 ; _NET_WM_STATE_REMOVE (when fullscreen-p (deactivate-fullscreen window))) (1 ; _NET_WM_STATE_ADD (unless fullscreen-p (activate-fullscreen window))) (2 ; _NET_WM_STATE_TOGGLE (if fullscreen-p (deactivate-fullscreen window) (activate-fullscreen window)))))) (defun maybe-map-window (window) (if (deny-request-p window *deny-map-request*) (unless *suppress-deny-messages* (if (eq (window-group window) (current-group)) (echo-string (window-screen window) (format nil "'~a' denied map request" (window-name window))) (echo-string (window-screen window) (format nil "'~a' denied map request in group ~a" (window-name window) (group-name (window-group window)))))) (frame-raise-window (window-group window) (window-frame window) window (if (eq (window-frame window) (tile-group-current-frame (window-group window))) t nil)))) (defun maybe-raise-window (window) (if (deny-request-p window *deny-raise-request*) (unless (or *suppress-deny-messages* ;; don't mention windows that are already visible (window-visible-p window)) (if (eq (window-group window) (current-group)) (echo-string (window-screen window) (format nil "'~a' denied raise request" (window-name window))) (echo-string (window-screen window) (format nil "'~a' denied raise request in group ~a" (window-name window) (group-name (window-group window)))))) (focus-all window))) (define-stump-event-handler :client-message (window type #|format|# data) (dformat 2 "client message: ~s ~s~%" type data) (case type (:_NET_CURRENT_DESKTOP ;switch desktop (let* ((screen (find-screen window)) (n (elt data 0)) (group (and screen (< n (length (screen-groups screen))) (elt (sort-groups screen) n)))) (when group (switch-to-group group)))) (:_NET_WM_DESKTOP ;move window to desktop (let* ((our-window (find-window window)) (screen (when our-window (window-screen our-window))) (n (elt data 0)) (group (and screen (< n (length (screen-groups screen))) (elt (sort-groups screen) n)))) (when (and our-window group) (move-window-to-group our-window group)))) (:_NET_ACTIVE_WINDOW (let ((our-window (find-window window)) (source (elt data 0))) (when our-window (if (= source 2) ;request is from a pager (focus-all our-window) (maybe-raise-window our-window))))) (:_NET_CLOSE_WINDOW (let ((our-window (find-window window))) (when our-window (delete-window our-window)))) (:_NET_WM_STATE (let ((our-window (find-window window))) (when our-window (let ((action (elt data 0)) (p1 (elt data 1)) (p2 (elt data 2))) (dolist (p (list p1 p2)) ;; Sometimes the number cannot be converted to an atom, so skip them. (unless (or (= p 0) (not (typep p '(unsigned-byte 29)))) (case (safe-atom-name p) (:_NET_WM_STATE_DEMANDS_ATTENTION (case action (1 (add-wm-state window :_NET_WM_STATE_DEMANDS_ATTENTION)) (2 (unless (find-wm-state window :_NET_WM_STATE_DEMANDS_ATTENTION) (add-wm-state window :_NET_WM_STATE_DEMANDS_ATTENTION)))) (maybe-set-urgency our-window)) (:_NET_WM_STATE_FULLSCREEN (update-fullscreen our-window action))))))))) (:_NET_MOVERESIZE_WINDOW (let ((our-window (find-window window))) (when our-window (let ((x (elt data 1)) (y (elt data 2))) (dformat 3 "!!! Data: ~S~%" data) (group-move-request (window-group our-window) our-window x y :root))))) (t (dformat 2 "ignored message~%")))) (define-stump-event-handler :focus-out (window mode kind) (dformat 5 "~@{~s ~}~%" window mode kind)) (define-stump-event-handler :focus-in (window mode) (let ((win (find-window window))) (when (and win (eq mode :normal)) (let ((screen (window-screen win))) (unless (eq win (screen-focus screen)) (setf (screen-focus screen) win)))))) ;;; Mouse focus (defun focus-all (win) "Focus the window, frame, group and screen belonging to WIN. Raise the window in it's frame." (when win (unmap-message-window (window-screen win)) (switch-to-screen (window-screen win)) (let ((group (window-group win))) (switch-to-group group) (group-focus-window (window-group win) win)))) (define-stump-event-handler :enter-notify (window mode) (when (and window (eq mode :normal) (eq *mouse-focus-policy* :sloppy)) (let ((win (find-window window))) (when (and win (find win (top-windows))) (focus-all win) (update-all-mode-lines))))) (define-stump-event-handler :button-press (window code x y child time) (let (screen ml win) (cond ((and (setf screen (find-screen window)) (not child)) (group-button-press (screen-current-group screen) x y :root) (run-hook-with-args *root-click-hook* screen code x y)) ((setf ml (find-mode-line-window window)) (run-hook-with-args *mode-line-click-hook* ml code x y)) ((setf win (find-window-by-parent window (top-windows))) (group-button-press (window-group win) x y win)))) ;; Pass click to client (xlib:allow-events *display* :replay-pointer time)) ;; Handling event :KEY-PRESS ;; (:DISPLAY # :EVENT-KEY :KEY-PRESS :EVENT-CODE 2 :SEND-EVENT-P NIL :CODE 45 :SEQUENCE 1419 :TIME 98761213 :ROOT # :WINDOW # :EVENT-WINDOW # :CHILD ;; # :ROOT-X 754 :ROOT-Y 223 :X 753 :Y 222 :STATE 4 :SAME-SCREEN-P T) ;; H (defun handle-event (&rest event-slots &key display event-key &allow-other-keys) (declare (ignore display)) (dformat 1 ">>> ~S~%" event-key) (let ((eventfn (gethash event-key *event-fn-table*)) (win (getf event-slots :window)) (*current-event-time* (getf event-slots :time))) (when eventfn ;; XXX: In both the clisp and sbcl clx libraries, sometimes what ;; should be a window will be a pixmap instead. In this case, we ;; need to manually translate it to a window to avoid breakage ;; in stumpwm. So far the only slot that seems to be affected is ;; the :window slot for configure-request and reparent-notify ;; events. It appears as though the hash table of XIDs and clx ;; structures gets out of sync with X or perhaps X assigns a ;; duplicate ID for a pixmap and a window. (when (and win (not (xlib:window-p win))) (dformat 10 "Pixmap Workaround! ~s should be a window!~%" win) (setf (getf event-slots :window) (make-xlib-window win))) (handler-case (progn ;; This is not the stumpwm top level, but if the restart ;; is in the top level then it seems the event being ;; processed isn't popped off the stack and is immediately ;; reprocessed after restarting to the top level. So fake ;; it, and put the restart here. (with-simple-restart (top-level "Return to stumpwm's top level") (apply eventfn event-slots)) (xlib:display-finish-output *display*)) ((or xlib:window-error xlib:drawable-error) (c) ;; Asynchronous errors are handled in the error ;; handler. Synchronous errors like trying to get the window ;; hints on a deleted window are caught and ignored here. We ;; do this inside the event handler so that the event is ;; handled. If we catch it higher up the event will not be ;; flushed from the queue and we'll get ourselves into an ;; infinite loop. (dformat 4 "ignore synchronous ~a~%" c)))) (dformat 2 "<<< ~S~%" event-key) t)) stumpwm-0.9.9/fdump.lisp000066400000000000000000000174331242702317100152600ustar00rootroot00000000000000;; fdump.lisp -- Layout save and restore routines. ;; Copyright (C) 2007-2008 Jonathan Liles, 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, see ;; . ;; Commentary: ;; Code: (in-package #:stumpwm) (export '(ddump ddump-current ddump-screens dump-desktop-to-file dump-group-to-file dump-screen-to-file fdump fdump-current fdump-height fdump-number fdump-width fdump-windows fdump-x fdump-y gdump gdump-current gdump-name gdump-number gdump-tree place-existing-windows restore sdump sdump-current sdump-groups sdump-number)) (defstruct fdump number x y width height windows current) ;; group dump (defstruct gdump number name tree current) ;; screen dump (defstruct sdump number groups current) ;; desktop dump (defstruct ddump screens current) (defun dump-group (group &optional (window-dump-fn 'window-id)) (labels ((dump (f) (make-fdump :windows (mapcar window-dump-fn (frame-windows group f)) :current (and (frame-window f) (funcall window-dump-fn (frame-window f))) :number (frame-number f) :x (frame-x f) :y (frame-y f) :width (frame-width f) :height (frame-height f))) (copy (tree) (cond ((null tree) tree) ((typep tree 'frame) (dump tree)) (t (mapcar #'copy tree))))) (make-gdump ;; we only use the name and number for screen and desktop restores :number (group-number group) :name (group-name group) :tree (copy (tile-group-frame-tree group)) :current (frame-number (tile-group-current-frame group))))) (defun dump-screen (screen) (make-sdump :number (screen-id screen) :current (group-number (screen-current-group screen)) :groups (mapcar 'dump-group (sort-groups screen)))) (defun dump-desktop () (make-ddump :screens (mapcar 'dump-screen *screen-list*) :current (screen-id (current-screen)))) (defun dump-to-file (foo name) (with-open-file (fp name :direction :output :if-exists :supersede) (with-standard-io-syntax (let ((*package* (find-package :stumpwm)) (*print-pretty* t)) (prin1 foo fp))))) (defcommand dump-group-to-file (file) ((:rest "Dump To File: ")) "Dumps the frames of the current group of the current screen to the named file." (dump-to-file (dump-group (current-group)) file) (message "Group dumped")) (defcommand-alias dump-group dump-group-to-file) (defcommand dump-screen-to-file (file) ((:rest "Dump To File: ")) "Dumps the frames of all groups of the current screen to the named file" (dump-to-file (dump-screen (current-screen)) file) (message "Screen dumped")) (defcommand-alias dump-screen dump-screen-to-file) (defcommand dump-desktop-to-file (file) ((:rest "Dump To File: ")) "Dumps the frames of all groups of all screens to the named file" (dump-to-file (dump-desktop) file) (message "Desktop dumped")) (defcommand-alias dump-desktop dump-desktop-to-file) ;;; (defun read-dump-from-file (file) (with-open-file (fp file :direction :input) (with-standard-io-syntax (let ((*package* (find-package :stumpwm))) (read fp))))) (defun restore-group (group gdump &optional auto-populate (window-dump-fn 'window-id)) (let ((windows (group-windows group))) (labels ((give-frame-a-window (f) (unless (frame-window f) (setf (frame-window f) (find f windows :key 'window-frame)))) (restore (fd) (let ((f (make-frame :number (fdump-number fd) :x (fdump-x fd) :y (fdump-y fd) :width (fdump-width fd) :height (fdump-height fd)))) ;; import matching windows (if auto-populate (choose-new-frame-window f group) (progn (dolist (w windows) (when (equal (fdump-current fd) (funcall window-dump-fn w)) (setf (frame-window f) w)) (when (find (funcall window-dump-fn w) (fdump-windows fd) :test 'equal) (setf (window-frame w) f))))) (when (fdump-current fd) (give-frame-a-window f)) f)) (copy (tree) (cond ((null tree) tree) ((typep tree 'fdump) (restore tree)) (t (mapcar #'copy tree))))) ;; clear references to old frames (dolist (w windows) (setf (window-frame w) nil)) (setf (tile-group-frame-tree group) (copy (gdump-tree gdump)) (tile-group-current-frame group) (find (gdump-current gdump) (group-frames group) :key 'frame-number)) ;; give any windows still not in a frame a frame (dolist (w windows) (unless (window-frame w) (setf (window-frame w) (tile-group-current-frame group)))) ;; FIXME: if the current window was blank in the dump, this does not honour that. (give-frame-a-window (tile-group-current-frame group)) ;; raise the curtains (dolist (w windows) (if (eq (frame-window (window-frame w)) w) (unhide-window w) (hide-window w))) (sync-all-frame-windows group) (focus-frame group (tile-group-current-frame group))))) (defun restore-screen (screen sdump) "Restore all frames in all groups of given screen. Create groups if they don't already exist." (dolist (gdump (sdump-groups sdump)) (restore-group (or (find-group screen (gdump-name gdump)) ;; FIXME: if the group doesn't exist then ;; windows won't be migrated from existing ;; groups (add-group screen (gdump-name gdump))) gdump))) (defun restore-desktop (ddump) "Restore all frames, all groups, and all screens." (dolist (sdump (ddump-screens ddump)) (let ((screen (find (sdump-number sdump) *screen-list* :key 'screen-id :test '=))) (when screen (restore-screen screen sdump))))) (defcommand restore-from-file (file) ((:rest "Restore From File: ")) "Restores screen, groups, or frames from named file, depending on file's contents." (let ((dump (read-dump-from-file file))) (typecase dump (gdump (restore-group (current-group) dump) (message "Group restored.")) (sdump (restore-screen (current-screen) dump) (message "Screen restored.")) (ddump (restore-desktop dump) (message "Desktop restored.")) (t (message "Don't know how to restore ~a" dump))))) (defcommand-alias restore restore-from-file) (defcommand place-existing-windows () () "Re-arrange existing windows according to placement rules." (sync-window-placement)) stumpwm-0.9.9/floating-group.lisp000066400000000000000000000265341242702317100171040ustar00rootroot00000000000000;;; implementation of a floating style window management group (in-package :stumpwm) ;;; floating window (defclass float-window (window) ((last-width :initform 0 :accessor float-window-last-width) (last-height :initform 0 :accessor float-window-last-height) (last-x :initform 0 :accessor float-window-last-x) (last-y :initform 0 :accessor float-window-last-y)) ) (defvar *float-window-border* 1) (defvar *float-window-title-height* 10) ;; some book keeping functions (defmethod (setf window-x) :before (val (window float-window)) (unless (eql (window-x window) val) (setf (float-window-last-x window) (window-x window)))) (defmethod (setf window-y) :before (val (window float-window)) (unless (eql (window-y window) val) (setf (float-window-last-y window) (window-y window)))) (defmethod (setf window-width) :before (val (window float-window)) (unless (eql (window-width window) val) (setf (float-window-last-width window) (window-width window)))) (defmethod (setf window-height) :before (val (window float-window)) (unless (eql (window-height window) val) (setf (float-window-last-height window) (window-height window)))) (defun float-window-move-resize (win &key x y width height (border *float-window-border*)) ;; x and y position the parent window while width, height resize the ;; xwin (meaning the parent will have a larger width). (with-slots (xwin parent) win (xlib:with-state (parent) (xlib:with-state (xwin) (when x (setf (xlib:drawable-x parent) x (window-x win) x)) (when y (setf (xlib:drawable-y parent) y (window-y win) y)) (when width (setf (xlib:drawable-width parent) (+ (xlib:drawable-x xwin) width border) (xlib:drawable-width xwin) width (window-width win) width)) (when height (setf (xlib:drawable-height parent) (+ (xlib:drawable-y xwin) height border) (xlib:drawable-height xwin) height (window-height win) height)))))) (defmethod update-decoration ((window float-window)) (let ((group (window-group window))) (setf (xlib:window-background (window-parent window)) (if (eq (group-current-window group) window) (screen-float-focus-color (window-screen window)) (screen-float-unfocus-color (window-screen window)))) (xlib:clear-area (window-parent window)))) (defmethod window-sync ((window float-window) hint) (declare (ignore hint)) ) (defmethod window-head ((window float-window)) (dolist (head (screen-heads (group-screen (window-group window)))) (when (and (>= (window-x window) (frame-x head)) (>= (window-y window) (frame-y head)) (<= (+ (window-x window) (window-width window)) (+ (frame-x head) (frame-width head))) (<= (+ (window-y window) (window-height window)) (+ (frame-y head) (frame-height head)))) (return head)))) (defmethod window-visible-p ((win float-window)) (eql (window-state win) +normal-state+)) (defmethod (setf window-fullscreen) :after (val (window float-window)) (with-slots (last-x last-y last-width last-height parent) window (if val (let ((head (window-head window))) (with-slots (x y width height) window (format t "major on: ~a ~a ~a ~a~%" x y width height)) (set-window-geometry window :x 0 :y 0) (float-window-move-resize window :x (frame-x head) :y (frame-y head) :width (frame-width head) :height (frame-height head) :border 0) (format t "loot after: ~a ~a ~a ~a~%" last-x last-y last-width last-height)) (progn (format t "fullscreenage: ~a ~a ~a ~a~%" last-x last-y last-width last-height) ;; restore the position (set-window-geometry window :x *float-window-border* :y *float-window-title-height*) (float-window-move-resize window :x last-x :y last-y :width last-width :height last-height))))) ;;; floating group (defclass float-group (group) ((current-window :accessor float-group-current-window)) ) (defmethod group-startup ((group float-group)) ) (defmethod group-add-window ((group float-group) window &key &allow-other-keys) (change-class window 'float-window) (float-window-align window) (focus-window window)) (defun &float-focus-next (group) (if (group-windows group) (focus-window (first (group-windows group))) (no-focus group nil))) (defmethod group-delete-window ((group float-group) window) (declare (ignore window)) (&float-focus-next group)) (defmethod group-wake-up ((group float-group)) (&float-focus-next group)) (defmethod group-suspend ((group float-group)) ) (defmethod group-current-window ((group float-group)) (screen-focus (group-screen group))) (defmethod group-current-head ((group float-group)) (if (group-current-window group) (window-head (group-current-window group)) (first (screen-heads (group-screen group))))) (defun float-window-align (window) (with-slots (parent xwin width height) window (set-window-geometry window :x *float-window-border* :y *float-window-title-height*) (xlib:with-state (parent) (setf (xlib:drawable-width parent) (+ width (* 2 *float-window-border*)) (xlib:drawable-height parent) (+ height *float-window-title-height* *float-window-border*) (xlib:window-background parent) (xlib:alloc-color (xlib:screen-default-colormap (screen-number (window-screen window))) "Orange"))) (xlib:clear-area (window-parent window)))) (defmethod group-resize-request ((group float-group) window width height) (float-window-move-resize window :width width :height height)) (defmethod group-move-request ((group float-group) window x y relative-to) (declare (ignore relative-to)) (float-window-move-resize window :x x :y y)) (defmethod group-raise-request ((group float-group) window type) (declare (ignore type)) (focus-window window)) (defmethod group-lost-focus ((group float-group)) (&float-focus-next group)) (defmethod group-indicate-focus ((group float-group)) ) (defmethod group-focus-window ((group float-group) window) (focus-window window)) (defmethod group-root-exposure ((group float-group)) ) (defmethod group-add-head ((group float-group) head) (declare (ignore head))) (defmethod group-remove-head ((group float-group) head) (declare (ignore head))) (defmethod group-resize-head ((group float-group) oh nh) (declare (ignore oh nh))) (defmethod group-sync-all-heads ((group float-group)) ) (defmethod group-sync-head ((group float-group) head) (declare (ignore head)) ) (defmethod group-button-press ((group float-group) x y (window float-window)) (let ((screen (group-screen group)) (initial-width (xlib:drawable-width (window-parent window))) (initial-height (xlib:drawable-height (window-parent window)))) (when (eq *mouse-focus-policy* :click) (focus-window window)) ;; When in border (multiple-value-bind (relx rely same-screen-p child state-mask) (xlib:query-pointer (window-parent window)) (declare (ignore relx rely same-screen-p child)) (when (or (< x (xlib:drawable-x (window-xwin window))) (> x (+ (xlib:drawable-width (window-xwin window)) (xlib:drawable-x (window-xwin window)))) (< y (xlib:drawable-y (window-xwin window))) (> y (+ (xlib:drawable-height (window-xwin window)) (xlib:drawable-y (window-xwin window)))) (intersection (modifiers-super *modifiers*) (xlib:make-state-keys state-mask))) ;; When resizing warp pointer to left-right corner (when (find :button-3 (xlib:make-state-keys state-mask)) (xlib:warp-pointer (window-parent window) initial-width initial-height)) (multiple-value-bind (relx rely same-screen-p child state-mask) (xlib:query-pointer (window-parent window)) (declare (ignore same-screen-p child)) (labels ((move-window-event-handler (&rest event-slots &key event-key &allow-other-keys) (case event-key (:button-release :done) (:motion-notify (with-slots (parent) window (xlib:with-state (parent) ;; Either move or resize the window (cond ((find :button-1 (xlib:make-state-keys state-mask)) (setf (xlib:drawable-x parent) (- (getf event-slots :x) relx) (xlib:drawable-y parent) (- (getf event-slots :y) rely))) ((find :button-3 (xlib:make-state-keys state-mask)) (let ((w (- (getf event-slots :x) (xlib:drawable-x parent))) (h (- (getf event-slots :y) (xlib:drawable-y parent) *float-window-title-height*))) ;; Don't let the window become too small (float-window-move-resize window :width (max w *min-frame-width*) :height (max h *min-frame-height*))))))) t) ;; We need to eat these events or they'll ALL ;; come blasting in later. Also things start ;; lagging hard if we don't (on clisp anyway). (:configure-notify t) (:exposure t) (t nil)))) (xlib:grab-pointer (screen-root screen) '(:button-release :pointer-motion)) (unwind-protect ;; Wait until the mouse button is released (loop for ev = (xlib:process-event *display* :handler #'move-window-event-handler :timeout nil :discard-p t) until (eq ev :done)) (ungrab-pointer)) (update-configuration window) ;; don't forget to update the cache (setf (window-x window) (xlib:drawable-x (window-parent window)) (window-y window) (xlib:drawable-y (window-parent window))))))))) (defmethod group-button-press ((group float-group) x y where) (declare (ignore x y where)) ) (defcommand gnew-float (name) ((:rest "Group Name: ")) "Create a floating window group with the specified name and switch to it." (add-group (current-screen) name :type 'float-group)) (defcommand gnewbg-float (name) ((:rest "Group Name: ")) "Create a floating window group with the specified name, but do not switch to it." (add-group (current-screen) name :background t :type 'float-group)) stumpwm-0.9.9/font-rendering.lisp000066400000000000000000000036021242702317100170570ustar00rootroot00000000000000 (in-package :stumpwm) (defgeneric font-exists-p (font)) (defgeneric open-font (display font)) (defgeneric close-font (font)) (defgeneric font-ascent (font)) (defgeneric font-descent (font)) (defgeneric font-height (font)) (defgeneric text-lines-height (font string)) (defgeneric text-line-width (font text &rest keys &key start end translate)) (defgeneric draw-image-glyphs (drawable gcontext font x y sequence &rest keys &key start end translate width size)) ;;;; X11 fonts (defmethod font-exists-p ((font string)) ;; if we can list the font then it exists (plusp (length (xlib:list-font-names *display* font :max-fonts 1)))) (defmethod open-font ((display xlib:display) (font string)) (xlib:open-font display (first (xlib:list-font-names display font :max-fonts 1)))) (defmethod close-font ((font xlib:font)) (xlib:close-font font)) (defmethod font-ascent ((font xlib:font)) (xlib:font-ascent font)) (defmethod font-descent ((font xlib:font)) (xlib:font-descent font)) (defmethod font-height ((font xlib:font)) (+ (font-ascent font) (font-descent font))) (defmethod text-line-width ((font xlib:font) text &rest keys &key (start 0) end translate) (declare (ignorable start end translate)) (apply 'xlib:text-width font text keys)) (defmethod draw-image-glyphs (drawable gcontext (font xlib:font) x y sequence &rest keys &key (start 0) end translate width size) (declare (ignorable start end translate width size)) (setf (xlib:gcontext-font gcontext) font) (apply 'xlib:draw-image-glyphs drawable gcontext x y sequence keys)) (defmethod font-height ((fonts cons)) (loop for font in fonts maximizing (font-height font))) stumpwm-0.9.9/group.lisp000066400000000000000000000507411242702317100153000ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; All group related code resides here ;; ;; Code: (in-package #:stumpwm) (export '(current-group group-windows move-window-to-group)) (defvar *default-group-type* 'tile-group "The type of group that should be created by default.") (defclass group () ((screen :initarg :screen :accessor group-screen) (windows :initform nil :accessor group-windows) (number :initarg :number :accessor group-number) (name :initarg :name :accessor group-name))) ;;; The group API (defgeneric group-startup (group) (:documentation "Called on all groups while stumpwm is starting up.")) (defgeneric group-add-window (group window &key &allow-other-keys) (:documentation "Called when a window is added to the group. All house keeping is already taken care of. Only the group's specific window managing housekeeping need be done. This function accepts keys to inform the group on how to place the window.")) (defgeneric group-delete-window (group window) (:documentation "Called when a window is removed from thegroup. All house keeping is already taken care of. Only the group's specific window managing housekeeping need be done.")) (defgeneric group-wake-up (group) (:documentation "When the group becomes the current group, this function is called. This call is expected to set the focus.")) (defgeneric group-suspend (group) (:documentation "When the group is no longer the current group, this function is called.")) (defgeneric group-current-window (group) (:documentation "The group is asked to return its focused window.")) (defgeneric group-current-head (group) (:documentation "The group is asked to return its current head.")) (defgeneric group-resize-request (group window width height) (:documentation "The window requested a width and/or height change.")) (defgeneric group-move-request (group window x y relative-to) (:documentation "The window requested a position change.")) (defgeneric group-raise-request (group window type) (:documentation "A request has been made to raise the window. TYPE is the type of raise request being made. :MAP means the window has made requested to be mapped. :above means the window has requested to to be placed above its siblings.")) (defgeneric group-lost-focus (group) (:documentation "The current window was hidden or destroyed or something happened to it. So the group is asked to do something smart about it.")) (defgeneric group-indicate-focus (group) (:documentation "The group is asked to in some way show the user where the keyboard focus is.")) (defgeneric group-focus-window (group win) (:documentation "The group is asked to focus the specified window wherever it is.")) (defgeneric group-button-press (group x y child) (:documentation "The user clicked somewhere in the group.")) (defgeneric group-root-exposure (group) (:documentation "The root window got an exposure event. If the group needs to redraw anything on it, this is where it should do it.")) (defgeneric group-add-head (group head) (:documentation "A head is being added to this group's screen.")) (defgeneric group-remove-head (group head) (:documentation "A head is being removed from this group's screen.")) (defgeneric group-resize-head (group oh nh) (:documentation "A head is being resized on this group's screen.")) (defgeneric group-sync-all-heads (group) (:documentation "Called when the head configuration for the group changes.")) (defgeneric group-sync-head (group head) (:documentation "When a head or its usable area is resized, this is called. When the modeline size changes, this is called.")) (defun current-group (&optional (screen (current-screen))) "Return the current group for the current screen, unless otherwise specified." (screen-current-group screen)) (defun move-group-to-head (screen group) "Move window to the head of the group's window list." ;(assert (member window (screen-mapped-windows screen))) (move-to-head (screen-groups screen) group)) (defun sort-groups (screen) "Return a copy of the screen's group list sorted by number." (sort1 (screen-groups screen) '< :key 'group-number)) (defun group-map-number (group) (let* ((num (group-number group)) (index (1- (abs num)))) (if (and (>= index 0) (< index (length *group-number-map*))) (format nil "~:[~;-~]~a" (minusp num) (elt *group-number-map* index)) (princ-to-string num)))) (defun fmt-group-status (group) (let ((screen (group-screen group))) (cond ((eq group (screen-current-group screen)) #\*) ((and (typep (second (screen-groups screen)) 'group) (eq group (second (screen-groups screen)))) #\+) (t #\-)))) (defun find-free-group-number (screen) "Return a free group number in SCREEN." (find-free-number (mapcar 'group-number (screen-groups screen)) 1)) (defun find-free-hidden-group-number (screen) "Return a free hidden group number for SCREEN. Hidden group numbers start at -1 and go down." (find-free-number (mapcar 'group-number (screen-groups screen)) -1 :negative)) (defun non-hidden-groups (groups) "Return only those groups that are not hidden." (remove-if (lambda (g) (< (group-number g) 1)) groups)) (defun netwm-group-id (group) "netwm specifies that desktop/group numbers are contiguous and start at 0. Return a netwm compliant group id." (let ((screen (group-screen group))) (position group (sort-groups screen)))) (defun switch-to-group (new-group) (let* ((screen (group-screen new-group)) (old-group (screen-current-group screen))) (unless (eq new-group old-group) ;; restore the visible windows (dolist (w (group-windows new-group)) (when (eq (window-state w) +normal-state+) (xwin-unhide (window-xwin w) (window-parent w)))) (dolist (w (reverse (group-windows old-group))) (when (eq (window-state w) +normal-state+) (xwin-hide w))) (setf (screen-current-group screen) new-group) (move-group-to-head screen new-group) ;; restore the focus (setf (screen-focus screen) nil) (group-wake-up new-group) (xlib:change-property (screen-root screen) :_NET_CURRENT_DESKTOP (list (netwm-group-id new-group)) :cardinal 32) (update-all-mode-lines) (run-hook-with-args *focus-group-hook* new-group old-group)))) (defun move-window-to-group (window to-group) (labels ((really-move-window (window to-group) (unless (eq (window-group window) to-group) (hide-window window) ;; house keeping (setf (group-windows (window-group window)) (remove window (group-windows (window-group window)))) (group-delete-window (window-group window) window) (setf (window-group window) to-group (window-number window) (find-free-window-number to-group)) (push window (group-windows to-group)) (xlib:change-property (window-xwin window) :_NET_WM_DESKTOP (list (netwm-group-id to-group)) :cardinal 32) (group-add-window to-group window)))) ;; When a modal window is moved, all the windows it shadows must be moved ;; as well. When a shadowed window is moved, the modal shadowing it must ;; be moved. (cond ((window-modal-p window) (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)) (modals-of window))) (t (really-move-window window to-group))))) (defun next-group (current &optional (groups (non-hidden-groups (screen-groups (group-screen current))))) "Return the group following @var{current} in @var{groups}. If none are found return @code{NIL}." (let* ((matches (member current groups)) (next-group (if (null (cdr matches)) ;; If the last one in the list is current, then ;; use the first one. (car groups) ;; Otherwise, use the next one in the list. (cadr matches)))) (if (eq next-group current) nil next-group))) (defun merge-groups (from-group to-group) "Merge all windows in FROM-GROUP into TO-GROUP." (dolist (window (group-windows from-group)) (move-window-to-group window to-group))) (defun netwm-group (window &optional (screen (window-screen window))) "Get the window's desktop property and return a matching group, if there exists one." (let ((id (first (xlib:get-property (window-xwin window) :_NET_WM_DESKTOP)))) (when (and id (< id (length (screen-groups screen)))) (elt (sort-groups screen) id)))) (defun netwm-set-group (window) "Set the desktop property for the given window." (xlib:change-property (window-xwin window) :_NET_WM_DESKTOP (list (netwm-group-id (window-group window))) :cardinal 32)) (defun netwm-set-allowed-actions (window) (xlib:change-property (window-xwin window) :_NET_WM_ALLOWED_ACTIONS (mapcar (lambda (a) (xlib:intern-atom *display* a)) +netwm-allowed-actions+) :atom 32)) (defun netwm-update-groups (screen) "update all windows to reflect a change in the group list." ;; FIXME: This could be optimized only to update windows when there ;; is a need. (loop for i from 0 for group in (sort-groups screen) do (dolist (w (group-windows group)) (xlib:change-property (window-xwin w) :_NET_WM_DESKTOP (list i) :cardinal 32)))) (defun netwm-set-group-properties (screen) "Set NETWM properties regarding groups of SCREEN. Groups are known as \"virtual desktops\" in the NETWM standard." (let ((root (screen-root screen))) ;; _NET_NUMBER_OF_DESKTOPS (xlib:change-property root :_NET_NUMBER_OF_DESKTOPS (list (length (screen-groups screen))) :cardinal 32) (unless *initializing* ;; _NET_CURRENT_DESKTOP (xlib:change-property root :_NET_CURRENT_DESKTOP (list (netwm-group-id (screen-current-group screen))) :cardinal 32)) ;; _NET_DESKTOP_NAMES (xlib:change-property root :_NET_DESKTOP_NAMES (let ((names (mapcan (lambda (group) (list (string-to-utf8 (group-name group)) '(0))) (sort-groups screen)))) (apply #'concatenate 'list names)) :UTF8_STRING 8))) (defun kill-group (group to-group) (unless (eq group to-group) (let ((screen (group-screen group))) (merge-groups group to-group) (setf (screen-groups screen) (remove group (screen-groups screen))) (netwm-update-groups screen) (netwm-set-group-properties screen)))) (defun add-group (screen name &key background (type *default-group-type*)) "Create a new group in SCREEN with the supplied name. group names starting with a . are considered hidden groups. Hidden groups are skipped by gprev and gnext and do not show up in the group listings (unless *list-hidden-groups* is T). They also use negative numbers." (check-type screen screen) (check-type name string) (if (or (string= name "") (string= name ".")) (error "Groups must have a name.") (let ((ng (or (find-group screen name) (let ((ng (make-instance type :screen screen :number (if (char= (char name 0) #\.) (find-free-hidden-group-number screen) (find-free-group-number screen)) :name name))) (setf (screen-groups screen) (append (screen-groups screen) (list ng))) (netwm-set-group-properties screen) (netwm-update-groups screen) ng)))) (unless background (switch-to-group ng)) ng))) (defun find-group (screen name) "Return the group with the name, NAME. Or NIL if none exists." (find name (screen-groups screen) :key 'group-name :test 'string=)) ;;; Group commands ;; FIXME: groups are to screens exactly as windows are to ;; groups. There is a lot of duplicate code that could be globbed ;; together. (defun group-forward (current list) "Switch to the next non-hidden-group in the list, if one exists. Returns the new group." (let ((ng (next-group current (non-hidden-groups list)))) (when ng (switch-to-group ng) ng))) (defun group-forward-with-window (current list) "Switch to the next group in the list, if one exists, and moves the current window of the current group to the new one." (let ((next (group-forward current list)) (win (group-current-window current))) (when (and next win) (move-window-to-group win next) (really-raise-window win)))) (defcommand gnew (name) ((:string "Group Name: ")) "Create a new group with the specified name. The new group becomes the current group. If @var{name} begins with a dot (``.'') the group new group will be created in the hidden state. Hidden groups have group numbers less than one and are invisible to from gprev, gnext, and, optionally, groups and vgroups commands." (add-group (current-screen) name)) (defcommand gnewbg (name) ((:string "Group Name: ")) "Create a new group but do not switch to it." (add-group (current-screen) name :background t)) (defcommand gnext () () "Cycle to the next group in the group list." (group-forward (current-group) (sort-groups (current-screen)))) (defcommand gprev () () "Cycle to the previous group in the group list." (group-forward (current-group) (reverse (sort-groups (current-screen))))) (defcommand gnext-with-window () () "Cycle to the next group in the group list, taking the current window along." (group-forward-with-window (current-group) (sort-groups (current-screen)))) (defcommand gprev-with-window () () "Cycle to the previous group in the group list, taking the current window along." (group-forward-with-window (current-group) (reverse (sort-groups (current-screen))))) (defcommand gother () () "Go back to the last group." (let ((groups (screen-groups (current-screen)))) (when (> (length groups) 1) (switch-to-group (second groups))))) (defcommand grename (name) ((:string "New name for group: ")) "Rename the current group." (let ((group (current-group))) (cond ((find-group (current-screen) name) (message "^1*^BError: Name already exists")) ((or (zerop (length name)) (string= name ".")) (message "^1*^BError: empty name")) (t (cond ((and (char= (char name 0) #\.) ;change to hidden group (not (char= (char (group-name group) 0) #\.))) (setf (group-number group) (find-free-hidden-group-number (current-screen)))) ((and (not (char= (char name 0) #\.)) ;change from hidden group (char= (char (group-name group) 0) #\.)) (setf (group-number group) (find-free-group-number (current-screen))))) (setf (group-name group) name))))) (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)) (sort-windows g))))) (if *list-hidden-groups* groups (non-hidden-groups groups))))) (echo-string-list screen names))) (defcommand groups (&optional (fmt *group-format*)) (:rest) "Display the list of groups with their number and name. @var{*group-format*} controls the formatting. The optional argument @var{fmt} can be used to override the default group formatting." (echo-groups (current-screen) fmt)) (defcommand vgroups (&optional gfmt wfmt) (:string :rest) "Like @command{groups} but also display the windows in each group. The optional arguments @var{gfmt} and @var{wfmt} can be used to override the default group formatting and window formatting, respectively." (echo-groups (current-screen) (or gfmt *group-format*) t (or wfmt *window-format*))) (defcommand gselect (to-group) ((:group "Select Group: ")) "Select the first group that starts with @var{substring}. @var{substring} can also be a number, in which case @command{gselect} selects the group with that number." (when to-group (switch-to-group to-group))) (defcommand grouplist (&optional (fmt *group-format*)) (:rest) "Allow the user to select a group from a list, like windowlist but for groups" (let ((group (second (select-from-menu (current-screen) (mapcar (lambda (g) (list (format-expand *group-formatters* fmt g) g)) (screen-groups (current-screen))))))) (when group (switch-to-group group)))) (defcommand gmove (to-group) ((:group "To Group: ")) "Move the current window to the specified group." (when (and to-group (current-window)) (move-window-to-group (current-window) to-group))) (defcommand gmove-and-follow (to-group) ((:group "To Group: ")) "Move the current window to the specified group, and switch to it." (let ((window (current-window))) (gmove to-group) (gselect to-group) (when window (really-raise-window window)))) (defcommand gmove-marked (to-group) ((:group "To Group: ")) "move the marked windows to the specified group." (when to-group (let ((group (current-group))) (dolist (i (marked-windows group)) (setf (window-marked i) nil) (move-window-to-group i to-group))))) (defcommand gkill () () "Kill the current group. All windows in the current group are migrated to the next group." (let* ((dead-group (current-group)) (groups (screen-groups (current-screen))) ;; If no "visible" group is found, try with all groups (to-group (or (next-group dead-group (non-hidden-groups groups)) (next-group dead-group groups)))) (if to-group (if (or (not %interactivep%) (not (group-windows dead-group)) (y-or-n-p (format nil "You are about to kill non-empty group \"^B^3*~a^n\" The windows will be moved to group \"^B^2*~a^n\" ^B^6*Confirm?^n " (group-name dead-group) (group-name to-group)))) (progn (switch-to-group to-group) (kill-group dead-group to-group) (message "Deleted")) (message "Canceled")) (message "There's only one group left")))) (defcommand gmerge (from) ((:group "From Group: ")) "Merge @var{from} into the current group. @var{from} is not deleted." (if (eq from (current-group)) (message "^B^3*Cannot merge group with itself!") (merge-groups from (current-group)))) stumpwm-0.9.9/head.lisp000066400000000000000000000144351242702317100150450ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Head functionality ;; ;; Code: (in-package #:stumpwm) (export '(current-head)) (defun head-by-number (screen n) (find n (screen-heads screen) :key 'head-number)) (defun parse-xinerama-head (line) (ppcre:register-groups-bind (('parse-integer number width height x y)) ("^ +head #([0-9]+): ([0-9]+)x([0-9]+) @ ([0-9]+),([0-9]+)" line :sharedp t) (handler-case (make-head :number number :x x :y y :width width :height height) (parse-error () nil)))) (defun make-screen-heads (screen root) "or use xdpyinfo to query the xinerama extension, if it's enabled." (or (and (xlib:query-extension *display* "XINERAMA") (with-current-screen screen ;; Ignore 'clone' heads. (loop for i = 0 then (1+ i) for h in (delete-duplicates (loop for i in (split-string (run-shell-command "xdpyinfo -ext XINERAMA" t)) for head = (parse-xinerama-head i) when head collect head) :test #'frames-overlap-p) do (setf (head-number h) i) collect h))) (list (make-head :number 0 :x 0 :y 0 :width (xlib:drawable-width root) :height (xlib:drawable-height root) :window nil)))) (defun copy-heads (screen) "Return a copy of screen's heads." (mapcar 'copy-frame (screen-heads screen))) ;; Determining a frame's head based on position probably won't ;; work with overlapping heads. Would it be better to walk ;; up the frame tree? (defun frame-head (group frame) (let ((center-x (+ (frame-x frame) (ash (frame-width frame) -1))) (center-y (+ (frame-y frame) (ash (frame-height frame) -1)))) (dolist (head (screen-heads (group-screen group))) (when (and (>= center-x (frame-x head)) (>= center-y (frame-y head)) (<= center-x (+ (frame-x head) (frame-width head))) (<= center-y (+ (frame-y head) (frame-height head)))) (return head))))) (defun group-heads (group) (screen-heads (group-screen group))) (defun resize-head (number x y width height) "Resize head number `number' to given dimension." (let* ((screen (current-screen)) (oh (find number (screen-heads screen) :key 'head-number)) (nh (make-head :number number :x x :y y :width width :height height :window nil))) (scale-head screen oh nh) (dolist (group (screen-groups screen)) (group-sync-head group oh)) (update-mode-lines screen))) (defun current-head (&optional (group (current-group))) (group-current-head group)) (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))) (defun frame-is-head (group frame) (< (frame-number frame) (length (group-heads group)))) (defun add-head (screen head) (dformat 1 "Adding head #~D~%" (head-number head)) (setf (screen-heads screen) (sort (push head (screen-heads screen)) #'< :key 'head-number)) (dolist (group (screen-groups screen)) (group-add-head group head))) (defun remove-head (screen head) (dformat 1 "Removing head #~D~%" (head-number head)) (when (head-mode-line head) (toggle-mode-line screen head)) (dolist (group (screen-groups screen)) (group-remove-head group head)) ;; Remove it from SCREEN's head list. (setf (screen-heads screen) (delete head (screen-heads screen)))) (defun scale-head (screen oh nh) "Scales head OH to match the dimensions of NH." (dolist (group (screen-groups screen)) (group-resize-head group oh nh)) (setf (head-x oh) (head-x nh) (head-y oh) (head-y nh) (head-width oh) (head-width nh) (head-height oh) (head-height nh))) (defun scale-screen (screen heads) "Scale all frames of all groups of SCREEN to match the dimensions of HEADS." (let ((oheads (screen-heads screen))) (when (< (length heads) (length oheads)) ;; Some heads were removed (or cloned), try to guess which. (dolist (oh oheads) (dolist (nh heads) (when (= (head-number oh) (head-number nh)) ;; Same frame number, probably the same head (setf (head-number nh) (head-number oh)))))) (dolist (h (set-difference oheads heads :test '= :key 'head-number)) (remove-head screen h)) (dolist (h (set-difference heads oheads :test '= :key 'head-number)) (add-head screen h)) (dolist (h (intersection heads oheads :test '= :key 'head-number)) (let ((nh (find (head-number h) heads :test '= :key 'head-number)) (oh (find (head-number h) oheads :test '= :key 'head-number))) (scale-head screen oh nh))))) (defun head-force-refresh (screen new-heads) (scale-screen screen new-heads) (mapc 'group-sync-all-heads (screen-groups screen)) (update-mode-lines screen)) (defcommand refresh-heads (&optional (screen (current-screen))) () "Refresh screens in case a monitor was connected, but a ConfigureNotify event was snarfed by another program." (head-force-refresh screen (make-screen-heads screen (screen-root screen)))) stumpwm-0.9.9/help.lisp000066400000000000000000000130211242702317100150620ustar00rootroot00000000000000;; Copyright (C) 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, see ;; . ;; Commentary: ;; ;; Help and introspection commands ;; ;; Code: (in-package #:stumpwm) (export '()) (defun columnize (list columns &key col-aligns (pad 1) (char #\Space) (align :left)) ;; only somewhat nasty (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)) data)) (padstr (make-string pad :initial-element char))) (apply 'mapcar 'concat ;; normalize width (loop for i in data for j in max for c from 0 collect (loop for k from 0 below rows for s = (or (nth k i) "") for len = (make-string (- j (length s)) :initial-element char) collect (ecase (or (nth c col-aligns) align) (:left (format nil "~a~a~a" (if (= c 0) "" padstr) s len)) (:right (format nil "~a~a~a" (if (= c 0) "" padstr) len s)))))))) (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))) keymaps)) (cols (ceiling (1+ (length data)) (truncate (- (head-height (current-head)) (* 2 (screen-msg-border-width screen))) (font-height (screen-font screen)))))) (message-no-timeout "Prefix: ~a~%~{~a~^~%~}" (print-key-seq key-seq) (columnize data cols)))) (defcommand commands () () "List all available commands." (let* ((screen (current-screen)) (data (all-commands)) (cols (ceiling (length data) (truncate (- (head-height (current-head)) (* 2 (screen-msg-border-width screen))) (font-height (screen-font screen)))))) (message-no-timeout "~{~a~^~%~}" (columnize data cols)))) (defcommand describe-key (keys) ((:key-seq "Describe Key: ")) "Either interactively type the key sequence or supply it as text. This command prints the command bound to the specified key sequence." (let ((cmd (loop for map in (top-maps) for cmd = (lookup-key-sequence map keys) when cmd return cmd))) (if cmd (message "~{~a~^ ~} is bound to \"~a\"." (mapcar 'print-key keys) cmd) (message "~{~a~^ ~} is not bound." (mapcar 'print-key keys))))) (defcommand describe-variable (var) ((:variable "Describe Variable: ")) "Print the online help associated with the specified variable." (message-no-timeout "~a" (with-output-to-string (s) (describe var s)))) (defcommand describe-function (fn) ((:function "Describe Function: ")) "Print the online help associated with the specified function." (message-no-timeout "~a" (with-output-to-string (s) (describe fn s)))) (defcommand describe-command (com) ((:command "Describe Command: ")) "Print the online help associated with the specified command." (let* ((deref (dereference-command-symbol com)) (struct (get-command-structure com nil))) (cond ((null struct) (message "Error: Command \"~a\" not found." com)) ((eq deref struct) (message-no-timeout "Command \"~a\":~%~a" (command-name struct) (documentation (command-name struct) 'function))) (t (message-no-timeout "\"~a\" is an alias for the command \"~a\":~%~a" (command-alias-from deref) (command-name struct) (documentation (command-name struct) 'function)))))) (defcommand where-is (cmd) ((:rest "Where is command: ")) "Print the key sequences bound to the specified command." (let ((bindings (loop for map in (top-maps) append (search-kmap cmd map)))) (if bindings (message-no-timeout "\"~a\" is on ~{~a~^, ~}" cmd (mapcar 'print-key-seq bindings)) (message-no-timeout "Command \"~a\" is not currently bound" cmd)))) (defcommand modifiers () () "List the modifiers stumpwm recognizes and what MOD-X it thinks they're on." (message "~@{~5@a: ~{~(~a~)~^ ~}~%~}" "Meta" (modifiers-meta *modifiers*) "Alt" (modifiers-alt *modifiers*) "Super" (modifiers-super *modifiers*) "Hyper" (modifiers-hyper *modifiers*) "AltGr" (modifiers-altgr *modifiers*))) stumpwm-0.9.9/input.lisp000066400000000000000000000732301242702317100153010ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; This file handles input stuff ;; ;; Code: (in-package :stumpwm) (export '(*input-history-ignore-duplicates* *input-map* *numpad-map* completing-read input-delete-region input-goto-char input-insert-char input-insert-string input-point input-substring input-validate-region read-one-char read-one-line)) (defstruct input-line string position history history-bk password) (defvar *input-map* nil "This is the keymap containing all input editing key bindings.") (when (null *input-map*) (setf *input-map* (let ((map (make-sparse-keymap))) (define-key map (kbd "DEL") 'input-delete-backward-char) (define-key map (kbd "M-DEL") 'input-backward-kill-word) (define-key map (kbd "C-d") 'input-delete-forward-char) (define-key map (kbd "M-d") 'input-forward-kill-word) (define-key map (kbd "Delete") 'input-delete-forward-char) (define-key map (kbd "C-f") 'input-forward-char) (define-key map (kbd "Right") 'input-forward-char) (define-key map (kbd "M-f") 'input-forward-word) (define-key map (kbd "C-b") 'input-backward-char) (define-key map (kbd "Left") 'input-backward-char) (define-key map (kbd "M-b") 'input-backward-word) (define-key map (kbd "C-a") 'input-move-beginning-of-line) (define-key map (kbd "Home") 'input-move-beginning-of-line) (define-key map (kbd "C-e") 'input-move-end-of-line) (define-key map (kbd "End") 'input-move-end-of-line) (define-key map (kbd "C-k") 'input-kill-line) (define-key map (kbd "C-u") 'input-kill-to-beginning) (define-key map (kbd "C-p") 'input-history-back) (define-key map (kbd "Up") 'input-history-back) (define-key map (kbd "C-n") 'input-history-forward) (define-key map (kbd "Down") 'input-history-forward) (define-key map (kbd "RET") 'input-submit) (define-key map (kbd "C-g") 'input-abort) (define-key map (kbd "ESC") 'input-abort) (define-key map (kbd "C-y") 'input-yank-selection) (define-key map (kbd "C-Y") 'input-yank-clipboard) (define-key map (kbd "TAB") 'input-complete-forward) (define-key map (kbd "ISO_Left_Tab") 'input-complete-backward) (define-key map t 'input-self-insert) map))) (defvar *input-history* nil "History for the input line.") (defvar *input-last-command* nil "The last input command.") (defvar *input-completions* nil "The list of completions") (defvar *input-current-completions* nil "The list of matching completions.") (defvar *input-current-completions-idx* nil "The current index in the current completions list.") (defvar *input-history-ignore-duplicates* nil "Do not add a command to the input history if it's already the first in the list.") (defvar *numpad-map* '((87 10 . 16) (88 11 . 16) (89 12 . 16) (106 61 . 16) (83 13 . 16) (84 14 . 16) (85 15 . 16) (86 21 . 17) (79 16 . 16) (80 17 . 16) (81 18 . 16) (63 17 . 17) (82 20 . 16) (104 36 . 16) (91 60 . 16) (90 19 . 17)) "A keycode to keycode map to re-wire numpads when the numlock key is active") ;;; keysym functions (defun is-modifier (keycode) "Return t if keycode is a modifier" (or (find keycode *all-modifiers* :test 'eql) ;; Treat No Symbol keys as modifiers (and therefore ignorable) (= (xlib:keycode->keysym *display* keycode 0) 0))) (defun keycode->character (code mods) (let ((idx (if (member :shift mods) 1 0))) (xlib:keysym->character *display* (xlib:keycode->keysym *display* code idx) 0))) ;;; line and key reading functions (defun setup-input-window (screen prompt input) "Set the input window up to read input" (let* ((height (font-height (screen-font screen))) (win (screen-input-window screen))) ;; Window dimensions (xlib:with-state (win) (setf (xlib:window-priority win) :above (xlib:drawable-height win) height)) (xlib:map-window win) ;; Draw the prompt (draw-input-bucket screen prompt input) ;; Ready to recieve input )) (defun shutdown-input-window (screen) (xlib:ungrab-keyboard *display*) (xlib:unmap-window (screen-input-window screen))) ;; Hack to avoid clobbering input from numpads with numlock on. (defun input-handle-key-press-event (&rest event-slots &key event-key root code state &allow-other-keys) (declare (ignore event-slots root)) (let ((numlock-on-p (= 2 (logand 2 (nth-value 4 (xlib:keyboard-control *display*))))) (numpad-key (assoc code *numpad-map*))) (when (and numlock-on-p numpad-key) (setf code (first (rest numpad-key)) state (rest (rest numpad-key)))) (list* event-key code state))) (defun input-handle-selection-event (&key window selection property &allow-other-keys) (declare (ignore selection)) (if property (xlib:get-property window property :type :string :result-type 'string :transform #'xlib:card8->char :delete-p t) "")) (defun read-key-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)) (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)) (:selection-notify (apply 'input-handle-selection-event event-slots)) (t nil))) (defun read-key () "Return a dotted pair (code . state) key." (loop for ev = (xlib:process-event *display* :handler #'read-key-handle-event :timeout nil) do (when (and (consp ev) (eq (first ev) :key-press)) (return (rest ev))))) (defun read-key-no-modifiers () "Like read-key but never returns a modifier key." (loop for k = (read-key) while (is-modifier (car k)) finally (return k))) (defun read-key-or-selection () (loop for ev = (xlib:process-event *display* :handler #'read-key-or-selection-handle-event :timeout nil) do (cond ((stringp ev) (return ev)) ((and (consp ev) (eq (first ev) :key-press)) (return (rest ev)))))) (defun make-input-string (initial-input) (make-array (length initial-input) :element-type 'character :initial-contents initial-input :adjustable t :fill-pointer t)) (defun completing-read (screen prompt completions &key (initial-input "") require-match) "Read a line of input through stumpwm and return it with TAB completion. completions can be a list, an fbound symbol, or a function. if its an fbound symbol or a function then that function is passed the substring to complete on and is expected to return a list of matches. If require-match argument is non-nil then the input must match with an element of the completions." (check-type completions (or list function symbol)) (let ((*input-completions* completions) (*input-current-completions* nil) (*input-current-completions-idx* nil)) (let ((line (read-one-line screen prompt :initial-input initial-input :require-match require-match))) (when line (string-trim " " line))))) (defun read-one-line (screen prompt &key (initial-input "") require-match password) "Read a line of input through stumpwm and return it. returns nil if the user aborted." (let ((*input-last-command* nil) (input (make-input-line :string (make-input-string initial-input) :position (length initial-input) :history -1 :password password))) (labels ((match-input () (let* ((in (string-trim " " (input-line-string input))) (compls (input-find-completions in *input-completions*))) (and (consp compls) (string= in (if (consp (car compls)) (caar compls) (car compls)))))) (key-loop () (loop for key = (read-key-or-selection) do (cond ((stringp key) ;; handle selection (input-insert-string input key) (draw-input-bucket screen prompt input)) ;; skip modifiers ((is-modifier (car key))) ((process-input screen prompt input (car key) (cdr key)) (if (or (not require-match) (match-input)) (return (input-line-string input)) (draw-input-bucket screen prompt input "[No match]" t))))))) (setup-input-window screen prompt input) (catch :abort (unwind-protect (with-focus (screen-input-window screen) (key-loop)) (shutdown-input-window screen)))))) (defun read-one-char (screen) "Read a single character from the user." (with-focus (screen-key-window screen) (let ((k (read-key-no-modifiers))) (keycode->character (car k) (xlib:make-state-keys (cdr k)))))) (defun draw-input-bucket (screen prompt input &optional (tail "") errorp) "Draw to the screen's input window the contents of input." (let* ((gcontext (screen-message-gc screen)) (win (screen-input-window screen)) (prompt-width (text-line-width (screen-font screen) prompt :translate #'translate-id)) (line-content (input-line-string input)) (string (if (input-line-password input) (make-string (length line-content) :initial-element #\*) line-content)) (string-width (text-line-width (screen-font screen) string :translate #'translate-id)) (space-width (text-line-width (screen-font screen) " " :translate #'translate-id)) (tail-width (text-line-width (screen-font screen) tail :translate #'translate-id)) (full-string-width (+ string-width space-width)) (pos (input-line-position input)) (width (+ prompt-width (max 100 (+ full-string-width space-width tail-width))))) (xlib:with-state (win) (xlib:clear-area win :x (+ *message-window-padding* prompt-width string-width)) (setf (xlib:drawable-width win) (+ width (* *message-window-padding* 2))) (setup-win-gravity screen win *input-window-gravity*)) (xlib:with-state (win) (draw-image-glyphs win gcontext (screen-font screen) *message-window-padding* (font-ascent (screen-font screen)) prompt :translate #'translate-id :size 16) (draw-image-glyphs win gcontext (screen-font screen) (+ *message-window-padding* prompt-width) (font-ascent (screen-font screen)) string :translate #'translate-id :size 16) (draw-image-glyphs win gcontext (screen-font screen) (+ *message-window-padding* prompt-width full-string-width space-width) (font-ascent (screen-font screen)) tail :translate #'translate-id :size 16) ;; draw a block cursor (invert-rect screen win (+ *message-window-padding* prompt-width (text-line-width (screen-font screen) (subseq string 0 pos) :translate #'translate-id)) 0 (text-line-width (screen-font screen) (if (>= pos (length string)) " " (string (char string pos))) :translate #'translate-id) (font-height (screen-font screen))) ;; draw the error (when errorp (invert-rect screen win 0 0 (xlib:drawable-width win) (xlib:drawable-height win)) (xlib:display-force-output *display*) (sleep 0.05) (invert-rect screen win 0 0 (xlib:drawable-width win) (xlib:drawable-height win)))))) (defun code-state->key (code state) (let* ((mods (xlib:make-state-keys state)) (shift-p (and (find :shift mods) t)) (altgr-p (and (intersection (modifiers-altgr *modifiers*) mods) t)) (base (if altgr-p 2 0)) (sym (xlib:keycode->keysym *display* code base)) (upsym (xlib:keycode->keysym *display* code (+ base 1)))) ;; If a keysym has a shift modifier, then use the uppercase keysym ;; and remove remove the shift modifier. (make-key :keysym (if (and shift-p (not (eql sym upsym))) upsym sym) :control (and (find :control mods) t) :shift (and shift-p (eql sym upsym)) :meta (and (intersection mods (modifiers-meta *modifiers*)) t) :alt (and (intersection mods (modifiers-alt *modifiers*)) t) :hyper (and (intersection mods (modifiers-hyper *modifiers*)) t) :super (and (intersection mods (modifiers-super *modifiers*)) t)))) ;;; input string utility functions (defun input-submit (input key) (declare (ignore input key)) :done) (defun input-abort (input key) (declare (ignore input key)) (throw :abort nil)) (defun input-goto-char (input point) "Move the cursor to the specified point in the string" (setf (input-line-position input) (min (max 0 point) (length (input-line-string input))))) (defun input-insert-string (input string) "Insert @var{string} into the input at the current position. @var{input} must be of type @var{input-line}. Input functions are passed this structure as their first argument." (check-type string string) (loop for c across string do (input-insert-char input c))) (defun input-point (input) "Return the position of the cursor." (check-type input input-line) (input-line-position input)) (defun input-validate-region (input start end) "Return a value pair of numbers where the first number is < the second and neither excedes the bounds of the input string." (values (max 0 (min start end)) (min (length (input-line-string input)) (max start end)))) (defun input-delete-region (input start end) "Delete the region between start and end in the input string" (check-type input input-line) (check-type start fixnum) (check-type end fixnum) (multiple-value-setq (start end) (input-validate-region input start end)) (replace (input-line-string input) (input-line-string input) :start2 end :start1 start) (decf (fill-pointer (input-line-string input)) (- end start)) (cond ((< (input-line-position input) start)) ((< (input-line-position input) end) (setf (input-line-position input) start)) (t (decf (input-line-position input) (- end start))))) (defun input-insert-char (input char) "Insert @var{char} into the input at the current position. @var{input} must be of type @var{input-line}. Input functions are passed this structure as their first argument." (vector-push-extend #\_ (input-line-string input)) (replace (input-line-string input) (input-line-string input) :start2 (input-line-position input) :start1 (1+ (input-line-position input))) (setf (char (input-line-string input) (input-line-position input)) char) (incf (input-line-position input))) (defun input-substring (input start end) "Return a the substring in INPUT bounded by START and END." (subseq (input-line-string input) start end)) ;;; "interactive" input functions (defun input-find-completions (str completions) (if (or (functionp completions) (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)))) completions))) (defun input-complete (input direction) ;; reset the completion list if this is the first time they're ;; trying to complete. (unless (find *input-last-command* '(input-complete-forward input-complete-backward)) (setf *input-current-completions* (input-find-completions (input-substring input 0 (input-point input)) *input-completions*) *input-current-completions-idx* -1)) (if *input-current-completions* (progn ;; Insert the next completion (input-delete-region input 0 (input-point input)) (if (eq direction :forward) (progn (incf *input-current-completions-idx*) (when (>= *input-current-completions-idx* (length *input-current-completions*)) (setf *input-current-completions-idx* 0))) (progn (decf *input-current-completions-idx*) (when (< *input-current-completions-idx* 0) (setf *input-current-completions-idx* (1- (length *input-current-completions*)))))) (let ((elt (nth *input-current-completions-idx* *input-current-completions*))) (input-insert-string input (if (listp elt) (first elt) elt)) (input-insert-char input #\Space))) :error)) (defun input-complete-forward (input key) (declare (ignore key)) (input-complete input :forward)) (defun input-complete-backward (input key) (declare (ignore key)) (input-complete input :backward)) (defun input-delete-backward-char (input key) (declare (ignore key)) (let ((pos (input-line-position input))) (cond ((or (<= (length (input-line-string input)) 0) (<= pos 0)) :error) (t (replace (input-line-string input) (input-line-string input) :start2 pos :start1 (1- pos)) (decf (fill-pointer (input-line-string input))) (decf (input-line-position input)))))) (defun input-delete-forward-char (input key) (declare (ignore key)) (let ((pos (input-line-position input))) (cond ((>= pos (length (input-line-string input))) :error) (t (replace (input-line-string input) (input-line-string input) :start1 pos :start2 (1+ pos)) (decf (fill-pointer (input-line-string input))))))) (defun input-forward-kill-word (input key) (declare (ignore key)) (let* ((p1 (position-if 'alphanumericp (input-line-string input) :start (input-line-position input))) (p2 (and p1 (position-if-not 'alphanumericp (input-line-string input) :start p1)))) (input-delete-region input (input-point input) (or p2 (length (input-line-string input)))))) (defun input-backward-kill-word (input key) (declare (ignore key)) (let* ((p1 (position-if 'alphanumericp (input-line-string input) :end (input-line-position input) :from-end t)) (p2 (and p1 (position-if-not 'alphanumericp (input-line-string input) :end p1 :from-end t)))) (input-delete-region input (input-point input) (or (and p2 (1+ p2)) 0)))) (defun input-forward-word (input key) (declare (ignore key)) (let* ((p1 (position-if 'alphanumericp (input-line-string input) :start (input-line-position input))) (p2 (and p1 (position-if-not 'alphanumericp (input-line-string input) :start p1)))) (setf (input-line-position input) (or p2 (length (input-line-string input)))))) (defun input-backward-word (input key) (declare (ignore key)) (let* ((p1 (position-if 'alphanumericp (input-line-string input) :end (input-line-position input) :from-end t)) (p2 (and p1 (position-if-not 'alphanumericp (input-line-string input) :end p1 :from-end t)))) (setf (input-line-position input) (or (and p2 (1+ p2)) 0)))) (defun input-forward-char (input key) (declare (ignore key)) (incf (input-line-position input)) (when (> (input-line-position input) (length (input-line-string input))) (setf (input-line-position input) (length (input-line-string input))))) (defun input-backward-char (input key) (declare (ignore key)) (decf (input-line-position input)) (when (< (input-line-position input) 0) (setf (input-line-position input) 0))) (defun input-move-beginning-of-line (input key) (declare (ignore key)) (setf (input-line-position input) 0)) (defun input-move-end-of-line (input key) (declare (ignore key)) (setf (input-line-position input) (length (input-line-string input)))) (defun input-kill-line (input key) (declare (ignore key)) (unless (= (input-line-position input) (length (input-line-string input))) (set-x-selection (subseq (input-line-string input) (input-line-position input)))) (setf (fill-pointer (input-line-string input)) (input-line-position input))) (defun input-kill-to-beginning (input key) (declare (ignore key)) (unless (= (input-line-position input) 0) (set-x-selection (subseq (input-line-string input) 0 (input-line-position input)))) (replace (input-line-string input) (input-line-string input) :start2 (input-line-position input) :start1 0) (decf (fill-pointer (input-line-string input)) (input-line-position input)) (setf (input-line-position input) 0)) (defun input-history-back (input key) (declare (ignore key)) (when (= (input-line-history input) -1) (setf (input-line-history-bk input) (input-line-string input))) (incf (input-line-history input)) (if (>= (input-line-history input) (length *input-history*)) (progn (decf (input-line-history input)) :error) (setf (input-line-string input) (make-input-string (elt *input-history* (input-line-history input))) (input-line-position input) (length (input-line-string input))))) (defun input-history-forward (input key) (declare (ignore key)) (decf (input-line-history input)) (cond ((< (input-line-history input) -1) (incf (input-line-history input)) :error) ((= (input-line-history input) -1) (setf (input-line-string input) (input-line-history-bk input) (input-line-position input) (length (input-line-string input)))) (t (setf (input-line-string input) (make-input-string (elt *input-history* (input-line-history input))) (input-line-position input) (length (input-line-string input)))))) (defun input-self-insert (input key) (let ((char (xlib:keysym->character *display* (key-keysym key)))) (if (or (key-mods-p key) (null char) (not (characterp char))) :error (input-insert-char input char)))) (defun input-yank-selection (input key) (declare (ignore key)) ;; if we own the selection then just insert it. (if (getf *x-selection* :primary) (input-insert-string input (getf *x-selection* :primary)) (xlib:convert-selection :primary :string (screen-input-window (current-screen)) :stumpwm-selection))) (defun input-yank-clipboard (input key) (declare (ignore key)) (if (getf *x-selection* :clipboard) (input-insert-string input (getf *x-selection* :clipboard)) (xlib:convert-selection :clipboard :string (screen-input-window (current-screen)) :stumpwm-selection))) ;;; Misc functions (defun process-input (screen prompt input code state) "Process the key (code and state), given the current input buffer. Returns a new modified input buffer." (labels ((process-key (code state) "Call the appropriate function based on the key pressed. Return 'done when the use has signalled the finish of his input (pressing Return), nil otherwise." (let* ((key (code-state->key code state)) (command (and key (lookup-key *input-map* key t)))) (if command (prog1 (funcall command input key) (setf *input-last-command* command)) :error)))) (case (process-key code state) (:done (unless (or (input-line-password input) (and *input-history-ignore-duplicates* (string= (input-line-string input) (first *input-history*)))) (push (input-line-string input) *input-history*)) :done) (:abort (throw :abort t)) (:error ;; FIXME draw inverted text (draw-input-bucket screen prompt input "" t) nil) (t (draw-input-bucket screen prompt input) nil)))) (defun all-modifier-codes () (multiple-value-bind (shift-codes lock-codes control-codes mod1-codes mod2-codes mod3-codes mod4-codes mod5-codes) (xlib:modifier-mapping *display*) (append shift-codes lock-codes control-codes mod1-codes mod2-codes mod3-codes mod4-codes mod5-codes))) (defun get-modifier-map () (labels ((find-mod (mod codes) (find (xlib:keysym->keycodes *display* (keysym-name->keysym mod)) codes))) (let ((modifiers (make-modifiers))) (multiple-value-bind (shift-codes lock-codes control-codes mod1-codes mod2-codes mod3-codes mod4-codes mod5-codes) (xlib:modifier-mapping *display*) (declare (ignore shift-codes lock-codes control-codes)) (loop for mod in '(:mod-1 :mod-2 :mod-3 :mod-4 :mod-5) for codes in (list mod1-codes mod2-codes mod3-codes mod4-codes mod5-codes) do (cond ((or (find-mod "Meta_L" codes) (find-mod "Meta_R" codes)) (push mod (modifiers-meta modifiers))) ((or (find-mod "Alt_L" codes) (find-mod "Alt_R" codes)) (push mod (modifiers-alt modifiers))) ((or (find-mod "Super_L" codes) (find-mod "Super_R" codes)) (push mod (modifiers-super modifiers))) ((or (find-mod "Hyper_L" codes) (find-mod "Hyper_R" codes)) (push mod (modifiers-hyper modifiers))) ((find-mod "Num_Lock" codes) (push mod (modifiers-numlock modifiers))) ((find-mod "ISO_Level3_Shift" codes) (push mod (modifiers-altgr modifiers))))) ;; If alt is defined but meta isn't set meta to alt and clear alt (when (and (modifiers-alt modifiers) (null (modifiers-meta modifiers))) (setf (modifiers-meta modifiers) (modifiers-alt modifiers) (modifiers-alt modifiers) nil)) modifiers)))) (defun update-modifier-map () (setf *modifiers* (get-modifier-map) *all-modifiers* (all-modifier-codes))) ;; (defun x11mod->stumpmod (screen state) ;; (let ((mod nil)) ;; (when (member state (modifiers-alt (screen-modifiers screen))) ;; (push :alt mod)) ;; (when (member state (modifiers-meta (screen-modifiers screen))) ;; (push :meta mod)) ;; (when (member state (modifiers-hyper (screen-modifiers screen))) ;; (push :hyper mod)) ;; (when (member state (modifiers-super (screen-modifiers screen))) ;; (push :super mod)) ;; (when (member state :control) ;; (push :control mod)) ;; mod)) (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)))) ;; (defun keycode->string (code state) ;; (concatenate 'string (mod->string state) ;; (string (keysym->character *display* ;; (xlib:keycode->keysym *display* code 0) ;; state)))) ;; (defun cook-keycode (code state) ;; (values (xlib:keycode->keysym *display* code 0) (x11mod->stumpmod state))) (defun y-or-n-p (message) "ask a \"y or n\" question on the current screen and return T if the user presses 'y'" (message "~a(y or n) " message) (char= (read-one-char (current-screen)) #\y)) (defun yes-or-no-p (message) "ask a \"yes or no\" question on the current screen and return T if the user presses 'yes'" (loop for line = (read-one-line (current-screen) (format nil "~a(yes or no) " message)) until (find line '("yes" "no") :test 'string-equal) do (message "Please answer yes or no") (sleep 1) finally (return (string-equal line "yes")))) stumpwm-0.9.9/iresize.lisp000066400000000000000000000073631242702317100156200ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;;; A resize minor mode. Something a bit better should probably be ;;; written. But it's an interesting way of doing it. ;; ;; Code: (in-package #:stumpwm) (export '(*resize-increment* iresize abort-iresize exit-iresize)) (defvar *resize-backup* nil) (defvar *resize-increment* 10 "Number of pixels to increment by when interactively resizing frames.") (defun set-resize-increment (val) (setf *resize-increment* val) (update-resize-map)) (defun update-resize-map () (let ((m (or *resize-map* (setf *resize-map* (make-sparse-keymap))))) (let ((i *resize-increment*)) (labels ((dk (m k c) (define-key m k (format nil c i)))) (dk m (kbd "Up") "resize 0 -~D") (dk m (kbd "C-p") "resize 0 -~D") (dk m (kbd "p") "resize 0 -~D") (dk m (kbd "k") "resize 0 -~D") (dk m (kbd "Down") "resize 0 ~D") (dk m (kbd "C-n") "resize 0 ~D") (dk m (kbd "n") "resize 0 ~D") (dk m (kbd "j") "resize 0 ~D") (dk m (kbd "Left") "resize -~D 0") (dk m (kbd "C-b") "resize -~D 0") (dk m (kbd "b") "resize -~D 0") (dk m (kbd "h") "resize -~D 0") (dk m (kbd "Right") "resize ~D 0") (dk m (kbd "C-f") "resize ~D 0") (dk m (kbd "f") "resize ~D 0") (dk m (kbd "l") "resize ~D 0") (define-key m (kbd "RET") "exit-iresize") (define-key m (kbd "C-g") "abort-iresize") (define-key m (kbd "ESC") "abort-iresize"))))) (update-resize-map) (defcommand (iresize tile-group) () () "Start the interactive resize mode. A new keymap specific to resizing the current frame is loaded. Hit @key{C-g}, @key{RET}, or @key{ESC} to exit." (let ((frame (tile-group-current-frame (current-group)))) (if (atom (tile-group-frame-head (current-group) (frame-head (current-group) frame))) (message "There's only 1 frame!") (progn (when *resize-hides-windows* (dolist (f (head-frames (current-group) (current-head))) (clear-frame f (current-group)))) (message "Resize Frame") (push-top-map *resize-map*) (draw-frame-outlines (current-group) (current-head))) ;; (setf *resize-backup* (copy-frame-tree (current-group))) ))) (defun resize-unhide () (clear-frame-outlines (current-group)) (when *resize-hides-windows* (let ((group (current-group)) (head (current-head))) (dolist (f (head-frames group head)) (sync-frame-windows group f)) (dolist (w (reverse (head-windows group head))) (setf (frame-window (window-frame w)) w) (raise-window w)) (when (current-window) (focus-window (current-window)))))) (defcommand (abort-iresize tile-group) () () "Exit from the interactive resize mode." (resize-unhide) (message "Abort resize") ;; TODO: actually revert the frames (pop-top-map)) (defcommand (exit-iresize tile-group) () () "Exit from the interactive resize mode." (resize-unhide) (message "Resize Complete") (pop-top-map)) stumpwm-0.9.9/keysyms.lisp000066400000000000000000003674071242702317100156620ustar00rootroot00000000000000;; Copyright (C) 2006-2008 Matthew Kennedy ;; ;; 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, see ;; . ;; Commentary: ;; ;; Mapping a keysym to a name is a client side activity in X11. Some ;; of the code here was taken from the CMUCL Hemlocks code base. The ;; actual mappings were taken from Xorg's keysymdefs.h. ;; ;; Code: (in-package #:stumpwm) (defvar *keysym-name-translations* (make-hash-table)) (defvar *name-keysym-translations* (make-hash-table :test #'equal)) (defun define-keysym (keysym name) "Define a mapping from a keysym name to a keysym." (setf (gethash keysym *keysym-name-translations*) name (gethash name *name-keysym-translations*) keysym)) (defun keysym-name->keysym (name) "Return the keysym corresponding to NAME." (multiple-value-bind (value present-p) (gethash name *name-keysym-translations*) (declare (ignore present-p)) value)) (defun keysym->keysym-name (keysym) "Return the name corresponding to KEYSYM." (multiple-value-bind (value present-p) (gethash keysym *keysym-name-translations*) (declare (ignore present-p)) value)) (define-keysym #xffffff "VoidSymbol") ;Void symbol (define-keysym #xff08 "BackSpace") ;Back space, back char (define-keysym #xff09 "Tab") (define-keysym #xff0a "Linefeed") ;Linefeed, LF (define-keysym #xff0b "Clear") (define-keysym #xff0d "Return") ;Return, enter (define-keysym #xff13 "Pause") ;Pause, hold (define-keysym #xff14 "Scroll_Lock") (define-keysym #xff15 "Sys_Req") (define-keysym #xff1b "Escape") (define-keysym #xffff "Delete") ;Delete, rubout (define-keysym #xff20 "Multi_key") ;Multi-key character compose (define-keysym #xff37 "Codeinput") (define-keysym #xff3c "SingleCandidate") (define-keysym #xff3d "MultipleCandidate") (define-keysym #xff3e "PreviousCandidate") (define-keysym #xff21 "Kanji") ;Kanji, Kanji convert (define-keysym #xff22 "Muhenkan") ;Cancel Conversion (define-keysym #xff23 "Henkan_Mode") ;Start/Stop Conversion (define-keysym #xff23 "Henkan") ;Alias for Henkan_Mode (define-keysym #xff24 "Romaji") ;to Romaji (define-keysym #xff25 "Hiragana") ;to Hiragana (define-keysym #xff26 "Katakana") ;to Katakana (define-keysym #xff27 "Hiragana_Katakana") ;Hiragana/Katakana toggle (define-keysym #xff28 "Zenkaku") ;to Zenkaku (define-keysym #xff29 "Hankaku") ;to Hankaku (define-keysym #xff2a "Zenkaku_Hankaku") ;Zenkaku/Hankaku toggle (define-keysym #xff2b "Touroku") ;Add to Dictionary (define-keysym #xff2c "Massyo") ;Delete from Dictionary (define-keysym #xff2d "Kana_Lock") ;Kana Lock (define-keysym #xff2e "Kana_Shift") ;Kana Shift (define-keysym #xff2f "Eisu_Shift") ;Alphanumeric Shift (define-keysym #xff30 "Eisu_toggle") ;Alphanumeric toggle (define-keysym #xff37 "Kanji_Bangou") ;Codeinput (define-keysym #xff3d "Zen_Koho") ;Multiple/All Candidate(s) (define-keysym #xff3e "Mae_Koho") ;Previous Candidate (define-keysym #xff50 "Home") (define-keysym #xff51 "Left") ;Move left, left arrow (define-keysym #xff52 "Up") ;Move up, up arrow (define-keysym #xff53 "Right") ;Move right, right arrow (define-keysym #xff54 "Down") ;Move down, down arrow (define-keysym #xff55 "Prior") ;Prior, previous (define-keysym #xff55 "Page_Up") (define-keysym #xff56 "Next") ;Next (define-keysym #xff56 "Page_Down") (define-keysym #xff57 "End") ;EOL (define-keysym #xff58 "Begin") ;BOL (define-keysym #xff60 "Select") ;Select, mark (define-keysym #xff61 "Print") (define-keysym #xff62 "Execute") ;Execute, run, do (define-keysym #xff63 "Insert") ;Insert, insert here (define-keysym #xff65 "Undo") (define-keysym #xff66 "Redo") ;Redo, again (define-keysym #xff67 "Menu") (define-keysym #xff68 "Find") ;Find, search (define-keysym #xff69 "Cancel") ;Cancel, stop, abort, exit (define-keysym #xff6a "Help") ;Help (define-keysym #xff6b "Break") (define-keysym #xff7e "Mode_switch") ;Character set switch (define-keysym #xff7e "script_switch") ;Alias for mode_switch (define-keysym #xff7f "Num_Lock") (define-keysym #xff80 "KP_Space") ;Space (define-keysym #xff89 "KP_Tab") (define-keysym #xff8d "KP_Enter") ;Enter (define-keysym #xff91 "KP_F1") ;PF1, KP_A, ... (define-keysym #xff92 "KP_F2") (define-keysym #xff93 "KP_F3") (define-keysym #xff94 "KP_F4") (define-keysym #xff95 "KP_Home") (define-keysym #xff96 "KP_Left") (define-keysym #xff97 "KP_Up") (define-keysym #xff98 "KP_Right") (define-keysym #xff99 "KP_Down") (define-keysym #xff9a "KP_Prior") (define-keysym #xff9a "KP_Page_Up") (define-keysym #xff9b "KP_Next") (define-keysym #xff9b "KP_Page_Down") (define-keysym #xff9c "KP_End") (define-keysym #xff9d "KP_Begin") (define-keysym #xff9e "KP_Insert") (define-keysym #xff9f "KP_Delete") (define-keysym #xffbd "KP_Equal") ;Equals (define-keysym #xffaa "KP_Multiply") (define-keysym #xffab "KP_Add") (define-keysym #xffac "KP_Separator") ;Separator, often comma (define-keysym #xffad "KP_Subtract") (define-keysym #xffae "KP_Decimal") (define-keysym #xffaf "KP_Divide") (define-keysym #xffb0 "KP_0") (define-keysym #xffb1 "KP_1") (define-keysym #xffb2 "KP_2") (define-keysym #xffb3 "KP_3") (define-keysym #xffb4 "KP_4") (define-keysym #xffb5 "KP_5") (define-keysym #xffb6 "KP_6") (define-keysym #xffb7 "KP_7") (define-keysym #xffb8 "KP_8") (define-keysym #xffb9 "KP_9") (define-keysym #xffbe "F1") (define-keysym #xffbf "F2") (define-keysym #xffc0 "F3") (define-keysym #xffc1 "F4") (define-keysym #xffc2 "F5") (define-keysym #xffc3 "F6") (define-keysym #xffc4 "F7") (define-keysym #xffc5 "F8") (define-keysym #xffc6 "F9") (define-keysym #xffc7 "F10") (define-keysym #xffc8 "F11") (define-keysym #xffc9 "F12") (define-keysym #xffca "F13") (define-keysym #xffcb "F14") (define-keysym #xffcc "F15") (define-keysym #xffcd "F16") (define-keysym #xffce "F17") (define-keysym #xffcf "F18") (define-keysym #xffd0 "F19") (define-keysym #xffd1 "F20") (define-keysym #xffd2 "F21") (define-keysym #xffd3 "F22") (define-keysym #xffd4 "F23") (define-keysym #xffd5 "F24") (define-keysym #xffd6 "F25") (define-keysym #xffd7 "F26") (define-keysym #xffd8 "F27") (define-keysym #xffd9 "F28") (define-keysym #xffda "F29") (define-keysym #xffdb "F30") (define-keysym #xffdc "F31") (define-keysym #xffdd "F32") (define-keysym #xffde "F33") (define-keysym #xffdf "F34") (define-keysym #xffe0 "F35") (define-keysym #xffe1 "Shift_L") ;Left shift (define-keysym #xffe2 "Shift_R") ;Right shift (define-keysym #xffe3 "Control_L") ;Left control (define-keysym #xffe4 "Control_R") ;Right control (define-keysym #xffe5 "Caps_Lock") ;Caps lock (define-keysym #xffe6 "Shift_Lock") ;Shift lock (define-keysym #xffe7 "Meta_L") ;Left meta (define-keysym #xffe8 "Meta_R") ;Right meta (define-keysym #xffe9 "Alt_L") ;Left alt (define-keysym #xffea "Alt_R") ;Right alt (define-keysym #xffeb "Super_L") ;Left super (define-keysym #xffec "Super_R") ;Right super (define-keysym #xffed "Hyper_L") ;Left hyper (define-keysym #xffee "Hyper_R") ;Right hyper (define-keysym #xfe01 "ISO_Lock") (define-keysym #xfe02 "ISO_Level2_Latch") (define-keysym #xfe03 "ISO_Level3_Shift") (define-keysym #xfe04 "ISO_Level3_Latch") (define-keysym #xfe05 "ISO_Level3_Lock") (define-keysym #xff7e "ISO_Group_Shift") ;Alias for mode_switch (define-keysym #xfe06 "ISO_Group_Latch") (define-keysym #xfe07 "ISO_Group_Lock") (define-keysym #xfe08 "ISO_Next_Group") (define-keysym #xfe09 "ISO_Next_Group_Lock") (define-keysym #xfe0a "ISO_Prev_Group") (define-keysym #xfe0b "ISO_Prev_Group_Lock") (define-keysym #xfe0c "ISO_First_Group") (define-keysym #xfe0d "ISO_First_Group_Lock") (define-keysym #xfe0e "ISO_Last_Group") (define-keysym #xfe0f "ISO_Last_Group_Lock") (define-keysym #xfe20 "ISO_Left_Tab") (define-keysym #xfe21 "ISO_Move_Line_Up") (define-keysym #xfe22 "ISO_Move_Line_Down") (define-keysym #xfe23 "ISO_Partial_Line_Up") (define-keysym #xfe24 "ISO_Partial_Line_Down") (define-keysym #xfe25 "ISO_Partial_Space_Left") (define-keysym #xfe26 "ISO_Partial_Space_Right") (define-keysym #xfe27 "ISO_Set_Margin_Left") (define-keysym #xfe28 "ISO_Set_Margin_Right") (define-keysym #xfe29 "ISO_Release_Margin_Left") (define-keysym #xfe2a "ISO_Release_Margin_Right") (define-keysym #xfe2b "ISO_Release_Both_Margins") (define-keysym #xfe2c "ISO_Fast_Cursor_Left") (define-keysym #xfe2d "ISO_Fast_Cursor_Right") (define-keysym #xfe2e "ISO_Fast_Cursor_Up") (define-keysym #xfe2f "ISO_Fast_Cursor_Down") (define-keysym #xfe30 "ISO_Continuous_Underline") (define-keysym #xfe31 "ISO_Discontinuous_Underline") (define-keysym #xfe32 "ISO_Emphasize") (define-keysym #xfe33 "ISO_Center_Object") (define-keysym #xfe34 "ISO_Enter") (define-keysym #xfe50 "dead_grave") (define-keysym #xfe51 "dead_acute") (define-keysym #xfe52 "dead_circumflex") (define-keysym #xfe53 "dead_tilde") (define-keysym #xfe54 "dead_macron") (define-keysym #xfe55 "dead_breve") (define-keysym #xfe56 "dead_abovedot") (define-keysym #xfe57 "dead_diaeresis") (define-keysym #xfe58 "dead_abovering") (define-keysym #xfe59 "dead_doubleacute") (define-keysym #xfe5a "dead_caron") (define-keysym #xfe5b "dead_cedilla") (define-keysym #xfe5c "dead_ogonek") (define-keysym #xfe5d "dead_iota") (define-keysym #xfe5e "dead_voiced_sound") (define-keysym #xfe5f "dead_semivoiced_sound") (define-keysym #xfe60 "dead_belowdot") (define-keysym #xfe61 "dead_hook") (define-keysym #xfe62 "dead_horn") (define-keysym #xfed0 "First_Virtual_Screen") (define-keysym #xfed1 "Prev_Virtual_Screen") (define-keysym #xfed2 "Next_Virtual_Screen") (define-keysym #xfed4 "Last_Virtual_Screen") (define-keysym #xfed5 "Terminate_Server") (define-keysym #xfe70 "AccessX_Enable") (define-keysym #xfe71 "AccessX_Feedback_Enable") (define-keysym #xfe72 "RepeatKeys_Enable") (define-keysym #xfe73 "SlowKeys_Enable") (define-keysym #xfe74 "BounceKeys_Enable") (define-keysym #xfe75 "StickyKeys_Enable") (define-keysym #xfe76 "MouseKeys_Enable") (define-keysym #xfe77 "MouseKeys_Accel_Enable") (define-keysym #xfe78 "Overlay1_Enable") (define-keysym #xfe79 "Overlay2_Enable") (define-keysym #xfe7a "AudibleBell_Enable") (define-keysym #xfee0 "Pointer_Left") (define-keysym #xfee1 "Pointer_Right") (define-keysym #xfee2 "Pointer_Up") (define-keysym #xfee3 "Pointer_Down") (define-keysym #xfee4 "Pointer_UpLeft") (define-keysym #xfee5 "Pointer_UpRight") (define-keysym #xfee6 "Pointer_DownLeft") (define-keysym #xfee7 "Pointer_DownRight") (define-keysym #xfee8 "Pointer_Button_Dflt") (define-keysym #xfee9 "Pointer_Button1") (define-keysym #xfeea "Pointer_Button2") (define-keysym #xfeeb "Pointer_Button3") (define-keysym #xfeec "Pointer_Button4") (define-keysym #xfeed "Pointer_Button5") (define-keysym #xfeee "Pointer_DblClick_Dflt") (define-keysym #xfeef "Pointer_DblClick1") (define-keysym #xfef0 "Pointer_DblClick2") (define-keysym #xfef1 "Pointer_DblClick3") (define-keysym #xfef2 "Pointer_DblClick4") (define-keysym #xfef3 "Pointer_DblClick5") (define-keysym #xfef4 "Pointer_Drag_Dflt") (define-keysym #xfef5 "Pointer_Drag1") (define-keysym #xfef6 "Pointer_Drag2") (define-keysym #xfef7 "Pointer_Drag3") (define-keysym #xfef8 "Pointer_Drag4") (define-keysym #xfefd "Pointer_Drag5") (define-keysym #xfef9 "Pointer_EnableKeys") (define-keysym #xfefa "Pointer_Accelerate") (define-keysym #xfefb "Pointer_DfltBtnNext") (define-keysym #xfefc "Pointer_DfltBtnPrev") (define-keysym #xfd01 "3270_Duplicate") (define-keysym #xfd02 "3270_FieldMark") (define-keysym #xfd03 "3270_Right2") (define-keysym #xfd04 "3270_Left2") (define-keysym #xfd05 "3270_BackTab") (define-keysym #xfd06 "3270_EraseEOF") (define-keysym #xfd07 "3270_EraseInput") (define-keysym #xfd08 "3270_Reset") (define-keysym #xfd09 "3270_Quit") (define-keysym #xfd0a "3270_PA1") (define-keysym #xfd0b "3270_PA2") (define-keysym #xfd0c "3270_PA3") (define-keysym #xfd0d "3270_Test") (define-keysym #xfd0e "3270_Attn") (define-keysym #xfd0f "3270_CursorBlink") (define-keysym #xfd10 "3270_AltCursor") (define-keysym #xfd11 "3270_KeyClick") (define-keysym #xfd12 "3270_Jump") (define-keysym #xfd13 "3270_Ident") (define-keysym #xfd14 "3270_Rule") (define-keysym #xfd15 "3270_Copy") (define-keysym #xfd16 "3270_Play") (define-keysym #xfd17 "3270_Setup") (define-keysym #xfd18 "3270_Record") (define-keysym #xfd19 "3270_ChangeScreen") (define-keysym #xfd1a "3270_DeleteWord") (define-keysym #xfd1b "3270_ExSelect") (define-keysym #xfd1c "3270_CursorSelect") (define-keysym #xfd1d "3270_PrintScreen") (define-keysym #xfd1e "3270_Enter") (define-keysym #x0020 "space") ;U+0020 SPACE (define-keysym #x0021 "exclam") ;U+0021 EXCLAMATION MARK (define-keysym #x0022 "quotedbl") ;U+0022 QUOTATION MARK (define-keysym #x0023 "numbersign") ;U+0023 NUMBER SIGN (define-keysym #x0024 "dollar") ;U+0024 DOLLAR SIGN (define-keysym #x0025 "percent") ;U+0025 PERCENT SIGN (define-keysym #x0026 "ampersand") ;U+0026 AMPERSAND (define-keysym #x0027 "apostrophe") ;U+0027 APOSTROPHE (define-keysym #x0027 "quoteright") ;deprecated (define-keysym #x0028 "parenleft") ;U+0028 LEFT PARENTHESIS (define-keysym #x0029 "parenright") ;U+0029 RIGHT PARENTHESIS (define-keysym #x002a "asterisk") ;U+002A ASTERISK (define-keysym #x002b "plus") ;U+002B PLUS SIGN (define-keysym #x002c "comma") ;U+002C COMMA (define-keysym #x002d "minus") ;U+002D HYPHEN-MINUS (define-keysym #x002e "period") ;U+002E FULL STOP (define-keysym #x002f "slash") ;U+002F SOLIDUS (define-keysym #x0030 "0") ;U+0030 DIGIT ZERO (define-keysym #x0031 "1") ;U+0031 DIGIT ONE (define-keysym #x0032 "2") ;U+0032 DIGIT TWO (define-keysym #x0033 "3") ;U+0033 DIGIT THREE (define-keysym #x0034 "4") ;U+0034 DIGIT FOUR (define-keysym #x0035 "5") ;U+0035 DIGIT FIVE (define-keysym #x0036 "6") ;U+0036 DIGIT SIX (define-keysym #x0037 "7") ;U+0037 DIGIT SEVEN (define-keysym #x0038 "8") ;U+0038 DIGIT EIGHT (define-keysym #x0039 "9") ;U+0039 DIGIT NINE (define-keysym #x003a "colon") ;U+003A COLON (define-keysym #x003b "semicolon") ;U+003B SEMICOLON (define-keysym #x003c "less") ;U+003C LESS-THAN SIGN (define-keysym #x003d "equal") ;U+003D EQUALS SIGN (define-keysym #x003e "greater") ;U+003E GREATER-THAN SIGN (define-keysym #x003f "question") ;U+003F QUESTION MARK (define-keysym #x0040 "at") ;U+0040 COMMERCIAL AT (define-keysym #x0041 "A") ;U+0041 LATIN CAPITAL LETTER A (define-keysym #x0042 "B") ;U+0042 LATIN CAPITAL LETTER B (define-keysym #x0043 "C") ;U+0043 LATIN CAPITAL LETTER C (define-keysym #x0044 "D") ;U+0044 LATIN CAPITAL LETTER D (define-keysym #x0045 "E") ;U+0045 LATIN CAPITAL LETTER E (define-keysym #x0046 "F") ;U+0046 LATIN CAPITAL LETTER F (define-keysym #x0047 "G") ;U+0047 LATIN CAPITAL LETTER G (define-keysym #x0048 "H") ;U+0048 LATIN CAPITAL LETTER H (define-keysym #x0049 "I") ;U+0049 LATIN CAPITAL LETTER I (define-keysym #x004a "J") ;U+004A LATIN CAPITAL LETTER J (define-keysym #x004b "K") ;U+004B LATIN CAPITAL LETTER K (define-keysym #x004c "L") ;U+004C LATIN CAPITAL LETTER L (define-keysym #x004d "M") ;U+004D LATIN CAPITAL LETTER M (define-keysym #x004e "N") ;U+004E LATIN CAPITAL LETTER N (define-keysym #x004f "O") ;U+004F LATIN CAPITAL LETTER O (define-keysym #x0050 "P") ;U+0050 LATIN CAPITAL LETTER P (define-keysym #x0051 "Q") ;U+0051 LATIN CAPITAL LETTER Q (define-keysym #x0052 "R") ;U+0052 LATIN CAPITAL LETTER R (define-keysym #x0053 "S") ;U+0053 LATIN CAPITAL LETTER S (define-keysym #x0054 "T") ;U+0054 LATIN CAPITAL LETTER T (define-keysym #x0055 "U") ;U+0055 LATIN CAPITAL LETTER U (define-keysym #x0056 "V") ;U+0056 LATIN CAPITAL LETTER V (define-keysym #x0057 "W") ;U+0057 LATIN CAPITAL LETTER W (define-keysym #x0058 "X") ;U+0058 LATIN CAPITAL LETTER X (define-keysym #x0059 "Y") ;U+0059 LATIN CAPITAL LETTER Y (define-keysym #x005a "Z") ;U+005A LATIN CAPITAL LETTER Z (define-keysym #x005b "bracketleft") ;U+005B LEFT SQUARE BRACKET (define-keysym #x005c "backslash") ;U+005C REVERSE SOLIDUS (define-keysym #x005d "bracketright") ;U+005D RIGHT SQUARE BRACKET (define-keysym #x005e "asciicircum") ;U+005E CIRCUMFLEX ACCENT (define-keysym #x005f "underscore") ;U+005F LOW LINE (define-keysym #x0060 "grave") ;U+0060 GRAVE ACCENT (define-keysym #x0060 "quoteleft") ;deprecated (define-keysym #x0061 "a") ;U+0061 LATIN SMALL LETTER A (define-keysym #x0062 "b") ;U+0062 LATIN SMALL LETTER B (define-keysym #x0063 "c") ;U+0063 LATIN SMALL LETTER C (define-keysym #x0064 "d") ;U+0064 LATIN SMALL LETTER D (define-keysym #x0065 "e") ;U+0065 LATIN SMALL LETTER E (define-keysym #x0066 "f") ;U+0066 LATIN SMALL LETTER F (define-keysym #x0067 "g") ;U+0067 LATIN SMALL LETTER G (define-keysym #x0068 "h") ;U+0068 LATIN SMALL LETTER H (define-keysym #x0069 "i") ;U+0069 LATIN SMALL LETTER I (define-keysym #x006a "j") ;U+006A LATIN SMALL LETTER J (define-keysym #x006b "k") ;U+006B LATIN SMALL LETTER K (define-keysym #x006c "l") ;U+006C LATIN SMALL LETTER L (define-keysym #x006d "m") ;U+006D LATIN SMALL LETTER M (define-keysym #x006e "n") ;U+006E LATIN SMALL LETTER N (define-keysym #x006f "o") ;U+006F LATIN SMALL LETTER O (define-keysym #x0070 "p") ;U+0070 LATIN SMALL LETTER P (define-keysym #x0071 "q") ;U+0071 LATIN SMALL LETTER Q (define-keysym #x0072 "r") ;U+0072 LATIN SMALL LETTER R (define-keysym #x0073 "s") ;U+0073 LATIN SMALL LETTER S (define-keysym #x0074 "t") ;U+0074 LATIN SMALL LETTER T (define-keysym #x0075 "u") ;U+0075 LATIN SMALL LETTER U (define-keysym #x0076 "v") ;U+0076 LATIN SMALL LETTER V (define-keysym #x0077 "w") ;U+0077 LATIN SMALL LETTER W (define-keysym #x0078 "x") ;U+0078 LATIN SMALL LETTER X (define-keysym #x0079 "y") ;U+0079 LATIN SMALL LETTER Y (define-keysym #x007a "z") ;U+007A LATIN SMALL LETTER Z (define-keysym #x007b "braceleft") ;U+007B LEFT CURLY BRACKET (define-keysym #x007c "bar") ;U+007C VERTICAL LINE (define-keysym #x007d "braceright") ;U+007D RIGHT CURLY BRACKET (define-keysym #x007e "asciitilde") ;U+007E TILDE (define-keysym #x00a0 "nobreakspace") ;U+00A0 NO-BREAK SPACE (define-keysym #x00a1 "exclamdown") ;U+00A1 INVERTED EXCLAMATION MARK (define-keysym #x00a2 "cent") ;U+00A2 CENT SIGN (define-keysym #x00a3 "sterling") ;U+00A3 POUND SIGN (define-keysym #x00a4 "currency") ;U+00A4 CURRENCY SIGN (define-keysym #x00a5 "yen") ;U+00A5 YEN SIGN (define-keysym #x00a6 "brokenbar") ;U+00A6 BROKEN BAR (define-keysym #x00a7 "section") ;U+00A7 SECTION SIGN (define-keysym #x00a8 "diaeresis") ;U+00A8 DIAERESIS (define-keysym #x00a9 "copyright") ;U+00A9 COPYRIGHT SIGN (define-keysym #x00aa "ordfeminine") ;U+00AA FEMININE ORDINAL INDICATOR (define-keysym #x00ab "guillemotleft") ;U+00AB LEFT-POINTING DOUBLE ANGLE QUOTATION MARK (define-keysym #x00ac "notsign") ;U+00AC NOT SIGN (define-keysym #x00ad "hyphen") ;U+00AD SOFT HYPHEN (define-keysym #x00ae "registered") ;U+00AE REGISTERED SIGN (define-keysym #x00af "macron") ;U+00AF MACRON (define-keysym #x00b0 "degree") ;U+00B0 DEGREE SIGN (define-keysym #x00b1 "plusminus") ;U+00B1 PLUS-MINUS SIGN (define-keysym #x00b2 "twosuperior") ;U+00B2 SUPERSCRIPT TWO (define-keysym #x00b3 "threesuperior") ;U+00B3 SUPERSCRIPT THREE (define-keysym #x00b4 "acute") ;U+00B4 ACUTE ACCENT (define-keysym #x00b5 "mu") ;U+00B5 MICRO SIGN (define-keysym #x00b6 "paragraph") ;U+00B6 PILCROW SIGN (define-keysym #x00b7 "periodcentered") ;U+00B7 MIDDLE DOT (define-keysym #x00b8 "cedilla") ;U+00B8 CEDILLA (define-keysym #x00b9 "onesuperior") ;U+00B9 SUPERSCRIPT ONE (define-keysym #x00ba "masculine") ;U+00BA MASCULINE ORDINAL INDICATOR (define-keysym #x00bb "guillemotright") ;U+00BB RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK (define-keysym #x00bc "onequarter") ;U+00BC VULGAR FRACTION ONE QUARTER (define-keysym #x00bd "onehalf") ;U+00BD VULGAR FRACTION ONE HALF (define-keysym #x00be "threequarters") ;U+00BE VULGAR FRACTION THREE QUARTERS (define-keysym #x00bf "questiondown") ;U+00BF INVERTED QUESTION MARK (define-keysym #x00c0 "Agrave") ;U+00C0 LATIN CAPITAL LETTER A WITH GRAVE (define-keysym #x00c1 "Aacute") ;U+00C1 LATIN CAPITAL LETTER A WITH ACUTE (define-keysym #x00c2 "Acircumflex") ;U+00C2 LATIN CAPITAL LETTER A WITH CIRCUMFLEX (define-keysym #x00c3 "Atilde") ;U+00C3 LATIN CAPITAL LETTER A WITH TILDE (define-keysym #x00c4 "Adiaeresis") ;U+00C4 LATIN CAPITAL LETTER A WITH DIAERESIS (define-keysym #x00c5 "Aring") ;U+00C5 LATIN CAPITAL LETTER A WITH RING ABOVE (define-keysym #x00c6 "AE") ;U+00C6 LATIN CAPITAL LETTER AE (define-keysym #x00c7 "Ccedilla") ;U+00C7 LATIN CAPITAL LETTER C WITH CEDILLA (define-keysym #x00c8 "Egrave") ;U+00C8 LATIN CAPITAL LETTER E WITH GRAVE (define-keysym #x00c9 "Eacute") ;U+00C9 LATIN CAPITAL LETTER E WITH ACUTE (define-keysym #x00ca "Ecircumflex") ;U+00CA LATIN CAPITAL LETTER E WITH CIRCUMFLEX (define-keysym #x00cb "Ediaeresis") ;U+00CB LATIN CAPITAL LETTER E WITH DIAERESIS (define-keysym #x00cc "Igrave") ;U+00CC LATIN CAPITAL LETTER I WITH GRAVE (define-keysym #x00cd "Iacute") ;U+00CD LATIN CAPITAL LETTER I WITH ACUTE (define-keysym #x00ce "Icircumflex") ;U+00CE LATIN CAPITAL LETTER I WITH CIRCUMFLEX (define-keysym #x00cf "Idiaeresis") ;U+00CF LATIN CAPITAL LETTER I WITH DIAERESIS (define-keysym #x00d0 "ETH") ;U+00D0 LATIN CAPITAL LETTER ETH (define-keysym #x00d0 "Eth") ;deprecated (define-keysym #x00d1 "Ntilde") ;U+00D1 LATIN CAPITAL LETTER N WITH TILDE (define-keysym #x00d2 "Ograve") ;U+00D2 LATIN CAPITAL LETTER O WITH GRAVE (define-keysym #x00d3 "Oacute") ;U+00D3 LATIN CAPITAL LETTER O WITH ACUTE (define-keysym #x00d4 "Ocircumflex") ;U+00D4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX (define-keysym #x00d5 "Otilde") ;U+00D5 LATIN CAPITAL LETTER O WITH TILDE (define-keysym #x00d6 "Odiaeresis") ;U+00D6 LATIN CAPITAL LETTER O WITH DIAERESIS (define-keysym #x00d7 "multiply") ;U+00D7 MULTIPLICATION SIGN (define-keysym #x00d8 "Oslash") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE (define-keysym #x00d8 "Ooblique") ;U+00D8 LATIN CAPITAL LETTER O WITH STROKE (define-keysym #x00d9 "Ugrave") ;U+00D9 LATIN CAPITAL LETTER U WITH GRAVE (define-keysym #x00da "Uacute") ;U+00DA LATIN CAPITAL LETTER U WITH ACUTE (define-keysym #x00db "Ucircumflex") ;U+00DB LATIN CAPITAL LETTER U WITH CIRCUMFLEX (define-keysym #x00dc "Udiaeresis") ;U+00DC LATIN CAPITAL LETTER U WITH DIAERESIS (define-keysym #x00dd "Yacute") ;U+00DD LATIN CAPITAL LETTER Y WITH ACUTE (define-keysym #x00de "THORN") ;U+00DE LATIN CAPITAL LETTER THORN (define-keysym #x00de "Thorn") ;deprecated (define-keysym #x00df "ssharp") ;U+00DF LATIN SMALL LETTER SHARP S (define-keysym #x00e0 "agrave") ;U+00E0 LATIN SMALL LETTER A WITH GRAVE (define-keysym #x00e1 "aacute") ;U+00E1 LATIN SMALL LETTER A WITH ACUTE (define-keysym #x00e2 "acircumflex") ;U+00E2 LATIN SMALL LETTER A WITH CIRCUMFLEX (define-keysym #x00e3 "atilde") ;U+00E3 LATIN SMALL LETTER A WITH TILDE (define-keysym #x00e4 "adiaeresis") ;U+00E4 LATIN SMALL LETTER A WITH DIAERESIS (define-keysym #x00e5 "aring") ;U+00E5 LATIN SMALL LETTER A WITH RING ABOVE (define-keysym #x00e6 "ae") ;U+00E6 LATIN SMALL LETTER AE (define-keysym #x00e7 "ccedilla") ;U+00E7 LATIN SMALL LETTER C WITH CEDILLA (define-keysym #x00e8 "egrave") ;U+00E8 LATIN SMALL LETTER E WITH GRAVE (define-keysym #x00e9 "eacute") ;U+00E9 LATIN SMALL LETTER E WITH ACUTE (define-keysym #x00ea "ecircumflex") ;U+00EA LATIN SMALL LETTER E WITH CIRCUMFLEX (define-keysym #x00eb "ediaeresis") ;U+00EB LATIN SMALL LETTER E WITH DIAERESIS (define-keysym #x00ec "igrave") ;U+00EC LATIN SMALL LETTER I WITH GRAVE (define-keysym #x00ed "iacute") ;U+00ED LATIN SMALL LETTER I WITH ACUTE (define-keysym #x00ee "icircumflex") ;U+00EE LATIN SMALL LETTER I WITH CIRCUMFLEX (define-keysym #x00ef "idiaeresis") ;U+00EF LATIN SMALL LETTER I WITH DIAERESIS (define-keysym #x00f0 "eth") ;U+00F0 LATIN SMALL LETTER ETH (define-keysym #x00f1 "ntilde") ;U+00F1 LATIN SMALL LETTER N WITH TILDE (define-keysym #x00f2 "ograve") ;U+00F2 LATIN SMALL LETTER O WITH GRAVE (define-keysym #x00f3 "oacute") ;U+00F3 LATIN SMALL LETTER O WITH ACUTE (define-keysym #x00f4 "ocircumflex") ;U+00F4 LATIN SMALL LETTER O WITH CIRCUMFLEX (define-keysym #x00f5 "otilde") ;U+00F5 LATIN SMALL LETTER O WITH TILDE (define-keysym #x00f6 "odiaeresis") ;U+00F6 LATIN SMALL LETTER O WITH DIAERESIS (define-keysym #x00f7 "division") ;U+00F7 DIVISION SIGN (define-keysym #x00f8 "oslash") ;U+00F8 LATIN SMALL LETTER O WITH STROKE (define-keysym #x00f8 "ooblique") ;U+00F8 LATIN SMALL LETTER O WITH STROKE (define-keysym #x00f9 "ugrave") ;U+00F9 LATIN SMALL LETTER U WITH GRAVE (define-keysym #x00fa "uacute") ;U+00FA LATIN SMALL LETTER U WITH ACUTE (define-keysym #x00fb "ucircumflex") ;U+00FB LATIN SMALL LETTER U WITH CIRCUMFLEX (define-keysym #x00fc "udiaeresis") ;U+00FC LATIN SMALL LETTER U WITH DIAERESIS (define-keysym #x00fd "yacute") ;U+00FD LATIN SMALL LETTER Y WITH ACUTE (define-keysym #x00fe "thorn") ;U+00FE LATIN SMALL LETTER THORN (define-keysym #x00ff "ydiaeresis") ;U+00FF LATIN SMALL LETTER Y WITH DIAERESIS (define-keysym #x01a1 "Aogonek") ;U+0104 LATIN CAPITAL LETTER A WITH OGONEK (define-keysym #x01a2 "breve") ;U+02D8 BREVE (define-keysym #x01a3 "Lstroke") ;U+0141 LATIN CAPITAL LETTER L WITH STROKE (define-keysym #x01a5 "Lcaron") ;U+013D LATIN CAPITAL LETTER L WITH CARON (define-keysym #x01a6 "Sacute") ;U+015A LATIN CAPITAL LETTER S WITH ACUTE (define-keysym #x01a9 "Scaron") ;U+0160 LATIN CAPITAL LETTER S WITH CARON (define-keysym #x01aa "Scedilla") ;U+015E LATIN CAPITAL LETTER S WITH CEDILLA (define-keysym #x01ab "Tcaron") ;U+0164 LATIN CAPITAL LETTER T WITH CARON (define-keysym #x01ac "Zacute") ;U+0179 LATIN CAPITAL LETTER Z WITH ACUTE (define-keysym #x01ae "Zcaron") ;U+017D LATIN CAPITAL LETTER Z WITH CARON (define-keysym #x01af "Zabovedot") ;U+017B LATIN CAPITAL LETTER Z WITH DOT ABOVE (define-keysym #x01b1 "aogonek") ;U+0105 LATIN SMALL LETTER A WITH OGONEK (define-keysym #x01b2 "ogonek") ;U+02DB OGONEK (define-keysym #x01b3 "lstroke") ;U+0142 LATIN SMALL LETTER L WITH STROKE (define-keysym #x01b5 "lcaron") ;U+013E LATIN SMALL LETTER L WITH CARON (define-keysym #x01b6 "sacute") ;U+015B LATIN SMALL LETTER S WITH ACUTE (define-keysym #x01b7 "caron") ;U+02C7 CARON (define-keysym #x01b9 "scaron") ;U+0161 LATIN SMALL LETTER S WITH CARON (define-keysym #x01ba "scedilla") ;U+015F LATIN SMALL LETTER S WITH CEDILLA (define-keysym #x01bb "tcaron") ;U+0165 LATIN SMALL LETTER T WITH CARON (define-keysym #x01bc "zacute") ;U+017A LATIN SMALL LETTER Z WITH ACUTE (define-keysym #x01bd "doubleacute") ;U+02DD DOUBLE ACUTE ACCENT (define-keysym #x01be "zcaron") ;U+017E LATIN SMALL LETTER Z WITH CARON (define-keysym #x01bf "zabovedot") ;U+017C LATIN SMALL LETTER Z WITH DOT ABOVE (define-keysym #x01c0 "Racute") ;U+0154 LATIN CAPITAL LETTER R WITH ACUTE (define-keysym #x01c3 "Abreve") ;U+0102 LATIN CAPITAL LETTER A WITH BREVE (define-keysym #x01c5 "Lacute") ;U+0139 LATIN CAPITAL LETTER L WITH ACUTE (define-keysym #x01c6 "Cacute") ;U+0106 LATIN CAPITAL LETTER C WITH ACUTE (define-keysym #x01c8 "Ccaron") ;U+010C LATIN CAPITAL LETTER C WITH CARON (define-keysym #x01ca "Eogonek") ;U+0118 LATIN CAPITAL LETTER E WITH OGONEK (define-keysym #x01cc "Ecaron") ;U+011A LATIN CAPITAL LETTER E WITH CARON (define-keysym #x01cf "Dcaron") ;U+010E LATIN CAPITAL LETTER D WITH CARON (define-keysym #x01d0 "Dstroke") ;U+0110 LATIN CAPITAL LETTER D WITH STROKE (define-keysym #x01d1 "Nacute") ;U+0143 LATIN CAPITAL LETTER N WITH ACUTE (define-keysym #x01d2 "Ncaron") ;U+0147 LATIN CAPITAL LETTER N WITH CARON (define-keysym #x01d5 "Odoubleacute") ;U+0150 LATIN CAPITAL LETTER O WITH DOUBLE ACUTE (define-keysym #x01d8 "Rcaron") ;U+0158 LATIN CAPITAL LETTER R WITH CARON (define-keysym #x01d9 "Uring") ;U+016E LATIN CAPITAL LETTER U WITH RING ABOVE (define-keysym #x01db "Udoubleacute") ;U+0170 LATIN CAPITAL LETTER U WITH DOUBLE ACUTE (define-keysym #x01de "Tcedilla") ;U+0162 LATIN CAPITAL LETTER T WITH CEDILLA (define-keysym #x01e0 "racute") ;U+0155 LATIN SMALL LETTER R WITH ACUTE (define-keysym #x01e3 "abreve") ;U+0103 LATIN SMALL LETTER A WITH BREVE (define-keysym #x01e5 "lacute") ;U+013A LATIN SMALL LETTER L WITH ACUTE (define-keysym #x01e6 "cacute") ;U+0107 LATIN SMALL LETTER C WITH ACUTE (define-keysym #x01e8 "ccaron") ;U+010D LATIN SMALL LETTER C WITH CARON (define-keysym #x01ea "eogonek") ;U+0119 LATIN SMALL LETTER E WITH OGONEK (define-keysym #x01ec "ecaron") ;U+011B LATIN SMALL LETTER E WITH CARON (define-keysym #x01ef "dcaron") ;U+010F LATIN SMALL LETTER D WITH CARON (define-keysym #x01f0 "dstroke") ;U+0111 LATIN SMALL LETTER D WITH STROKE (define-keysym #x01f1 "nacute") ;U+0144 LATIN SMALL LETTER N WITH ACUTE (define-keysym #x01f2 "ncaron") ;U+0148 LATIN SMALL LETTER N WITH CARON (define-keysym #x01f5 "odoubleacute") ;U+0151 LATIN SMALL LETTER O WITH DOUBLE ACUTE (define-keysym #x01fb "udoubleacute") ;U+0171 LATIN SMALL LETTER U WITH DOUBLE ACUTE (define-keysym #x01f8 "rcaron") ;U+0159 LATIN SMALL LETTER R WITH CARON (define-keysym #x01f9 "uring") ;U+016F LATIN SMALL LETTER U WITH RING ABOVE (define-keysym #x01fe "tcedilla") ;U+0163 LATIN SMALL LETTER T WITH CEDILLA (define-keysym #x01ff "abovedot") ;U+02D9 DOT ABOVE (define-keysym #x02a1 "Hstroke") ;U+0126 LATIN CAPITAL LETTER H WITH STROKE (define-keysym #x02a6 "Hcircumflex") ;U+0124 LATIN CAPITAL LETTER H WITH CIRCUMFLEX (define-keysym #x02a9 "Iabovedot") ;U+0130 LATIN CAPITAL LETTER I WITH DOT ABOVE (define-keysym #x02ab "Gbreve") ;U+011E LATIN CAPITAL LETTER G WITH BREVE (define-keysym #x02ac "Jcircumflex") ;U+0134 LATIN CAPITAL LETTER J WITH CIRCUMFLEX (define-keysym #x02b1 "hstroke") ;U+0127 LATIN SMALL LETTER H WITH STROKE (define-keysym #x02b6 "hcircumflex") ;U+0125 LATIN SMALL LETTER H WITH CIRCUMFLEX (define-keysym #x02b9 "idotless") ;U+0131 LATIN SMALL LETTER DOTLESS I (define-keysym #x02bb "gbreve") ;U+011F LATIN SMALL LETTER G WITH BREVE (define-keysym #x02bc "jcircumflex") ;U+0135 LATIN SMALL LETTER J WITH CIRCUMFLEX (define-keysym #x02c5 "Cabovedot") ;U+010A LATIN CAPITAL LETTER C WITH DOT ABOVE (define-keysym #x02c6 "Ccircumflex") ;U+0108 LATIN CAPITAL LETTER C WITH CIRCUMFLEX (define-keysym #x02d5 "Gabovedot") ;U+0120 LATIN CAPITAL LETTER G WITH DOT ABOVE (define-keysym #x02d8 "Gcircumflex") ;U+011C LATIN CAPITAL LETTER G WITH CIRCUMFLEX (define-keysym #x02dd "Ubreve") ;U+016C LATIN CAPITAL LETTER U WITH BREVE (define-keysym #x02de "Scircumflex") ;U+015C LATIN CAPITAL LETTER S WITH CIRCUMFLEX (define-keysym #x02e5 "cabovedot") ;U+010B LATIN SMALL LETTER C WITH DOT ABOVE (define-keysym #x02e6 "ccircumflex") ;U+0109 LATIN SMALL LETTER C WITH CIRCUMFLEX (define-keysym #x02f5 "gabovedot") ;U+0121 LATIN SMALL LETTER G WITH DOT ABOVE (define-keysym #x02f8 "gcircumflex") ;U+011D LATIN SMALL LETTER G WITH CIRCUMFLEX (define-keysym #x02fd "ubreve") ;U+016D LATIN SMALL LETTER U WITH BREVE (define-keysym #x02fe "scircumflex") ;U+015D LATIN SMALL LETTER S WITH CIRCUMFLEX (define-keysym #x03a2 "kra") ;U+0138 LATIN SMALL LETTER KRA (define-keysym #x03a2 "kappa") ;deprecated (define-keysym #x03a3 "Rcedilla") ;U+0156 LATIN CAPITAL LETTER R WITH CEDILLA (define-keysym #x03a5 "Itilde") ;U+0128 LATIN CAPITAL LETTER I WITH TILDE (define-keysym #x03a6 "Lcedilla") ;U+013B LATIN CAPITAL LETTER L WITH CEDILLA (define-keysym #x03aa "Emacron") ;U+0112 LATIN CAPITAL LETTER E WITH MACRON (define-keysym #x03ab "Gcedilla") ;U+0122 LATIN CAPITAL LETTER G WITH CEDILLA (define-keysym #x03ac "Tslash") ;U+0166 LATIN CAPITAL LETTER T WITH STROKE (define-keysym #x03b3 "rcedilla") ;U+0157 LATIN SMALL LETTER R WITH CEDILLA (define-keysym #x03b5 "itilde") ;U+0129 LATIN SMALL LETTER I WITH TILDE (define-keysym #x03b6 "lcedilla") ;U+013C LATIN SMALL LETTER L WITH CEDILLA (define-keysym #x03ba "emacron") ;U+0113 LATIN SMALL LETTER E WITH MACRON (define-keysym #x03bb "gcedilla") ;U+0123 LATIN SMALL LETTER G WITH CEDILLA (define-keysym #x03bc "tslash") ;U+0167 LATIN SMALL LETTER T WITH STROKE (define-keysym #x03bd "ENG") ;U+014A LATIN CAPITAL LETTER ENG (define-keysym #x03bf "eng") ;U+014B LATIN SMALL LETTER ENG (define-keysym #x03c0 "Amacron") ;U+0100 LATIN CAPITAL LETTER A WITH MACRON (define-keysym #x03c7 "Iogonek") ;U+012E LATIN CAPITAL LETTER I WITH OGONEK (define-keysym #x03cc "Eabovedot") ;U+0116 LATIN CAPITAL LETTER E WITH DOT ABOVE (define-keysym #x03cf "Imacron") ;U+012A LATIN CAPITAL LETTER I WITH MACRON (define-keysym #x03d1 "Ncedilla") ;U+0145 LATIN CAPITAL LETTER N WITH CEDILLA (define-keysym #x03d2 "Omacron") ;U+014C LATIN CAPITAL LETTER O WITH MACRON (define-keysym #x03d3 "Kcedilla") ;U+0136 LATIN CAPITAL LETTER K WITH CEDILLA (define-keysym #x03d9 "Uogonek") ;U+0172 LATIN CAPITAL LETTER U WITH OGONEK (define-keysym #x03dd "Utilde") ;U+0168 LATIN CAPITAL LETTER U WITH TILDE (define-keysym #x03de "Umacron") ;U+016A LATIN CAPITAL LETTER U WITH MACRON (define-keysym #x03e0 "amacron") ;U+0101 LATIN SMALL LETTER A WITH MACRON (define-keysym #x03e7 "iogonek") ;U+012F LATIN SMALL LETTER I WITH OGONEK (define-keysym #x03ec "eabovedot") ;U+0117 LATIN SMALL LETTER E WITH DOT ABOVE (define-keysym #x03ef "imacron") ;U+012B LATIN SMALL LETTER I WITH MACRON (define-keysym #x03f1 "ncedilla") ;U+0146 LATIN SMALL LETTER N WITH CEDILLA (define-keysym #x03f2 "omacron") ;U+014D LATIN SMALL LETTER O WITH MACRON (define-keysym #x03f3 "kcedilla") ;U+0137 LATIN SMALL LETTER K WITH CEDILLA (define-keysym #x03f9 "uogonek") ;U+0173 LATIN SMALL LETTER U WITH OGONEK (define-keysym #x03fd "utilde") ;U+0169 LATIN SMALL LETTER U WITH TILDE (define-keysym #x03fe "umacron") ;U+016B LATIN SMALL LETTER U WITH MACRON (define-keysym #x1001e02 "Babovedot") ;U+1E02 LATIN CAPITAL LETTER B WITH DOT ABOVE (define-keysym #x1001e03 "babovedot") ;U+1E03 LATIN SMALL LETTER B WITH DOT ABOVE (define-keysym #x1001e0a "Dabovedot") ;U+1E0A LATIN CAPITAL LETTER D WITH DOT ABOVE (define-keysym #x1001e80 "Wgrave") ;U+1E80 LATIN CAPITAL LETTER W WITH GRAVE (define-keysym #x1001e82 "Wacute") ;U+1E82 LATIN CAPITAL LETTER W WITH ACUTE (define-keysym #x1001e0b "dabovedot") ;U+1E0B LATIN SMALL LETTER D WITH DOT ABOVE (define-keysym #x1001ef2 "Ygrave") ;U+1EF2 LATIN CAPITAL LETTER Y WITH GRAVE (define-keysym #x1001e1e "Fabovedot") ;U+1E1E LATIN CAPITAL LETTER F WITH DOT ABOVE (define-keysym #x1001e1f "fabovedot") ;U+1E1F LATIN SMALL LETTER F WITH DOT ABOVE (define-keysym #x1001e40 "Mabovedot") ;U+1E40 LATIN CAPITAL LETTER M WITH DOT ABOVE (define-keysym #x1001e41 "mabovedot") ;U+1E41 LATIN SMALL LETTER M WITH DOT ABOVE (define-keysym #x1001e56 "Pabovedot") ;U+1E56 LATIN CAPITAL LETTER P WITH DOT ABOVE (define-keysym #x1001e81 "wgrave") ;U+1E81 LATIN SMALL LETTER W WITH GRAVE (define-keysym #x1001e57 "pabovedot") ;U+1E57 LATIN SMALL LETTER P WITH DOT ABOVE (define-keysym #x1001e83 "wacute") ;U+1E83 LATIN SMALL LETTER W WITH ACUTE (define-keysym #x1001e60 "Sabovedot") ;U+1E60 LATIN CAPITAL LETTER S WITH DOT ABOVE (define-keysym #x1001ef3 "ygrave") ;U+1EF3 LATIN SMALL LETTER Y WITH GRAVE (define-keysym #x1001e84 "Wdiaeresis") ;U+1E84 LATIN CAPITAL LETTER W WITH DIAERESIS (define-keysym #x1001e85 "wdiaeresis") ;U+1E85 LATIN SMALL LETTER W WITH DIAERESIS (define-keysym #x1001e61 "sabovedot") ;U+1E61 LATIN SMALL LETTER S WITH DOT ABOVE (define-keysym #x1000174 "Wcircumflex") ;U+0174 LATIN CAPITAL LETTER W WITH CIRCUMFLEX (define-keysym #x1001e6a "Tabovedot") ;U+1E6A LATIN CAPITAL LETTER T WITH DOT ABOVE (define-keysym #x1000176 "Ycircumflex") ;U+0176 LATIN CAPITAL LETTER Y WITH CIRCUMFLEX (define-keysym #x1000175 "wcircumflex") ;U+0175 LATIN SMALL LETTER W WITH CIRCUMFLEX (define-keysym #x1001e6b "tabovedot") ;U+1E6B LATIN SMALL LETTER T WITH DOT ABOVE (define-keysym #x1000177 "ycircumflex") ;U+0177 LATIN SMALL LETTER Y WITH CIRCUMFLEX (define-keysym #x13bc "OE") ;U+0152 LATIN CAPITAL LIGATURE OE (define-keysym #x13bd "oe") ;U+0153 LATIN SMALL LIGATURE OE (define-keysym #x13be "Ydiaeresis") ;U+0178 LATIN CAPITAL LETTER Y WITH DIAERESIS (define-keysym #x047e "overline") ;U+203E OVERLINE (define-keysym #x04a1 "kana_fullstop") ;U+3002 IDEOGRAPHIC FULL STOP (define-keysym #x04a2 "kana_openingbracket") ;U+300C LEFT CORNER BRACKET (define-keysym #x04a3 "kana_closingbracket") ;U+300D RIGHT CORNER BRACKET (define-keysym #x04a4 "kana_comma") ;U+3001 IDEOGRAPHIC COMMA (define-keysym #x04a5 "kana_conjunctive") ;U+30FB KATAKANA MIDDLE DOT (define-keysym #x04a5 "kana_middledot") ;deprecated (define-keysym #x04a6 "kana_WO") ;U+30F2 KATAKANA LETTER WO (define-keysym #x04a7 "kana_a") ;U+30A1 KATAKANA LETTER SMALL A (define-keysym #x04a8 "kana_i") ;U+30A3 KATAKANA LETTER SMALL I (define-keysym #x04a9 "kana_u") ;U+30A5 KATAKANA LETTER SMALL U (define-keysym #x04aa "kana_e") ;U+30A7 KATAKANA LETTER SMALL E (define-keysym #x04ab "kana_o") ;U+30A9 KATAKANA LETTER SMALL O (define-keysym #x04ac "kana_ya") ;U+30E3 KATAKANA LETTER SMALL YA (define-keysym #x04ad "kana_yu") ;U+30E5 KATAKANA LETTER SMALL YU (define-keysym #x04ae "kana_yo") ;U+30E7 KATAKANA LETTER SMALL YO (define-keysym #x04af "kana_tsu") ;U+30C3 KATAKANA LETTER SMALL TU (define-keysym #x04af "kana_tu") ;deprecated (define-keysym #x04b0 "prolongedsound") ;U+30FC KATAKANA-HIRAGANA PROLONGED SOUND MARK (define-keysym #x04b1 "kana_A") ;U+30A2 KATAKANA LETTER A (define-keysym #x04b2 "kana_I") ;U+30A4 KATAKANA LETTER I (define-keysym #x04b3 "kana_U") ;U+30A6 KATAKANA LETTER U (define-keysym #x04b4 "kana_E") ;U+30A8 KATAKANA LETTER E (define-keysym #x04b5 "kana_O") ;U+30AA KATAKANA LETTER O (define-keysym #x04b6 "kana_KA") ;U+30AB KATAKANA LETTER KA (define-keysym #x04b7 "kana_KI") ;U+30AD KATAKANA LETTER KI (define-keysym #x04b8 "kana_KU") ;U+30AF KATAKANA LETTER KU (define-keysym #x04b9 "kana_KE") ;U+30B1 KATAKANA LETTER KE (define-keysym #x04ba "kana_KO") ;U+30B3 KATAKANA LETTER KO (define-keysym #x04bb "kana_SA") ;U+30B5 KATAKANA LETTER SA (define-keysym #x04bc "kana_SHI") ;U+30B7 KATAKANA LETTER SI (define-keysym #x04bd "kana_SU") ;U+30B9 KATAKANA LETTER SU (define-keysym #x04be "kana_SE") ;U+30BB KATAKANA LETTER SE (define-keysym #x04bf "kana_SO") ;U+30BD KATAKANA LETTER SO (define-keysym #x04c0 "kana_TA") ;U+30BF KATAKANA LETTER TA (define-keysym #x04c1 "kana_CHI") ;U+30C1 KATAKANA LETTER TI (define-keysym #x04c1 "kana_TI") ;deprecated (define-keysym #x04c2 "kana_TSU") ;U+30C4 KATAKANA LETTER TU (define-keysym #x04c2 "kana_TU") ;deprecated (define-keysym #x04c3 "kana_TE") ;U+30C6 KATAKANA LETTER TE (define-keysym #x04c4 "kana_TO") ;U+30C8 KATAKANA LETTER TO (define-keysym #x04c5 "kana_NA") ;U+30CA KATAKANA LETTER NA (define-keysym #x04c6 "kana_NI") ;U+30CB KATAKANA LETTER NI (define-keysym #x04c7 "kana_NU") ;U+30CC KATAKANA LETTER NU (define-keysym #x04c8 "kana_NE") ;U+30CD KATAKANA LETTER NE (define-keysym #x04c9 "kana_NO") ;U+30CE KATAKANA LETTER NO (define-keysym #x04ca "kana_HA") ;U+30CF KATAKANA LETTER HA (define-keysym #x04cb "kana_HI") ;U+30D2 KATAKANA LETTER HI (define-keysym #x04cc "kana_FU") ;U+30D5 KATAKANA LETTER HU (define-keysym #x04cc "kana_HU") ;deprecated (define-keysym #x04cd "kana_HE") ;U+30D8 KATAKANA LETTER HE (define-keysym #x04ce "kana_HO") ;U+30DB KATAKANA LETTER HO (define-keysym #x04cf "kana_MA") ;U+30DE KATAKANA LETTER MA (define-keysym #x04d0 "kana_MI") ;U+30DF KATAKANA LETTER MI (define-keysym #x04d1 "kana_MU") ;U+30E0 KATAKANA LETTER MU (define-keysym #x04d2 "kana_ME") ;U+30E1 KATAKANA LETTER ME (define-keysym #x04d3 "kana_MO") ;U+30E2 KATAKANA LETTER MO (define-keysym #x04d4 "kana_YA") ;U+30E4 KATAKANA LETTER YA (define-keysym #x04d5 "kana_YU") ;U+30E6 KATAKANA LETTER YU (define-keysym #x04d6 "kana_YO") ;U+30E8 KATAKANA LETTER YO (define-keysym #x04d7 "kana_RA") ;U+30E9 KATAKANA LETTER RA (define-keysym #x04d8 "kana_RI") ;U+30EA KATAKANA LETTER RI (define-keysym #x04d9 "kana_RU") ;U+30EB KATAKANA LETTER RU (define-keysym #x04da "kana_RE") ;U+30EC KATAKANA LETTER RE (define-keysym #x04db "kana_RO") ;U+30ED KATAKANA LETTER RO (define-keysym #x04dc "kana_WA") ;U+30EF KATAKANA LETTER WA (define-keysym #x04dd "kana_N") ;U+30F3 KATAKANA LETTER N (define-keysym #x04de "voicedsound") ;U+309B KATAKANA-HIRAGANA VOICED SOUND MARK (define-keysym #x04df "semivoicedsound") ;U+309C KATAKANA-HIRAGANA SEMI-VOICED SOUND MARK (define-keysym #xff7e "kana_switch") ;Alias for mode_switch (define-keysym #x10006f0 "Farsi_0") ;U+06F0 EXTENDED ARABIC-INDIC DIGIT ZERO (define-keysym #x10006f1 "Farsi_1") ;U+06F1 EXTENDED ARABIC-INDIC DIGIT ONE (define-keysym #x10006f2 "Farsi_2") ;U+06F2 EXTENDED ARABIC-INDIC DIGIT TWO (define-keysym #x10006f3 "Farsi_3") ;U+06F3 EXTENDED ARABIC-INDIC DIGIT THREE (define-keysym #x10006f4 "Farsi_4") ;U+06F4 EXTENDED ARABIC-INDIC DIGIT FOUR (define-keysym #x10006f5 "Farsi_5") ;U+06F5 EXTENDED ARABIC-INDIC DIGIT FIVE (define-keysym #x10006f6 "Farsi_6") ;U+06F6 EXTENDED ARABIC-INDIC DIGIT SIX (define-keysym #x10006f7 "Farsi_7") ;U+06F7 EXTENDED ARABIC-INDIC DIGIT SEVEN (define-keysym #x10006f8 "Farsi_8") ;U+06F8 EXTENDED ARABIC-INDIC DIGIT EIGHT (define-keysym #x10006f9 "Farsi_9") ;U+06F9 EXTENDED ARABIC-INDIC DIGIT NINE (define-keysym #x100066a "Arabic_percent") ;U+066A ARABIC PERCENT SIGN (define-keysym #x1000670 "Arabic_superscript_alef") ;U+0670 ARABIC LETTER SUPERSCRIPT ALEF (define-keysym #x1000679 "Arabic_tteh") ;U+0679 ARABIC LETTER TTEH (define-keysym #x100067e "Arabic_peh") ;U+067E ARABIC LETTER PEH (define-keysym #x1000686 "Arabic_tcheh") ;U+0686 ARABIC LETTER TCHEH (define-keysym #x1000688 "Arabic_ddal") ;U+0688 ARABIC LETTER DDAL (define-keysym #x1000691 "Arabic_rreh") ;U+0691 ARABIC LETTER RREH (define-keysym #x05ac "Arabic_comma") ;U+060C ARABIC COMMA (define-keysym #x10006d4 "Arabic_fullstop") ;U+06D4 ARABIC FULL STOP (define-keysym #x1000660 "Arabic_0") ;U+0660 ARABIC-INDIC DIGIT ZERO (define-keysym #x1000661 "Arabic_1") ;U+0661 ARABIC-INDIC DIGIT ONE (define-keysym #x1000662 "Arabic_2") ;U+0662 ARABIC-INDIC DIGIT TWO (define-keysym #x1000663 "Arabic_3") ;U+0663 ARABIC-INDIC DIGIT THREE (define-keysym #x1000664 "Arabic_4") ;U+0664 ARABIC-INDIC DIGIT FOUR (define-keysym #x1000665 "Arabic_5") ;U+0665 ARABIC-INDIC DIGIT FIVE (define-keysym #x1000666 "Arabic_6") ;U+0666 ARABIC-INDIC DIGIT SIX (define-keysym #x1000667 "Arabic_7") ;U+0667 ARABIC-INDIC DIGIT SEVEN (define-keysym #x1000668 "Arabic_8") ;U+0668 ARABIC-INDIC DIGIT EIGHT (define-keysym #x1000669 "Arabic_9") ;U+0669 ARABIC-INDIC DIGIT NINE (define-keysym #x05bb "Arabic_semicolon") ;U+061B ARABIC SEMICOLON (define-keysym #x05bf "Arabic_question_mark") ;U+061F ARABIC QUESTION MARK (define-keysym #x05c1 "Arabic_hamza") ;U+0621 ARABIC LETTER HAMZA (define-keysym #x05c2 "Arabic_maddaonalef") ;U+0622 ARABIC LETTER ALEF WITH MADDA ABOVE (define-keysym #x05c3 "Arabic_hamzaonalef") ;U+0623 ARABIC LETTER ALEF WITH HAMZA ABOVE (define-keysym #x05c4 "Arabic_hamzaonwaw") ;U+0624 ARABIC LETTER WAW WITH HAMZA ABOVE (define-keysym #x05c5 "Arabic_hamzaunderalef") ;U+0625 ARABIC LETTER ALEF WITH HAMZA BELOW (define-keysym #x05c6 "Arabic_hamzaonyeh") ;U+0626 ARABIC LETTER YEH WITH HAMZA ABOVE (define-keysym #x05c7 "Arabic_alef") ;U+0627 ARABIC LETTER ALEF (define-keysym #x05c8 "Arabic_beh") ;U+0628 ARABIC LETTER BEH (define-keysym #x05c9 "Arabic_tehmarbuta") ;U+0629 ARABIC LETTER TEH MARBUTA (define-keysym #x05ca "Arabic_teh") ;U+062A ARABIC LETTER TEH (define-keysym #x05cb "Arabic_theh") ;U+062B ARABIC LETTER THEH (define-keysym #x05cc "Arabic_jeem") ;U+062C ARABIC LETTER JEEM (define-keysym #x05cd "Arabic_hah") ;U+062D ARABIC LETTER HAH (define-keysym #x05ce "Arabic_khah") ;U+062E ARABIC LETTER KHAH (define-keysym #x05cf "Arabic_dal") ;U+062F ARABIC LETTER DAL (define-keysym #x05d0 "Arabic_thal") ;U+0630 ARABIC LETTER THAL (define-keysym #x05d1 "Arabic_ra") ;U+0631 ARABIC LETTER REH (define-keysym #x05d2 "Arabic_zain") ;U+0632 ARABIC LETTER ZAIN (define-keysym #x05d3 "Arabic_seen") ;U+0633 ARABIC LETTER SEEN (define-keysym #x05d4 "Arabic_sheen") ;U+0634 ARABIC LETTER SHEEN (define-keysym #x05d5 "Arabic_sad") ;U+0635 ARABIC LETTER SAD (define-keysym #x05d6 "Arabic_dad") ;U+0636 ARABIC LETTER DAD (define-keysym #x05d7 "Arabic_tah") ;U+0637 ARABIC LETTER TAH (define-keysym #x05d8 "Arabic_zah") ;U+0638 ARABIC LETTER ZAH (define-keysym #x05d9 "Arabic_ain") ;U+0639 ARABIC LETTER AIN (define-keysym #x05da "Arabic_ghain") ;U+063A ARABIC LETTER GHAIN (define-keysym #x05e0 "Arabic_tatweel") ;U+0640 ARABIC TATWEEL (define-keysym #x05e1 "Arabic_feh") ;U+0641 ARABIC LETTER FEH (define-keysym #x05e2 "Arabic_qaf") ;U+0642 ARABIC LETTER QAF (define-keysym #x05e3 "Arabic_kaf") ;U+0643 ARABIC LETTER KAF (define-keysym #x05e4 "Arabic_lam") ;U+0644 ARABIC LETTER LAM (define-keysym #x05e5 "Arabic_meem") ;U+0645 ARABIC LETTER MEEM (define-keysym #x05e6 "Arabic_noon") ;U+0646 ARABIC LETTER NOON (define-keysym #x05e7 "Arabic_ha") ;U+0647 ARABIC LETTER HEH (define-keysym #x05e7 "Arabic_heh") ;deprecated (define-keysym #x05e8 "Arabic_waw") ;U+0648 ARABIC LETTER WAW (define-keysym #x05e9 "Arabic_alefmaksura") ;U+0649 ARABIC LETTER ALEF MAKSURA (define-keysym #x05ea "Arabic_yeh") ;U+064A ARABIC LETTER YEH (define-keysym #x05eb "Arabic_fathatan") ;U+064B ARABIC FATHATAN (define-keysym #x05ec "Arabic_dammatan") ;U+064C ARABIC DAMMATAN (define-keysym #x05ed "Arabic_kasratan") ;U+064D ARABIC KASRATAN (define-keysym #x05ee "Arabic_fatha") ;U+064E ARABIC FATHA (define-keysym #x05ef "Arabic_damma") ;U+064F ARABIC DAMMA (define-keysym #x05f0 "Arabic_kasra") ;U+0650 ARABIC KASRA (define-keysym #x05f1 "Arabic_shadda") ;U+0651 ARABIC SHADDA (define-keysym #x05f2 "Arabic_sukun") ;U+0652 ARABIC SUKUN (define-keysym #x1000653 "Arabic_madda_above") ;U+0653 ARABIC MADDAH ABOVE (define-keysym #x1000654 "Arabic_hamza_above") ;U+0654 ARABIC HAMZA ABOVE (define-keysym #x1000655 "Arabic_hamza_below") ;U+0655 ARABIC HAMZA BELOW (define-keysym #x1000698 "Arabic_jeh") ;U+0698 ARABIC LETTER JEH (define-keysym #x10006a4 "Arabic_veh") ;U+06A4 ARABIC LETTER VEH (define-keysym #x10006a9 "Arabic_keheh") ;U+06A9 ARABIC LETTER KEHEH (define-keysym #x10006af "Arabic_gaf") ;U+06AF ARABIC LETTER GAF (define-keysym #x10006ba "Arabic_noon_ghunna") ;U+06BA ARABIC LETTER NOON GHUNNA (define-keysym #x10006be "Arabic_heh_doachashmee") ;U+06BE ARABIC LETTER HEH DOACHASHMEE (define-keysym #x10006cc "Farsi_yeh") ;U+06CC ARABIC LETTER FARSI YEH (define-keysym #x10006cc "Arabic_farsi_yeh") ;U+06CC ARABIC LETTER FARSI YEH (define-keysym #x10006d2 "Arabic_yeh_baree") ;U+06D2 ARABIC LETTER YEH BARREE (define-keysym #x10006c1 "Arabic_heh_goal") ;U+06C1 ARABIC LETTER HEH GOAL (define-keysym #xff7e "Arabic_switch") ;Alias for mode_switch (define-keysym #x1000492 "Cyrillic_GHE_bar") ;U+0492 CYRILLIC CAPITAL LETTER GHE WITH STROKE (define-keysym #x1000493 "Cyrillic_ghe_bar") ;U+0493 CYRILLIC SMALL LETTER GHE WITH STROKE (define-keysym #x1000496 "Cyrillic_ZHE_descender") ;U+0496 CYRILLIC CAPITAL LETTER ZHE WITH DESCENDER (define-keysym #x1000497 "Cyrillic_zhe_descender") ;U+0497 CYRILLIC SMALL LETTER ZHE WITH DESCENDER (define-keysym #x100049a "Cyrillic_KA_descender") ;U+049A CYRILLIC CAPITAL LETTER KA WITH DESCENDER (define-keysym #x100049b "Cyrillic_ka_descender") ;U+049B CYRILLIC SMALL LETTER KA WITH DESCENDER (define-keysym #x100049c "Cyrillic_KA_vertstroke") ;U+049C CYRILLIC CAPITAL LETTER KA WITH VERTICAL STROKE (define-keysym #x100049d "Cyrillic_ka_vertstroke") ;U+049D CYRILLIC SMALL LETTER KA WITH VERTICAL STROKE (define-keysym #x10004a2 "Cyrillic_EN_descender") ;U+04A2 CYRILLIC CAPITAL LETTER EN WITH DESCENDER (define-keysym #x10004a3 "Cyrillic_en_descender") ;U+04A3 CYRILLIC SMALL LETTER EN WITH DESCENDER (define-keysym #x10004ae "Cyrillic_U_straight") ;U+04AE CYRILLIC CAPITAL LETTER STRAIGHT U (define-keysym #x10004af "Cyrillic_u_straight") ;U+04AF CYRILLIC SMALL LETTER STRAIGHT U (define-keysym #x10004b0 "Cyrillic_U_straight_bar") ;U+04B0 CYRILLIC CAPITAL LETTER STRAIGHT U WITH STROKE (define-keysym #x10004b1 "Cyrillic_u_straight_bar") ;U+04B1 CYRILLIC SMALL LETTER STRAIGHT U WITH STROKE (define-keysym #x10004b2 "Cyrillic_HA_descender") ;U+04B2 CYRILLIC CAPITAL LETTER HA WITH DESCENDER (define-keysym #x10004b3 "Cyrillic_ha_descender") ;U+04B3 CYRILLIC SMALL LETTER HA WITH DESCENDER (define-keysym #x10004b6 "Cyrillic_CHE_descender") ;U+04B6 CYRILLIC CAPITAL LETTER CHE WITH DESCENDER (define-keysym #x10004b7 "Cyrillic_che_descender") ;U+04B7 CYRILLIC SMALL LETTER CHE WITH DESCENDER (define-keysym #x10004b8 "Cyrillic_CHE_vertstroke") ;U+04B8 CYRILLIC CAPITAL LETTER CHE WITH VERTICAL STROKE (define-keysym #x10004b9 "Cyrillic_che_vertstroke") ;U+04B9 CYRILLIC SMALL LETTER CHE WITH VERTICAL STROKE (define-keysym #x10004ba "Cyrillic_SHHA") ;U+04BA CYRILLIC CAPITAL LETTER SHHA (define-keysym #x10004bb "Cyrillic_shha") ;U+04BB CYRILLIC SMALL LETTER SHHA (define-keysym #x10004d8 "Cyrillic_SCHWA") ;U+04D8 CYRILLIC CAPITAL LETTER SCHWA (define-keysym #x10004d9 "Cyrillic_schwa") ;U+04D9 CYRILLIC SMALL LETTER SCHWA (define-keysym #x10004e2 "Cyrillic_I_macron") ;U+04E2 CYRILLIC CAPITAL LETTER I WITH MACRON (define-keysym #x10004e3 "Cyrillic_i_macron") ;U+04E3 CYRILLIC SMALL LETTER I WITH MACRON (define-keysym #x10004e8 "Cyrillic_O_bar") ;U+04E8 CYRILLIC CAPITAL LETTER BARRED O (define-keysym #x10004e9 "Cyrillic_o_bar") ;U+04E9 CYRILLIC SMALL LETTER BARRED O (define-keysym #x10004ee "Cyrillic_U_macron") ;U+04EE CYRILLIC CAPITAL LETTER U WITH MACRON (define-keysym #x10004ef "Cyrillic_u_macron") ;U+04EF CYRILLIC SMALL LETTER U WITH MACRON (define-keysym #x06a1 "Serbian_dje") ;U+0452 CYRILLIC SMALL LETTER DJE (define-keysym #x06a2 "Macedonia_gje") ;U+0453 CYRILLIC SMALL LETTER GJE (define-keysym #x06a3 "Cyrillic_io") ;U+0451 CYRILLIC SMALL LETTER IO (define-keysym #x06a4 "Ukrainian_ie") ;U+0454 CYRILLIC SMALL LETTER UKRAINIAN IE (define-keysym #x06a4 "Ukranian_je") ;deprecated (define-keysym #x06a5 "Macedonia_dse") ;U+0455 CYRILLIC SMALL LETTER DZE (define-keysym #x06a6 "Ukrainian_i") ;U+0456 CYRILLIC SMALL LETTER BYELORUSSIAN-UKRAINIAN I (define-keysym #x06a6 "Ukranian_i") ;deprecated (define-keysym #x06a7 "Ukrainian_yi") ;U+0457 CYRILLIC SMALL LETTER YI (define-keysym #x06a7 "Ukranian_yi") ;deprecated (define-keysym #x06a8 "Cyrillic_je") ;U+0458 CYRILLIC SMALL LETTER JE (define-keysym #x06a8 "Serbian_je") ;deprecated (define-keysym #x06a9 "Cyrillic_lje") ;U+0459 CYRILLIC SMALL LETTER LJE (define-keysym #x06a9 "Serbian_lje") ;deprecated (define-keysym #x06aa "Cyrillic_nje") ;U+045A CYRILLIC SMALL LETTER NJE (define-keysym #x06aa "Serbian_nje") ;deprecated (define-keysym #x06ab "Serbian_tshe") ;U+045B CYRILLIC SMALL LETTER TSHE (define-keysym #x06ac "Macedonia_kje") ;U+045C CYRILLIC SMALL LETTER KJE (define-keysym #x06ad "Ukrainian_ghe_with_upturn") ;U+0491 CYRILLIC SMALL LETTER GHE WITH UPTURN (define-keysym #x06ae "Byelorussian_shortu") ;U+045E CYRILLIC SMALL LETTER SHORT U (define-keysym #x06af "Cyrillic_dzhe") ;U+045F CYRILLIC SMALL LETTER DZHE (define-keysym #x06af "Serbian_dze") ;deprecated (define-keysym #x06b0 "numerosign") ;U+2116 NUMERO SIGN (define-keysym #x06b1 "Serbian_DJE") ;U+0402 CYRILLIC CAPITAL LETTER DJE (define-keysym #x06b2 "Macedonia_GJE") ;U+0403 CYRILLIC CAPITAL LETTER GJE (define-keysym #x06b3 "Cyrillic_IO") ;U+0401 CYRILLIC CAPITAL LETTER IO (define-keysym #x06b4 "Ukrainian_IE") ;U+0404 CYRILLIC CAPITAL LETTER UKRAINIAN IE (define-keysym #x06b4 "Ukranian_JE") ;deprecated (define-keysym #x06b5 "Macedonia_DSE") ;U+0405 CYRILLIC CAPITAL LETTER DZE (define-keysym #x06b6 "Ukrainian_I") ;U+0406 CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I (define-keysym #x06b6 "Ukranian_I") ;deprecated (define-keysym #x06b7 "Ukrainian_YI") ;U+0407 CYRILLIC CAPITAL LETTER YI (define-keysym #x06b7 "Ukranian_YI") ;deprecated (define-keysym #x06b8 "Cyrillic_JE") ;U+0408 CYRILLIC CAPITAL LETTER JE (define-keysym #x06b8 "Serbian_JE") ;deprecated (define-keysym #x06b9 "Cyrillic_LJE") ;U+0409 CYRILLIC CAPITAL LETTER LJE (define-keysym #x06b9 "Serbian_LJE") ;deprecated (define-keysym #x06ba "Cyrillic_NJE") ;U+040A CYRILLIC CAPITAL LETTER NJE (define-keysym #x06ba "Serbian_NJE") ;deprecated (define-keysym #x06bb "Serbian_TSHE") ;U+040B CYRILLIC CAPITAL LETTER TSHE (define-keysym #x06bc "Macedonia_KJE") ;U+040C CYRILLIC CAPITAL LETTER KJE (define-keysym #x06bd "Ukrainian_GHE_WITH_UPTURN") ;U+0490 CYRILLIC CAPITAL LETTER GHE WITH UPTURN (define-keysym #x06be "Byelorussian_SHORTU") ;U+040E CYRILLIC CAPITAL LETTER SHORT U (define-keysym #x06bf "Cyrillic_DZHE") ;U+040F CYRILLIC CAPITAL LETTER DZHE (define-keysym #x06bf "Serbian_DZE") ;deprecated (define-keysym #x06c0 "Cyrillic_yu") ;U+044E CYRILLIC SMALL LETTER YU (define-keysym #x06c1 "Cyrillic_a") ;U+0430 CYRILLIC SMALL LETTER A (define-keysym #x06c2 "Cyrillic_be") ;U+0431 CYRILLIC SMALL LETTER BE (define-keysym #x06c3 "Cyrillic_tse") ;U+0446 CYRILLIC SMALL LETTER TSE (define-keysym #x06c4 "Cyrillic_de") ;U+0434 CYRILLIC SMALL LETTER DE (define-keysym #x06c5 "Cyrillic_ie") ;U+0435 CYRILLIC SMALL LETTER IE (define-keysym #x06c6 "Cyrillic_ef") ;U+0444 CYRILLIC SMALL LETTER EF (define-keysym #x06c7 "Cyrillic_ghe") ;U+0433 CYRILLIC SMALL LETTER GHE (define-keysym #x06c8 "Cyrillic_ha") ;U+0445 CYRILLIC SMALL LETTER HA (define-keysym #x06c9 "Cyrillic_i") ;U+0438 CYRILLIC SMALL LETTER I (define-keysym #x06ca "Cyrillic_shorti") ;U+0439 CYRILLIC SMALL LETTER SHORT I (define-keysym #x06cb "Cyrillic_ka") ;U+043A CYRILLIC SMALL LETTER KA (define-keysym #x06cc "Cyrillic_el") ;U+043B CYRILLIC SMALL LETTER EL (define-keysym #x06cd "Cyrillic_em") ;U+043C CYRILLIC SMALL LETTER EM (define-keysym #x06ce "Cyrillic_en") ;U+043D CYRILLIC SMALL LETTER EN (define-keysym #x06cf "Cyrillic_o") ;U+043E CYRILLIC SMALL LETTER O (define-keysym #x06d0 "Cyrillic_pe") ;U+043F CYRILLIC SMALL LETTER PE (define-keysym #x06d1 "Cyrillic_ya") ;U+044F CYRILLIC SMALL LETTER YA (define-keysym #x06d2 "Cyrillic_er") ;U+0440 CYRILLIC SMALL LETTER ER (define-keysym #x06d3 "Cyrillic_es") ;U+0441 CYRILLIC SMALL LETTER ES (define-keysym #x06d4 "Cyrillic_te") ;U+0442 CYRILLIC SMALL LETTER TE (define-keysym #x06d5 "Cyrillic_u") ;U+0443 CYRILLIC SMALL LETTER U (define-keysym #x06d6 "Cyrillic_zhe") ;U+0436 CYRILLIC SMALL LETTER ZHE (define-keysym #x06d7 "Cyrillic_ve") ;U+0432 CYRILLIC SMALL LETTER VE (define-keysym #x06d8 "Cyrillic_softsign") ;U+044C CYRILLIC SMALL LETTER SOFT SIGN (define-keysym #x06d9 "Cyrillic_yeru") ;U+044B CYRILLIC SMALL LETTER YERU (define-keysym #x06da "Cyrillic_ze") ;U+0437 CYRILLIC SMALL LETTER ZE (define-keysym #x06db "Cyrillic_sha") ;U+0448 CYRILLIC SMALL LETTER SHA (define-keysym #x06dc "Cyrillic_e") ;U+044D CYRILLIC SMALL LETTER E (define-keysym #x06dd "Cyrillic_shcha") ;U+0449 CYRILLIC SMALL LETTER SHCHA (define-keysym #x06de "Cyrillic_che") ;U+0447 CYRILLIC SMALL LETTER CHE (define-keysym #x06df "Cyrillic_hardsign") ;U+044A CYRILLIC SMALL LETTER HARD SIGN (define-keysym #x06e0 "Cyrillic_YU") ;U+042E CYRILLIC CAPITAL LETTER YU (define-keysym #x06e1 "Cyrillic_A") ;U+0410 CYRILLIC CAPITAL LETTER A (define-keysym #x06e2 "Cyrillic_BE") ;U+0411 CYRILLIC CAPITAL LETTER BE (define-keysym #x06e3 "Cyrillic_TSE") ;U+0426 CYRILLIC CAPITAL LETTER TSE (define-keysym #x06e4 "Cyrillic_DE") ;U+0414 CYRILLIC CAPITAL LETTER DE (define-keysym #x06e5 "Cyrillic_IE") ;U+0415 CYRILLIC CAPITAL LETTER IE (define-keysym #x06e6 "Cyrillic_EF") ;U+0424 CYRILLIC CAPITAL LETTER EF (define-keysym #x06e7 "Cyrillic_GHE") ;U+0413 CYRILLIC CAPITAL LETTER GHE (define-keysym #x06e8 "Cyrillic_HA") ;U+0425 CYRILLIC CAPITAL LETTER HA (define-keysym #x06e9 "Cyrillic_I") ;U+0418 CYRILLIC CAPITAL LETTER I (define-keysym #x06ea "Cyrillic_SHORTI") ;U+0419 CYRILLIC CAPITAL LETTER SHORT I (define-keysym #x06eb "Cyrillic_KA") ;U+041A CYRILLIC CAPITAL LETTER KA (define-keysym #x06ec "Cyrillic_EL") ;U+041B CYRILLIC CAPITAL LETTER EL (define-keysym #x06ed "Cyrillic_EM") ;U+041C CYRILLIC CAPITAL LETTER EM (define-keysym #x06ee "Cyrillic_EN") ;U+041D CYRILLIC CAPITAL LETTER EN (define-keysym #x06ef "Cyrillic_O") ;U+041E CYRILLIC CAPITAL LETTER O (define-keysym #x06f0 "Cyrillic_PE") ;U+041F CYRILLIC CAPITAL LETTER PE (define-keysym #x06f1 "Cyrillic_YA") ;U+042F CYRILLIC CAPITAL LETTER YA (define-keysym #x06f2 "Cyrillic_ER") ;U+0420 CYRILLIC CAPITAL LETTER ER (define-keysym #x06f3 "Cyrillic_ES") ;U+0421 CYRILLIC CAPITAL LETTER ES (define-keysym #x06f4 "Cyrillic_TE") ;U+0422 CYRILLIC CAPITAL LETTER TE (define-keysym #x06f5 "Cyrillic_U") ;U+0423 CYRILLIC CAPITAL LETTER U (define-keysym #x06f6 "Cyrillic_ZHE") ;U+0416 CYRILLIC CAPITAL LETTER ZHE (define-keysym #x06f7 "Cyrillic_VE") ;U+0412 CYRILLIC CAPITAL LETTER VE (define-keysym #x06f8 "Cyrillic_SOFTSIGN") ;U+042C CYRILLIC CAPITAL LETTER SOFT SIGN (define-keysym #x06f9 "Cyrillic_YERU") ;U+042B CYRILLIC CAPITAL LETTER YERU (define-keysym #x06fa "Cyrillic_ZE") ;U+0417 CYRILLIC CAPITAL LETTER ZE (define-keysym #x06fb "Cyrillic_SHA") ;U+0428 CYRILLIC CAPITAL LETTER SHA (define-keysym #x06fc "Cyrillic_E") ;U+042D CYRILLIC CAPITAL LETTER E (define-keysym #x06fd "Cyrillic_SHCHA") ;U+0429 CYRILLIC CAPITAL LETTER SHCHA (define-keysym #x06fe "Cyrillic_CHE") ;U+0427 CYRILLIC CAPITAL LETTER CHE (define-keysym #x06ff "Cyrillic_HARDSIGN") ;U+042A CYRILLIC CAPITAL LETTER HARD SIGN (define-keysym #x07a1 "Greek_ALPHAaccent") ;U+0386 GREEK CAPITAL LETTER ALPHA WITH TONOS (define-keysym #x07a2 "Greek_EPSILONaccent") ;U+0388 GREEK CAPITAL LETTER EPSILON WITH TONOS (define-keysym #x07a3 "Greek_ETAaccent") ;U+0389 GREEK CAPITAL LETTER ETA WITH TONOS (define-keysym #x07a4 "Greek_IOTAaccent") ;U+038A GREEK CAPITAL LETTER IOTA WITH TONOS (define-keysym #x07a5 "Greek_IOTAdieresis") ;U+03AA GREEK CAPITAL LETTER IOTA WITH DIALYTIKA (define-keysym #x07a5 "Greek_IOTAdiaeresis") ;old typo (define-keysym #x07a7 "Greek_OMICRONaccent") ;U+038C GREEK CAPITAL LETTER OMICRON WITH TONOS (define-keysym #x07a8 "Greek_UPSILONaccent") ;U+038E GREEK CAPITAL LETTER UPSILON WITH TONOS (define-keysym #x07a9 "Greek_UPSILONdieresis") ;U+03AB GREEK CAPITAL LETTER UPSILON WITH DIALYTIKA (define-keysym #x07ab "Greek_OMEGAaccent") ;U+038F GREEK CAPITAL LETTER OMEGA WITH TONOS (define-keysym #x07ae "Greek_accentdieresis") ;U+0385 GREEK DIALYTIKA TONOS (define-keysym #x07af "Greek_horizbar") ;U+2015 HORIZONTAL BAR (define-keysym #x07b1 "Greek_alphaaccent") ;U+03AC GREEK SMALL LETTER ALPHA WITH TONOS (define-keysym #x07b2 "Greek_epsilonaccent") ;U+03AD GREEK SMALL LETTER EPSILON WITH TONOS (define-keysym #x07b3 "Greek_etaaccent") ;U+03AE GREEK SMALL LETTER ETA WITH TONOS (define-keysym #x07b4 "Greek_iotaaccent") ;U+03AF GREEK SMALL LETTER IOTA WITH TONOS (define-keysym #x07b5 "Greek_iotadieresis") ;U+03CA GREEK SMALL LETTER IOTA WITH DIALYTIKA (define-keysym #x07b6 "Greek_iotaaccentdieresis") ;U+0390 GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS (define-keysym #x07b7 "Greek_omicronaccent") ;U+03CC GREEK SMALL LETTER OMICRON WITH TONOS (define-keysym #x07b8 "Greek_upsilonaccent") ;U+03CD GREEK SMALL LETTER UPSILON WITH TONOS (define-keysym #x07b9 "Greek_upsilondieresis") ;U+03CB GREEK SMALL LETTER UPSILON WITH DIALYTIKA (define-keysym #x07ba "Greek_upsilonaccentdieresis") ;U+03B0 GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS (define-keysym #x07bb "Greek_omegaaccent") ;U+03CE GREEK SMALL LETTER OMEGA WITH TONOS (define-keysym #x07c1 "Greek_ALPHA") ;U+0391 GREEK CAPITAL LETTER ALPHA (define-keysym #x07c2 "Greek_BETA") ;U+0392 GREEK CAPITAL LETTER BETA (define-keysym #x07c3 "Greek_GAMMA") ;U+0393 GREEK CAPITAL LETTER GAMMA (define-keysym #x07c4 "Greek_DELTA") ;U+0394 GREEK CAPITAL LETTER DELTA (define-keysym #x07c5 "Greek_EPSILON") ;U+0395 GREEK CAPITAL LETTER EPSILON (define-keysym #x07c6 "Greek_ZETA") ;U+0396 GREEK CAPITAL LETTER ZETA (define-keysym #x07c7 "Greek_ETA") ;U+0397 GREEK CAPITAL LETTER ETA (define-keysym #x07c8 "Greek_THETA") ;U+0398 GREEK CAPITAL LETTER THETA (define-keysym #x07c9 "Greek_IOTA") ;U+0399 GREEK CAPITAL LETTER IOTA (define-keysym #x07ca "Greek_KAPPA") ;U+039A GREEK CAPITAL LETTER KAPPA (define-keysym #x07cb "Greek_LAMDA") ;U+039B GREEK CAPITAL LETTER LAMDA (define-keysym #x07cb "Greek_LAMBDA") ;U+039B GREEK CAPITAL LETTER LAMDA (define-keysym #x07cc "Greek_MU") ;U+039C GREEK CAPITAL LETTER MU (define-keysym #x07cd "Greek_NU") ;U+039D GREEK CAPITAL LETTER NU (define-keysym #x07ce "Greek_XI") ;U+039E GREEK CAPITAL LETTER XI (define-keysym #x07cf "Greek_OMICRON") ;U+039F GREEK CAPITAL LETTER OMICRON (define-keysym #x07d0 "Greek_PI") ;U+03A0 GREEK CAPITAL LETTER PI (define-keysym #x07d1 "Greek_RHO") ;U+03A1 GREEK CAPITAL LETTER RHO (define-keysym #x07d2 "Greek_SIGMA") ;U+03A3 GREEK CAPITAL LETTER SIGMA (define-keysym #x07d4 "Greek_TAU") ;U+03A4 GREEK CAPITAL LETTER TAU (define-keysym #x07d5 "Greek_UPSILON") ;U+03A5 GREEK CAPITAL LETTER UPSILON (define-keysym #x07d6 "Greek_PHI") ;U+03A6 GREEK CAPITAL LETTER PHI (define-keysym #x07d7 "Greek_CHI") ;U+03A7 GREEK CAPITAL LETTER CHI (define-keysym #x07d8 "Greek_PSI") ;U+03A8 GREEK CAPITAL LETTER PSI (define-keysym #x07d9 "Greek_OMEGA") ;U+03A9 GREEK CAPITAL LETTER OMEGA (define-keysym #x07e1 "Greek_alpha") ;U+03B1 GREEK SMALL LETTER ALPHA (define-keysym #x07e2 "Greek_beta") ;U+03B2 GREEK SMALL LETTER BETA (define-keysym #x07e3 "Greek_gamma") ;U+03B3 GREEK SMALL LETTER GAMMA (define-keysym #x07e4 "Greek_delta") ;U+03B4 GREEK SMALL LETTER DELTA (define-keysym #x07e5 "Greek_epsilon") ;U+03B5 GREEK SMALL LETTER EPSILON (define-keysym #x07e6 "Greek_zeta") ;U+03B6 GREEK SMALL LETTER ZETA (define-keysym #x07e7 "Greek_eta") ;U+03B7 GREEK SMALL LETTER ETA (define-keysym #x07e8 "Greek_theta") ;U+03B8 GREEK SMALL LETTER THETA (define-keysym #x07e9 "Greek_iota") ;U+03B9 GREEK SMALL LETTER IOTA (define-keysym #x07ea "Greek_kappa") ;U+03BA GREEK SMALL LETTER KAPPA (define-keysym #x07eb "Greek_lamda") ;U+03BB GREEK SMALL LETTER LAMDA (define-keysym #x07eb "Greek_lambda") ;U+03BB GREEK SMALL LETTER LAMDA (define-keysym #x07ec "Greek_mu") ;U+03BC GREEK SMALL LETTER MU (define-keysym #x07ed "Greek_nu") ;U+03BD GREEK SMALL LETTER NU (define-keysym #x07ee "Greek_xi") ;U+03BE GREEK SMALL LETTER XI (define-keysym #x07ef "Greek_omicron") ;U+03BF GREEK SMALL LETTER OMICRON (define-keysym #x07f0 "Greek_pi") ;U+03C0 GREEK SMALL LETTER PI (define-keysym #x07f1 "Greek_rho") ;U+03C1 GREEK SMALL LETTER RHO (define-keysym #x07f2 "Greek_sigma") ;U+03C3 GREEK SMALL LETTER SIGMA (define-keysym #x07f3 "Greek_finalsmallsigma") ;U+03C2 GREEK SMALL LETTER FINAL SIGMA (define-keysym #x07f4 "Greek_tau") ;U+03C4 GREEK SMALL LETTER TAU (define-keysym #x07f5 "Greek_upsilon") ;U+03C5 GREEK SMALL LETTER UPSILON (define-keysym #x07f6 "Greek_phi") ;U+03C6 GREEK SMALL LETTER PHI (define-keysym #x07f7 "Greek_chi") ;U+03C7 GREEK SMALL LETTER CHI (define-keysym #x07f8 "Greek_psi") ;U+03C8 GREEK SMALL LETTER PSI (define-keysym #x07f9 "Greek_omega") ;U+03C9 GREEK SMALL LETTER OMEGA (define-keysym #xff7e "Greek_switch") ;Alias for mode_switch (define-keysym #x08a1 "leftradical") ;U+23B7 RADICAL SYMBOL BOTTOM (define-keysym #x08a2 "topleftradical") ;(U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT) (define-keysym #x08a3 "horizconnector") ;(U+2500 BOX DRAWINGS LIGHT HORIZONTAL) (define-keysym #x08a4 "topintegral") ;U+2320 TOP HALF INTEGRAL (define-keysym #x08a5 "botintegral") ;U+2321 BOTTOM HALF INTEGRAL (define-keysym #x08a6 "vertconnector") ;(U+2502 BOX DRAWINGS LIGHT VERTICAL) (define-keysym #x08a7 "topleftsqbracket") ;U+23A1 LEFT SQUARE BRACKET UPPER CORNER (define-keysym #x08a8 "botleftsqbracket") ;U+23A3 LEFT SQUARE BRACKET LOWER CORNER (define-keysym #x08a9 "toprightsqbracket") ;U+23A4 RIGHT SQUARE BRACKET UPPER CORNER (define-keysym #x08aa "botrightsqbracket") ;U+23A6 RIGHT SQUARE BRACKET LOWER CORNER (define-keysym #x08ab "topleftparens") ;U+239B LEFT PARENTHESIS UPPER HOOK (define-keysym #x08ac "botleftparens") ;U+239D LEFT PARENTHESIS LOWER HOOK (define-keysym #x08ad "toprightparens") ;U+239E RIGHT PARENTHESIS UPPER HOOK (define-keysym #x08ae "botrightparens") ;U+23A0 RIGHT PARENTHESIS LOWER HOOK (define-keysym #x08af "leftmiddlecurlybrace") ;U+23A8 LEFT CURLY BRACKET MIDDLE PIECE (define-keysym #x08b0 "rightmiddlecurlybrace") ;U+23AC RIGHT CURLY BRACKET MIDDLE PIECE (define-keysym #x08b1 "topleftsummation") (define-keysym #x08b2 "botleftsummation") (define-keysym #x08b3 "topvertsummationconnector") (define-keysym #x08b4 "botvertsummationconnector") (define-keysym #x08b5 "toprightsummation") (define-keysym #x08b6 "botrightsummation") (define-keysym #x08b7 "rightmiddlesummation") (define-keysym #x08bc "lessthanequal") ;U+2264 LESS-THAN OR EQUAL TO (define-keysym #x08bd "notequal") ;U+2260 NOT EQUAL TO (define-keysym #x08be "greaterthanequal") ;U+2265 GREATER-THAN OR EQUAL TO (define-keysym #x08bf "integral") ;U+222B INTEGRAL (define-keysym #x08c0 "therefore") ;U+2234 THEREFORE (define-keysym #x08c1 "variation") ;U+221D PROPORTIONAL TO (define-keysym #x08c2 "infinity") ;U+221E INFINITY (define-keysym #x08c5 "nabla") ;U+2207 NABLA (define-keysym #x08c8 "approximate") ;U+223C TILDE OPERATOR (define-keysym #x08c9 "similarequal") ;U+2243 ASYMPTOTICALLY EQUAL TO (define-keysym #x08cd "ifonlyif") ;U+21D4 LEFT RIGHT DOUBLE ARROW (define-keysym #x08ce "implies") ;U+21D2 RIGHTWARDS DOUBLE ARROW (define-keysym #x08cf "identical") ;U+2261 IDENTICAL TO (define-keysym #x08d6 "radical") ;U+221A SQUARE ROOT (define-keysym #x08da "includedin") ;U+2282 SUBSET OF (define-keysym #x08db "includes") ;U+2283 SUPERSET OF (define-keysym #x08dc "intersection") ;U+2229 INTERSECTION (define-keysym #x08dd "union") ;U+222A UNION (define-keysym #x08de "logicaland") ;U+2227 LOGICAL AND (define-keysym #x08df "logicalor") ;U+2228 LOGICAL OR (define-keysym #x08ef "partialderivative") ;U+2202 PARTIAL DIFFERENTIAL (define-keysym #x08f6 "function") ;U+0192 LATIN SMALL LETTER F WITH HOOK (define-keysym #x08fb "leftarrow") ;U+2190 LEFTWARDS ARROW (define-keysym #x08fc "uparrow") ;U+2191 UPWARDS ARROW (define-keysym #x08fd "rightarrow") ;U+2192 RIGHTWARDS ARROW (define-keysym #x08fe "downarrow") ;U+2193 DOWNWARDS ARROW (define-keysym #x09df "blank") (define-keysym #x09e0 "soliddiamond") ;U+25C6 BLACK DIAMOND (define-keysym #x09e1 "checkerboard") ;U+2592 MEDIUM SHADE (define-keysym #x09e2 "ht") ;U+2409 SYMBOL FOR HORIZONTAL TABULATION (define-keysym #x09e3 "ff") ;U+240C SYMBOL FOR FORM FEED (define-keysym #x09e4 "cr") ;U+240D SYMBOL FOR CARRIAGE RETURN (define-keysym #x09e5 "lf") ;U+240A SYMBOL FOR LINE FEED (define-keysym #x09e8 "nl") ;U+2424 SYMBOL FOR NEWLINE (define-keysym #x09e9 "vt") ;U+240B SYMBOL FOR VERTICAL TABULATION (define-keysym #x09ea "lowrightcorner") ;U+2518 BOX DRAWINGS LIGHT UP AND LEFT (define-keysym #x09eb "uprightcorner") ;U+2510 BOX DRAWINGS LIGHT DOWN AND LEFT (define-keysym #x09ec "upleftcorner") ;U+250C BOX DRAWINGS LIGHT DOWN AND RIGHT (define-keysym #x09ed "lowleftcorner") ;U+2514 BOX DRAWINGS LIGHT UP AND RIGHT (define-keysym #x09ee "crossinglines") ;U+253C BOX DRAWINGS LIGHT VERTICAL AND HORIZONTAL (define-keysym #x09ef "horizlinescan1") ;U+23BA HORIZONTAL SCAN LINE-1 (define-keysym #x09f0 "horizlinescan3") ;U+23BB HORIZONTAL SCAN LINE-3 (define-keysym #x09f1 "horizlinescan5") ;U+2500 BOX DRAWINGS LIGHT HORIZONTAL (define-keysym #x09f2 "horizlinescan7") ;U+23BC HORIZONTAL SCAN LINE-7 (define-keysym #x09f3 "horizlinescan9") ;U+23BD HORIZONTAL SCAN LINE-9 (define-keysym #x09f4 "leftt") ;U+251C BOX DRAWINGS LIGHT VERTICAL AND RIGHT (define-keysym #x09f5 "rightt") ;U+2524 BOX DRAWINGS LIGHT VERTICAL AND LEFT (define-keysym #x09f6 "bott") ;U+2534 BOX DRAWINGS LIGHT UP AND HORIZONTAL (define-keysym #x09f7 "topt") ;U+252C BOX DRAWINGS LIGHT DOWN AND HORIZONTAL (define-keysym #x09f8 "vertbar") ;U+2502 BOX DRAWINGS LIGHT VERTICAL (define-keysym #x0aa1 "emspace") ;U+2003 EM SPACE (define-keysym #x0aa2 "enspace") ;U+2002 EN SPACE (define-keysym #x0aa3 "em3space") ;U+2004 THREE-PER-EM SPACE (define-keysym #x0aa4 "em4space") ;U+2005 FOUR-PER-EM SPACE (define-keysym #x0aa5 "digitspace") ;U+2007 FIGURE SPACE (define-keysym #x0aa6 "punctspace") ;U+2008 PUNCTUATION SPACE (define-keysym #x0aa7 "thinspace") ;U+2009 THIN SPACE (define-keysym #x0aa8 "hairspace") ;U+200A HAIR SPACE (define-keysym #x0aa9 "emdash") ;U+2014 EM DASH (define-keysym #x0aaa "endash") ;U+2013 EN DASH (define-keysym #x0aac "signifblank") ;(U+2423 OPEN BOX) (define-keysym #x0aae "ellipsis") ;U+2026 HORIZONTAL ELLIPSIS (define-keysym #x0aaf "doubbaselinedot") ;U+2025 TWO DOT LEADER (define-keysym #x0ab0 "onethird") ;U+2153 VULGAR FRACTION ONE THIRD (define-keysym #x0ab1 "twothirds") ;U+2154 VULGAR FRACTION TWO THIRDS (define-keysym #x0ab2 "onefifth") ;U+2155 VULGAR FRACTION ONE FIFTH (define-keysym #x0ab3 "twofifths") ;U+2156 VULGAR FRACTION TWO FIFTHS (define-keysym #x0ab4 "threefifths") ;U+2157 VULGAR FRACTION THREE FIFTHS (define-keysym #x0ab5 "fourfifths") ;U+2158 VULGAR FRACTION FOUR FIFTHS (define-keysym #x0ab6 "onesixth") ;U+2159 VULGAR FRACTION ONE SIXTH (define-keysym #x0ab7 "fivesixths") ;U+215A VULGAR FRACTION FIVE SIXTHS (define-keysym #x0ab8 "careof") ;U+2105 CARE OF (define-keysym #x0abb "figdash") ;U+2012 FIGURE DASH (define-keysym #x0abc "leftanglebracket") ;(U+27E8 MATHEMATICAL LEFT ANGLE BRACKET) (define-keysym #x0abd "decimalpoint") ;(U+002E FULL STOP) (define-keysym #x0abe "rightanglebracket") ;(U+27E9 MATHEMATICAL RIGHT ANGLE BRACKET) (define-keysym #x0abf "marker") (define-keysym #x0ac3 "oneeighth") ;U+215B VULGAR FRACTION ONE EIGHTH (define-keysym #x0ac4 "threeeighths") ;U+215C VULGAR FRACTION THREE EIGHTHS (define-keysym #x0ac5 "fiveeighths") ;U+215D VULGAR FRACTION FIVE EIGHTHS (define-keysym #x0ac6 "seveneighths") ;U+215E VULGAR FRACTION SEVEN EIGHTHS (define-keysym #x0ac9 "trademark") ;U+2122 TRADE MARK SIGN (define-keysym #x0aca "signaturemark") ;(U+2613 SALTIRE) (define-keysym #x0acb "trademarkincircle") (define-keysym #x0acc "leftopentriangle") ;(U+25C1 WHITE LEFT-POINTING TRIANGLE) (define-keysym #x0acd "rightopentriangle") ;(U+25B7 WHITE RIGHT-POINTING TRIANGLE) (define-keysym #x0ace "emopencircle") ;(U+25CB WHITE CIRCLE) (define-keysym #x0acf "emopenrectangle") ;(U+25AF WHITE VERTICAL RECTANGLE) (define-keysym #x0ad0 "leftsinglequotemark") ;U+2018 LEFT SINGLE QUOTATION MARK (define-keysym #x0ad1 "rightsinglequotemark") ;U+2019 RIGHT SINGLE QUOTATION MARK (define-keysym #x0ad2 "leftdoublequotemark") ;U+201C LEFT DOUBLE QUOTATION MARK (define-keysym #x0ad3 "rightdoublequotemark") ;U+201D RIGHT DOUBLE QUOTATION MARK (define-keysym #x0ad4 "prescription") ;U+211E PRESCRIPTION TAKE (define-keysym #x0ad6 "minutes") ;U+2032 PRIME (define-keysym #x0ad7 "seconds") ;U+2033 DOUBLE PRIME (define-keysym #x0ad9 "latincross") ;U+271D LATIN CROSS (define-keysym #x0ada "hexagram") (define-keysym #x0adb "filledrectbullet") ;(U+25AC BLACK RECTANGLE) (define-keysym #x0adc "filledlefttribullet") ;(U+25C0 BLACK LEFT-POINTING TRIANGLE) (define-keysym #x0add "filledrighttribullet") ;(U+25B6 BLACK RIGHT-POINTING TRIANGLE) (define-keysym #x0ade "emfilledcircle") ;(U+25CF BLACK CIRCLE) (define-keysym #x0adf "emfilledrect") ;(U+25AE BLACK VERTICAL RECTANGLE) (define-keysym #x0ae0 "enopencircbullet") ;(U+25E6 WHITE BULLET) (define-keysym #x0ae1 "enopensquarebullet") ;(U+25AB WHITE SMALL SQUARE) (define-keysym #x0ae2 "openrectbullet") ;(U+25AD WHITE RECTANGLE) (define-keysym #x0ae3 "opentribulletup") ;(U+25B3 WHITE UP-POINTING TRIANGLE) (define-keysym #x0ae4 "opentribulletdown") ;(U+25BD WHITE DOWN-POINTING TRIANGLE) (define-keysym #x0ae5 "openstar") ;(U+2606 WHITE STAR) (define-keysym #x0ae6 "enfilledcircbullet") ;(U+2022 BULLET) (define-keysym #x0ae7 "enfilledsqbullet") ;(U+25AA BLACK SMALL SQUARE) (define-keysym #x0ae8 "filledtribulletup") ;(U+25B2 BLACK UP-POINTING TRIANGLE) (define-keysym #x0ae9 "filledtribulletdown") ;(U+25BC BLACK DOWN-POINTING TRIANGLE) (define-keysym #x0aea "leftpointer") ;(U+261C WHITE LEFT POINTING INDEX) (define-keysym #x0aeb "rightpointer") ;(U+261E WHITE RIGHT POINTING INDEX) (define-keysym #x0aec "club") ;U+2663 BLACK CLUB SUIT (define-keysym #x0aed "diamond") ;U+2666 BLACK DIAMOND SUIT (define-keysym #x0aee "heart") ;U+2665 BLACK HEART SUIT (define-keysym #x0af0 "maltesecross") ;U+2720 MALTESE CROSS (define-keysym #x0af1 "dagger") ;U+2020 DAGGER (define-keysym #x0af2 "doubledagger") ;U+2021 DOUBLE DAGGER (define-keysym #x0af3 "checkmark") ;U+2713 CHECK MARK (define-keysym #x0af4 "ballotcross") ;U+2717 BALLOT X (define-keysym #x0af5 "musicalsharp") ;U+266F MUSIC SHARP SIGN (define-keysym #x0af6 "musicalflat") ;U+266D MUSIC FLAT SIGN (define-keysym #x0af7 "malesymbol") ;U+2642 MALE SIGN (define-keysym #x0af8 "femalesymbol") ;U+2640 FEMALE SIGN (define-keysym #x0af9 "telephone") ;U+260E BLACK TELEPHONE (define-keysym #x0afa "telephonerecorder") ;U+2315 TELEPHONE RECORDER (define-keysym #x0afb "phonographcopyright") ;U+2117 SOUND RECORDING COPYRIGHT (define-keysym #x0afc "caret") ;U+2038 CARET (define-keysym #x0afd "singlelowquotemark") ;U+201A SINGLE LOW-9 QUOTATION MARK (define-keysym #x0afe "doublelowquotemark") ;U+201E DOUBLE LOW-9 QUOTATION MARK (define-keysym #x0aff "cursor") (define-keysym #x0ba3 "leftcaret") ;(U+003C LESS-THAN SIGN) (define-keysym #x0ba6 "rightcaret") ;(U+003E GREATER-THAN SIGN) (define-keysym #x0ba8 "downcaret") ;(U+2228 LOGICAL OR) (define-keysym #x0ba9 "upcaret") ;(U+2227 LOGICAL AND) (define-keysym #x0bc0 "overbar") ;(U+00AF MACRON) (define-keysym #x0bc2 "downtack") ;U+22A5 UP TACK (define-keysym #x0bc3 "upshoe") ;(U+2229 INTERSECTION) (define-keysym #x0bc4 "downstile") ;U+230A LEFT FLOOR (define-keysym #x0bc6 "underbar") ;(U+005F LOW LINE) (define-keysym #x0bca "jot") ;U+2218 RING OPERATOR (define-keysym #x0bcc "quad") ;U+2395 APL FUNCTIONAL SYMBOL QUAD (define-keysym #x0bce "uptack") ;U+22A4 DOWN TACK (define-keysym #x0bcf "circle") ;U+25CB WHITE CIRCLE (define-keysym #x0bd3 "upstile") ;U+2308 LEFT CEILING (define-keysym #x0bd6 "downshoe") ;(U+222A UNION) (define-keysym #x0bd8 "rightshoe") ;(U+2283 SUPERSET OF) (define-keysym #x0bda "leftshoe") ;(U+2282 SUBSET OF) (define-keysym #x0bdc "lefttack") ;U+22A2 RIGHT TACK (define-keysym #x0bfc "righttack") ;U+22A3 LEFT TACK (define-keysym #x0cdf "hebrew_doublelowline") ;U+2017 DOUBLE LOW LINE (define-keysym #x0ce0 "hebrew_aleph") ;U+05D0 HEBREW LETTER ALEF (define-keysym #x0ce1 "hebrew_bet") ;U+05D1 HEBREW LETTER BET (define-keysym #x0ce1 "hebrew_beth") ;deprecated (define-keysym #x0ce2 "hebrew_gimel") ;U+05D2 HEBREW LETTER GIMEL (define-keysym #x0ce2 "hebrew_gimmel") ;deprecated (define-keysym #x0ce3 "hebrew_dalet") ;U+05D3 HEBREW LETTER DALET (define-keysym #x0ce3 "hebrew_daleth") ;deprecated (define-keysym #x0ce4 "hebrew_he") ;U+05D4 HEBREW LETTER HE (define-keysym #x0ce5 "hebrew_waw") ;U+05D5 HEBREW LETTER VAV (define-keysym #x0ce6 "hebrew_zain") ;U+05D6 HEBREW LETTER ZAYIN (define-keysym #x0ce6 "hebrew_zayin") ;deprecated (define-keysym #x0ce7 "hebrew_chet") ;U+05D7 HEBREW LETTER HET (define-keysym #x0ce7 "hebrew_het") ;deprecated (define-keysym #x0ce8 "hebrew_tet") ;U+05D8 HEBREW LETTER TET (define-keysym #x0ce8 "hebrew_teth") ;deprecated (define-keysym #x0ce9 "hebrew_yod") ;U+05D9 HEBREW LETTER YOD (define-keysym #x0cea "hebrew_finalkaph") ;U+05DA HEBREW LETTER FINAL KAF (define-keysym #x0ceb "hebrew_kaph") ;U+05DB HEBREW LETTER KAF (define-keysym #x0cec "hebrew_lamed") ;U+05DC HEBREW LETTER LAMED (define-keysym #x0ced "hebrew_finalmem") ;U+05DD HEBREW LETTER FINAL MEM (define-keysym #x0cee "hebrew_mem") ;U+05DE HEBREW LETTER MEM (define-keysym #x0cef "hebrew_finalnun") ;U+05DF HEBREW LETTER FINAL NUN (define-keysym #x0cf0 "hebrew_nun") ;U+05E0 HEBREW LETTER NUN (define-keysym #x0cf1 "hebrew_samech") ;U+05E1 HEBREW LETTER SAMEKH (define-keysym #x0cf1 "hebrew_samekh") ;deprecated (define-keysym #x0cf2 "hebrew_ayin") ;U+05E2 HEBREW LETTER AYIN (define-keysym #x0cf3 "hebrew_finalpe") ;U+05E3 HEBREW LETTER FINAL PE (define-keysym #x0cf4 "hebrew_pe") ;U+05E4 HEBREW LETTER PE (define-keysym #x0cf5 "hebrew_finalzade") ;U+05E5 HEBREW LETTER FINAL TSADI (define-keysym #x0cf5 "hebrew_finalzadi") ;deprecated (define-keysym #x0cf6 "hebrew_zade") ;U+05E6 HEBREW LETTER TSADI (define-keysym #x0cf6 "hebrew_zadi") ;deprecated (define-keysym #x0cf7 "hebrew_qoph") ;U+05E7 HEBREW LETTER QOF (define-keysym #x0cf7 "hebrew_kuf") ;deprecated (define-keysym #x0cf8 "hebrew_resh") ;U+05E8 HEBREW LETTER RESH (define-keysym #x0cf9 "hebrew_shin") ;U+05E9 HEBREW LETTER SHIN (define-keysym #x0cfa "hebrew_taw") ;U+05EA HEBREW LETTER TAV (define-keysym #x0cfa "hebrew_taf") ;deprecated (define-keysym #xff7e "Hebrew_switch") ;Alias for mode_switch (define-keysym #x0da1 "Thai_kokai") ;U+0E01 THAI CHARACTER KO KAI (define-keysym #x0da2 "Thai_khokhai") ;U+0E02 THAI CHARACTER KHO KHAI (define-keysym #x0da3 "Thai_khokhuat") ;U+0E03 THAI CHARACTER KHO KHUAT (define-keysym #x0da4 "Thai_khokhwai") ;U+0E04 THAI CHARACTER KHO KHWAI (define-keysym #x0da5 "Thai_khokhon") ;U+0E05 THAI CHARACTER KHO KHON (define-keysym #x0da6 "Thai_khorakhang") ;U+0E06 THAI CHARACTER KHO RAKHANG (define-keysym #x0da7 "Thai_ngongu") ;U+0E07 THAI CHARACTER NGO NGU (define-keysym #x0da8 "Thai_chochan") ;U+0E08 THAI CHARACTER CHO CHAN (define-keysym #x0da9 "Thai_choching") ;U+0E09 THAI CHARACTER CHO CHING (define-keysym #x0daa "Thai_chochang") ;U+0E0A THAI CHARACTER CHO CHANG (define-keysym #x0dab "Thai_soso") ;U+0E0B THAI CHARACTER SO SO (define-keysym #x0dac "Thai_chochoe") ;U+0E0C THAI CHARACTER CHO CHOE (define-keysym #x0dad "Thai_yoying") ;U+0E0D THAI CHARACTER YO YING (define-keysym #x0dae "Thai_dochada") ;U+0E0E THAI CHARACTER DO CHADA (define-keysym #x0daf "Thai_topatak") ;U+0E0F THAI CHARACTER TO PATAK (define-keysym #x0db0 "Thai_thothan") ;U+0E10 THAI CHARACTER THO THAN (define-keysym #x0db1 "Thai_thonangmontho") ;U+0E11 THAI CHARACTER THO NANGMONTHO (define-keysym #x0db2 "Thai_thophuthao") ;U+0E12 THAI CHARACTER THO PHUTHAO (define-keysym #x0db3 "Thai_nonen") ;U+0E13 THAI CHARACTER NO NEN (define-keysym #x0db4 "Thai_dodek") ;U+0E14 THAI CHARACTER DO DEK (define-keysym #x0db5 "Thai_totao") ;U+0E15 THAI CHARACTER TO TAO (define-keysym #x0db6 "Thai_thothung") ;U+0E16 THAI CHARACTER THO THUNG (define-keysym #x0db7 "Thai_thothahan") ;U+0E17 THAI CHARACTER THO THAHAN (define-keysym #x0db8 "Thai_thothong") ;U+0E18 THAI CHARACTER THO THONG (define-keysym #x0db9 "Thai_nonu") ;U+0E19 THAI CHARACTER NO NU (define-keysym #x0dba "Thai_bobaimai") ;U+0E1A THAI CHARACTER BO BAIMAI (define-keysym #x0dbb "Thai_popla") ;U+0E1B THAI CHARACTER PO PLA (define-keysym #x0dbc "Thai_phophung") ;U+0E1C THAI CHARACTER PHO PHUNG (define-keysym #x0dbd "Thai_fofa") ;U+0E1D THAI CHARACTER FO FA (define-keysym #x0dbe "Thai_phophan") ;U+0E1E THAI CHARACTER PHO PHAN (define-keysym #x0dbf "Thai_fofan") ;U+0E1F THAI CHARACTER FO FAN (define-keysym #x0dc0 "Thai_phosamphao") ;U+0E20 THAI CHARACTER PHO SAMPHAO (define-keysym #x0dc1 "Thai_moma") ;U+0E21 THAI CHARACTER MO MA (define-keysym #x0dc2 "Thai_yoyak") ;U+0E22 THAI CHARACTER YO YAK (define-keysym #x0dc3 "Thai_rorua") ;U+0E23 THAI CHARACTER RO RUA (define-keysym #x0dc4 "Thai_ru") ;U+0E24 THAI CHARACTER RU (define-keysym #x0dc5 "Thai_loling") ;U+0E25 THAI CHARACTER LO LING (define-keysym #x0dc6 "Thai_lu") ;U+0E26 THAI CHARACTER LU (define-keysym #x0dc7 "Thai_wowaen") ;U+0E27 THAI CHARACTER WO WAEN (define-keysym #x0dc8 "Thai_sosala") ;U+0E28 THAI CHARACTER SO SALA (define-keysym #x0dc9 "Thai_sorusi") ;U+0E29 THAI CHARACTER SO RUSI (define-keysym #x0dca "Thai_sosua") ;U+0E2A THAI CHARACTER SO SUA (define-keysym #x0dcb "Thai_hohip") ;U+0E2B THAI CHARACTER HO HIP (define-keysym #x0dcc "Thai_lochula") ;U+0E2C THAI CHARACTER LO CHULA (define-keysym #x0dcd "Thai_oang") ;U+0E2D THAI CHARACTER O ANG (define-keysym #x0dce "Thai_honokhuk") ;U+0E2E THAI CHARACTER HO NOKHUK (define-keysym #x0dcf "Thai_paiyannoi") ;U+0E2F THAI CHARACTER PAIYANNOI (define-keysym #x0dd0 "Thai_saraa") ;U+0E30 THAI CHARACTER SARA A (define-keysym #x0dd1 "Thai_maihanakat") ;U+0E31 THAI CHARACTER MAI HAN-AKAT (define-keysym #x0dd2 "Thai_saraaa") ;U+0E32 THAI CHARACTER SARA AA (define-keysym #x0dd3 "Thai_saraam") ;U+0E33 THAI CHARACTER SARA AM (define-keysym #x0dd4 "Thai_sarai") ;U+0E34 THAI CHARACTER SARA I (define-keysym #x0dd5 "Thai_saraii") ;U+0E35 THAI CHARACTER SARA II (define-keysym #x0dd6 "Thai_saraue") ;U+0E36 THAI CHARACTER SARA UE (define-keysym #x0dd7 "Thai_sarauee") ;U+0E37 THAI CHARACTER SARA UEE (define-keysym #x0dd8 "Thai_sarau") ;U+0E38 THAI CHARACTER SARA U (define-keysym #x0dd9 "Thai_sarauu") ;U+0E39 THAI CHARACTER SARA UU (define-keysym #x0dda "Thai_phinthu") ;U+0E3A THAI CHARACTER PHINTHU (define-keysym #x0dde "Thai_maihanakat_maitho") (define-keysym #x0ddf "Thai_baht") ;U+0E3F THAI CURRENCY SYMBOL BAHT (define-keysym #x0de0 "Thai_sarae") ;U+0E40 THAI CHARACTER SARA E (define-keysym #x0de1 "Thai_saraae") ;U+0E41 THAI CHARACTER SARA AE (define-keysym #x0de2 "Thai_sarao") ;U+0E42 THAI CHARACTER SARA O (define-keysym #x0de3 "Thai_saraaimaimuan") ;U+0E43 THAI CHARACTER SARA AI MAIMUAN (define-keysym #x0de4 "Thai_saraaimaimalai") ;U+0E44 THAI CHARACTER SARA AI MAIMALAI (define-keysym #x0de5 "Thai_lakkhangyao") ;U+0E45 THAI CHARACTER LAKKHANGYAO (define-keysym #x0de6 "Thai_maiyamok") ;U+0E46 THAI CHARACTER MAIYAMOK (define-keysym #x0de7 "Thai_maitaikhu") ;U+0E47 THAI CHARACTER MAITAIKHU (define-keysym #x0de8 "Thai_maiek") ;U+0E48 THAI CHARACTER MAI EK (define-keysym #x0de9 "Thai_maitho") ;U+0E49 THAI CHARACTER MAI THO (define-keysym #x0dea "Thai_maitri") ;U+0E4A THAI CHARACTER MAI TRI (define-keysym #x0deb "Thai_maichattawa") ;U+0E4B THAI CHARACTER MAI CHATTAWA (define-keysym #x0dec "Thai_thanthakhat") ;U+0E4C THAI CHARACTER THANTHAKHAT (define-keysym #x0ded "Thai_nikhahit") ;U+0E4D THAI CHARACTER NIKHAHIT (define-keysym #x0df0 "Thai_leksun") ;U+0E50 THAI DIGIT ZERO (define-keysym #x0df1 "Thai_leknung") ;U+0E51 THAI DIGIT ONE (define-keysym #x0df2 "Thai_leksong") ;U+0E52 THAI DIGIT TWO (define-keysym #x0df3 "Thai_leksam") ;U+0E53 THAI DIGIT THREE (define-keysym #x0df4 "Thai_leksi") ;U+0E54 THAI DIGIT FOUR (define-keysym #x0df5 "Thai_lekha") ;U+0E55 THAI DIGIT FIVE (define-keysym #x0df6 "Thai_lekhok") ;U+0E56 THAI DIGIT SIX (define-keysym #x0df7 "Thai_lekchet") ;U+0E57 THAI DIGIT SEVEN (define-keysym #x0df8 "Thai_lekpaet") ;U+0E58 THAI DIGIT EIGHT (define-keysym #x0df9 "Thai_lekkao") ;U+0E59 THAI DIGIT NINE (define-keysym #xff31 "Hangul") ;Hangul start/stop(toggle) (define-keysym #xff32 "Hangul_Start") ;Hangul start (define-keysym #xff33 "Hangul_End") ;Hangul end, English start (define-keysym #xff34 "Hangul_Hanja") ;Start Hangul->Hanja Conversion (define-keysym #xff35 "Hangul_Jamo") ;Hangul Jamo mode (define-keysym #xff36 "Hangul_Romaja") ;Hangul Romaja mode (define-keysym #xff37 "Hangul_Codeinput") ;Hangul code input mode (define-keysym #xff38 "Hangul_Jeonja") ;Jeonja mode (define-keysym #xff39 "Hangul_Banja") ;Banja mode (define-keysym #xff3a "Hangul_PreHanja") ;Pre Hanja conversion (define-keysym #xff3b "Hangul_PostHanja") ;Post Hanja conversion (define-keysym #xff3c "Hangul_SingleCandidate") ;Single candidate (define-keysym #xff3d "Hangul_MultipleCandidate") ;Multiple candidate (define-keysym #xff3e "Hangul_PreviousCandidate") ;Previous candidate (define-keysym #xff3f "Hangul_Special") ;Special symbols (define-keysym #xff7e "Hangul_switch") ;Alias for mode_switch (define-keysym #x0ea1 "Hangul_Kiyeog") (define-keysym #x0ea2 "Hangul_SsangKiyeog") (define-keysym #x0ea3 "Hangul_KiyeogSios") (define-keysym #x0ea4 "Hangul_Nieun") (define-keysym #x0ea5 "Hangul_NieunJieuj") (define-keysym #x0ea6 "Hangul_NieunHieuh") (define-keysym #x0ea7 "Hangul_Dikeud") (define-keysym #x0ea8 "Hangul_SsangDikeud") (define-keysym #x0ea9 "Hangul_Rieul") (define-keysym #x0eaa "Hangul_RieulKiyeog") (define-keysym #x0eab "Hangul_RieulMieum") (define-keysym #x0eac "Hangul_RieulPieub") (define-keysym #x0ead "Hangul_RieulSios") (define-keysym #x0eae "Hangul_RieulTieut") (define-keysym #x0eaf "Hangul_RieulPhieuf") (define-keysym #x0eb0 "Hangul_RieulHieuh") (define-keysym #x0eb1 "Hangul_Mieum") (define-keysym #x0eb2 "Hangul_Pieub") (define-keysym #x0eb3 "Hangul_SsangPieub") (define-keysym #x0eb4 "Hangul_PieubSios") (define-keysym #x0eb5 "Hangul_Sios") (define-keysym #x0eb6 "Hangul_SsangSios") (define-keysym #x0eb7 "Hangul_Ieung") (define-keysym #x0eb8 "Hangul_Jieuj") (define-keysym #x0eb9 "Hangul_SsangJieuj") (define-keysym #x0eba "Hangul_Cieuc") (define-keysym #x0ebb "Hangul_Khieuq") (define-keysym #x0ebc "Hangul_Tieut") (define-keysym #x0ebd "Hangul_Phieuf") (define-keysym #x0ebe "Hangul_Hieuh") (define-keysym #x0ebf "Hangul_A") (define-keysym #x0ec0 "Hangul_AE") (define-keysym #x0ec1 "Hangul_YA") (define-keysym #x0ec2 "Hangul_YAE") (define-keysym #x0ec3 "Hangul_EO") (define-keysym #x0ec4 "Hangul_E") (define-keysym #x0ec5 "Hangul_YEO") (define-keysym #x0ec6 "Hangul_YE") (define-keysym #x0ec7 "Hangul_O") (define-keysym #x0ec8 "Hangul_WA") (define-keysym #x0ec9 "Hangul_WAE") (define-keysym #x0eca "Hangul_OE") (define-keysym #x0ecb "Hangul_YO") (define-keysym #x0ecc "Hangul_U") (define-keysym #x0ecd "Hangul_WEO") (define-keysym #x0ece "Hangul_WE") (define-keysym #x0ecf "Hangul_WI") (define-keysym #x0ed0 "Hangul_YU") (define-keysym #x0ed1 "Hangul_EU") (define-keysym #x0ed2 "Hangul_YI") (define-keysym #x0ed3 "Hangul_I") (define-keysym #x0ed4 "Hangul_J_Kiyeog") (define-keysym #x0ed5 "Hangul_J_SsangKiyeog") (define-keysym #x0ed6 "Hangul_J_KiyeogSios") (define-keysym #x0ed7 "Hangul_J_Nieun") (define-keysym #x0ed8 "Hangul_J_NieunJieuj") (define-keysym #x0ed9 "Hangul_J_NieunHieuh") (define-keysym #x0eda "Hangul_J_Dikeud") (define-keysym #x0edb "Hangul_J_Rieul") (define-keysym #x0edc "Hangul_J_RieulKiyeog") (define-keysym #x0edd "Hangul_J_RieulMieum") (define-keysym #x0ede "Hangul_J_RieulPieub") (define-keysym #x0edf "Hangul_J_RieulSios") (define-keysym #x0ee0 "Hangul_J_RieulTieut") (define-keysym #x0ee1 "Hangul_J_RieulPhieuf") (define-keysym #x0ee2 "Hangul_J_RieulHieuh") (define-keysym #x0ee3 "Hangul_J_Mieum") (define-keysym #x0ee4 "Hangul_J_Pieub") (define-keysym #x0ee5 "Hangul_J_PieubSios") (define-keysym #x0ee6 "Hangul_J_Sios") (define-keysym #x0ee7 "Hangul_J_SsangSios") (define-keysym #x0ee8 "Hangul_J_Ieung") (define-keysym #x0ee9 "Hangul_J_Jieuj") (define-keysym #x0eea "Hangul_J_Cieuc") (define-keysym #x0eeb "Hangul_J_Khieuq") (define-keysym #x0eec "Hangul_J_Tieut") (define-keysym #x0eed "Hangul_J_Phieuf") (define-keysym #x0eee "Hangul_J_Hieuh") (define-keysym #x0eef "Hangul_RieulYeorinHieuh") (define-keysym #x0ef0 "Hangul_SunkyeongeumMieum") (define-keysym #x0ef1 "Hangul_SunkyeongeumPieub") (define-keysym #x0ef2 "Hangul_PanSios") (define-keysym #x0ef3 "Hangul_KkogjiDalrinIeung") (define-keysym #x0ef4 "Hangul_SunkyeongeumPhieuf") (define-keysym #x0ef5 "Hangul_YeorinHieuh") (define-keysym #x0ef6 "Hangul_AraeA") (define-keysym #x0ef7 "Hangul_AraeAE") (define-keysym #x0ef8 "Hangul_J_PanSios") (define-keysym #x0ef9 "Hangul_J_KkogjiDalrinIeung") (define-keysym #x0efa "Hangul_J_YeorinHieuh") (define-keysym #x0eff "Korean_Won") ;(U+20A9 WON SIGN) (define-keysym #x1000587 "Armenian_ligature_ew") ;U+0587 ARMENIAN SMALL LIGATURE ECH YIWN (define-keysym #x1000589 "Armenian_full_stop") ;U+0589 ARMENIAN FULL STOP (define-keysym #x1000589 "Armenian_verjaket") ;U+0589 ARMENIAN FULL STOP (define-keysym #x100055d "Armenian_separation_mark") ;U+055D ARMENIAN COMMA (define-keysym #x100055d "Armenian_but") ;U+055D ARMENIAN COMMA (define-keysym #x100058a "Armenian_hyphen") ;U+058A ARMENIAN HYPHEN (define-keysym #x100058a "Armenian_yentamna") ;U+058A ARMENIAN HYPHEN (define-keysym #x100055c "Armenian_exclam") ;U+055C ARMENIAN EXCLAMATION MARK (define-keysym #x100055c "Armenian_amanak") ;U+055C ARMENIAN EXCLAMATION MARK (define-keysym #x100055b "Armenian_accent") ;U+055B ARMENIAN EMPHASIS MARK (define-keysym #x100055b "Armenian_shesht") ;U+055B ARMENIAN EMPHASIS MARK (define-keysym #x100055e "Armenian_question") ;U+055E ARMENIAN QUESTION MARK (define-keysym #x100055e "Armenian_paruyk") ;U+055E ARMENIAN QUESTION MARK (define-keysym #x1000531 "Armenian_AYB") ;U+0531 ARMENIAN CAPITAL LETTER AYB (define-keysym #x1000561 "Armenian_ayb") ;U+0561 ARMENIAN SMALL LETTER AYB (define-keysym #x1000532 "Armenian_BEN") ;U+0532 ARMENIAN CAPITAL LETTER BEN (define-keysym #x1000562 "Armenian_ben") ;U+0562 ARMENIAN SMALL LETTER BEN (define-keysym #x1000533 "Armenian_GIM") ;U+0533 ARMENIAN CAPITAL LETTER GIM (define-keysym #x1000563 "Armenian_gim") ;U+0563 ARMENIAN SMALL LETTER GIM (define-keysym #x1000534 "Armenian_DA") ;U+0534 ARMENIAN CAPITAL LETTER DA (define-keysym #x1000564 "Armenian_da") ;U+0564 ARMENIAN SMALL LETTER DA (define-keysym #x1000535 "Armenian_YECH") ;U+0535 ARMENIAN CAPITAL LETTER ECH (define-keysym #x1000565 "Armenian_yech") ;U+0565 ARMENIAN SMALL LETTER ECH (define-keysym #x1000536 "Armenian_ZA") ;U+0536 ARMENIAN CAPITAL LETTER ZA (define-keysym #x1000566 "Armenian_za") ;U+0566 ARMENIAN SMALL LETTER ZA (define-keysym #x1000537 "Armenian_E") ;U+0537 ARMENIAN CAPITAL LETTER EH (define-keysym #x1000567 "Armenian_e") ;U+0567 ARMENIAN SMALL LETTER EH (define-keysym #x1000538 "Armenian_AT") ;U+0538 ARMENIAN CAPITAL LETTER ET (define-keysym #x1000568 "Armenian_at") ;U+0568 ARMENIAN SMALL LETTER ET (define-keysym #x1000539 "Armenian_TO") ;U+0539 ARMENIAN CAPITAL LETTER TO (define-keysym #x1000569 "Armenian_to") ;U+0569 ARMENIAN SMALL LETTER TO (define-keysym #x100053a "Armenian_ZHE") ;U+053A ARMENIAN CAPITAL LETTER ZHE (define-keysym #x100056a "Armenian_zhe") ;U+056A ARMENIAN SMALL LETTER ZHE (define-keysym #x100053b "Armenian_INI") ;U+053B ARMENIAN CAPITAL LETTER INI (define-keysym #x100056b "Armenian_ini") ;U+056B ARMENIAN SMALL LETTER INI (define-keysym #x100053c "Armenian_LYUN") ;U+053C ARMENIAN CAPITAL LETTER LIWN (define-keysym #x100056c "Armenian_lyun") ;U+056C ARMENIAN SMALL LETTER LIWN (define-keysym #x100053d "Armenian_KHE") ;U+053D ARMENIAN CAPITAL LETTER XEH (define-keysym #x100056d "Armenian_khe") ;U+056D ARMENIAN SMALL LETTER XEH (define-keysym #x100053e "Armenian_TSA") ;U+053E ARMENIAN CAPITAL LETTER CA (define-keysym #x100056e "Armenian_tsa") ;U+056E ARMENIAN SMALL LETTER CA (define-keysym #x100053f "Armenian_KEN") ;U+053F ARMENIAN CAPITAL LETTER KEN (define-keysym #x100056f "Armenian_ken") ;U+056F ARMENIAN SMALL LETTER KEN (define-keysym #x1000540 "Armenian_HO") ;U+0540 ARMENIAN CAPITAL LETTER HO (define-keysym #x1000570 "Armenian_ho") ;U+0570 ARMENIAN SMALL LETTER HO (define-keysym #x1000541 "Armenian_DZA") ;U+0541 ARMENIAN CAPITAL LETTER JA (define-keysym #x1000571 "Armenian_dza") ;U+0571 ARMENIAN SMALL LETTER JA (define-keysym #x1000542 "Armenian_GHAT") ;U+0542 ARMENIAN CAPITAL LETTER GHAD (define-keysym #x1000572 "Armenian_ghat") ;U+0572 ARMENIAN SMALL LETTER GHAD (define-keysym #x1000543 "Armenian_TCHE") ;U+0543 ARMENIAN CAPITAL LETTER CHEH (define-keysym #x1000573 "Armenian_tche") ;U+0573 ARMENIAN SMALL LETTER CHEH (define-keysym #x1000544 "Armenian_MEN") ;U+0544 ARMENIAN CAPITAL LETTER MEN (define-keysym #x1000574 "Armenian_men") ;U+0574 ARMENIAN SMALL LETTER MEN (define-keysym #x1000545 "Armenian_HI") ;U+0545 ARMENIAN CAPITAL LETTER YI (define-keysym #x1000575 "Armenian_hi") ;U+0575 ARMENIAN SMALL LETTER YI (define-keysym #x1000546 "Armenian_NU") ;U+0546 ARMENIAN CAPITAL LETTER NOW (define-keysym #x1000576 "Armenian_nu") ;U+0576 ARMENIAN SMALL LETTER NOW (define-keysym #x1000547 "Armenian_SHA") ;U+0547 ARMENIAN CAPITAL LETTER SHA (define-keysym #x1000577 "Armenian_sha") ;U+0577 ARMENIAN SMALL LETTER SHA (define-keysym #x1000548 "Armenian_VO") ;U+0548 ARMENIAN CAPITAL LETTER VO (define-keysym #x1000578 "Armenian_vo") ;U+0578 ARMENIAN SMALL LETTER VO (define-keysym #x1000549 "Armenian_CHA") ;U+0549 ARMENIAN CAPITAL LETTER CHA (define-keysym #x1000579 "Armenian_cha") ;U+0579 ARMENIAN SMALL LETTER CHA (define-keysym #x100054a "Armenian_PE") ;U+054A ARMENIAN CAPITAL LETTER PEH (define-keysym #x100057a "Armenian_pe") ;U+057A ARMENIAN SMALL LETTER PEH (define-keysym #x100054b "Armenian_JE") ;U+054B ARMENIAN CAPITAL LETTER JHEH (define-keysym #x100057b "Armenian_je") ;U+057B ARMENIAN SMALL LETTER JHEH (define-keysym #x100054c "Armenian_RA") ;U+054C ARMENIAN CAPITAL LETTER RA (define-keysym #x100057c "Armenian_ra") ;U+057C ARMENIAN SMALL LETTER RA (define-keysym #x100054d "Armenian_SE") ;U+054D ARMENIAN CAPITAL LETTER SEH (define-keysym #x100057d "Armenian_se") ;U+057D ARMENIAN SMALL LETTER SEH (define-keysym #x100054e "Armenian_VEV") ;U+054E ARMENIAN CAPITAL LETTER VEW (define-keysym #x100057e "Armenian_vev") ;U+057E ARMENIAN SMALL LETTER VEW (define-keysym #x100054f "Armenian_TYUN") ;U+054F ARMENIAN CAPITAL LETTER TIWN (define-keysym #x100057f "Armenian_tyun") ;U+057F ARMENIAN SMALL LETTER TIWN (define-keysym #x1000550 "Armenian_RE") ;U+0550 ARMENIAN CAPITAL LETTER REH (define-keysym #x1000580 "Armenian_re") ;U+0580 ARMENIAN SMALL LETTER REH (define-keysym #x1000551 "Armenian_TSO") ;U+0551 ARMENIAN CAPITAL LETTER CO (define-keysym #x1000581 "Armenian_tso") ;U+0581 ARMENIAN SMALL LETTER CO (define-keysym #x1000552 "Armenian_VYUN") ;U+0552 ARMENIAN CAPITAL LETTER YIWN (define-keysym #x1000582 "Armenian_vyun") ;U+0582 ARMENIAN SMALL LETTER YIWN (define-keysym #x1000553 "Armenian_PYUR") ;U+0553 ARMENIAN CAPITAL LETTER PIWR (define-keysym #x1000583 "Armenian_pyur") ;U+0583 ARMENIAN SMALL LETTER PIWR (define-keysym #x1000554 "Armenian_KE") ;U+0554 ARMENIAN CAPITAL LETTER KEH (define-keysym #x1000584 "Armenian_ke") ;U+0584 ARMENIAN SMALL LETTER KEH (define-keysym #x1000555 "Armenian_O") ;U+0555 ARMENIAN CAPITAL LETTER OH (define-keysym #x1000585 "Armenian_o") ;U+0585 ARMENIAN SMALL LETTER OH (define-keysym #x1000556 "Armenian_FE") ;U+0556 ARMENIAN CAPITAL LETTER FEH (define-keysym #x1000586 "Armenian_fe") ;U+0586 ARMENIAN SMALL LETTER FEH (define-keysym #x100055a "Armenian_apostrophe") ;U+055A ARMENIAN APOSTROPHE (define-keysym #x10010d0 "Georgian_an") ;U+10D0 GEORGIAN LETTER AN (define-keysym #x10010d1 "Georgian_ban") ;U+10D1 GEORGIAN LETTER BAN (define-keysym #x10010d2 "Georgian_gan") ;U+10D2 GEORGIAN LETTER GAN (define-keysym #x10010d3 "Georgian_don") ;U+10D3 GEORGIAN LETTER DON (define-keysym #x10010d4 "Georgian_en") ;U+10D4 GEORGIAN LETTER EN (define-keysym #x10010d5 "Georgian_vin") ;U+10D5 GEORGIAN LETTER VIN (define-keysym #x10010d6 "Georgian_zen") ;U+10D6 GEORGIAN LETTER ZEN (define-keysym #x10010d7 "Georgian_tan") ;U+10D7 GEORGIAN LETTER TAN (define-keysym #x10010d8 "Georgian_in") ;U+10D8 GEORGIAN LETTER IN (define-keysym #x10010d9 "Georgian_kan") ;U+10D9 GEORGIAN LETTER KAN (define-keysym #x10010da "Georgian_las") ;U+10DA GEORGIAN LETTER LAS (define-keysym #x10010db "Georgian_man") ;U+10DB GEORGIAN LETTER MAN (define-keysym #x10010dc "Georgian_nar") ;U+10DC GEORGIAN LETTER NAR (define-keysym #x10010dd "Georgian_on") ;U+10DD GEORGIAN LETTER ON (define-keysym #x10010de "Georgian_par") ;U+10DE GEORGIAN LETTER PAR (define-keysym #x10010df "Georgian_zhar") ;U+10DF GEORGIAN LETTER ZHAR (define-keysym #x10010e0 "Georgian_rae") ;U+10E0 GEORGIAN LETTER RAE (define-keysym #x10010e1 "Georgian_san") ;U+10E1 GEORGIAN LETTER SAN (define-keysym #x10010e2 "Georgian_tar") ;U+10E2 GEORGIAN LETTER TAR (define-keysym #x10010e3 "Georgian_un") ;U+10E3 GEORGIAN LETTER UN (define-keysym #x10010e4 "Georgian_phar") ;U+10E4 GEORGIAN LETTER PHAR (define-keysym #x10010e5 "Georgian_khar") ;U+10E5 GEORGIAN LETTER KHAR (define-keysym #x10010e6 "Georgian_ghan") ;U+10E6 GEORGIAN LETTER GHAN (define-keysym #x10010e7 "Georgian_qar") ;U+10E7 GEORGIAN LETTER QAR (define-keysym #x10010e8 "Georgian_shin") ;U+10E8 GEORGIAN LETTER SHIN (define-keysym #x10010e9 "Georgian_chin") ;U+10E9 GEORGIAN LETTER CHIN (define-keysym #x10010ea "Georgian_can") ;U+10EA GEORGIAN LETTER CAN (define-keysym #x10010eb "Georgian_jil") ;U+10EB GEORGIAN LETTER JIL (define-keysym #x10010ec "Georgian_cil") ;U+10EC GEORGIAN LETTER CIL (define-keysym #x10010ed "Georgian_char") ;U+10ED GEORGIAN LETTER CHAR (define-keysym #x10010ee "Georgian_xan") ;U+10EE GEORGIAN LETTER XAN (define-keysym #x10010ef "Georgian_jhan") ;U+10EF GEORGIAN LETTER JHAN (define-keysym #x10010f0 "Georgian_hae") ;U+10F0 GEORGIAN LETTER HAE (define-keysym #x10010f1 "Georgian_he") ;U+10F1 GEORGIAN LETTER HE (define-keysym #x10010f2 "Georgian_hie") ;U+10F2 GEORGIAN LETTER HIE (define-keysym #x10010f3 "Georgian_we") ;U+10F3 GEORGIAN LETTER WE (define-keysym #x10010f4 "Georgian_har") ;U+10F4 GEORGIAN LETTER HAR (define-keysym #x10010f5 "Georgian_hoe") ;U+10F5 GEORGIAN LETTER HOE (define-keysym #x10010f6 "Georgian_fi") ;U+10F6 GEORGIAN LETTER FI (define-keysym #x1001e8a "Xabovedot") ;U+1E8A LATIN CAPITAL LETTER X WITH DOT ABOVE (define-keysym #x100012c "Ibreve") ;U+012C LATIN CAPITAL LETTER I WITH BREVE (define-keysym #x10001b5 "Zstroke") ;U+01B5 LATIN CAPITAL LETTER Z WITH STROKE (define-keysym #x10001e6 "Gcaron") ;U+01E6 LATIN CAPITAL LETTER G WITH CARON (define-keysym #x10001d1 "Ocaron") ;U+01D2 LATIN CAPITAL LETTER O WITH CARON (define-keysym #x100019f "Obarred") ;U+019F LATIN CAPITAL LETTER O WITH MIDDLE TILDE (define-keysym #x1001e8b "xabovedot") ;U+1E8B LATIN SMALL LETTER X WITH DOT ABOVE (define-keysym #x100012d "ibreve") ;U+012D LATIN SMALL LETTER I WITH BREVE (define-keysym #x10001b6 "zstroke") ;U+01B6 LATIN SMALL LETTER Z WITH STROKE (define-keysym #x10001e7 "gcaron") ;U+01E7 LATIN SMALL LETTER G WITH CARON (define-keysym #x10001d2 "ocaron") ;U+01D2 LATIN SMALL LETTER O WITH CARON (define-keysym #x1000275 "obarred") ;U+0275 LATIN SMALL LETTER BARRED O (define-keysym #x100018f "SCHWA") ;U+018F LATIN CAPITAL LETTER SCHWA (define-keysym #x1000259 "schwa") ;U+0259 LATIN SMALL LETTER SCHWA (define-keysym #x1001e36 "Lbelowdot") ;U+1E36 LATIN CAPITAL LETTER L WITH DOT BELOW (define-keysym #x1001e37 "lbelowdot") ;U+1E37 LATIN SMALL LETTER L WITH DOT BELOW (define-keysym #x1001ea0 "Abelowdot") ;U+1EA0 LATIN CAPITAL LETTER A WITH DOT BELOW (define-keysym #x1001ea1 "abelowdot") ;U+1EA1 LATIN SMALL LETTER A WITH DOT BELOW (define-keysym #x1001ea2 "Ahook") ;U+1EA2 LATIN CAPITAL LETTER A WITH HOOK ABOVE (define-keysym #x1001ea3 "ahook") ;U+1EA3 LATIN SMALL LETTER A WITH HOOK ABOVE (define-keysym #x1001ea4 "Acircumflexacute") ;U+1EA4 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ea5 "acircumflexacute") ;U+1EA5 LATIN SMALL LETTER A WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ea6 "Acircumflexgrave") ;U+1EA6 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ea7 "acircumflexgrave") ;U+1EA7 LATIN SMALL LETTER A WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ea8 "Acircumflexhook") ;U+1EA8 LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001ea9 "acircumflexhook") ;U+1EA9 LATIN SMALL LETTER A WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001eaa "Acircumflextilde") ;U+1EAA LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND TILDE (define-keysym #x1001eab "acircumflextilde") ;U+1EAB LATIN SMALL LETTER A WITH CIRCUMFLEX AND TILDE (define-keysym #x1001eac "Acircumflexbelowdot") ;U+1EAC LATIN CAPITAL LETTER A WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001ead "acircumflexbelowdot") ;U+1EAD LATIN SMALL LETTER A WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001eae "Abreveacute") ;U+1EAE LATIN CAPITAL LETTER A WITH BREVE AND ACUTE (define-keysym #x1001eaf "abreveacute") ;U+1EAF LATIN SMALL LETTER A WITH BREVE AND ACUTE (define-keysym #x1001eb0 "Abrevegrave") ;U+1EB0 LATIN CAPITAL LETTER A WITH BREVE AND GRAVE (define-keysym #x1001eb1 "abrevegrave") ;U+1EB1 LATIN SMALL LETTER A WITH BREVE AND GRAVE (define-keysym #x1001eb2 "Abrevehook") ;U+1EB2 LATIN CAPITAL LETTER A WITH BREVE AND HOOK ABOVE (define-keysym #x1001eb3 "abrevehook") ;U+1EB3 LATIN SMALL LETTER A WITH BREVE AND HOOK ABOVE (define-keysym #x1001eb4 "Abrevetilde") ;U+1EB4 LATIN CAPITAL LETTER A WITH BREVE AND TILDE (define-keysym #x1001eb5 "abrevetilde") ;U+1EB5 LATIN SMALL LETTER A WITH BREVE AND TILDE (define-keysym #x1001eb6 "Abrevebelowdot") ;U+1EB6 LATIN CAPITAL LETTER A WITH BREVE AND DOT BELOW (define-keysym #x1001eb7 "abrevebelowdot") ;U+1EB7 LATIN SMALL LETTER A WITH BREVE AND DOT BELOW (define-keysym #x1001eb8 "Ebelowdot") ;U+1EB8 LATIN CAPITAL LETTER E WITH DOT BELOW (define-keysym #x1001eb9 "ebelowdot") ;U+1EB9 LATIN SMALL LETTER E WITH DOT BELOW (define-keysym #x1001eba "Ehook") ;U+1EBA LATIN CAPITAL LETTER E WITH HOOK ABOVE (define-keysym #x1001ebb "ehook") ;U+1EBB LATIN SMALL LETTER E WITH HOOK ABOVE (define-keysym #x1001ebc "Etilde") ;U+1EBC LATIN CAPITAL LETTER E WITH TILDE (define-keysym #x1001ebd "etilde") ;U+1EBD LATIN SMALL LETTER E WITH TILDE (define-keysym #x1001ebe "Ecircumflexacute") ;U+1EBE LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ebf "ecircumflexacute") ;U+1EBF LATIN SMALL LETTER E WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ec0 "Ecircumflexgrave") ;U+1EC0 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ec1 "ecircumflexgrave") ;U+1EC1 LATIN SMALL LETTER E WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ec2 "Ecircumflexhook") ;U+1EC2 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001ec3 "ecircumflexhook") ;U+1EC3 LATIN SMALL LETTER E WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001ec4 "Ecircumflextilde") ;U+1EC4 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND TILDE (define-keysym #x1001ec5 "ecircumflextilde") ;U+1EC5 LATIN SMALL LETTER E WITH CIRCUMFLEX AND TILDE (define-keysym #x1001ec6 "Ecircumflexbelowdot") ;U+1EC6 LATIN CAPITAL LETTER E WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001ec7 "ecircumflexbelowdot") ;U+1EC7 LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001ec8 "Ihook") ;U+1EC8 LATIN CAPITAL LETTER I WITH HOOK ABOVE (define-keysym #x1001ec9 "ihook") ;U+1EC9 LATIN SMALL LETTER I WITH HOOK ABOVE (define-keysym #x1001eca "Ibelowdot") ;U+1ECA LATIN CAPITAL LETTER I WITH DOT BELOW (define-keysym #x1001ecb "ibelowdot") ;U+1ECB LATIN SMALL LETTER I WITH DOT BELOW (define-keysym #x1001ecc "Obelowdot") ;U+1ECC LATIN CAPITAL LETTER O WITH DOT BELOW (define-keysym #x1001ecd "obelowdot") ;U+1ECD LATIN SMALL LETTER O WITH DOT BELOW (define-keysym #x1001ece "Ohook") ;U+1ECE LATIN CAPITAL LETTER O WITH HOOK ABOVE (define-keysym #x1001ecf "ohook") ;U+1ECF LATIN SMALL LETTER O WITH HOOK ABOVE (define-keysym #x1001ed0 "Ocircumflexacute") ;U+1ED0 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ed1 "ocircumflexacute") ;U+1ED1 LATIN SMALL LETTER O WITH CIRCUMFLEX AND ACUTE (define-keysym #x1001ed2 "Ocircumflexgrave") ;U+1ED2 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ed3 "ocircumflexgrave") ;U+1ED3 LATIN SMALL LETTER O WITH CIRCUMFLEX AND GRAVE (define-keysym #x1001ed4 "Ocircumflexhook") ;U+1ED4 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001ed5 "ocircumflexhook") ;U+1ED5 LATIN SMALL LETTER O WITH CIRCUMFLEX AND HOOK ABOVE (define-keysym #x1001ed6 "Ocircumflextilde") ;U+1ED6 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND TILDE (define-keysym #x1001ed7 "ocircumflextilde") ;U+1ED7 LATIN SMALL LETTER O WITH CIRCUMFLEX AND TILDE (define-keysym #x1001ed8 "Ocircumflexbelowdot") ;U+1ED8 LATIN CAPITAL LETTER O WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001ed9 "ocircumflexbelowdot") ;U+1ED9 LATIN SMALL LETTER O WITH CIRCUMFLEX AND DOT BELOW (define-keysym #x1001eda "Ohornacute") ;U+1EDA LATIN CAPITAL LETTER O WITH HORN AND ACUTE (define-keysym #x1001edb "ohornacute") ;U+1EDB LATIN SMALL LETTER O WITH HORN AND ACUTE (define-keysym #x1001edc "Ohorngrave") ;U+1EDC LATIN CAPITAL LETTER O WITH HORN AND GRAVE (define-keysym #x1001edd "ohorngrave") ;U+1EDD LATIN SMALL LETTER O WITH HORN AND GRAVE (define-keysym #x1001ede "Ohornhook") ;U+1EDE LATIN CAPITAL LETTER O WITH HORN AND HOOK ABOVE (define-keysym #x1001edf "ohornhook") ;U+1EDF LATIN SMALL LETTER O WITH HORN AND HOOK ABOVE (define-keysym #x1001ee0 "Ohorntilde") ;U+1EE0 LATIN CAPITAL LETTER O WITH HORN AND TILDE (define-keysym #x1001ee1 "ohorntilde") ;U+1EE1 LATIN SMALL LETTER O WITH HORN AND TILDE (define-keysym #x1001ee2 "Ohornbelowdot") ;U+1EE2 LATIN CAPITAL LETTER O WITH HORN AND DOT BELOW (define-keysym #x1001ee3 "ohornbelowdot") ;U+1EE3 LATIN SMALL LETTER O WITH HORN AND DOT BELOW (define-keysym #x1001ee4 "Ubelowdot") ;U+1EE4 LATIN CAPITAL LETTER U WITH DOT BELOW (define-keysym #x1001ee5 "ubelowdot") ;U+1EE5 LATIN SMALL LETTER U WITH DOT BELOW (define-keysym #x1001ee6 "Uhook") ;U+1EE6 LATIN CAPITAL LETTER U WITH HOOK ABOVE (define-keysym #x1001ee7 "uhook") ;U+1EE7 LATIN SMALL LETTER U WITH HOOK ABOVE (define-keysym #x1001ee8 "Uhornacute") ;U+1EE8 LATIN CAPITAL LETTER U WITH HORN AND ACUTE (define-keysym #x1001ee9 "uhornacute") ;U+1EE9 LATIN SMALL LETTER U WITH HORN AND ACUTE (define-keysym #x1001eea "Uhorngrave") ;U+1EEA LATIN CAPITAL LETTER U WITH HORN AND GRAVE (define-keysym #x1001eeb "uhorngrave") ;U+1EEB LATIN SMALL LETTER U WITH HORN AND GRAVE (define-keysym #x1001eec "Uhornhook") ;U+1EEC LATIN CAPITAL LETTER U WITH HORN AND HOOK ABOVE (define-keysym #x1001eed "uhornhook") ;U+1EED LATIN SMALL LETTER U WITH HORN AND HOOK ABOVE (define-keysym #x1001eee "Uhorntilde") ;U+1EEE LATIN CAPITAL LETTER U WITH HORN AND TILDE (define-keysym #x1001eef "uhorntilde") ;U+1EEF LATIN SMALL LETTER U WITH HORN AND TILDE (define-keysym #x1001ef0 "Uhornbelowdot") ;U+1EF0 LATIN CAPITAL LETTER U WITH HORN AND DOT BELOW (define-keysym #x1001ef1 "uhornbelowdot") ;U+1EF1 LATIN SMALL LETTER U WITH HORN AND DOT BELOW (define-keysym #x1001ef4 "Ybelowdot") ;U+1EF4 LATIN CAPITAL LETTER Y WITH DOT BELOW (define-keysym #x1001ef5 "ybelowdot") ;U+1EF5 LATIN SMALL LETTER Y WITH DOT BELOW (define-keysym #x1001ef6 "Yhook") ;U+1EF6 LATIN CAPITAL LETTER Y WITH HOOK ABOVE (define-keysym #x1001ef7 "yhook") ;U+1EF7 LATIN SMALL LETTER Y WITH HOOK ABOVE (define-keysym #x1001ef8 "Ytilde") ;U+1EF8 LATIN CAPITAL LETTER Y WITH TILDE (define-keysym #x1001ef9 "ytilde") ;U+1EF9 LATIN SMALL LETTER Y WITH TILDE (define-keysym #x10001a0 "Ohorn") ;U+01A0 LATIN CAPITAL LETTER O WITH HORN (define-keysym #x10001a1 "ohorn") ;U+01A1 LATIN SMALL LETTER O WITH HORN (define-keysym #x10001af "Uhorn") ;U+01AF LATIN CAPITAL LETTER U WITH HORN (define-keysym #x10001b0 "uhorn") ;U+01B0 LATIN SMALL LETTER U WITH HORN (define-keysym #x10020a0 "EcuSign") ;U+20A0 EURO-CURRENCY SIGN (define-keysym #x10020a1 "ColonSign") ;U+20A1 COLON SIGN (define-keysym #x10020a2 "CruzeiroSign") ;U+20A2 CRUZEIRO SIGN (define-keysym #x10020a3 "FFrancSign") ;U+20A3 FRENCH FRANC SIGN (define-keysym #x10020a4 "LiraSign") ;U+20A4 LIRA SIGN (define-keysym #x10020a5 "MillSign") ;U+20A5 MILL SIGN (define-keysym #x10020a6 "NairaSign") ;U+20A6 NAIRA SIGN (define-keysym #x10020a7 "PesetaSign") ;U+20A7 PESETA SIGN (define-keysym #x10020a8 "RupeeSign") ;U+20A8 RUPEE SIGN (define-keysym #x10020a9 "WonSign") ;U+20A9 WON SIGN (define-keysym #x10020aa "NewSheqelSign") ;U+20AA NEW SHEQEL SIGN (define-keysym #x10020ab "DongSign") ;U+20AB DONG SIGN (define-keysym #x20ac "EuroSign") ;U+20AC EURO SIGN (define-keysym #x1002070 "zerosuperior") ;U+2070 SUPERSCRIPT ZERO (define-keysym #x1002074 "foursuperior") ;U+2074 SUPERSCRIPT FOUR (define-keysym #x1002075 "fivesuperior") ;U+2075 SUPERSCRIPT FIVE (define-keysym #x1002076 "sixsuperior") ;U+2076 SUPERSCRIPT SIX (define-keysym #x1002077 "sevensuperior") ;U+2077 SUPERSCRIPT SEVEN (define-keysym #x1002078 "eightsuperior") ;U+2078 SUPERSCRIPT EIGHT (define-keysym #x1002079 "ninesuperior") ;U+2079 SUPERSCRIPT NINE (define-keysym #x1002080 "zerosubscript") ;U+2080 SUBSCRIPT ZERO (define-keysym #x1002081 "onesubscript") ;U+2081 SUBSCRIPT ONE (define-keysym #x1002082 "twosubscript") ;U+2082 SUBSCRIPT TWO (define-keysym #x1002083 "threesubscript") ;U+2083 SUBSCRIPT THREE (define-keysym #x1002084 "foursubscript") ;U+2084 SUBSCRIPT FOUR (define-keysym #x1002085 "fivesubscript") ;U+2085 SUBSCRIPT FIVE (define-keysym #x1002086 "sixsubscript") ;U+2086 SUBSCRIPT SIX (define-keysym #x1002087 "sevensubscript") ;U+2087 SUBSCRIPT SEVEN (define-keysym #x1002088 "eightsubscript") ;U+2088 SUBSCRIPT EIGHT (define-keysym #x1002089 "ninesubscript") ;U+2089 SUBSCRIPT NINE (define-keysym #x1002202 "partdifferential") ;U+2202 PARTIAL DIFFERENTIAL (define-keysym #x1002205 "emptyset") ;U+2205 NULL SET (define-keysym #x1002208 "elementof") ;U+2208 ELEMENT OF (define-keysym #x1002209 "notelementof") ;U+2209 NOT AN ELEMENT OF (define-keysym #x100220B "containsas") ;U+220B CONTAINS AS MEMBER (define-keysym #x100221A "squareroot") ;U+221A SQUARE ROOT (define-keysym #x100221B "cuberoot") ;U+221B CUBE ROOT (define-keysym #x100221C "fourthroot") ;U+221C FOURTH ROOT (define-keysym #x100222C "dintegral") ;U+222C DOUBLE INTEGRAL (define-keysym #x100222D "tintegral") ;U+222D TRIPLE INTEGRAL (define-keysym #x1002235 "because") ;U+2235 BECAUSE (define-keysym #x1002248 "approxeq") ;U+2245 ALMOST EQUAL TO (define-keysym #x1002247 "notapproxeq") ;U+2247 NOT ALMOST EQUAL TO (define-keysym #x1002262 "notidentical") ;U+2262 NOT IDENTICAL TO (define-keysym #x1002263 "stricteq") ;U+2263 STRICTLY EQUIVALENT TO ;; A bunch of extended keysyms (define-keysym #x100000A8 "hpmute_acute") (define-keysym #x100000A9 "hpmute_grave") (define-keysym #x100000AA "hpmute_asciicircum") (define-keysym #x100000AB "hpmute_diaeresis") (define-keysym #x100000AC "hpmute_asciitilde") (define-keysym #x100000AF "hplira") (define-keysym #x100000BE "hpguilder") (define-keysym #x100000EE "hpYdiaeresis") (define-keysym #x100000EE "hpIO") (define-keysym #x100000F6 "hplongminus") (define-keysym #x100000FC "hpblock") (define-keysym #x1000FF00 "apLineDel") (define-keysym #x1000FF01 "apCharDel") (define-keysym #x1000FF02 "apCopy") (define-keysym #x1000FF03 "apCut") (define-keysym #x1000FF04 "apPaste") (define-keysym #x1000FF05 "apMove") (define-keysym #x1000FF06 "apGrow") (define-keysym #x1000FF07 "apCmd") (define-keysym #x1000FF08 "apShell") (define-keysym #x1000FF09 "apLeftBar") (define-keysym #x1000FF0A "apRightBar") (define-keysym #x1000FF0B "apLeftBox") (define-keysym #x1000FF0C "apRightBox") (define-keysym #x1000FF0D "apUpBox") (define-keysym #x1000FF0E "apDownBox") (define-keysym #x1000FF0F "apPop") (define-keysym #x1000FF10 "apRead") (define-keysym #x1000FF11 "apEdit") (define-keysym #x1000FF12 "apSave") (define-keysym #x1000FF13 "apExit") (define-keysym #x1000FF14 "apRepeat") (define-keysym #x1000FF48 "hpModelock1") (define-keysym #x1000FF49 "hpModelock2") (define-keysym #x1000FF6C "hpReset") (define-keysym #x1000FF6D "hpSystem") (define-keysym #x1000FF6E "hpUser") (define-keysym #x1000FF6F "hpClearLine") (define-keysym #x1000FF70 "hpInsertLine") (define-keysym #x1000FF71 "hpDeleteLine") (define-keysym #x1000FF72 "hpInsertChar") (define-keysym #x1000FF73 "hpDeleteChar") (define-keysym #x1000FF74 "hpBackTab") (define-keysym #x1000FF75 "hpKP_BackTab") (define-keysym #x1000FFA8 "apKP_parenleft") (define-keysym #x1000FFA9 "apKP_parenright") (define-keysym #x10004001 "I2ND_FUNC_L") (define-keysym #x10004002 "I2ND_FUNC_R") (define-keysym #x10004003 "IREMOVE") (define-keysym #x10004004 "IREPEAT") (define-keysym #x10004101 "IA1") (define-keysym #x10004102 "IA2") (define-keysym #x10004103 "IA3") (define-keysym #x10004104 "IA4") (define-keysym #x10004105 "IA5") (define-keysym #x10004106 "IA6") (define-keysym #x10004107 "IA7") (define-keysym #x10004108 "IA8") (define-keysym #x10004109 "IA9") (define-keysym #x1000410A "IA10") (define-keysym #x1000410B "IA11") (define-keysym #x1000410C "IA12") (define-keysym #x1000410D "IA13") (define-keysym #x1000410E "IA14") (define-keysym #x1000410F "IA15") (define-keysym #x10004201 "IB1") (define-keysym #x10004202 "IB2") (define-keysym #x10004203 "IB3") (define-keysym #x10004204 "IB4") (define-keysym #x10004205 "IB5") (define-keysym #x10004206 "IB6") (define-keysym #x10004207 "IB7") (define-keysym #x10004208 "IB8") (define-keysym #x10004209 "IB9") (define-keysym #x1000420A "IB10") (define-keysym #x1000420B "IB11") (define-keysym #x1000420C "IB12") (define-keysym #x1000420D "IB13") (define-keysym #x1000420E "IB14") (define-keysym #x1000420F "IB15") (define-keysym #x10004210 "IB16") (define-keysym #x1000FF00 "DRemove") (define-keysym #x1000FEB0 "Dring_accent") (define-keysym #x1000FE5E "Dcircumflex_accent") (define-keysym #x1000FE2C "Dcedilla_accent") (define-keysym #x1000FE27 "Dacute_accent") (define-keysym #x1000FE60 "Dgrave_accent") (define-keysym #x1000FE7E "Dtilde") (define-keysym #x1000FE22 "Ddiaeresis") (define-keysym #x1004FF02 "osfCopy") (define-keysym #x1004FF03 "osfCut") (define-keysym #x1004FF04 "osfPaste") (define-keysym #x1004FF07 "osfBackTab") (define-keysym #x1004FF08 "osfBackSpace") (define-keysym #x1004FF0B "osfClear") (define-keysym #x1004FF1B "osfEscape") (define-keysym #x1004FF31 "osfAddMode") (define-keysym #x1004FF32 "osfPrimaryPaste") (define-keysym #x1004FF33 "osfQuickPaste") (define-keysym #x1004FF40 "osfPageLeft") (define-keysym #x1004FF41 "osfPageUp") (define-keysym #x1004FF42 "osfPageDown") (define-keysym #x1004FF43 "osfPageRight") (define-keysym #x1004FF44 "osfActivate") (define-keysym #x1004FF45 "osfMenuBar") (define-keysym #x1004FF51 "osfLeft") (define-keysym #x1004FF52 "osfUp") (define-keysym #x1004FF53 "osfRight") (define-keysym #x1004FF54 "osfDown") (define-keysym #x1004FF55 "osfPrior") (define-keysym #x1004FF56 "osfNext") (define-keysym #x1004FF57 "osfEndLine") (define-keysym #x1004FF58 "osfBeginLine") (define-keysym #x1004FF59 "osfEndData") (define-keysym #x1004FF5A "osfBeginData") (define-keysym #x1004FF5B "osfPrevMenu") (define-keysym #x1004FF5C "osfNextMenu") (define-keysym #x1004FF5D "osfPrevField") (define-keysym #x1004FF5E "osfNextField") (define-keysym #x1004FF60 "osfSelect") (define-keysym #x1004FF63 "osfInsert") (define-keysym #x1004FF65 "osfUndo") (define-keysym #x1004FF67 "osfMenu") (define-keysym #x1004FF69 "osfCancel") (define-keysym #x1004FF6A "osfHelp") (define-keysym #x1004FF71 "osfSelectAll") (define-keysym #x1004FF72 "osfDeselectAll") (define-keysym #x1004FF73 "osfReselect") (define-keysym #x1004FF74 "osfExtend") (define-keysym #x1004FF78 "osfRestore") (define-keysym #x1004FF7E "osfSwitchDirection") (define-keysym #x1004FFF5 "osfPriorMinor") (define-keysym #x1004FFF6 "osfNextMinor") (define-keysym #x1004FFF7 "osfRightLine") (define-keysym #x1004FFF8 "osfLeftLine") (define-keysym #x1004FFFF "osfDelete") (define-keysym #x1005FF00 "SunFA_Grave") (define-keysym #x1005FF01 "SunFA_Circum") (define-keysym #x1005FF02 "SunFA_Tilde") (define-keysym #x1005FF03 "SunFA_Acute") (define-keysym #x1005FF04 "SunFA_Diaeresis") (define-keysym #x1005FF05 "SunFA_Cedilla") (define-keysym #x1005FF10 "SunF36") (define-keysym #x1005FF11 "SunF37") (define-keysym #x1005FF60 "SunSys_Req") (define-keysym #x1005FF70 "SunProps") (define-keysym #x1005FF71 "SunFront") (define-keysym #x1005FF72 "SunCopy") (define-keysym #x1005FF73 "SunOpen") (define-keysym #x1005FF74 "SunPaste") (define-keysym #x1005FF75 "SunCut") (define-keysym #x1005FF76 "SunPowerSwitch") (define-keysym #x1005FF77 "SunAudioLowerVolume") (define-keysym #x1005FF78 "SunAudioMute") (define-keysym #x1005FF79 "SunAudioRaiseVolume") (define-keysym #x1005FF7A "SunVideoDegauss") (define-keysym #x1005FF7B "SunVideoLowerBrightness") (define-keysym #x1005FF7C "SunVideoRaiseBrightness") (define-keysym #x1005FF7D "SunPowerSwitchShift") (define-keysym #xFF20 "SunCompose") (define-keysym #xFF55 "SunPageUp") (define-keysym #xFF56 "SunPageDown") (define-keysym #xFF61 "SunPrint_Screen") (define-keysym #xFF65 "SunUndo") (define-keysym #xFF66 "SunAgain") (define-keysym #xFF68 "SunFind") (define-keysym #xFF69 "SunStop") (define-keysym #xFF7E "SunAltGraph") (define-keysym #x1006FF00 "WYSetup") (define-keysym #x1006FF00 "ncdSetup") (define-keysym #x10070001 "XeroxPointerButton1") (define-keysym #x10070002 "XeroxPointerButton2") (define-keysym #x10070003 "XeroxPointerButton3") (define-keysym #x10070004 "XeroxPointerButton4") (define-keysym #x10070005 "XeroxPointerButton5") (define-keysym #x1008FF01 "XF86ModeLock") (define-keysym #x1008FF02 "XF86MonBrightnessUp") (define-keysym #x1008FF03 "XF86MonBrightnessDown") (define-keysym #x1008FF04 "XF86KbdLightOnOff") (define-keysym #x1008FF05 "XF86KbdBrightnessUp") (define-keysym #x1008FF06 "XF86KbdBrightnessDown") (define-keysym #x1008FF10 "XF86Standby") (define-keysym #x1008FF11 "XF86AudioLowerVolume") (define-keysym #x1008FF12 "XF86AudioMute") (define-keysym #x1008FF13 "XF86AudioRaiseVolume") (define-keysym #x1008FF14 "XF86AudioPlay") (define-keysym #x1008FF15 "XF86AudioStop") (define-keysym #x1008FF16 "XF86AudioPrev") (define-keysym #x1008FF17 "XF86AudioNext") (define-keysym #x1008FF18 "XF86HomePage") (define-keysym #x1008FF19 "XF86Mail") (define-keysym #x1008FF1A "XF86Start") (define-keysym #x1008FF1B "XF86Search") (define-keysym #x1008FF1C "XF86AudioRecord") (define-keysym #x1008FF1D "XF86Calculator") (define-keysym #x1008FF1E "XF86Memo") (define-keysym #x1008FF1F "XF86ToDoList") (define-keysym #x1008FF20 "XF86Calendar") (define-keysym #x1008FF21 "XF86PowerDown") (define-keysym #x1008FF22 "XF86ContrastAdjust") (define-keysym #x1008FF23 "XF86RockerUp") (define-keysym #x1008FF24 "XF86RockerDown") (define-keysym #x1008FF25 "XF86RockerEnter") (define-keysym #x1008FF26 "XF86Back") (define-keysym #x1008FF27 "XF86Forward") (define-keysym #x1008FF28 "XF86Stop") (define-keysym #x1008FF29 "XF86Refresh") (define-keysym #x1008FF2A "XF86PowerOff") (define-keysym #x1008FF2B "XF86WakeUp") (define-keysym #x1008FF2C "XF86Eject") (define-keysym #x1008FF2D "XF86ScreenSaver") (define-keysym #x1008FF2E "XF86WWW") (define-keysym #x1008FF2F "XF86Sleep") (define-keysym #x1008FF30 "XF86Favorites") (define-keysym #x1008FF31 "XF86AudioPause") (define-keysym #x1008FF32 "XF86AudioMedia") (define-keysym #x1008FF33 "XF86MyComputer") (define-keysym #x1008FF34 "XF86VendorHome") (define-keysym #x1008FF35 "XF86LightBulb") (define-keysym #x1008FF36 "XF86Shop") (define-keysym #x1008FF37 "XF86History") (define-keysym #x1008FF38 "XF86OpenURL") (define-keysym #x1008FF39 "XF86AddFavorite") (define-keysym #x1008FF3A "XF86HotLinks") (define-keysym #x1008FF3B "XF86BrightnessAdjust") (define-keysym #x1008FF3C "XF86Finance") (define-keysym #x1008FF3D "XF86Community") (define-keysym #x1008FF3E "XF86AudioRewind") (define-keysym #x1008FF3F "XF86BackForward") (define-keysym #x1008FF40 "XF86Launch0") (define-keysym #x1008FF41 "XF86Launch1") (define-keysym #x1008FF42 "XF86Launch2") (define-keysym #x1008FF43 "XF86Launch3") (define-keysym #x1008FF44 "XF86Launch4") (define-keysym #x1008FF45 "XF86Launch5") (define-keysym #x1008FF46 "XF86Launch6") (define-keysym #x1008FF47 "XF86Launch7") (define-keysym #x1008FF48 "XF86Launch8") (define-keysym #x1008FF49 "XF86Launch9") (define-keysym #x1008FF4A "XF86LaunchA") (define-keysym #x1008FF4B "XF86LaunchB") (define-keysym #x1008FF4C "XF86LaunchC") (define-keysym #x1008FF4D "XF86LaunchD") (define-keysym #x1008FF4E "XF86LaunchE") (define-keysym #x1008FF4F "XF86LaunchF") (define-keysym #x1008FF50 "XF86ApplicationLeft") (define-keysym #x1008FF51 "XF86ApplicationRight") (define-keysym #x1008FF52 "XF86Book") (define-keysym #x1008FF53 "XF86CD") (define-keysym #x1008FF54 "XF86Calculater") (define-keysym #x1008FF55 "XF86Clear") (define-keysym #x1008FF56 "XF86Close") (define-keysym #x1008FF57 "XF86Copy") (define-keysym #x1008FF58 "XF86Cut") (define-keysym #x1008FF59 "XF86Display") (define-keysym #x1008FF5A "XF86DOS") (define-keysym #x1008FF5B "XF86Documents") (define-keysym #x1008FF5C "XF86Excel") (define-keysym #x1008FF5D "XF86Explorer") (define-keysym #x1008FF5E "XF86Game") (define-keysym #x1008FF5F "XF86Go") (define-keysym #x1008FF60 "XF86iTouch") (define-keysym #x1008FF61 "XF86LogOff") (define-keysym #x1008FF62 "XF86Market") (define-keysym #x1008FF63 "XF86Meeting") (define-keysym #x1008FF65 "XF86MenuKB") (define-keysym #x1008FF66 "XF86MenuPB") (define-keysym #x1008FF67 "XF86MySites") (define-keysym #x1008FF68 "XF86New") (define-keysym #x1008FF69 "XF86News") (define-keysym #x1008FF6A "XF86OfficeHome") (define-keysym #x1008FF6B "XF86Open") (define-keysym #x1008FF6C "XF86Option") (define-keysym #x1008FF6D "XF86Paste") (define-keysym #x1008FF6E "XF86Phone") (define-keysym #x1008FF70 "XF86Q") (define-keysym #x1008FF72 "XF86Reply") (define-keysym #x1008FF73 "XF86Reload") (define-keysym #x1008FF74 "XF86RotateWindows") (define-keysym #x1008FF75 "XF86RotationPB") (define-keysym #x1008FF76 "XF86RotationKB") (define-keysym #x1008FF77 "XF86Save") (define-keysym #x1008FF78 "XF86ScrollUp") (define-keysym #x1008FF79 "XF86ScrollDown") (define-keysym #x1008FF7A "XF86ScrollClick") (define-keysym #x1008FF7B "XF86Send") (define-keysym #x1008FF7C "XF86Spell") (define-keysym #x1008FF7D "XF86SplitScreen") (define-keysym #x1008FF7E "XF86Support") (define-keysym #x1008FF7F "XF86TaskPane") (define-keysym #x1008FF80 "XF86Terminal") (define-keysym #x1008FF81 "XF86Tools") (define-keysym #x1008FF82 "XF86Travel") (define-keysym #x1008FF84 "XF86UserPB") (define-keysym #x1008FF85 "XF86User1KB") (define-keysym #x1008FF86 "XF86User2KB") (define-keysym #x1008FF87 "XF86Video") (define-keysym #x1008FF88 "XF86WheelButton") (define-keysym #x1008FF89 "XF86Word") (define-keysym #x1008FF8A "XF86Xfer") (define-keysym #x1008FF8B "XF86ZoomIn") (define-keysym #x1008FF8C "XF86ZoomOut") (define-keysym #x1008FF8D "XF86Away") (define-keysym #x1008FF8E "XF86Messenger") (define-keysym #x1008FF8F "XF86WebCam") (define-keysym #x1008FF90 "XF86MailForward") (define-keysym #x1008FF91 "XF86Pictures") (define-keysym #x1008FF92 "XF86Music") (define-keysym #x1008FF93 "XF86Battery") (define-keysym #x1008FF94 "XF86Bluetooth") (define-keysym #x1008FF95 "XF86WLAN") (define-keysym #x1008FF96 "XF86UWB") (define-keysym #x1008FF97 "XF86AudioForward") (define-keysym #x1008FF98 "XF86AudioRepeat") (define-keysym #x1008FF99 "XF86AudioRandomPlay") (define-keysym #x1008FF9A "XF86Subtitle") (define-keysym #x1008FF9B "XF86AudioCycleTrack") (define-keysym #x1008FF9C "XF86CycleAngle") (define-keysym #x1008FF9D "XF86FrameBack") (define-keysym #x1008FF9E "XF86FrameForward") (define-keysym #x1008FF9F "XF86Time") (define-keysym #x1008FFA0 "XF86Select") (define-keysym #x1008FFA1 "XF86View") (define-keysym #x1008FFA2 "XF86TopMenu") (define-keysym #x1008FFA3 "XF86Red") (define-keysym #x1008FFA4 "XF86Green") (define-keysym #x1008FFA5 "XF86Yellow") (define-keysym #x1008FFA6 "XF86Blue") (define-keysym #x1008FFA7 "XF86Suspend") (define-keysym #x1008FFA8 "XF86Hibernate") (define-keysym #x1008FFA9 "XF86TouchpadToggle") (define-keysym #x1008FFB0 "XF86TouchpadOn") (define-keysym #x1008FFB1 "XF86TouchpadOff") (define-keysym #x1008FFB2 "XF86AudioMicMute") (define-keysym #x1008FE01 "XF86_Switch_VT_1") (define-keysym #x1008FE02 "XF86_Switch_VT_2") (define-keysym #x1008FE03 "XF86_Switch_VT_3") (define-keysym #x1008FE04 "XF86_Switch_VT_4") (define-keysym #x1008FE05 "XF86_Switch_VT_5") (define-keysym #x1008FE06 "XF86_Switch_VT_6") (define-keysym #x1008FE07 "XF86_Switch_VT_7") (define-keysym #x1008FE08 "XF86_Switch_VT_8") (define-keysym #x1008FE09 "XF86_Switch_VT_9") (define-keysym #x1008FE0A "XF86_Switch_VT_10") (define-keysym #x1008FE0B "XF86_Switch_VT_11") (define-keysym #x1008FE0C "XF86_Switch_VT_12") (define-keysym #x1008FE20 "XF86_Ungrab") (define-keysym #x1008FE21 "XF86_ClearGrab") (define-keysym #x1008FE22 "XF86_Next_VMode") (define-keysym #x1008FE23 "XF86_Prev_VMode") (define-keysym #x100000A8 "usldead_acute") (define-keysym #x100000A9 "usldead_grave") (define-keysym #x100000AB "usldead_diaeresis") (define-keysym #x100000AA "usldead_asciicircum") (define-keysym #x100000AC "usldead_asciitilde") (define-keysym #x1000FE2C "usldead_cedilla") (define-keysym #x1000FEB0 "usldead_ring") stumpwm-0.9.9/keytrans.lisp000066400000000000000000000072621242702317100160040ustar00rootroot00000000000000;; Copyright (C) 2006-2008 Matthew Kennedy ;; ;; 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, see ;; . ;; Commentary: ;; ;; Translate between stumpwm key names and keysym names. ;; ;; Code: (in-package #:stumpwm) (defvar *stumpwm-name->keysym-name-translations* (make-hash-table :test #'equal) "Hashtable mapping from stumpwm key names to keysym names.") (defun define-keysym-name (stumpwm-name keysym-name) "Define a mapping from a STUMPWM-NAME to KEYSYM-NAME. This function is used to translate Emacs-like names to keysym names." (setf (gethash stumpwm-name *stumpwm-name->keysym-name-translations*) keysym-name)) (defun stumpwm-name->keysym-name (stumpwm-name) (multiple-value-bind (value present-p) (gethash stumpwm-name *stumpwm-name->keysym-name-translations*) (declare (ignore present-p)) value)) (defun keysym-name->stumpwm-name (keysym-name) (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) "Return the keysym corresponding to STUMPWM-NAME. If no mapping for STUMPWM-NAME exists, then fallback by calling KEYSYM-NAME->KEYSYM." (let ((keysym-name (stumpwm-name->keysym-name stumpwm-name))) (keysym-name->keysym (or keysym-name stumpwm-name)))) (defun keysym->stumpwm-name (keysym) "Return the stumpwm key name corresponding to KEYSYM. If no mapping for the stumpwm key name exists, then fall back by calling KEYSYM->KEYSYM-NAME." (let ((keysym-name (keysym->keysym-name keysym))) (or (keysym-name->stumpwm-name keysym-name) keysym-name))) (define-keysym-name "RET" "Return") (define-keysym-name "ESC" "Escape") (define-keysym-name "TAB" "Tab") (define-keysym-name "DEL" "BackSpace") (define-keysym-name "SPC" "space") (define-keysym-name "!" "exclam") (define-keysym-name "\"" "quotedbl") (define-keysym-name "$" "dollar") (define-keysym-name "%" "percent") (define-keysym-name "&" "ampersand") (define-keysym-name "'" "quoteright") ;deprecated (define-keysym-name "'" "apostrophe") (define-keysym-name "`" "quoteleft") ;deprecated (define-keysym-name "`" "grave") (define-keysym-name "&" "ampersand") (define-keysym-name "(" "parenleft") (define-keysym-name ")" "parenright") (define-keysym-name "*" "asterisk") (define-keysym-name "+" "plus") (define-keysym-name "," "comma") (define-keysym-name "-" "minus") (define-keysym-name "." "period") (define-keysym-name "/" "slash") (define-keysym-name ":" "colon") (define-keysym-name ";" "semicolon") (define-keysym-name "<" "less") (define-keysym-name "=" "equal") (define-keysym-name ">" "greater") (define-keysym-name "?" "question") (define-keysym-name "@" "at") (define-keysym-name "[" "bracketleft") (define-keysym-name "\\" "backslash") (define-keysym-name "]" "bracketright") (define-keysym-name "^" "asciicircum") (define-keysym-name "_" "underscore") (define-keysym-name "#" "numbersign") (define-keysym-name "{" "braceleft") (define-keysym-name "|" "bar") (define-keysym-name "}" "braceright") (define-keysym-name "~" "asciitilde") stumpwm-0.9.9/kmap.lisp000066400000000000000000000220611242702317100150660ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; This file handles keymaps ;; ;; Code: (in-package stumpwm) (export '(*top-map* *root-map* define-key kbd lookup-command lookup-key make-sparse-keymap undefine-key)) (defvar *top-map* nil "The top level key map. This is where you'll find the binding for the @dfn{prefix map}.") (defvar *root-map* nil "This is the keymap by default bound to @kbd{C-t}. It is known as the @dfn{prefix map}.") (defstruct key keysym shift control meta alt hyper super) (defstruct kmap bindings) (defstruct binding key command) (defun make-sparse-keymap () "Create an empty keymap. If you want to create a new list of bindings in the key binding tree, this is where you start. To hang frame related bindings off @kbd{C-t C-f} one might use the following code: @example \(defvar *my-frame-bindings* (let ((m (stumpwm:make-sparse-keymap))) (stumpwm:define-key m (stumpwm:kbd \"f\") \"curframe\") (stumpwm:define-key m (stumpwm:kbd \"M-b\") \"move-focus left\") m ; NOTE: this is important )) \(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd \"C-f\") '*my-frame-bindings*) @end example" (make-kmap)) (defun lookup-command (keymap command) "Return a list of keys that are bound to command" (loop for i in (kmap-bindings keymap) when (equal command (binding-command i)) collect (binding-key i))) (defun lookup-key (keymap key &optional accept-default) (labels ((retcmd (key) (when key (binding-command key)))) (or (retcmd (find key (kmap-bindings keymap) :key 'binding-key :test 'equalp)) (and accept-default (retcmd (find t (kmap-bindings keymap) :key 'binding-key)))))) (defun key-mods-p (key) (or (key-shift key) (key-control key) (key-meta key) (key-alt key) (key-hyper key) (key-super key))) (defun x11-mods (key &optional with-numlock with-capslock) "Return the modifiers for key in a format that clx understands. if WITH-NUMLOCK is non-nil then include the numlock modifier. if WITH-CAPSLOCK is non-nil then include the capslock modifier. Most of the time these just gets in the way." (let (mods) (when (key-shift key) (push :shift mods)) (when (key-control key) (push :control mods)) (when (key-meta key) (setf mods (append (modifiers-meta *modifiers*) mods))) (when (key-alt key) (setf mods (append (modifiers-alt *modifiers*) mods))) (when (key-hyper key) (setf mods (append (modifiers-hyper *modifiers*) mods))) (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))) (defun report-kbd-parse-error (c stream) (format stream "Failed to parse key string: ~s" (slot-value c 'string))) (define-condition kbd-parse-error (stumpwm-error) ((string :initarg :string)) (:report report-kbd-parse-error) (:documentation "Raised when a kbd string failed to parse.")) (defun parse-mods (mods end) "MODS is a sequence of #\- pairs. Return a list suitable for passing as the last argument to (apply #'make-key ...)" (unless (evenp end) (signal 'kbd-parse-error :string mods)) (apply #'nconc (loop for i from 0 below end by 2 if (char/= (char mods (1+ i)) #\-) do (signal 'kbd-parse) collect (case (char mods i) (#\M (list :meta t)) (#\A (list :alt t)) (#\C (list :control t)) (#\H (list :hyper t)) (#\s (list :super t)) (#\S (list :shift t)) (t (signal 'kbd-parse-error :string mods)))))) (defun parse-key (string) "Parse STRING and return a key structure. Raise an error of type kbd-parse if the key failed to parse." (let* ((p (when (> (length string) 2) (position #\- string :from-end t :end (- (length string) 1)))) (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) (signal 'kbd-parse-error :string string)))) (defun parse-key-seq (keys) "KEYS is a key sequence. Parse it and return the list of keys." (mapcar 'parse-key (split-string keys))) (defun kbd (keys) "This compiles a key string into a key structure used by `define-key', `undefine-key', `set-prefix-key' and others." ;; XXX: define-key needs to be fixed to handle a list of keys (first (parse-key-seq keys))) (defun copy-key-into (from to) "copy the contents of TO into FROM." (setf (key-keysym to) (key-keysym from) (key-shift to) (key-shift from) (key-control to) (key-control from) (key-meta to) (key-meta from) (key-alt to) (key-alt from) (key-hyper to) (key-hyper from) (key-super to) (key-super from))) (defun print-mods (key) (concatenate 'string (when (key-control key) "C-") (when (key-meta key) "M-") (when (key-alt key) "A-") (when (key-shift key) "S-") (when (key-super key) "s-") (when (key-hyper key) "H-"))) (defun print-key (key) (format nil "~a~a" (print-mods key) (keysym->stumpwm-name (key-keysym key)))) (defun print-key-seq (seq) (format nil "^5*~{~a~^ ~}^n" (mapcar 'print-key seq))) (defun define-key (map key command) "Add a keybinding mapping for the key, @var{key}, to the command, @var{command}, in the specified keymap. If @var{command} is nil, remove an exising binding. For example, @example \(stumpwm:define-key stumpwm:*root-map* (stumpwm:kbd \"C-z\") \"echo Zzzzz...\") @end example Now when you type C-t C-z, you'll see the text ``Zzzzz...'' pop up." (declare (type kmap map) (type (or key (eql t)) key)) (let ((binding (find key (kmap-bindings map) :key 'binding-key :test 'equalp))) (if command (setf (kmap-bindings map) (append (if binding (delete binding (kmap-bindings map)) (kmap-bindings map)) (list (make-binding :key key :command command)))) (setf (kmap-bindings map) (delete binding (kmap-bindings map)))) ;; We need to tell the X server when changing the top-map bindings. (when (eq map *top-map*) (sync-keys)))) ;; Not really needed. Keep it for backward compatibility. (defun undefine-key (map key) "Clear the key binding in the specified keybinding." (define-key map key nil)) (defun lookup-key-sequence (kmap key-seq) "Return the command bound to the key sequenc, KEY-SEQ, in keymap KMAP." (when (kmap-symbol-p kmap) (setf kmap (symbol-value kmap))) (check-type kmap kmap) (let* ((key (car key-seq)) (cmd (lookup-key kmap key))) (cond ((null (cdr key-seq)) cmd) (cmd (if (kmap-or-kmap-symbol-p cmd) (lookup-key-sequence cmd (cdr key-seq)) cmd)) (t nil)))) (defun kmap-symbol-p (x) (and (symbolp x) (boundp x) (kmap-p (symbol-value x)))) (defun kmap-or-kmap-symbol-p (x) (or (kmap-p x) (kmap-symbol-p x))) (defun dereference-kmaps (kmaps) (mapcar (lambda (m) (if (kmap-symbol-p m) (symbol-value m) m)) kmaps)) (defun search-kmap (command keymap &key (test 'equal)) "Search the keymap for the specified binding. Return the key sequences that run binding." (labels ((search-it (cmd kmap key-seq) (when (kmap-symbol-p kmap) (setf kmap (symbol-value kmap))) (check-type kmap kmap) (loop for i in (kmap-bindings kmap) if (funcall test (binding-command i) cmd) collect (cons (binding-key i) key-seq) else if (kmap-or-kmap-symbol-p (binding-command i)) append (search-it cmd (binding-command i) (cons (binding-key i) key-seq))))) (mapcar 'reverse (search-it command keymap nil)))) ;;; The Top Map (defvar *top-map-list* nil) (defun push-top-map (new-top) (push *top-map* *top-map-list*) (setf *top-map* new-top) (sync-keys)) (defun pop-top-map () (when *top-map-list* (setf *top-map* (pop *top-map-list*)) (sync-keys) t)) stumpwm-0.9.9/load-stumpwm.lisp.in000066400000000000000000000017111242702317100171730ustar00rootroot00000000000000(in-package #:cl-user) #-(or sbcl clisp ccl ecl lispworks6) (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@") :inherit-configuration)) (asdf:oos 'asdf:load-op 'stumpwm) stumpwm-0.9.9/make-image.lisp.in000066400000000000000000000040411242702317100165360ustar00rootroot00000000000000(in-package #:cl-user) (load "load-stumpwm.lisp") #-ecl (stumpwm:set-module-dir "@CONTRIB_DIR@") #+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) #+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.") stumpwm-0.9.9/manual.lisp000066400000000000000000000140211242702317100154100ustar00rootroot00000000000000;; Copyright (C) 2007-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, see ;; . ;; Commentary: ;; ;; Generate the texinfo manual from docstrings in the source. Note, ;; this only works in sbcl, clisp and lispworks ;; ;; Code: (in-package #:stumpwm) #+sbcl (require :sb-introspect) ;; handy for figuring out which symbol is borking the documentation (defun dprint (sym) (declare (ignorable sym)) ;;(format t "~&Doing ~a..." sym)) ) (defun generate-function-doc (s line) (ppcre:register-groups-bind (name) ("^@@@ (.*)" line) (dprint name) (let ((fn (if (find #\( name :test 'char=) ;; handle (setf ) functions (with-standard-io-syntax (let ((*package* (find-package :stumpwm))) (fdefinition (read-from-string name)))) (symbol-function (find-symbol (string-upcase name) :stumpwm)))) (*print-pretty* nil)) (format s "@defun {~a} ~{~a~^ ~}~%~a~&@end defun~%~%" name #+sbcl (sb-introspect:function-lambda-list fn) #+clisp (ext:arglist fn) #+lispworks (lw:function-lambda-list fn) #- (or sbcl clisp lispworks) '("(Check the code for args list)") (documentation fn 'function)) t))) (defun generate-macro-doc (s line) (ppcre:register-groups-bind (name) ("^%%% (.*)" line) (dprint name) (let* ((symbol (find-symbol (string-upcase name) :stumpwm)) (*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) #+lispworks (lw:function-lambda-list symbol) #- (or sbcl clisp 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)) t))) (defun generate-variable-doc (s line) (ppcre:register-groups-bind (name) ("^### (.*)" line) (dprint name) (let ((sym (find-symbol (string-upcase name) :stumpwm))) (format s "@defvar ~a~%~a~&@end defvar~%~%" name (documentation sym 'variable)) t))) (defun generate-hook-doc (s line) (ppcre:register-groups-bind (name) ("^\\$\\$\\$ (.*)" line) (dprint name) (let ((sym (find-symbol (string-upcase name) :stumpwm))) (format s "@defvr {Hook} ~a~%~a~&@end defvr~%~%" name (documentation sym 'variable)) t))) (defun generate-command-doc (s line) (ppcre:register-groups-bind (name) ("^!!! (.*)" line) (dprint name) (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) #+lispworks (lw:function-lambda-list cmd) #- (or sbcl clisp lispworks) '("(Check the code for args list)") (documentation cmd 'function)) t))) (defun generate-manual (&key (in #p"stumpwm.texi.in") (out #p"stumpwm.texi")) (let ((*print-case* :downcase)) (with-open-file (os out :direction :output :if-exists :supersede) (with-open-file (is in :direction :input) (loop for line = (read-line is nil is) until (eq line is) do (or (generate-function-doc os line) (generate-macro-doc os line) (generate-hook-doc os line) (generate-variable-doc os line) (generate-command-doc os line) (write-line line os))))))) stumpwm-0.9.9/menu.lisp000066400000000000000000000231611242702317100151040ustar00rootroot00000000000000;; Copyright (C) 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, see ;; . ;; Commentary: ;; ;; Implementation of an interactive menu. ;; ;; Code: ;;; interactive menu (in-package #:stumpwm) (export '(select-from-menu menu-state-selected menu-state-table)) (defvar *menu-map* nil "The keymap used by the interactive menu.") (when (null *menu-map*) (setf *menu-map* (let ((m (make-sparse-keymap))) (define-key m (kbd "C-p") 'menu-up) (define-key m (kbd "Up") 'menu-up) (define-key m (kbd "S-Up") 'menu-scroll-up) (define-key m (kbd "SunPageUp") 'menu-page-up) (define-key m (kbd "C-n") 'menu-down) (define-key m (kbd "Down") 'menu-down) (define-key m (kbd "S-Down") 'menu-scroll-down) (define-key m (kbd "SunPageDown") 'menu-page-down) (define-key m (kbd "DEL") 'menu-backspace) (define-key m (kbd "C-g") 'menu-abort) (define-key m (kbd "ESC") 'menu-abort) (define-key m (kbd "RET") 'menu-finish) m))) (defstruct menu-state table prompt selected view-start view-end (current-input (make-array 10 :element-type 'character :adjustable t :fill-pointer 0))) (defun bound-check-menu (menu) "Adjust the menu view and selected item based on current view and new selection." (let ((len (length (menu-state-table menu)))) (setf (menu-state-selected menu) (cond ((< (menu-state-selected menu) 0) (1- len)) ((>= (menu-state-selected menu) len) 0) (t (menu-state-selected menu)))) (when (and *menu-maximum-height* (> len *menu-maximum-height*)) ; scrolling required (let ((sel (menu-state-selected menu))) (setf (values (menu-state-view-start menu) (menu-state-view-end menu)) (cond ((< sel *menu-maximum-height*) (values 0 *menu-maximum-height*)) ((> sel (- len *menu-maximum-height*)) (values (- len *menu-maximum-height*) len)) ((< sel (menu-state-view-start menu)) (values (- sel *menu-scrolling-step*) (- (+ sel *menu-maximum-height*) *menu-scrolling-step*))) ((>= sel (menu-state-view-end menu)) (values (+ (- sel *menu-maximum-height*) *menu-scrolling-step*) (+ sel *menu-scrolling-step*))) (t (values (menu-state-view-start menu) (menu-state-view-end menu))))))))) (defun menu-up (menu) (setf (fill-pointer (menu-state-current-input menu)) 0) (decf (menu-state-selected menu)) (bound-check-menu menu)) (defun menu-down (menu) (setf (fill-pointer (menu-state-current-input menu)) 0) (incf (menu-state-selected menu)) (bound-check-menu menu)) (defun menu-scroll-up (menu) (setf (fill-pointer (menu-state-current-input menu)) 0) (decf (menu-state-selected menu) *menu-scrolling-step*) (bound-check-menu menu)) (defun menu-scroll-down (menu) (setf (fill-pointer (menu-state-current-input menu)) 0) (incf (menu-state-selected menu) *menu-scrolling-step*) (bound-check-menu menu)) (defun menu-page-up (menu) (when *menu-maximum-height* ;;No scrolling = no page up/down (setf (fill-pointer (menu-state-current-input menu)) 0) (decf (menu-state-selected menu) *menu-maximum-height*) (let ((*menu-scrolling-step* *menu-maximum-height*)) (bound-check-menu menu)))) (defun menu-page-down (menu) (when *menu-maximum-height* (setf (fill-pointer (menu-state-current-input menu)) 0) (incf (menu-state-selected menu) *menu-maximum-height*) (let ((*menu-scrolling-step* *menu-maximum-height*)) (bound-check-menu menu)))) (defun menu-finish (menu) (throw :menu-quit (nth (menu-state-selected menu) (menu-state-table menu)))) (defun menu-abort (menu) (declare (ignore menu)) (throw :menu-quit nil)) (defun get-input-char (key) "If @var{key} is a character suitable for menu completion (e.g. not backspace or F9), return it otherwise return nil" (let ((char (xlib:keysym->character *display* (key-keysym key)))) (if (or (key-mods-p key) (null char) (not (characterp char))) nil char))) (defun menu-element-name (element) (if (listp element) (first element) element)) (defun menu-backspace (menu) (when (> (fill-pointer (menu-state-current-input menu)) 0) (vector-pop (menu-state-current-input menu)) (check-menu-complete menu nil))) (defun check-menu-complete (menu key-seq) "If the user entered a key not mapped in @var{*menu-map}, check if he's trying to type an entry's name. Match is case insensitive as long as the user types lower-case characters. If @var{key-seq} is nil, some other function has manipulated the current-input and is requesting a re-computation of the match." (let ((input-char (and key-seq (get-input-char key-seq)))) (when input-char (vector-push-extend input-char (menu-state-current-input menu))) (when (or input-char (not key-seq)) (do* ((cur-pos 0 (1+ cur-pos)) (rest-elem (menu-state-table menu) (cdr rest-elem)) (cur-elem (car rest-elem) (car rest-elem)) (cur-elem-name (menu-element-name cur-elem) (menu-element-name cur-elem)) (current-input-length (length (menu-state-current-input menu))) (match-regex (ppcre:create-scanner (menu-state-current-input menu) :case-insensitive-mode (string= (string-downcase (menu-state-current-input menu)) (menu-state-current-input menu))))) ((not cur-elem)) (when (and (>= (length cur-elem-name) current-input-length) (ppcre:scan match-regex cur-elem-name)) (setf (menu-state-selected menu) cur-pos) (bound-check-menu menu) (return)))))) (defun select-from-menu (screen table &optional prompt (initial-selection 0) extra-keymap) "Prompt the user to select from a menu on SCREEN. TABLE can be a list of values or an alist. If it's an alist, the CAR of each element is displayed in the menu. What is displayed as menu items must be strings. EXTRA-KEYMAP can be a keymap whose bindings will take precedence over the default bindings. Returns the selected element in TABLE or nil if aborted. " (check-type screen screen) (check-type table list) (check-type prompt (or null string)) (check-type initial-selection integer) (let* ((menu-options (mapcar #'menu-element-name table)) (menu-require-scrolling (and *menu-maximum-height* (> (length menu-options) *menu-maximum-height*))) (menu (make-menu-state :table table :prompt prompt :view-start (if menu-require-scrolling initial-selection 0) :view-end (if menu-require-scrolling (+ initial-selection *menu-maximum-height*) (length menu-options)) :selected initial-selection)) (*record-last-msg-override* t) (*suppress-echo-timeout* t)) (bound-check-menu menu) (catch :menu-quit (unwind-protect (with-focus (screen-key-window screen) (loop (let ((strings (subseq menu-options (menu-state-view-start menu) (menu-state-view-end menu))) (highlight (- (menu-state-selected menu) (menu-state-view-start menu)))) (unless (= 0 (menu-state-view-start menu)) (setf strings (cons "..." strings)) (incf highlight)) (unless (= (length menu-options) (menu-state-view-end menu)) (setf strings (nconc strings '("...")))) (unless (= (fill-pointer (menu-state-current-input menu)) 0) (setf strings (cons (format nil "Search: ~a" (menu-state-current-input menu)) strings)) (incf highlight)) (when prompt (setf strings (cons prompt strings)) (incf highlight)) (echo-string-list screen strings highlight)) (multiple-value-bind (action key-seq) (read-from-keymap (if extra-keymap (list extra-keymap *menu-map*) (list *menu-map*))) (if action (funcall action menu) (check-menu-complete menu (first key-seq)))))) (unmap-all-message-windows))))) stumpwm-0.9.9/message-window.lisp000066400000000000000000000305161242702317100170730ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; message printing functions ;; ;; Code: (in-package #:stumpwm) (export '(echo-string err message gravity-coords)) (defun max-width (font l) "Return the width of the longest string in L using FONT." (loop for i in l maximize (text-line-width font i :translate #'translate-id))) (defgeneric gravity-coords (gravity width height minx miny maxx maxy) (:documentation "Get the X and Y coordinates to place something of width WIDTH and height HEIGHT within an area defined by MINX MINY MAXX and MAXY, guided by GRAVITY.")) (defmacro define-simple-gravity (name x y) "Define a simple gravity calculation of name NAME, where X and Y are one of :MIN, :MAX or :CENTER." `(defmethod gravity-coords ((gravity (eql ,name)) (width number) (height number) (minx number) (miny number) (maxx number) (maxy number)) (declare (ignorable gravity width height minx miny maxx maxy)) (values ,(ecase x (:min 'minx) (:max '(- maxx width)) (:center '(+ minx (truncate (- maxx minx width) 2)))) ,(ecase y (:min 'miny) (:max '(- maxy height)) (:center '(+ miny (truncate (- maxy miny height) 2))))))) (define-simple-gravity :top-right :max :min) (define-simple-gravity :top-left :min :min) (define-simple-gravity :bottom-right :max :max) (define-simple-gravity :bottom-left :min :max) (define-simple-gravity :right :max :center) (define-simple-gravity :left :min :center) (define-simple-gravity :top :center :min) (define-simple-gravity :bottom :center :max) (define-simple-gravity :center :center :center) (defun setup-win-gravity (screen win gravity) "Position the x, y of the window according to its gravity. This function expects to be wrapped in a with-state for win." (xlib:with-state ((screen-root screen)) (let* ((w (+ (xlib:drawable-width win) (* (xlib:drawable-border-width win) 2))) (h (+ (xlib:drawable-height win) (* (xlib:drawable-border-width win) 2))) (head-x (head-x (current-head))) (head-y (head-y (current-head))) (head-maxx (+ head-x (head-width (current-head)))) (head-maxy (+ head-y (head-height (current-head))))) (multiple-value-bind (x y) (gravity-coords gravity w h head-x head-y head-maxx head-maxy) (setf (xlib:drawable-y win) (max head-y y) (xlib:drawable-x win) (max head-x x)))))) (defun setup-message-window (screen width height) (let ((win (screen-message-window screen))) ;; Now that we know the dimensions, raise and resize it. (xlib:with-state (win) (setf (xlib:drawable-height win) height (xlib:drawable-width win) (+ width (* *message-window-padding* 2)) (xlib:window-priority win) :above) (setup-win-gravity screen win *message-window-gravity*)) (xlib:map-window win) (incf (screen-ignore-msg-expose screen)) ;; Have to flush this or the window might get cleared ;; after we've already started drawing it. (xlib:display-finish-output *display*))) (defun invert-rect (screen win x y width height) "invert the color in the rectangular area. Used for highlighting text." (let ((gcontext (xlib:create-gcontext :drawable win :foreground (screen-fg-color screen) :function boole-xor))) (xlib:draw-rectangle win gcontext x y width height t) (setf (xlib:gcontext-foreground gcontext) (screen-bg-color screen)) (xlib:draw-rectangle win gcontext x y width height t))) (defun unmap-message-window (screen) "Unmap the screen's message window, if it is mapped." (unless (eq (xlib:window-map-state (screen-message-window screen)) :unmapped) (xlib:unmap-window (screen-message-window screen)))) (defun unmap-all-message-windows () (mapc #'unmap-message-window *screen-list*) (when (timer-p *message-window-timer*) (cancel-timer *message-window-timer*) (setf *message-window-timer* nil))) (defun unmap-frame-indicator-window (screen) "Unmap the screen's message window, if it is mapped." ;; (unless (eq (xlib:window-map-state (screen-frame-window screen)) :unmapped) (xlib:unmap-window (screen-frame-window screen))) (defun unmap-all-frame-indicator-windows () (mapc #'unmap-frame-indicator-window *screen-list*) (when (timer-p *frame-indicator-timer*) (cancel-timer *frame-indicator-timer*) (setf *frame-indicator-timer* nil))) (defun reset-message-window-timer () "Set the message window timer to timeout in *timeout-wait* seconds." (unless *ignore-echo-timeout* (when (timer-p *message-window-timer*) (cancel-timer *message-window-timer*)) (setf *message-window-timer* (run-with-timer *timeout-wait* nil 'unmap-all-message-windows)))) (defun reset-frame-indicator-timer () "Set the message window timer to timeout in *timeout-wait* seconds." (when (timer-p *frame-indicator-timer*) (cancel-timer *frame-indicator-timer*)) (setf *frame-indicator-timer* (run-with-timer *timeout-frame-indicator-wait* nil 'unmap-all-frame-indicator-windows))) (defun show-frame-outline (group &optional (clear t)) ;; Don't draw if this isn't a current group! (when (find group (mapcar 'screen-current-group *screen-list*)) (dformat 5 "show-frame-outline!~%") ;; *resize-hides-windows* uses the frame outlines for display, ;; so try not to interfere. (unless (eq *top-map* *resize-map*) (when clear (clear-frame-outlines group)) (let ((frame (tile-group-current-frame group))) (unless (and (= 1 (length (tile-group-frame-tree group))) (atom (first (tile-group-frame-tree group)))) ;; draw the outline (unless (frame-window frame) (draw-frame-outline group frame t t))))))) (defun show-frame-indicator (group &optional force) (show-frame-outline group) ;; FIXME: Arg, these tests are already done in show-frame-outline (when (find group (mapcar 'screen-current-group *screen-list*)) (when (or force (and (or (> (length (tile-group-frame-tree group)) 1) (not (atom (first (tile-group-frame-tree group))))) (not *suppress-frame-indicator*))) (let ((frame (tile-group-current-frame group)) (w (screen-frame-window (current-screen))) (string (if (stringp *frame-indicator-text*) *frame-indicator-text* (prin1-to-string *frame-indicator-text*))) (font (screen-font (current-screen)))) ;; If it's already mapped it'll appear briefly in the wrong ;; place, so unmap it first. (xlib:unmap-window w) (xlib:with-state (w) (setf (xlib:drawable-x w) (+ (frame-x frame) (truncate (- (frame-width frame) (text-line-width font string)) 2)) (xlib:drawable-y w) (+ (frame-display-y group frame) (truncate (- (frame-height frame) (font-height font)) 2)) (xlib:window-priority w) :above)) (xlib:map-window w) (echo-in-window w font (screen-fg-color (current-screen)) (screen-bg-color (current-screen)) string) (reset-frame-indicator-timer))))) (defun echo-in-window (win font fg bg string) (let* ((height (font-height font)) (gcontext (xlib:create-gcontext :drawable win :font (when (typep font 'xlib:font) font) :foreground fg :background bg)) (width (text-line-width font string))) (xlib:with-state (win) (setf (xlib:drawable-height win) height (xlib:drawable-width win) width)) (xlib:clear-area win) (xlib:display-finish-output *display*) (draw-image-glyphs win gcontext font 0 (font-ascent font) string :translate #'translate-id :size 16))) (defun push-last-message (screen strings highlights) ;; only push unique messages (unless *record-last-msg-override* (push strings (screen-last-msg screen)) (push highlights (screen-last-msg-highlights screen)) ;; crop for size (when (>= (length (screen-last-msg screen)) *max-last-message-size*) (setf (screen-last-msg screen) (butlast (screen-last-msg screen))) (setf (screen-last-msg-highlights screen) (butlast (screen-last-msg-highlights screen)))))) (defun redraw-current-message (screen) (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)))) (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))))) (defun echo-string-list (screen strings &rest highlights) "Draw each string in l in the screen's message window. HIGHLIGHT is the nth entry to highlight." (when strings (unless *executing-stumpwm-command* (multiple-value-bind (width height) (rendered-size strings (screen-message-cc screen)) (setup-message-window screen width height) (render-strings screen (screen-message-cc screen) *message-window-padding* 0 strings highlights)) (setf (screen-current-msg screen) strings (screen-current-msg-highlights screen) highlights) ;; Set a timer to hide the message after a number of seconds (if *suppress-echo-timeout* ;; any left over timers need to be canceled. (when (timer-p *message-window-timer*) (cancel-timer *message-window-timer*) (setf *message-window-timer* nil)) (reset-message-window-timer))) (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))) (defun echo-string (screen msg) "Display @var{string} in the message bar on @var{screen}. You almost always want to use @command{message}." (echo-string-list screen (split-string msg (string #\Newline)))) (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))) (defun err (fmt &rest args) "run FMT and ARGS through format and echo the result to the 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) (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))) ;;; Commands (defvar *lastmsg-nth* nil) (defcommand lastmsg () () "Display the last message. If the previous command was lastmsg, then continue cycling back through the message history." (if (string= *last-command* "lastmsg") (progn (incf *lastmsg-nth*) (if (>= *lastmsg-nth* (length (screen-last-msg (current-screen)))) (setf *lastmsg-nth* 0))) (setf *lastmsg-nth* 0)) (if (screen-last-msg (current-screen)) (echo-nth-last-message (current-screen) *lastmsg-nth*) (message "No last message."))) stumpwm-0.9.9/mode-line.lisp000066400000000000000000000533331242702317100160150ustar00rootroot00000000000000;; Copyright (C) 2006-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, see ;; . (in-package :stumpwm) (export '(*mode-line-background-color* *mode-line-border-color* *mode-line-border-width* *mode-line-foreground-color* *mode-line-pad-x* *mode-line-pad-y* *mode-line-position* *mode-line-timeout* *hidden-window-color* *mode-line-highlight-template* *screen-mode-line-format* *screen-mode-line-formatters* add-screen-mode-line-formatter enable-mode-line toggle-mode-line bar bar-zone-color)) (defstruct mode-line screen head window format position contents cc height factor (mode :stump)) (defun mode-line-gc (ml) (ccontext-gc (mode-line-cc ml))) (defvar *mode-line-position* :top "Specifies where the mode line is displayed. Valid values are :top and :bottom.") (defvar *mode-line-border-width* 1 "Specifies how thick the mode line's border will be. Integer value.") (defvar *mode-line-pad-x* 5 "Specifies the number of padding pixels between the text and the side of the mode line. Integer value.") (defvar *mode-line-pad-y* 1 "The number of padding pixels between the modeline text and the top/bottom of the modeline? Integer value.") (defvar *mode-line-background-color* "Gray20" "The mode line background color.") (defvar *mode-line-foreground-color* "Gray50" "The mode line foreground color.") (defvar *mode-line-border-color* "Gray30" "The mode line border color.") (defvar *hidden-window-color* "^5*" "Color command for hidden windows when using the fmt-head-window-list-hidden-windows formatter. To disable coloring hidden windows, set this to an empty string.") (defvar *mode-line-highlight-template* "^R~A^r" "The string passed to FORMAT to highlight things in the mode line.") (defvar *screen-mode-line-format* "[^B%n^b] %W" "This variable describes what will be displayed on the modeline for each screen. Turn it on with the function TOGGLE-MODE-LINE or the mode-line command. It is a list where each element may be a string, a symbol, or a list. For a symbol its value is used. For a list of the form (:eval FORM) FORM is evaluated and the result is used as a mode line element. If it is a string the string is printed with the following formatting options: @table @asis @item %h List the number of the head the mode-line belongs to @item %w List all windows in the current group windows using @var{*window-format*} @item %W List all windows on the current head of the current group using @var{*window-format*} @item %g List the groups using @var{*group-format*} @item %n The current group's name @item %u Using @var{*window-format*}, return a 1 line list of the urgent windows, space seperated. @item %v Using @var{*window-format*}, return a 1 line list of the windows, space separated. The currently focused window is highlighted with fmt-highlight. Any non-visible windows are colored the *hidden-window-color*. @item %d Using @var{*time-modeline-string*}, print the time. @end table A number of modules have been written that extends the possible formatting strings. See their documentation for details.") (defvar *screen-mode-line-formatters* '((#\h fmt-head) (#\w fmt-window-list) (#\W fmt-head-window-list) (#\g fmt-group-list) (#\n fmt-group) (#\u fmt-urgent-window-list) (#\v fmt-head-window-list-hidden-windows) (#\d fmt-modeline-time)) "An alist containing format character format function pairs for formatting screen mode-lines. functions are passed the screen's current group.") (defvar *current-mode-line-formatters* nil "used in formatting modeline strings.") (defvar *current-mode-line-formatter-args* nil "used in formatting modeline strings.") (defvar *mode-line-timeout* 60 "The modeline updates after each command, when a new window appears or an existing one disappears, and on a timer. This variable controls how many seconds elapse between each update. If this variable is changed while the modeline is visible, you must toggle the modeline to update timer.") (defvar *mode-line-timer* nil "The timer that updates the modeline") ;;; Formatters (defun add-screen-mode-line-formatter (character fmt-fun) "Add a format function to a format character (or overwrite an existing one)." (setf *screen-mode-line-formatters* (cons (list character fmt-fun) (remove character *screen-mode-line-formatters* :key #'first)))) ;; All mode-line formatters take the mode-line they are being invoked from ;; as the first argument. Additional arguments (everything between the first ;; ',' and the ';' are provided as strings [not yet implemented]). (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))) (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)) (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))) (sort-groups (group-screen (mode-line-current-group ml)))))) (defun fmt-head (ml) (format nil "~d" (head-number (mode-line-head ml)))) (defun fmt-group (ml) (format nil "~a" (group-name (mode-line-current-group ml)))) (defun fmt-highlight (s) (format nil *mode-line-highlight-template* s)) (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)) #'< :key #'window-number)))) (defun fmt-hidden (s) (format nil (concat "^[" *hidden-window-color* "~A^]") s)) (defun fmt-head-window-list-hidden-windows (ml) "Using *window-format*, return a 1 line list of the windows, space separated. The currently focused window is highlighted with fmt-highlight. Any non-visible windows are colored the *hidden-window-color*." (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)))) (sort1 all #'< :key #'window-number))))) (defun fmt-modeline-time (ml) (declare (ignore ml)) (time-format *time-modeline-string*)) (defvar *bar-med-color* "^B") (defvar *bar-hi-color* "^B^3*") (defvar *bar-crit-color* "^B^1*") (defun bar-zone-color (amount &optional (med 20) (hi 50) (crit 90) reverse) "Return a color command based on the magnitude of the argument. If the limits for the levels aren't specified, they default to sensible values for a percentage. With reverse, lower numbers are more critical." (labels ((past (n) (funcall (if reverse #'<= #'>=) amount n))) (cond ((past crit) *bar-crit-color*) ((past hi) *bar-hi-color*) ((past med) *bar-med-color*) (t "")))) (defun repeat (n char) (make-string n :initial-element char)) (defun bar (percent width full empty) "Return a progress bar string of WIDTH characters composed of characters FULL and EMPTY at PERCENT complete." (let ((chars (truncate (* (/ width 100) percent)))) (format nil "^[~A~A^]~A" (bar-zone-color percent) (repeat chars full) (repeat (- width chars) empty)))) (defvar *alt-prev-index* 0) (defvar *alt-prev-time* 0) ;; TODO: Figure out a way to objectify fmt-alternate and fmt-scroll so that ;; multiple instances can coexist. (defun alternate (strings period) "Show each of STRINGS, alternating at most once every PERIOD seconds." (let ((now (/ (get-internal-real-time) internal-time-units-per-second))) (when (>= (- now *alt-prev-time*) period) (setf *alt-prev-time* now) (if (< *alt-prev-index* (1- (length strings))) (incf *alt-prev-index*) (setf *alt-prev-index* 0)))) (elt strings *alt-prev-index*)) (defvar *scroll-prev-index* 0) (defvar *scroll-prev-time* 0) (defvar *scroll-prev-dir* :forward) (defun scroll (string width delay) "Scroll STRING within the space of WIDTH characters, with a step of DELAY" (let ((now (/ (get-internal-real-time) internal-time-units-per-second))) (when (>= (- now *scroll-prev-time*) delay) (setf *scroll-prev-time* now) (case *scroll-prev-dir* (:forward (if (< *scroll-prev-index* (- (length string) width)) (incf *scroll-prev-index*) (setf *scroll-prev-dir* :backward))) (:backward (if (> *scroll-prev-index* 0) (decf *scroll-prev-index*) (setf *scroll-prev-dir* :forward)))))) (subseq string *scroll-prev-index* (+ *scroll-prev-index* width))) (defun make-mode-line-window (parent screen) "Create a window suitable for a modeline." (xlib:create-window :parent parent :x 0 :y 0 :width 1 :height 1 :background (alloc-color screen *mode-line-background-color*) :border (alloc-color screen *mode-line-border-color*) :border-width *mode-line-border-width* ;; You can click the modeline :event-mask (xlib:make-event-mask :button-press :exposure) ;; these windows are not controlled by the window manager :override-redirect :on)) (defun resize-mode-line (ml) (when (eq (mode-line-mode ml) :stump) ;; This is a StumpWM mode-line (setf (xlib:drawable-height (mode-line-window ml)) (+ (* 2 *mode-line-pad-y*) (nth-value 1 (rendered-size (split-string (mode-line-contents ml) (string #\Newline)) (mode-line-cc ml)))))) (setf (xlib:drawable-width (mode-line-window ml)) (- (frame-width (mode-line-head ml)) (* 2 (xlib:drawable-border-width (mode-line-window ml)))) (xlib:drawable-height (mode-line-window ml)) (min (xlib:drawable-height (mode-line-window ml)) (truncate (head-height (mode-line-head ml)) 4)) (mode-line-height ml) (+ (xlib:drawable-height (mode-line-window ml)) (* 2 (xlib:drawable-border-width (mode-line-window ml)))) (mode-line-factor ml) (- 1 (/ (mode-line-height ml) (head-height (mode-line-head ml)))) (xlib:drawable-x (mode-line-window ml)) (head-x (mode-line-head ml)) (xlib:drawable-y (mode-line-window ml)) (if (eq (mode-line-position ml) :top) (head-y (mode-line-head ml)) (- (+ (head-y (mode-line-head ml)) (head-height (mode-line-head ml))) (mode-line-height ml))))) (defgeneric mode-line-format-elt (elt)) (defmethod mode-line-format-elt ((elt string)) (apply 'format-expand *current-mode-line-formatters* elt *current-mode-line-formatter-args*)) (defmethod mode-line-format-elt ((elt symbol)) (if (boundp elt) (let ((val (symbol-value elt))) ;; ignore T and nil, like emacs. (unless (or (eq val t) (eq val nil)) (mode-line-format-elt val))) (symbol-name elt))) (defmethod mode-line-format-elt ((elt null)) "") (defmethod mode-line-format-elt ((elt list)) (etypecase (first elt) ((or string list) (apply 'concatenate 'string (mapcar 'mode-line-format-elt elt))) (symbol (mode-line-format-elt (case (first elt) ;; FIXME: silently failing is probably not the best idea. (:eval (ignore-errors (eval (second elt)))) (t (and (boundp (first elt)) (symbol-value (first elt)) (second elt)))))))) (defun mode-line-format-string (ml) (mode-line-format-elt (mode-line-format ml))) (defun make-mode-line-gc (window screen) (xlib:create-gcontext :drawable window :font (when (typep (screen-font screen) 'xlib:font) (screen-font screen)) :foreground (alloc-color screen *mode-line-foreground-color*) :background (alloc-color screen *mode-line-background-color*))) (defun update-mode-line-color-context (ml) (let* ((cc (mode-line-cc ml)) (screen (mode-line-screen ml)) (bright (lookup-color screen *mode-line-foreground-color*))) (adjust-color bright 0.25) (setf (ccontext-default-bright cc) (alloc-color screen bright)))) (defun make-head-mode-line (screen head format) (let* ((w (make-mode-line-window (screen-root screen) screen)) (gc (make-mode-line-gc w screen))) (make-mode-line :window w :screen screen :head head :format format :position *mode-line-position* :cc (make-ccontext :gc gc :screen screen :font (screen-font screen) :win w :default-fg (xlib:gcontext-foreground gc) :default-bg (xlib:gcontext-background gc))))) (defun mode-line-current-group (ml) (screen-current-group (mode-line-screen ml))) (defun redraw-mode-line (ml &optional force) (when (eq (mode-line-mode ml) :stump) (let* ((*current-mode-line-formatters* *screen-mode-line-formatters*) (*current-mode-line-formatter-args* (list ml)) (string (mode-line-format-string ml))) (when (or force (not (string= (mode-line-contents ml) string))) (setf (mode-line-contents ml) string) (resize-mode-line ml) (render-strings (mode-line-screen ml) (mode-line-cc ml) *mode-line-pad-x* *mode-line-pad-y* (split-string string (string #\Newline)) '()))))) (defun find-mode-line-window (xwin) (dolist (s *screen-list*) (dolist (h (screen-heads s)) (let ((mode-line (head-mode-line h))) (when (and mode-line (eq (mode-line-window mode-line) xwin)) (return-from find-mode-line-window mode-line)))))) (defun sync-mode-line (ml) (dolist (group (screen-groups (mode-line-screen ml))) (group-sync-head group (mode-line-head ml)))) (defun set-mode-line-window (ml xwin) "Use an external window as mode-line." (run-hook-with-args *destroy-mode-line-hook* ml) (xlib:destroy-window (mode-line-window ml)) (setf (mode-line-window ml) xwin (mode-line-mode ml) :visible (xlib:window-priority (mode-line-window ml)) :above) (resize-mode-line ml) (sync-mode-line ml)) (defun destroy-mode-line-window (ml) (run-hook-with-args *destroy-mode-line-hook* ml) (xlib:destroy-window (mode-line-window ml)) (setf (head-mode-line (mode-line-head ml)) nil) (sync-mode-line ml)) (defun move-mode-line-to-head (ml head) (if (head-mode-line head) (when (mode-line-head ml) ;; head already has a mode-line. Try swapping them. (let ((old-head (mode-line-head ml))) (setf (mode-line-head ml) head (head-mode-line old-head) (head-mode-line head) (mode-line-head (head-mode-line head)) old-head (head-mode-line head) ml))) (progn (when (mode-line-head ml) (setf (head-mode-line (mode-line-head ml)) nil)) (setf (head-mode-line head) ml (mode-line-head ml) head)))) (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))))) (screen-heads (mode-line-screen ml))))) (when (or (not head) (not (eq (head-mode-line head) ml))) ;; No luck. Just try to find a head without a mode-line already. (setf head (find-if-not #'head-mode-line (screen-heads (mode-line-screen ml))))) (if head (progn (unless (eq ml (head-mode-line head)) (move-mode-line-to-head ml head)) (when (mode-line-head ml) (setf (mode-line-position ml) (if (< y (/ (head-height (mode-line-head ml)) 2)) :top :bottom)))) nil))) (defun place-mode-line-window (screen xwin) (let ((ml (make-mode-line :window xwin :screen screen :mode :visible :position *mode-line-position*))) (xlib:reparent-window xwin (screen-root screen) 0 0) (when (update-mode-line-position ml (xlib:drawable-x xwin) (xlib:drawable-y xwin)) (resize-mode-line ml) (xlib:map-window xwin) (sync-mode-line ml)))) (defun update-mode-lines (screen) "Update all mode lines on SCREEN" (dolist (h (screen-heads screen)) (let ((mode-line (head-mode-line h))) (when mode-line (redraw-mode-line mode-line))))) (defun update-all-mode-lines () "Update all mode lines." (mapc 'update-mode-lines *screen-list*)) (defun turn-on-mode-line-timer () (when (timer-p *mode-line-timer*) (cancel-timer *mode-line-timer*)) (setf *mode-line-timer* (run-with-timer *mode-line-timeout* *mode-line-timeout* 'update-all-mode-lines))) (defun all-heads () "Return all heads on all screens." (loop for s in *screen-list* nconc (copy-list (screen-heads s)))) (defun maybe-cancel-mode-line-timer () (unless (find-if 'head-mode-line (all-heads)) (when (timer-p *mode-line-timer*) (cancel-timer *mode-line-timer*) (setf *mode-line-timer* nil)))) (defun toggle-mode-line (screen head &optional (format '*screen-mode-line-format*)) "Toggle the state of the mode line for the specified screen" (check-type format (or symbol list string)) (let ((ml (head-mode-line head))) (if ml (case (mode-line-mode ml) (:visible ;; Hide it. (setf (mode-line-mode ml) :hidden) (xlib:unmap-window (mode-line-window ml))) (:hidden ;; Show it. (setf (mode-line-mode ml) :visible) (xlib:map-window (mode-line-window ml))) (:stump ;; Delete it (run-hook-with-args *destroy-mode-line-hook* ml) (xlib:destroy-window (mode-line-window ml)) (xlib:free-gcontext (mode-line-gc ml)) (setf (head-mode-line head) nil) (maybe-cancel-mode-line-timer))) (progn (setf (head-mode-line head) (make-head-mode-line screen head format)) (update-mode-line-color-context (head-mode-line head)) (resize-mode-line (head-mode-line head)) (xlib:map-window (mode-line-window (head-mode-line head))) (redraw-mode-line (head-mode-line head)) (dformat 3 "modeline: ~s~%" (head-mode-line head)) ;; setup the timer (turn-on-mode-line-timer) (run-hook-with-args *new-mode-line-hook* (head-mode-line head)))) (dolist (group (screen-groups screen)) (group-sync-head group head)))) (defun enable-mode-line (screen head state &optional format) "Set the state of SCREEN's HEAD's mode-line. If STATE is T and FORMAT is specified, then the mode-line's format is updated." (check-type screen screen) (check-type head head) (check-type format (or symbol list string)) (if state (if (head-mode-line head) (when format (setf (mode-line-format (head-mode-line head)) format)) (toggle-mode-line screen head (or format '*screen-mode-line-format*))) (when (head-mode-line head) (toggle-mode-line screen head)))) (defcommand mode-line () () "A command to toggle the mode line visibility." (toggle-mode-line (current-screen) (current-head))) stumpwm-0.9.9/module.lisp000066400000000000000000000112571242702317100154300ustar00rootroot00000000000000;; Copyright (C) 2008 Julian Stecklina, Shawn Betts, Ivy Foster ;; Copyright (C) 2014 David Bjergaard ;; ;; 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, see ;; . ;; Commentary: ;; ;; Use `set-module-dir' to set the location stumpwm searches for modules. ;; Code: (in-package #:stumpwm) (export '(load-module list-modules *load-path* *module-dir* init-load-path set-module-dir find-module add-to-load-path)) (defvar *module-dir* #.(asdf:system-relative-pathname (asdf:find-system :stumpwm) (make-pathname :directory '(:relative "contrib"))) "The location of the contrib modules on your system.") (defun build-load-path (path) "Maps subdirectories of path, returning a list of all subdirs in the path which contain any files ending in .asd" (map 'list #'directory-namestring (remove-if-not (lambda (file) (search "asd" (file-namestring file))) (list-directory-recursive path t)))) (defvar *load-path* nil "A list of paths in which modules can be found, by default it is populated by any asdf systems found in `*module-dir*' set from the configure script when StumpWM was built, or later by the user using `add-to-load-path'") (defun sync-asdf-central-registry (load-path) "Sync `LOAD-PATH' with `ASDF:*CENTRAL-REGISTRY*'" (setf asdf:*central-registry* (union load-path asdf:*central-registry*))) (defun init-load-path (path) "Recursively builds a list of paths that contain modules. This is called each time StumpWM starts with the argument `*module-dir'" (let ((load-path (build-load-path path))) (setf *load-path* load-path) ;(format t "~{~a ~%~}" *load-path*) (sync-asdf-central-registry load-path))) (defun set-module-dir (dir) "Sets the location of the for StumpWM to find modules" (when (stringp dir) (setf dir (pathname (concat dir "/")))) (setf *module-dir* dir) (init-load-path *module-dir*)) (define-stumpwm-type :module (input prompt) (or (argument-pop-rest input) (completing-read (current-screen) prompt (list-modules) :require-match t))) (defun find-asd-file (path) "Returns the first file ending with asd in `PATH', nil else." (first (remove-if-not (lambda (file) (search "asd" (file-namestring file))) (list-directory path)))) (defun list-modules () "Return a list of the available modules." (flet ((list-module (dir) (pathname-name (find-asd-file dir)))) (flatten (mapcar #'list-module *load-path*)))) (defun find-module (name) (if name (find name (list-modules) :test #'string=) nil)) (defun ensure-pathname (path) (if (stringp path) (first (directory path)) path)) (defcommand set-contrib-dir (path) ((:string "Directory: ")) "Deprecated, use `add-to-load-path' instead" (message "Use add-to-load-path instead.")) (defcommand add-to-load-path (path) ((:string "Directory: ")) "If `PATH' is not in `*LOAD-PATH*' add it, check if `PATH' contains an asdf system, and if so add it to the central registry" (let* ((pathspec (find (ensure-pathname path) *load-path*)) (in-central-registry (find pathspec asdf:*central-registry*)) (is-asdf-path (find-asd-file path))) (cond ((and pathspec in-central-registry is-asdf-path) *load-path*) ((and pathspec is-asdf-path (not in-central-registry)) (setf asdf:*central-registry* (append (list pathspec) asdf:*central-registry*))) ((and is-asdf-path (not pathspec)) (setf asdf:*central-registry* (append (list (ensure-pathname path)) asdf:*central-registry*)) (setf *load-path* (append (list (ensure-pathname path)) *load-path*))) (T *load-path*)))) (defcommand load-module (name) ((:module "Load Module: ")) "Loads the contributed module with the given NAME." (let ((module (find-module name))) (when module (asdf:operate 'asdf:load-op module)))) ;; End of file stumpwm-0.9.9/package.lisp000066400000000000000000000015411242702317100155310ustar00rootroot00000000000000;; package.lisp -- ;; 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, see ;; . (defpackage :stumpwm (:use :cl) (:shadow #:yes-or-no-p #:y-or-n-p)) (defpackage :stumpwm-user (:use :cl :stumpwm)) stumpwm-0.9.9/pathnames.lisp000066400000000000000000000126441242702317100161240ustar00rootroot00000000000000;;; -*- Mode: Lisp -*- ;;; This code is taken from CL-FAD. Original copyright notice follows: ;;; $Header: /usr/local/cvsrep/cl-fad/fad.lisp,v 1.35 2009/09/30 14:23:10 edi Exp $ ;;; Copyright (c) 2004, Peter Seibel. All rights reserved. ;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved. ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package :stumpwm) (export '(list-directory)) (defun component-present-p (value) "Helper function for DIRECTORY-PATHNAME-P which checks whether VALUE is neither NIL nor the keyword :UNSPECIFIC." (and value (not (eql value :unspecific)))) (defun directory-pathname-p (pathspec) "Returns NIL if PATHSPEC \(a pathname designator) does not designate a directory, PATHSPEC otherwise. It is irrelevant whether file or directory designated by PATHSPEC does actually exist." (and (not (component-present-p (pathname-name pathspec))) (not (component-present-p (pathname-type pathspec))) pathspec)) (defun pathname-as-directory (pathspec) "Converts the non-wild pathname designator PATHSPEC to directory form." (let ((pathname (pathname pathspec))) (when (wild-pathname-p pathname) (error "Can't reliably convert wild pathnames.")) (cond ((not (directory-pathname-p pathspec)) (make-pathname :directory (append (or (pathname-directory pathname) (list :relative)) (list (file-namestring pathname))) :name nil :type nil :defaults pathname)) (t pathname)))) (defun directory-wildcard (dirname) "Returns a wild pathname designator that designates all files within 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 "*" :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 (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")) (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 `FLATTEN-P' is non-nil, flatten the list." (let ((files (map 'list (lambda (dir) (if (directory-pathname-p dir) (list-directory-recursive dir) dir)) (list-directory dirname)))) (if flatten-p (flatten files) files))) ;;; EOF stumpwm-0.9.9/primitives.lisp000066400000000000000000001223151242702317100163340ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; This file contains primitive data structures and functions used ;; throughout stumpwm. ;; ;; Code: (in-package :stumpwm) #+ecl (require "clx") (export '(*suppress-abort-messages* *suppress-frame-indicator* *suppress-window-placement-indicator* *timeout-wait* *timeout-frame-indicator-wait* *frame-indicator-text* *frame-indicator-timer* *message-window-timer* *command-mode-start-hook* *command-mode-end-hook* *urgent-window-hook* *new-window-hook* *destroy-window-hook* *focus-window-hook* *place-window-hook* *start-hook* *quit-hook* *internal-loop-hook* *event-processing-hook* *focus-frame-hook* *new-frame-hook* *split-frame-hook* *message-hook* *top-level-error-hook* *focus-group-hook* *key-press-hook* *root-click-hook* *new-mode-line-hook* *destroy-mode-line-hook* *mode-line-click-hook* *display* *shell-program* *maxsize-border-width* *transient-border-width* *normal-border-width* *text-color* *window-events* *window-parent-events* *message-window-padding* *message-window-gravity* *editor-bindings* *input-window-gravity* *normal-gravity* *maxsize-gravity* *transient-gravity* *top-level-error-action* *window-name-source* *frame-number-map* *all-modifiers* *modifiers* *screen-list* *initializing* *processing-existing-windows* *executing-stumpwm-command* *debug-level* *debug-expose-events* *debug-stream* *window-formatters* *window-format* *group-formatters* *group-format* *list-hidden-groups* *x-selection* *last-command* *max-last-message-size* *record-last-msg-override* *suppress-echo-timeout* *run-or-raise-all-groups* *run-or-raise-all-screens* *deny-map-request* *deny-raise-request* *suppress-deny-messages* *honor-window-moves* *resize-hides-windows* *min-frame-width* *min-frame-height* *new-frame-action* *new-window-preferred-frame* *startup-message* *default-package* *window-placement-rules* *mouse-focus-policy* *root-click-focuses-frame* *banish-pointer-to* *xwin-to-window* *resize-map* *default-group-name* *window-border-style* *data-dir* add-hook clear-window-placement-rules concat data-dir-file dformat flatten define-frame-preference redirect-all-output remove-hook run-hook run-hook-with-args command-mode-start-message command-mode-end-message split-string with-restarts-menu with-data-file move-to-head format-expand)) ;;; Message Timer (defvar *suppress-abort-messages* nil "Suppress abort message when non-nil.") (defvar *timeout-wait* 5 "Specifies, in seconds, how long a message will appear for. This must be an integer.") (defvar *timeout-frame-indicator-wait* 1 "The amount of time a frame indicator timeout takes.") (defvar *frame-indicator-timer* nil "Keep track of the timer that hides the frame indicator.") (defvar *frame-indicator-text* " Current Frame " "What appears in the frame indicator window?") (defvar *suppress-frame-indicator* nil "Set this to T if you never want to see the frame indicator.") (defvar *suppress-window-placement-indicator* nil "Set to T if you never want to see messages that windows were placed according to rules.") (defvar *message-window-timer* nil "Keep track of the timer that hides the message window.") ;;; Grabbed pointer (defvar *grab-pointer-count* 0 "The number of times the pointer has been grabbed.") (defvar *grab-pointer-font* "cursor" "The font used for the grabbed pointer.") (defvar *grab-pointer-character* 64 "ID of a character used for the grabbed pointer.") (defvar *grab-pointer-character-mask* 65 "ID of a character mask used for the grabbed pointer.") (defvar *grab-pointer-foreground* (xlib:make-color :red 0.0 :green 0.0 :blue 0.0) "The foreground color of the grabbed pointer.") (defvar *grab-pointer-background* (xlib:make-color :red 1.0 :green 1.0 :blue 1.0) "The background color of the grabbed pointer.") ;;; Hooks (defvar *command-mode-start-hook* '(command-mode-start-message) "A hook called whenever command mode is started") (defvar *command-mode-end-hook* '(command-mode-end-message) "A hook called whenever command mode is ended") (defvar *urgent-window-hook* '() "A hook called whenever a window sets the property indicating that it demands the user's attention") (defvar *map-window-hook* '() "A hook called whenever a window is mapped.") (defvar *unmap-window-hook* '() "A hook called whenever a window is withdrawn.") (defvar *new-window-hook* '() "A hook called whenever a window is added to the window list. This includes a genuinely new window as well as bringing a withdrawn window back into the window list.") (defvar *destroy-window-hook* '() "A hook called whenever a window is destroyed or withdrawn.") (defvar *focus-window-hook* '() "A hook called when a window is given focus. It is called with 2 arguments: the current window and the last window (could be nil).") (defvar *place-window-hook* '() "A hook called whenever a window is placed by rule. Arguments are window group and frame") (defvar *start-hook* '() "A hook called when stumpwm starts.") (defvar *quit-hook* '() "A hook called when stumpwm quits.") (defvar *internal-loop-hook* '() "A hook called inside stumpwm's inner loop.") (defvar *event-processing-hook* '() "A hook called inside stumpwm's inner loop, before the default event processing takes place. This hook is run inside (with-event-queue ...).") (defvar *focus-frame-hook* '() "A hook called when a frame is given focus. The hook functions are called with 2 arguments: the current frame and the last frame.") (defvar *new-frame-hook* '() "A hook called when a new frame is created. the hook is called with the frame as an argument.") (defvar *split-frame-hook* '() "A hook called when a frame is split. the hook is called with the old frame (window is removed), and two new frames as arguments.") (defvar *message-hook* '() "A hook called whenever stumpwm displays a message. The hook function is passed any number of arguments. Each argument is a line of text.") (defvar *top-level-error-hook* '() "Called when a top level error occurs. Note that this hook is run before the error is dealt with according to *top-level-error-action*.") (defvar *focus-group-hook* '() "A hook called whenever stumpwm switches groups. It is called with 2 arguments: the current group and the last group.") (defvar *key-press-hook* '() "A hook called whenever a key under *top-map* is pressed. It is called with 3 argument: the key, the (possibly incomplete) key sequence it is a part of, and command value bound to the key.") (defvar *root-click-hook* '() "A hook called whenever there is a mouse click on the root window. Called with 4 arguments, the screen containing the root window, the button clicked, and the x and y of the pointer.") (defvar *new-mode-line-hook* '() "Called whenever the mode-line is created. It is called with argument, the mode-line") (defvar *destroy-mode-line-hook* '() "Called whenever the mode-line is destroyed. It is called with argument, the mode-line") (defvar *mode-line-click-hook* '() "Called whenever the mode-line is clicked. It is called with 4 arguments, the mode-line, the button clicked, and the x and y of the pointer.") ;; Data types and globals used by stumpwm (defvar *display* nil "The display for the X server") (defvar *shell-program* "/bin/sh" "The shell program used by @code{run-shell-command}.") (defvar *maxsize-border-width* 1 "The width in pixels given to the borders of windows with maxsize or ratio hints.") (defvar *transient-border-width* 1 "The width in pixels given to the borders of transient or pop-up windows.") (defvar *normal-border-width* 1 "The width in pixels given to the borders of regular windows.") (defvar *text-color* "white" "The color of message text.") (defvar *menu-maximum-height* nil "Defines the maxium number of lines to display in the menu before enabling scrolling. If NIL scrolling is disabled.") (defvar *menu-scrolling-step* 1 "Number of lines to scroll when hitting the menu list limit.") (defparameter +netwm-supported+ '(:_NET_SUPPORTING_WM_CHECK :_NET_NUMBER_OF_DESKTOPS :_NET_DESKTOP_GEOMETRY :_NET_DESKTOP_VIEWPORT :_NET_CURRENT_DESKTOP :_NET_WM_WINDOW_TYPE :_NET_WM_STATE :_NET_WM_STATE_MODAL :_NET_WM_ALLOWED_ACTIONS :_NET_WM_STATE_FULLSCREEN :_NET_WM_STATE_HIDDEN :_NET_WM_STATE_DEMANDS_ATTENTION :_NET_WM_FULL_WINDOW_PLACEMENT :_NET_CLOSE_WINDOW :_NET_CLIENT_LIST :_NET_CLIENT_LIST_STACKING :_NET_ACTIVE_WINDOW :_NET_WM_DESKTOP :_KDE_NET_SYSTEM_TRAY_WINDOW_FOR) "Supported NETWM properties. Window types are in +WINDOW-TYPES+.") (defparameter +netwm-allowed-actions+ '(:_NET_WM_ACTION_CHANGE_DESKTOP :_NET_WM_ACTION_FULLSCREEN :_NET_WM_ACTION_CLOSE) "Allowed NETWM actions for managed windows") (defparameter +netwm-window-types+ '( ;; (:_NET_WM_WINDOW_TYPE_DESKTOP . :desktop) (:_NET_WM_WINDOW_TYPE_DOCK . :dock) ;; (:_NET_WM_WINDOW_TYPE_TOOLBAR . :toolbar) ;; (:_NET_WM_WINDOW_TYPE_MENU . :menu) ;; (:_NET_WM_WINDOW_TYPE_UTILITY . :utility) ;; (:_NET_WM_WINDOW_TYPE_SPLASH . :splash) (:_NET_WM_WINDOW_TYPE_DIALOG . :dialog) (:_NET_WM_WINDOW_TYPE_NORMAL . :normal)) "Alist mapping NETWM window types to keywords. Include only those we are ready to support.") ;; Window states (defconstant +withdrawn-state+ 0) (defconstant +normal-state+ 1) (defconstant +iconic-state+ 3) (defvar *window-events* '(:structure-notify :property-change :colormap-change :focus-change :enter-window) "The events to listen for on managed windows.") (defvar *window-parent-events* '(:substructure-notify :substructure-redirect) "The events to listen for on managed windows' parents.") ;; Message window variables (defvar *message-window-padding* 5 "The number of pixels that pad the text in the message window.") (defvar *message-window-gravity* :top-right "This variable controls where the message window appears. The follow are valid values. @table @asis @item :top-left @item :top-right @item :bottom-left @item :bottom-right @item :center @item :top @item :left @item :right @item :bottom @end table") ;; line editor (defvar *editor-bindings* nil "A list of key-bindings for line editing.") (defvar *input-window-gravity* :top-right "This variable controls where the input window appears. The follow are valid values. @table @asis @item :top-left @item :top-right @item :bottom-left @item :bottom-right @item :center @item :top @item :left @item :right @item :bottom @end table") ;; default values. use the set-* functions to these attributes (defparameter +default-foreground-color+ "White") (defparameter +default-background-color+ "Black") (defparameter +default-window-background-color+ "Black") (defparameter +default-border-color+ "White") (defparameter +default-font-name+ "9x15bold") (defparameter +default-focus-color+ "White") (defparameter +default-unfocus-color+ "Black") (defparameter +default-float-focus-color+ "Orange") (defparameter +default-float-unfocus-color+ "SteelBlue4") (defparameter +default-frame-outline-width+ 2) ;; Don't set these variables directly, use set- instead (defvar *normal-gravity* :center) (defvar *maxsize-gravity* :center) (defvar *transient-gravity* :center) (defvar *top-level-error-action* :abort "If an error is encountered at the top level, in STUMPWM-INTERNAL-LOOP, then this variable decides what action shall be taken. By default it will print a message to the screen and to *standard-output*. Valid values are :message, :break, :abort. :break will break to the debugger. This can be problematic because if the user hit's a mapped key the ENTIRE keyboard will be frozen and you will have to login remotely to regain control. :abort quits stumpmwm.") (defvar *window-name-source* :title "This variable controls what is used for the window's name. The default is @code{:title}. @table @code @item :title Use the window's title given to it by its owner. @item :class Use the window's resource class. @item :resource-name Use the window's resource name. @end table") (defstruct frame (number nil :type integer) x y width height window) (defstruct (head (:include frame)) ;; point back to the screen this head belongs to screen ;; a bar along the top or bottom that displays anything you want. mode-line) (defclass screen () ((id :initform nil :accessor screen-id) (host :initform nil :accessor screen-host) (number :initform nil :accessor screen-number) (heads :initform nil :accessor screen-heads :documentation "heads of screen") (groups :initform nil :accessor screen-groups :documentation "the list of groups available on this screen") (current-group :initform nil :accessor screen-current-group) ;; various colors (as returned by alloc-color) (border-color :initform nil :accessor screen-border-color) (fg-color :initform nil :accessor screen-fg-color) (bg-color :initform nil :accessor screen-bg-color) (win-bg-color :initform nil :accessor screen-win-bg-color) (focus-color :initform nil :accessor screen-focus-color) (unfocus-color :initform nil :accessor screen-unfocus-color) (float-focus-color :initform nil :accessor screen-float-focus-color) (float-unfocus-color :initform nil :accessor screen-float-unfocus-color) (msg-border-width :initform nil :accessor screen-msg-border-width) (frame-outline-width :initform nil :accessor screen-frame-outline-width) (fonts :initform '(nil) :accessor screen-fonts) (mapped-windows :initform nil :accessor screen-mapped-windows :documentation "A list of all mapped windows. These are the raw xlib:window's. window structures are stored in groups.") (withdrawn-windows :initform nil :accessor screen-withdrawn-windows :documentation "A list of withdrawn windows. These are of type stumpwm::window and when they're mapped again they'll be put back in the group they were in when they were unmapped unless that group doesn't exist, in which case they go into the current group.") (urgent-windows :initform nil :accessor screen-urgent-windows :documentation "a list of windows for which (window-urgent-p) currently true.") (input-window :initform nil :accessor screen-input-window) (key-window :initform nil :accessor screen-key-window :documentation "the window that accepts further keypresses after a toplevel key has been pressed.") (focus-window :initform nil :accessor screen-focus-window :documentation "The window that gets focus when no window has focus") ;; (frame-window :initform nil :accessor screen-frame-window) (frame-outline-gc :initform nil :accessor screen-frame-outline-gc) ;; color contexts (message-cc :initform nil :accessor screen-message-cc) (mode-line-cc :initform nil :accessor screen-mode-line-cc) ;; color maps (color-map-normal :initform nil :accessor screen-color-map-normal) (color-map-bright :initform nil :accessor screen-color-map-bright) (ignore-msg-expose :initform nil :accessor screen-ignore-msg-expose :documentation "used to ignore the first expose even when mapping the message window.") ;; the window that has focus (focus :initform nil :accessor screen-focus) (current-msg :initform nil :accessor screen-current-msg) (current-msg-highlights :initform nil :accessor screen-current-msg-highlights) (last-msg :initform nil :accessor screen-last-msg) (last-msg-highlights :initform nil :accessor screen-last-msg-highlights))) (defstruct ccontext screen win px gc default-fg default-bright default-bg fg bg brightp reversep color-stack font) (defun screen-message-window (screen) (ccontext-win (screen-message-cc screen))) (defun screen-message-pixmap (screen) (ccontext-px (screen-message-cc screen))) (defun screen-message-gc (screen) (ccontext-gc (screen-message-cc screen))) (defun screen-font (screen) (first (screen-fonts screen))) (defmethod print-object ((object frame) stream) (format stream "#S(frame ~d ~a ~d ~d ~d ~d)" (frame-number object) (frame-window object) (frame-x object) (frame-y object) (frame-width object) (frame-height object))) (defvar *window-number-map* "0123456789" "Set this to a string to remap the window numbers to something more convenient.") (defvar *group-number-map* "1234567890" "Set this to a string to remap the group numbers to something more convenient.") (defvar *frame-number-map* "0123456789abcdefghijklmnopqrstuvxwyz" "Set this to a string to remap the frame numbers to more convenient keys. For instance, \"hutenosa\" would map frame 0 to 7 to be selectable by hitting the appropriate homerow key on a dvorak keyboard. Currently, only single char keys are supported. By default, the frame labels are the 36 (lower-case) alphanumeric characters, starting with numbers 0-9.") (defun get-frame-number-translation (frame) "Given a frame return its number translation using *frame-number-map* as a char." (let ((num (frame-number frame))) (or (and (< num (length *frame-number-map*)) (char *frame-number-map* num)) ;; translate the frame number to a char. FIXME: it loops after 9 (char (prin1-to-string num) 0)))) (defstruct modifiers (meta nil) (alt nil) (hyper nil) (super nil) (altgr nil) (numlock nil)) (defvar *all-modifiers* nil "A list of all keycodes that are considered modifiers") (defvar *modifiers* nil "A mapping from modifier type to x11 modifier.") (defmethod print-object ((object screen) stream) (format stream "#S" (screen-number object))) (defvar *screen-list* '() "The list of screens managed by stumpwm.") (defvar *initializing* nil "True when starting stumpwm. Use this variable in your rc file to run code that should only be executed once, when stumpwm starts up and loads the rc file.") (defvar *processing-existing-windows* nil "True when processing pre-existing windows at startup.") (defvar *executing-stumpwm-command* nil "True when executing external commands.") (defvar *interactivep* nil "True when a defcommand is executed from colon or a keybinding") ;;; The restarts menu macro (defmacro with-restarts-menu (&body body) "Execute BODY. If an error occurs allow the user to pick a restart from a menu of possible restarts. If a restart is not chosen, resignal the error." (let ((c (gensym))) `(handler-bind ((warning #'muffle-warning) ((or serious-condition error) (lambda (,c) (restarts-menu ,c) (signal ,c)))) ,@body))) ;;; Hook functionality (defun run-hook-with-args (hook &rest args) "Call each function in HOOK and pass args to it." (handler-case (with-simple-restart (abort-hooks "Abort running the remaining hooks.") (with-restarts-menu (dolist (fn hook) (with-simple-restart (continue-hooks "Continue running the remaining hooks.") (apply fn args))))) (t (c) (message "^B^1*Error on hook ^b~S^B!~% ^n~A" hook c) (values nil c)))) (defun run-hook (hook) "Call each function in HOOK." (run-hook-with-args hook)) (defmacro add-hook (hook fn) "Add @var{function} to the hook @var{hook-variable}. For example, to display a message whenever you switch frames: @example \(defun my-rad-fn (to-frame from-frame) (stumpwm:message \"Mustard!\")) \(stumpmwm:add-hook stumpwm:*focus-frame-hook* 'my-rad-fn) @end example" `(setf ,hook (adjoin ,fn ,hook))) (defmacro remove-hook (hook fn) "Remove the specified function from the hook." `(setf ,hook (remove ,fn ,hook))) ;; Misc. utility functions (defun conc1 (list arg) "Append arg to the end of list" (nconc list (list arg))) (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))) (defun mapcar-hash (fn hash) "Just like maphash except it accumulates the result in a list." (let ((accum nil)) (labels ((mapfn (key val) (push (funcall fn key val) accum))) (maphash #'mapfn hash)) accum)) (defun find-free-number (l &optional (min 0) dir) "Return a number that is not in the list l. If dir is :negative then 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)) l) dirfn)) (max (car (last nums))) (inc (if (eq dir :negative) -1 1)) (new-num (loop for n = min then (+ n inc) for i in nums when (/= n i) do (return n)))) (dformat 3 "Free number: ~S~%" nums) (if new-num new-num ;; there was no space between the numbers, so use the max+inc (if max (+ inc max) min)))) (defun remove-plist (plist &rest keys) "Remove the keys from the plist. Useful for re-using the &REST arg after removing some options." (do (copy rest) ((null (setq rest (nth-value 2 (get-properties plist keys)))) (nreconc copy plist)) (do () ((eq plist rest)) (push (pop plist) copy) (push (pop plist) copy)) (setq plist (cddr plist)))) (defun screen-display-string (screen &optional (assign t)) (format nil (if assign "DISPLAY=~a:~d.~d" "~a:~d.~d") (screen-host screen) (xlib:display-display *display*) (screen-id screen))) (defun split-seq (seq separators &key test default-value) "split a sequence into sub sequences given the list of seperators." (let ((seps separators)) (labels ((sep (c) (find c seps :test test))) (or (loop for i = (position-if (complement #'sep) seq) then (position-if (complement #'sep) seq :start j) as j = (position-if #'sep seq :start (or i 0)) while i collect (subseq seq i j) while j) ;; the empty seq causes the above to return NIL, so help ;; it out a little. default-value)))) (defun split-string (string &optional (separators " ")) "Splits STRING into substrings where there are matches for SEPARATORS. Each match for SEPARATORS is a splitting point. The substrings between the splitting points are made into a list which is returned. ***If SEPARATORS is absent, it defaults to \"[ \f\t\n\r\v]+\". If there is match for SEPARATORS at the beginning of STRING, we do not include a null substring for that. Likewise, if there is a match at the end of STRING, we don't include a null substring for that. Modifies the match data; use `save-match-data' if necessary." (split-seq string separators :test #'char= :default-value '(""))) (defun insert-before (list item nth) "Insert ITEM before the NTH element of LIST." (declare (type (integer 0 *) nth)) (let* ((nth (min nth (length list))) (pre (subseq list 0 nth)) (post (subseq list nth))) (nconc pre (list item) post))) (defvar *debug-level* 0 "Set this variable to a number > 0 to turn on debugging. The greater the number the more debugging output.") (defvar *debug-expose-events* nil "Set this variable for a visual indication of expose events on internal StumpWM windows.") (defvar *debug-stream* *error-output* "This is the stream debugging output is sent to. It defaults to *error-output*. It may be more convenient for you to pipe debugging output directly to a file.") (defun dformat (level fmt &rest args) (when (>= *debug-level* level) (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)) *debug-stream*) (force-output *debug-stream*))) (defvar *redirect-stream* nil "This variable Keeps track of the stream all output is sent to when `redirect-all-output' is called so if it changes we can close it before reopening.") (defun redirect-all-output (file) "Elect to redirect all output to the specified file. For instance, if you want everything to go to ~/.stumpwm.d/debug-output.txt you would do: @example (redirect-all-output (data-dir-file \"debug-output\" \"txt\")) @end example " (when (typep *redirect-stream* 'file-stream) (close *redirect-stream*)) (setf *redirect-stream* (open file :direction :output :if-exists :append :if-does-not-exist :create) *error-output* *redirect-stream* *standard-output* *redirect-stream* *trace-output* *redirect-stream* *debug-stream* *redirect-stream*)) ;;; ;;; formatting routines (defun format-expand (fmt-alist fmt &rest args) (let* ((chars (coerce fmt 'list)) (output "") (cur chars)) ;; FIXME: this is horribly inneficient (loop (cond ((null cur) (return-from format-expand output)) ;; if % is the last char in the string then it's a literal. ((and (char= (car cur) #\%) (cdr cur)) (setf cur (cdr cur)) (let* ((tmp (loop while (and cur (char<= #\0 (car cur) #\9)) collect (pop cur))) (len (and tmp (parse-integer (coerce tmp 'string)))) ;; So that eg "%25^t" will trim from the left (from-left-p (when (char= #\^ (car cur)) (pop cur)))) (if (null cur) (format t "%~a~@[~a~]" len from-left-p) (let* ((fmt (cadr (assoc (car cur) fmt-alist :test 'char=))) (str (cond (fmt ;; it can return any type, not jut as string. (format nil "~a" (apply fmt args))) ((char= (car cur) #\%) (string #\%)) (t (concatenate 'string (string #\%) (string (car cur))))))) ;; crop string if needed (setf output (concatenate 'string output (cond ((null len) str) ((not from-left-p) ; Default behavior (subseq str 0 (min len (length str)))) ;; New behavior -- trim from the left (t (subseq str (max 0 (- (length str) len))))))) (setf cur (cdr cur)))))) (t (setf output (concatenate 'string output (string (car cur))) cur (cdr cur))))))) (defvar *window-formatters* '((#\n window-map-number) (#\s fmt-window-status) (#\t window-name) (#\c window-class) (#\i window-res) (#\r window-role) (#\m fmt-window-marked) (#\h window-height) (#\w window-width) (#\g gravity-for-window)) "an alist containing format character format function pairs for formatting window lists.") (defvar *window-format* "%m%n%s%50t" "This variable decides how the window list is formatted. It is a string with the following formatting options: @table @asis @item %n Substitutes the windows number translated via *window-number-map*, if there are more windows than *window-number-map* then will use the window-number. @item %s Substitute the window's status. * means current window, + means last window, and - means any other window. @item %t Substitute the window's name. @item %c Substitute the window's class. @item %i Substitute the window's resource ID. @item %m Draw a # if the window is marked. @end table Note, a prefix number can be used to crop the argument to a specified size. For instance, @samp{%20t} crops the window's title to 20 characters.") (defvar *window-info-format* "%wx%h %n (%t)" "The format used in the info command. @xref{*window-format*} for formatting details.") (defvar *group-formatters* '((#\n group-map-number) (#\s fmt-group-status) (#\t group-name)) "An alist of characters and formatter functions. The character can be used as a format character in @var{*group-format*}. When the character is encountered in the string, the corresponding function is called with a group as an argument. The functions return value is inserted into the string. If the return value isn't a string it is converted to one using @code{prin1-to-string}.") (defvar *group-format* "%n%s%t" "The format string that decides what information will show up in the group listing. The following format options are available: @table @asis @item %n Substitutes the group number translated via *group-number-map*, if there are more windows than *group-number-map* then will use the group-number. @item %s The group's status. Similar to a window's status. @item %t The group's name. @end table") (defvar *list-hidden-groups* nil "Controls whether hidden groups are displayed by 'groups' and 'vgroups' commands") ;; (defun font-height (font) ;; (+ (font-descent font) ;; (font-ascent font))) (defvar *x-selection* nil "This is a plist of stumpwm's current selections. The different properties are generally set when killing text in the input bar.") (defvar *last-command* nil "Set to the last interactive command run.") (defvar *max-last-message-size* 20 "how many previous messages to keep.") (defvar *record-last-msg-override* nil "assign this to T and messages won't be recorded. It is recommended this is assigned using LET.") (defvar *suppress-echo-timeout* nil "Assign this T and messages will not time out. It is recommended this is assigned using LET.") (defvar *ignore-echo-timeout* nil "Assign this T and the message time out won't be touched. It is recommended this is assigned using LET.") (defvar *run-or-raise-all-groups* t "When this is @code{T} the @code{run-or-raise} function searches all groups for a running instance. Set it to NIL to search only the current group.") (defvar *run-or-raise-all-screens* nil "When this is @code{T} the @code{run-or-raise} function searches all screens for a running instance. Set it to @code{NIL} to search only the current screen. If @var{*run-or-raise-all-groups*} is @code{NIL} this variable has no effect.") (defvar *deny-map-request* nil "A list of window properties that stumpwm should deny matching windows' requests to become mapped for the first time.") (defvar *deny-raise-request* nil "Exactly the same as @var{*deny-map-request*} but for raise requests. Note that no denial message is displayed if the window is already visible.") (defvar *suppress-deny-messages* nil "For complete focus on the task at hand, set this to @code{T} and no raise/map denial messages will be seen.") (defvar *honor-window-moves* t "Allow windows to move between frames.") (defvar *resize-hides-windows* nil "Set to T to hide windows during interactive resize") (defun deny-request-p (window deny-list) (or (eq deny-list t) (and (listp deny-list) (find-if (lambda (props) (apply 'window-matches-properties-p window props)) deny-list) t))) (defun flatten (list) "Flatten LIST" (labels ( (mklist (x) (if (listp x) x (list x))) ) (mapcan #'(lambda (x) (if (atom x) (mklist x) (flatten x))) list))) (defun list-splice-replace (item list &rest replacements) "splice REPLACEMENTS into LIST where ITEM is, removing ITEM. Return the new list." (let ((p (position item list))) (if p (nconc (subseq list 0 p) replacements (subseq list (1+ p))) list))) (defvar *min-frame-width* 50 "The minimum width a frame can be. A frame will not shrink below this width. Splitting will not affect frames if the new frame widths are less than this value.") (defvar *min-frame-height* 50 "The minimum height a frame can be. A frame will not shrink below this height. Splitting will not affect frames if the new frame heights are less than this value.") (defvar *new-frame-action* :last-window "When a new frame is created, this variable controls what is put in the new frame. Valid values are @table @code @item :empty The frame is left empty @item :last-window The last focused window that is not currently visible is placed in the frame. This is the default. @end table") (defvar *new-window-preferred-frame* '(:focused) "This variable controls what frame a new window appears in. It is a list of preferences. The first preference that is satisfied is used. Valid list elements are as follows: @table @code @item :focused Choose the focused frame. @item :last Choose the last focused frame. @item :empty Choose any empty frame. @item :unfocused Choose any unfocused frame. @end table Alternatively, it can be set to a function that takes one argument, the new window, and returns the preferred frame or a list of the above preferences.") (defun backtrace-string () "Similar to print-backtrace, but return the backtrace as a string." (with-output-to-string (*standard-output*) (print-backtrace))) (defvar *startup-message* "^2*Welcome to The ^BStump^b ^BW^bindow ^BM^banager! Press ^5*~a ?^2* for help." "This is the message StumpWM displays when it starts. Set it to NIL to suppress.") (defvar *default-package* (find-package '#:stumpwm-user) "This is the package eval reads and executes in. You might want to set this to @code{:stumpwm} if you find yourself using a lot of internal stumpwm symbols. Setting this variable anywhere but in your rc file will have no effect.") (defun concat (&rest strings) (apply 'concatenate 'string strings)) (defvar *window-placement-rules* '() "List of rules governing window placement. Use define-frame-preference to add rules") (defmacro define-frame-preference (target-group &rest frame-rules) "Create a rule that matches windows and automatically places them in a specified group and frame. Each frame rule is a lambda list: @example \(frame-number raise lock &key create restore dump-name class instance type role title) @end example @table @var @item frame-number The frame number to send matching windows to @item raise When non-nil, raise and focus the window in its frame @item lock When this is nil, this rule will only match when the current group matches @var{target-group}. When non-nil, this rule matches regardless of the group and the window is sent to @var{target-group}. If @var{lock} and @var{raise} are both non-nil, then stumpwm will jump to the specified group and focus the matched window. @item create When non-NIL the group is created and eventually restored when the value of create is a group dump filename in *DATA-DIR*. Defaults to NIL. @item restore When non-NIL the group is restored even if it already exists. This arg should be set to the dump filename to use for forced restore. Defaults to NIL @item class The window's class must match @var{class}. @item instance The window's instance/resource name must match @var{instance}. @item type The window's type must match @var{type}. @item role The window's role must match @var{role}. @item title The window's title must match @var{title}. @end table" (let ((x (gensym "X"))) `(dolist (,x ',frame-rules) ;; verify the correct structure (destructuring-bind (frame-number raise lock &rest keys &key create restore class instance type role title) ,x (declare (ignore create restore class instance type role title)) (push (list* ,target-group frame-number raise lock keys) *window-placement-rules*))))) (defun clear-window-placement-rules () "Clear all window placement rules." (setf *window-placement-rules* nil)) (defvar *mouse-focus-policy* :ignore "The mouse focus policy decides how the mouse affects input focus. Possible values are :ignore, :sloppy, and :click. :ignore means stumpwm ignores the mouse. :sloppy means input focus follows the mouse; the window that the mouse is in gets the focus. :click means input focus is transfered to the window you click on.") (defvar *root-click-focuses-frame* t "Set to NIL if you don't want clicking the root window to focus the frame containing the pointer.") (defvar *banish-pointer-to* :head "Where to put the pointer when no argument is given to (banish-pointer) or the banish command. May be one of :screen :head :frame or :window") (defvar *xwin-to-window* (make-hash-table) "Hash table for looking up windows quickly.") (defvar *resize-map* nil "The keymap used for resizing a window") (defvar *default-group-name* "Default" "The name of the default group.") (defmacro with-focus (xwin &body body) "Set the focus to xwin, do body, then restore focus" `(progn (grab-keyboard ,xwin) (unwind-protect (progn ,@body) (ungrab-keyboard)))) (defvar *last-unhandled-error* nil "If an unrecoverable error occurs, this variable will contain the condition and the backtrace.") (defvar *show-command-backtrace* nil "When this is T a backtrace is displayed with errors that occurred within an interactive call to a command.") (defvar *window-border-style* :thick "This controls the appearance of the border around windows. valid values are: @table @var @item :thick All space within the frame not used by the window is dedicated to the border. @item :thin Only the border width as controlled by *maxsize-border-width* *normal-border-width* and *transient-border-width* is used as the border. The rest is filled with the unfocus color. @item :tight The same as :thin but the border surrounds the window and the wasted space within the frame is not obscured, revealing the background. @item :none Like :tight but no border is ever visible. @end table After changing this variable you may need to call sync-all-frame-windows to see the change.") (defvar *data-dir* nil "The directory used by stumpwm to store data between sessions.") (defun data-dir-file (name &optional type) "Return a pathname inside stumpwm's data dir with the specified name and type" (ensure-directories-exist *data-dir*) (make-pathname :name name :type type :defaults *data-dir*)) (defmacro with-data-file ((s file &rest keys &key (if-exists :supersede) &allow-other-keys) &body body) "Open a file in StumpWM's data directory. keyword arguments are sent directly to OPEN. Note that IF-EXISTS defaults to :supersede, instead of :error." (declare (ignorable if-exists)) `(progn (ensure-directories-exist *data-dir*) (with-open-file (,s ,(merge-pathnames file *data-dir*) ,@keys) ,@body))) (defmacro move-to-head (list elt) "Move the specified element in in LIST to the head of the list." `(progn (setf ,list (remove ,elt ,list)) (push ,elt ,list))) (define-condition stumpwm-error (error) () (:documentation "Any stumpwm specific error should inherit this.")) (defun intern1 (thing &optional (package *package*) (rt *readtable*)) "A DWIM intern." (intern (ecase (readtable-case rt) (:upcase (string-upcase thing)) (:downcase (string-downcase thing)) ;; Prooobably this is what they want? It could make sense to ;; upcase them as well. (:preserve thing) (:invert (string-downcase thing))) package)) (defun command-mode-start-message () (message "Press C-g to exit command-mode.")) (defun command-mode-end-message () (message "Exited command-mode.")) stumpwm-0.9.9/sample-stumpwmrc.lisp000066400000000000000000000050301242702317100174530ustar00rootroot00000000000000;; -*-lisp-*- ;; ;; Here is a sample .stumpwmrc file (in-package :stumpwm) ;; change the prefix key to something else (set-prefix-key (kbd "C-z")) ;; prompt the user for an interactive command. The first arg is an ;; optional initial contents. (defcommand colon1 (&optional (initial "")) (:rest) (let ((cmd (read-one-line (current-screen) ": " :initial-input initial))) (when cmd (eval-command cmd t)))) ;; Read some doc (define-key *root-map* (kbd "d") "exec gv") ;; Browse somewhere (define-key *root-map* (kbd "b") "colon1 exec firefox http://www.") ;; Ssh somewhere (define-key *root-map* (kbd "C-s") "colon1 exec xterm -e ssh ") ;; Lock screen (define-key *root-map* (kbd "C-l") "exec xlock") ;; Web jump (works for Google and Imdb) (defmacro make-web-jump (name prefix) `(defcommand ,name (search) ((:rest ,(concatenate 'string name " search: "))) (substitute #\+ #\Space search) (run-shell-command (concatenate 'string ,prefix search)))) (make-web-jump "google" "firefox http://www.google.fr/search?q=") (make-web-jump "imdb" "firefox http://www.imdb.com/find?q=") ;; C-t M-s is a terrble binding, but you get the idea. (define-key *root-map* (kbd "M-s") "google") (define-key *root-map* (kbd "i") "imdb") ;; Message window font (set-font "-xos4-terminus-medium-r-normal--14-140-72-72-c-80-iso8859-15") ;;; Define window placement policy... ;; Clear rules (clear-window-placement-rules) ;; Last rule to match takes precedence! ;; TIP: if the argument to :title or :role begins with an ellipsis, a substring ;; match is performed. ;; TIP: if the :create flag is set then a missing group will be created and ;; restored from *data-dir*/create file. ;; TIP: if the :restore flag is set then group dump is restored even for an ;; existing group using *data-dir*/restore file. (define-frame-preference "Default" ;; frame raise lock (lock AND raise == jumpto) (0 t nil :class "Konqueror" :role "...konqueror-mainwindow") (1 t nil :class "XTerm")) (define-frame-preference "Ardour" (0 t t :instance "ardour_editor" :type :normal) (0 t t :title "Ardour - Session Control") (0 nil nil :class "XTerm") (1 t nil :type :normal) (1 t t :instance "ardour_mixer") (2 t t :instance "jvmetro") (1 t t :instance "qjackctl") (3 t t :instance "qjackctl" :role "qjackctlMainForm")) (define-frame-preference "Shareland" (0 t nil :class "XTerm") (1 nil t :class "aMule")) (define-frame-preference "Emacs" (1 t t :restore "emacs-editing-dump" :title "...xdvi") (0 t t :create "emacs-dump" :class "Emacs"))stumpwm-0.9.9/screen.lisp000066400000000000000000000517501242702317100154240ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Screen functionality ;; ;; Code: (in-package #:stumpwm) (export '(current-screen current-window screen-current-window screen-number screen-groups screen-windows screen-height screen-width set-fg-color set-bg-color set-border-color set-win-bg-color set-focus-color set-unfocus-color set-float-focus-color set-float-unfocus-color set-msg-border-width set-frame-outline-width set-font)) ;; Screen helper functions (defun translate-id (src src-start src-end font dst dst-start) "A simple replacement for xlib:translate-default. just the identity with a range check." (let ((min (xlib:font-min-char font)) (max (xlib:font-max-char font))) (decf src-end) (if (stringp src) ; clx does this test so i guess it's needed (loop for i from src-start to src-end for j from dst-start as c = (char-code (char src i)) if (<= min c max) do (setf (aref dst j) c) ;; replace unknown characters with question marks else do (setf (aref dst j) (char-code #\?)) finally (return i)) (loop for i from src-start to src-end for j from dst-start as c = (elt src i) as n = (if (characterp c) (char-code c) c) if (and (integerp n) (<= min n max)) do (setf (aref dst j) n) ;; ditto else do (setf (aref dst j) (char-code #\?)) finally (return i))))) (defun screen-x (screen) (declare (ignore screen)) 0) (defun screen-y (screen) (declare (ignore screen)) 0) (defun screen-height (screen) (let ((root (screen-root screen))) (xlib:drawable-height root))) (defun screen-true-height (screen) "Return the height of the screen regardless of the modeline" (let ((root (screen-root screen))) (xlib:drawable-height root))) (defun screen-width (screen) (let ((root (screen-root screen))) (xlib:drawable-width root))) (defun find-screen (root) "Return the screen containing the root window." (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))) (defun netwm-update-client-list-stacking (screen) (unless *initializing* (xlib:change-property (screen-root screen) :_NET_CLIENT_LIST_STACKING ;; Order is bottom to top. (reverse (mapcar 'window-xwin (all-windows))) :window 32 :transform #'xlib:drawable-id :mode :replace))) (defun netwm-update-client-list (screen) (xlib:change-property (screen-root screen) :_NET_CLIENT_LIST (screen-mapped-windows screen) :window 32 :transform #'xlib:drawable-id :mode :replace) (netwm-update-client-list-stacking screen)) (defun screen-add-mapped-window (screen xwin) (push xwin (screen-mapped-windows screen)) (netwm-update-client-list screen)) (defun screen-remove-mapped-window (screen xwin) (unregister-window xwin) (setf (screen-mapped-windows screen) (remove xwin (screen-mapped-windows screen))) (netwm-update-client-list screen)) (defun sort-screens () "Return the list of screen sorted by ID." (sort1 *screen-list* '< :key 'screen-id)) (defun next-screen (&optional (list (sort-screens))) (let ((matches (member (current-screen) list))) (if (null (cdr matches)) ;; If the last one in the list is current, then ;; use the first one. (car list) ;; Otherwise, use the next one in the list. (cadr matches)))) (defun move-screen-to-head (screen) (move-to-head *screen-list* screen)) (defun switch-to-screen (screen) (when (and screen (not (eq screen (current-screen)))) (if (screen-focus screen) (xlib:set-input-focus *display* (window-xwin (screen-focus screen)) :POINTER-ROOT) (xlib:set-input-focus *display* (screen-focus-window screen) :POINTER-ROOT)) (move-screen-to-head screen))) (defun screen-set-focus (screen window) (when (eq (window-group window) (screen-current-group screen)) ;;(format t "FOCUS TO: ~a ~a~%" window (window-xwin window)) ;;(format t "FOCUS BEFORE: ~a~%" (multiple-value-list (xlib:input-focus *display*))) ;;(format t "FOCUS RET: ~a~%" (xlib:set-input-focus *display* (window-xwin window) :POINTER-ROOT)) (xlib:set-input-focus *display* (window-xwin window) :POINTER-ROOT) ;;(xlib:display-finish-output *display*) ;;(format t "FOCUS IS: ~a~%" (multiple-value-list (xlib:input-focus *display*))) (xlib:change-property (screen-root screen) :_NET_ACTIVE_WINDOW (list (window-xwin window)) :window 32 :transform #'xlib:drawable-id :mode :replace) (setf (screen-focus screen) window) (move-screen-to-head screen))) (defun screen-current-window (screen) "Return the current window on the specified screen" (group-current-window (screen-current-group screen))) (defun current-window () "Return the current window on the current screen" (screen-current-window (current-screen))) (defun register-window (window) (setf (gethash (xlib:window-id (window-xwin window)) *xwin-to-window*) window)) (defun unregister-window (xwin) (remhash (xlib:window-id xwin) *xwin-to-window*)) (defun window-by-id (id) (gethash id *xwin-to-window*)) (defun find-window (xwin) (window-by-id (xlib:window-id xwin))) (defun find-window-by-parent (xwin &optional (windows (all-windows))) (dformat 3 "find-window-by-parent!~%") (find xwin windows :key 'window-parent :test 'xlib:window-equal)) (defun screen-root (screen) (xlib:screen-root (screen-number screen))) (defun update-colors-for-screen (screen) (let ((fg (screen-fg-color screen)) (bg (screen-bg-color screen))) (setf (xlib:gcontext-foreground (screen-message-gc screen)) fg (xlib:gcontext-background (screen-message-gc screen)) bg (xlib:gcontext-foreground (screen-frame-outline-gc screen)) fg (xlib:gcontext-background (screen-frame-outline-gc screen)) bg (ccontext-default-fg (screen-message-cc screen)) fg (ccontext-default-bg (screen-message-cc screen)) bg)) (dolist (i (list (screen-message-window screen) (screen-input-window screen) (screen-frame-window screen))) (setf (xlib:window-border i) (screen-border-color screen) (xlib:window-background i) (screen-bg-color screen))) ;; update the backgrounds of all the managed windows (dolist (g (screen-groups screen)) (dolist (w (group-windows g)) (unless (eq w (group-current-window g)) (setf (xlib:window-background (window-parent w)) (screen-win-bg-color screen)) (xlib:clear-area (window-parent w))))) (dolist (i (screen-withdrawn-windows screen)) (setf (xlib:window-background (window-parent i)) (screen-win-bg-color screen)) (xlib:clear-area (window-parent i))) (update-screen-color-context screen)) (defun update-colors-all-screens () "After setting the fg, bg, or border colors. call this to sync any existing windows." (mapc 'update-colors-for-screen *screen-list*)) (defun update-border-for-screen (screen) (setf (xlib:drawable-border-width (screen-input-window screen)) (screen-msg-border-width screen) (xlib:drawable-border-width (screen-message-window screen)) (screen-msg-border-width screen) (xlib:drawable-border-width (screen-frame-window screen)) (screen-msg-border-width screen))) (defun update-border-all-screens () "After setting the border width call this to sync any existing windows." (mapc 'update-border-for-screen *screen-list*)) (defun internal-window-p (screen win) "Return t if win is a window used by stumpwm" (or (xlib:window-equal (screen-message-window screen) win) (xlib:window-equal (screen-input-window screen) win) (xlib:window-equal (screen-focus-window screen) win) (xlib:window-equal (screen-key-window screen) win))) (defun color-exists-p (color) (handler-case (loop for i in *screen-list* always (xlib:lookup-color (xlib:screen-default-colormap (screen-number i)) color)) (xlib:name-error () nil))) ;; (defun font-exists-p (font-name) ;; ;; if we can list the font then it exists ;; (plusp (length (xlib:list-font-names *display* font-name :max-fonts 1)))) (defmacro set-any-color (val color) `(progn (dolist (s *screen-list*) (setf (,val s) (alloc-color s ,color))) (update-colors-all-screens))) ;; FIXME: I don't like any of this. Isn't there a way to define ;; a setf method to call (update-colors-all-screens) when the user ;; does eg. (setf *foreground-color* "green") instead of having ;; these redundant set-foo functions? (defun set-fg-color (color) "Set the foreground color for the message bar and input bar. @var{color} can be any color recognized by X." (setf *text-color* color) (set-any-color screen-fg-color color)) (defun set-bg-color (color) "Set the background color for the message bar and input bar. @var{color} can be any color recognized by X." (set-any-color screen-bg-color color)) (defun set-border-color (color) "Set the border color for the message bar and input bar. @var{color} can be any color recognized by X." (set-any-color screen-border-color color)) (defun set-win-bg-color (color) "Set the background color of the window. The background color will only be visible for windows with size increment hints such as @samp{emacs} and @samp{xterm}." (set-any-color screen-win-bg-color color)) (defun set-focus-color (color) "Set the border color for focused windows. This is only used when there is more than one frame." (set-any-color screen-focus-color color)) (defun set-unfocus-color (color) "Set the border color for windows without focus. This is only used when there is more than one frame." (set-any-color screen-unfocus-color color)) (defun set-float-focus-color (color) "Set the border color for focused windows in a float group." (set-any-color screen-float-focus-color color)) (defun set-float-unfocus-color (color) "Set the border color for windows without focus in a float group." (set-any-color screen-float-unfocus-color color)) (defun set-msg-border-width (width) "Set the border width for the message bar, input bar and frame indicator." (check-type width (integer 0)) (dolist (i *screen-list*) (setf (screen-msg-border-width i) width)) (update-border-all-screens) t) (defun set-frame-outline-width (width) (check-type width (integer 0)) (dolist (i *screen-list*) (setf (screen-frame-outline-width i) (if (oddp width) (1+ width) width) (xlib:gcontext-line-width (screen-frame-outline-gc i)) (screen-frame-outline-width i))) (update-border-all-screens) t) (defun set-font (font) "Set the font(s) for the message bar and input bar." (when (if (listp font) (every #'identity (mapcar #'font-exists-p font)) (font-exists-p font)) (dolist (screen *screen-list*) (let ((fonts (if (listp font) (mapcar (lambda (font) (open-font *display* font)) font) (list (open-font *display* font))))) (mapc #'close-font (screen-fonts screen)) (setf (screen-fonts screen) fonts))) t)) (defmacro with-current-screen (screen &body body) "A macro to help us out with early set up." `(let ((*screen-list* (list ,screen))) ,@body)) (defun current-screen () "Return the current screen." (car *screen-list*)) (defun netwm-set-properties (screen focus-window) "Set NETWM properties on the root window of the specified screen. FOCUS-WINDOW is an extra window used for _NET_SUPPORTING_WM_CHECK." (let* ((screen-number (screen-number screen)) (root (xlib:screen-root screen-number))) ;; _NET_SUPPORTED (xlib:change-property root :_NET_SUPPORTED (mapcar (lambda (a) (xlib:intern-atom *display* a)) (append +netwm-supported+ (mapcar #'car +netwm-window-types+))) :atom 32) ;; _NET_SUPPORTING_WM_CHECK (xlib:change-property root :_NET_SUPPORTING_WM_CHECK (list focus-window) :window 32 :transform #'xlib:drawable-id) (xlib:change-property focus-window :_NET_SUPPORTING_WM_CHECK (list focus-window) :window 32 :transform #'xlib:drawable-id) (xlib:change-property focus-window :_NET_WM_NAME "stumpwm" :string 8 :transform #'xlib:char->card8) ;; _NET_CLIENT_LIST (xlib:change-property root :_NET_CLIENT_LIST () :window 32 :transform #'xlib:drawable-id) ;; _NET_DESKTOP_GEOMETRY (xlib:change-property root :_NET_DESKTOP_GEOMETRY (list (xlib:screen-width screen-number) (xlib:screen-height screen-number)) :cardinal 32) ;; _NET_DESKTOP_VIEWPORT (xlib:change-property root :_NET_DESKTOP_VIEWPORT (list 0 0) :cardinal 32) (netwm-set-group-properties screen))) (defun init-screen (screen-number id host) "Given a screen number, returns a screen structure with initialized members" ;; Listen for the window manager events on the root window (dformat 1 "Initializing screen: ~a ~a~%" host id) (setf (xlib:window-event-mask (xlib:screen-root screen-number)) '(:substructure-redirect :substructure-notify :property-change :structure-notify :button-press :exposure)) (xlib:display-finish-output *display*) ;; Initialize the screen structure (labels ((ac (color) (xlib:alloc-color (xlib:screen-default-colormap screen-number) color))) (let* ((screen (make-instance 'screen)) (fg (ac +default-foreground-color+)) (bg (ac +default-background-color+)) (border (ac +default-border-color+)) (focus (ac +default-focus-color+)) (unfocus (ac +default-unfocus-color+)) (float-focus (ac +default-float-focus-color+)) (float-unfocus (ac +default-float-unfocus-color+)) (win-bg (ac +default-window-background-color+)) (input-window (xlib:create-window :parent (xlib:screen-root screen-number) :x 0 :y 0 :width 20 :height 20 :background bg :border border :border-width 1 :colormap (xlib:screen-default-colormap screen-number) :event-mask '(:key-press :key-release))) (focus-window (xlib:create-window :parent (xlib:screen-root screen-number) :x 0 :y 0 :width 1 :height 1)) (key-window (xlib:create-window :parent (xlib:screen-root screen-number) :x 0 :y 0 :width 1 :height 1 :event-mask '(:key-press :key-release))) (message-window (xlib:create-window :parent (xlib:screen-root screen-number) :x 0 :y 0 :width 1 :height 1 :background bg :bit-gravity :north-east :border border :border-width 1 :colormap (xlib:screen-default-colormap screen-number) :event-mask '(:exposure))) (frame-window (xlib:create-window :parent (xlib:screen-root screen-number) :x 0 :y 0 :width 20 :height 20 :background bg :border border :border-width 1 :colormap (xlib:screen-default-colormap screen-number) :event-mask '(:exposure))) (font (open-font *display* (if (font-exists-p +default-font-name+) +default-font-name+ "*"))) (group (make-instance 'tile-group :screen screen :number 1 :name *default-group-name*))) ;; Create our screen structure ;; The focus window is mapped at all times (xlib:map-window focus-window) (xlib:map-window key-window) (setf (screen-number screen) screen-number (screen-id screen) id (screen-host screen) host (screen-groups screen) (list group) (screen-current-group screen) group (screen-fonts screen) (list font) (screen-fg-color screen) fg (screen-bg-color screen) bg (screen-win-bg-color screen) win-bg (screen-border-color screen) border (screen-focus-color screen) focus (screen-unfocus-color screen) unfocus (screen-float-focus-color screen) float-focus (screen-float-unfocus-color screen) float-unfocus (screen-msg-border-width screen) 1 (screen-frame-outline-width screen) +default-frame-outline-width+ (screen-input-window screen) input-window (screen-focus-window screen) focus-window (screen-key-window screen) key-window (screen-frame-window screen) frame-window (screen-ignore-msg-expose screen) 0 (screen-message-cc screen) (make-ccontext :win message-window :screen screen :font font :gc (xlib:create-gcontext :drawable message-window :font (when (typep font 'xlib:font) font) :foreground fg :background bg)) (screen-frame-outline-gc screen) (xlib:create-gcontext :drawable (screen-root screen) :font (when (typep font 'xlib:font) font) :foreground fg :background fg :line-style :double-dash :line-width +default-frame-outline-width+)) (setf (screen-heads screen) (make-screen-heads screen (xlib:screen-root screen-number)) (tile-group-frame-tree group) (copy-heads screen) (tile-group-current-frame group) (first (tile-group-frame-tree group))) (netwm-set-properties screen focus-window) (update-colors-for-screen screen) (update-color-map screen) (xwin-grab-keys focus-window group) screen))) ;;; Screen commands (defcommand snext () () "Go to the next screen." (switch-to-screen (next-screen)) (group-wake-up (current-group))) (defcommand sprev () () "Go to the previous screen." (switch-to-screen (next-screen (reverse (sort-screens)))) (group-wake-up (current-group))) (defcommand sother () () "Go to the last screen." (switch-to-screen (cadr *screen-list*)) (group-wake-up (current-group))) stumpwm-0.9.9/selection.lisp000066400000000000000000000107351242702317100161300ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Handle the X selection. ;; ;; Code: (in-package #:stumpwm) (export '(get-x-selection set-x-selection)) (defun export-selection (selection) (let* ((screen (current-screen)) (selwin (screen-focus-window (current-screen))) (root (screen-root screen))) (xlib:set-selection-owner *display* selection selwin) (unless (xlib:window-equal (xlib:selection-owner *display* selection) selwin) (error "Can't set selection owner")) ;; also set the cut buffer for completeness. Note that this always sets cut ;; buffer 0. (xlib:change-property root :cut-buffer0 (getf *x-selection* selection) :string 8 :transform #'xlib:char->card8 :mode :replace))) (defun set-x-selection (text &optional (selection :primary)) "Set the X11 selection string to @var{string}." (setf (getf *x-selection* selection) text) (export-selection selection)) (defun send-selection (requestor property selection target time) (dformat 1 "send-selection ~s ~s ~s ~s ~s~%" requestor property selection target time) (case target ;; they're requesting what targets are available (:targets (xlib:change-property requestor property (list :targets :string :utf8_string) target 8 :mode :replace)) ;; send them a string (:string (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)) ;; we don't know how to handle anything else (t (setf property nil))) (xlib:send-event requestor :selection-notify nil :display *display* :window requestor :selection selection :property property :target target :time time) (xlib:display-finish-output *display*)) (defun get-x-selection (&optional timeout (selection :primary)) "Return the x selection no matter what client own it." (labels ((wait-for-selection (&rest event-slots &key display event-key &allow-other-keys) (declare (ignore display)) (when (eq event-key :selection-notify) (destructuring-bind (&key window property &allow-other-keys) event-slots (if property (utf8-to-string (xlib:get-property window property :type :utf8_string :result-type 'vector :delete-p t)) ""))))) (or (getf *x-selection* selection) (progn (xlib:convert-selection selection :utf8_string (screen-input-window (current-screen)) :stumpwm-selection) ;; Note: this may spend longer than timeout in this loop but it will eventually return. (let ((time (get-internal-real-time))) (loop for ret = (xlib:process-event *display* :handler #'wait-for-selection :timeout timeout :discard-p nil) when (or ret (> (/ (- time (get-internal-real-time)) internal-time-units-per-second) timeout)) ;; make sure we return a string return (or ret ""))))))) ;;; Commands (defcommand putsel (string) ((:rest "Text: ")) "Stuff the string @var{string} into the X selection." (set-x-selection string)) ;; FIXME: this function is basically useless atm. (defcommand getsel () () "Echo the X selection." (message "~a" (get-x-selection))) (defcommand copy-last-message () () "Copy the last message displayed into the X selection" (when (screen-last-msg (current-screen)) (set-x-selection (uncolorify (format nil "~{~a~^~%~}" (car (screen-last-msg (current-screen)))))))) stumpwm-0.9.9/stumpwm.asd000066400000000000000000000036531242702317100154600ustar00rootroot00000000000000;;; -*- Mode: Lisp -*- (defpackage :stumpwm-system (:use :cl :asdf)) (in-package :stumpwm-system) ;; This is a hack for debian because it calls cmucl's clx ;; cmucl-clx. *very* annoying. I don't actually know if debian still ;; does this. #+cmu (progn (ignore-errors (require :cmucl-clx)) (ignore-errors (require :clx))) (defsystem :stumpwm :name "StumpWM" :author "Shawn Betts " :version "0.9.8" :maintainer "David Bjergaard " ;; :license "GNU General Public License" :description "A tiling, keyboard driven window manager" :serial t :depends-on (:cl-ppcre #-cmu :clx #+sbcl :sb-posix) :components ((:file "package") (:file "primitives") (:file "workarounds") (:file "wrappers") (:file "pathnames") (:file "font-rendering") (:file "keysyms") (:file "keytrans") (:file "kmap") (:file "input") (:file "core") (:file "command") (:file "menu") (:file "screen") (:file "head") (:file "group") (:file "bindings") (:file "events") (:file "window") (:file "floating-group") (:file "tile-group") (:file "tile-window") (:file "window-placement") (:file "message-window") (:file "selection") (:file "module") (:file "stumpwm") (:file "user") (:file "iresize") (:file "help") (:file "fdump") (:file "time") (:file "mode-line") (:file "color") (:file "wse") ;; keep this last so it always gets recompiled if ;; anything changes (:file "version"))) stumpwm-0.9.9/stumpwm.lisp000066400000000000000000000255601242702317100156610ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Code: (in-package :stumpwm) (export '(cancel-timer run-with-timer stumpwm timer-p)) ;;; Main (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 rc files exist), the error if it didn't, and the rc file that was loaded. When CATCH-ERRORS is nil, errors are left to be handled further up. " (let* ((xdg-config-dir (let ((dir (getenv "XDG_CONFIG_HOME"))) (if (or (not dir) (string= dir "")) (merge-pathnames #p".config/" (user-homedir-pathname)) dir))) (user-rc (probe-file (merge-pathnames #p".stumpwmrc" (user-homedir-pathname)))) (conf-rc (probe-file (merge-pathnames #p"stumpwm/config" xdg-config-dir))) (etc-rc (probe-file #p"/etc/stumpwmrc")) (rc (or user-rc conf-rc etc-rc))) (if rc (if catch-errors (handler-case (load rc) (error (c) (values nil (format nil "~a" c) rc)) (:no-error (&rest args) (declare (ignore args)) (values t nil rc))) (progn (load rc) (values t nil rc))) (values t nil nil)))) (defun error-handler (display error-key &rest key-vals &key asynchronous &allow-other-keys) "Handle X errors" (cond ;; ignore asynchronous window errors ((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)) ;; all other asynchronous errors are printed. (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)))) ;;; Timers (defvar *timer-list* nil "List of active timers.") (defstruct timer time repeat function args) (defun run-with-timer (secs repeat function &rest args) "Perform an action after a delay of SECS seconds. Repeat the action every REPEAT seconds, if repeat is non-nil. SECS and REPEAT may be reals. The action is to call FUNCTION with arguments ARGS." (check-type secs (real 0 *)) (check-type repeat (or null (real 0 *))) (check-type function (or function symbol)) (let ((timer (make-timer :repeat repeat :function function :args args))) (schedule-timer timer secs) (setf *timer-list* (merge 'list *timer-list* (list timer) #'< :key #'timer-time)) timer)) (defun cancel-timer (timer) "Remove TIMER from the list of active timers." (check-type timer timer) (setf *timer-list* (remove timer *timer-list*))) (defun schedule-timer (timer when) (setf (timer-time timer) (+ (get-internal-real-time) (* when internal-time-units-per-second)))) (defun run-expired-timers () (let ((now (get-internal-real-time)) (timers *timer-list*) (pending '()) (remaining '())) (setf *timer-list* (dolist (timer timers (sort remaining #'< :key #'timer-time)) (if (<= (timer-time timer) now) (progn (push timer pending) (when (timer-repeat timer) (schedule-timer timer (timer-repeat timer)) (push timer remaining))) (push timer remaining)))) (dolist (timer pending) (apply (timer-function timer) (timer-args timer))))) (defun get-next-timeout (timers) "Return the number of seconds until the next timeout or nil if there are no timers." (when timers (max (/ (- (timer-time (car timers)) (get-internal-real-time)) internal-time-units-per-second) 0))) (defun perform-top-level-error-action (c) (ecase *top-level-error-action* (:message (let ((s (format nil "~&Caught '~a' at the top level. Please report this." c))) (write-line s) (print-backtrace) (message "^1*^B~a" s))) (:break (invoke-debugger c)) (:abort (throw :top-level (list c (backtrace-string)))))) (defun stumpwm-internal-loop () "The internal loop that waits for events and handles them." (loop (run-hook *internal-loop-hook*) (handler-bind ((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))) (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)))) ;; 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. (xlib:display-finish-output *display*) (let* ((to (get-next-timeout *timer-list*)) (timeout (and to (ceiling to))) (nevents (xlib:event-listen *display* timeout))) (dformat 10 "timeout: ~a~%" timeout) (when timeout (run-expired-timers)) (xlib:with-event-queue (*display*) (when nevents (run-hook *event-processing-hook*) (xlib:process-event *display* :handler #'handle-event :timeout 0))))))) (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) (values ;; clx doesn't like (vector character *) (coerce (or host "") '(simple-array character (*))) display screen (cond (protocol (intern1 protocol :keyword)) ((or (string= host "") (string-equal host "unix")) :local) (t :internet))))) (defun stumpwm-internal (display-str) (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) (xlib:display-error-handler *display*) 'error-handler) (with-simple-restart (quit-stumpwm "Quit Stumpwm") ;; In the event of an error, we always need to close the display (unwind-protect (progn (let ((*initializing* t)) ;; we need to do this first because init-screen grabs keys (update-modifier-map) ;; Initialize all the screens (setf *screen-list* (loop for i in (xlib:display-roots *display*) for n from 0 collect (init-screen i n host))) (xlib:display-finish-output *display*) ;; Load rc file (let ((*package* (find-package *default-package*))) (multiple-value-bind (success err rc) (load-rc-file) (if success (and *startup-message* (message *startup-message* (print-key *escape-key*))) (message "^B^1*Error loading ^b~A^B: ^n~A" rc err)))) (when *last-unhandled-error* (message-no-timeout "^B^1*StumpWM Crashed With An Unhandled Error!~%Copy the error to the clipboard with the 'copy-unhandled-error' command.~%^b~a^B^n~%~%~a" (first *last-unhandled-error*) (second *last-unhandled-error*))) (mapc 'process-existing-windows *screen-list*) ;; We need to setup each screen with its current window. Go ;; through them in reverse so the first screen's frame ends up ;; with focus. (dolist (s (reverse *screen-list*)) ;; map the current group's windows (mapc 'unhide-window (reverse (group-windows (screen-current-group s)))) ;; update groups (dolist (g (reverse (screen-groups s))) (dformat 3 "Group windows: ~S~%" (group-windows g)) (group-startup g)) ;; switch to the (old) current group. (let ((netwm-id (first (xlib:get-property (screen-root s) :_NET_CURRENT_DESKTOP)))) (when (and netwm-id (< netwm-id (length (screen-groups s)))) (switch-to-group (elt (sort-groups s) netwm-id)))) (redraw-current-message (current-screen)))) ;; Let's manage. (let ((*package* (find-package *default-package*))) (run-hook *start-hook*) (stumpwm-internal-loop))) (xlib:close-display *display*)))) ;; what should the top level loop do? :quit) ;; Usage: (stumpwm) (defun stumpwm (&optional (display-str (or (getenv "DISPLAY") ":0"))) "Start the stump window manager." (setf *data-dir* (make-pathname :directory (append (pathname-directory (user-homedir-pathname)) (list ".stumpwm.d")))) (init-load-path *module-dir*) (loop (let ((ret (catch :top-level (stumpwm-internal display-str)))) (setf *last-unhandled-error* nil) (cond ((and (consp ret) (typep (first ret) 'condition)) (format t "~&Caught '~a' at the top level. Please report this.~%~a" (first ret) (second ret)) (setf *last-unhandled-error* ret)) ;; 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))) ((eq ret :restart)) (t (run-hook *quit-hook*) ;; the number is the unix return code (return-from stumpwm 0)))))) stumpwm-0.9.9/stumpwm.texi.in000066400000000000000000002174241242702317100162720ustar00rootroot00000000000000\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename stumpwm.info @settitle StumpWM Manual @setchapternewpage odd @c %**end of header @dircategory X11 @direntry * StumpWM: (stumpwm). A Common Lisp window manager @end direntry @ifinfo This is the Stump Window Manager user manual. Copyright @copyright{} 2000-2008 Shawn Betts Copyright @copyright{} 2014 David Bjergaard Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. @ignore Permission is granted to process this file through TeX and print the results, provided the printed document carries a copying permission notice identical to this one except for the removal of this paragraph (this paragraph not being relevant to the printed manual). @end ignore Permission is granted to copy and distribute modified versions of this manual under the conditions for verbatim copying, provided also that the sections entitled ``Copying'' and ``GNU General Public License'' are included exactly as in the original, and provided that the entire resulting derived work is distributed under the terms of a permission notice identical to this one. Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. @end ifinfo @iftex @kbdinputstyle code @end iftex @titlepage @sp 10 @titlefont{The Stump Window Manager} @author Shawn Betts, David Bjergaard @page @vskip 0pt plus 1filll Copyright @copyright{} 2000-2008 Shawn Betts Copyright @copyright{} 2014 David Bjergaard Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. Permission is granted to copy and distribute modified versions of this manual under the conditions for verbatim copying, provided also that the sections entitled ``Copying'' and ``GNU General Public License'' are included exactly as in the original, and provided that the entire resulting derived work is distributed under the terms of a permission notice identical to this one. Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. @end titlepage @node Top, Introduction, (dir), (dir) @ifinfo This document explains how to use The Stump Window Manager. @end ifinfo @menu * Introduction:: * Key Bindings:: * Commands:: * Message and Input Bar:: * Windows:: * Frames:: * Mode-line:: * Groups:: * Screens:: * Interacting With Unix:: * Interacting With X11:: * Miscellaneous Commands:: * Colors:: * Hooks:: * Modules:: * Hacking:: * Command and Function Index:: * Variable Index:: @detailmenu --- The Detailed Node Listing --- Introduction * Starting StumpWM:: * Basic Usage:: * Basic Concepts:: * Manipulating Frames and Windows:: * Interacting with the Lisp process:: * Contact the StumpWM developers:: Basic Concepts * Screens and Heads:: * Group Basics:: * Floating Group Basics:: * Frame Basics:: * Window Basics:: * System Trays and the Mode Line:: Manipulating Frames and Windows * Moving Between Frames:: * Manipulating Windows:: Key Bindings * List of Default Keybindings:: * Binding Keys:: * Modifiers:: Commands * Writing Commands:: * StumpWM Types:: Message and Input Bar * Customizing The Bar:: * Using The Input Bar:: * Programming The Message Bar:: * Programming the Input Bar:: Windows * Window Marks:: * Customizing Window Appearance:: * Controlling Raise And Map Requests:: * Programming With Windows:: * Rule Based Window Placement:: Frames * Interactively Resizing Frames:: * Frame Dumping:: Groups * Customizing Groups:: Screens * External Monitors:: * Programming With Screens:: Miscellaneous Commands * Menus:: * StumpWM's Data Directory:: * Debugging StumpWM:: * Timers:: * Getting Help:: Colors * Behind The Scenes Look At Colors:: Modules * Writing Modules:: Hacking * General Advice:: * Using git with StumpWM:: * Sending Patches:: @end detailmenu @end menu @node Introduction, Key Bindings, Top, Top @chapter Introduction StumpWM is a manual, tiling X11 window manager written entirely in Common Lisp. Unlike traditional window managers, StumpWM places windows in order to maximize the amount of the screen used. The window layouts managed by StumpWM are defined by the user in much the same way that windows are managed by GNU screen, or emacs. Before StumpWM, there was ratpoison, another tiling window manager written entirely in C. StumpWM grew out of the authors' frustration with writing ratpoison in C. Very quickly we realized we were building into ratpoison lispy-emacs style paradigms. StumpWM's goals are similar to ratpoison's but with an emphasis on customizability, completeness, and cushiness. @menu * Starting StumpWM:: * Basic Usage:: * Basic Concepts:: * Manipulating Frames and Windows:: * Interacting with the Lisp process:: * Contact the StumpWM developers:: @end menu @node Starting StumpWM, Basic Usage, Introduction, Introduction @section Starting StumpWM There are a number of ways to start StumpWM but the most straight forward method is as follows. This assumes you have a copy of the StumpWM source code and are using the @samp{SBCL} Common Lisp environment. @enumerate @item Install the prerequisites and build StumpWM as described in @file{README}. This should give you a @file{stumpwm} executable. @item In your @file{~/.xinitrc} file include the line @command{/path/to/stumpwm}. Remember to replace @samp{/path/to/} with the actual path. @item Finally, start X windows with @command{startx}. Cross your fingers. You should see a @samp{Welcome To the Stump Window Manager} message pop up in the upper, right corner. At this point, you have successfully started StumpWM. @end enumerate @node Basic Usage, Basic Concepts, Starting StumpWM, Introduction @section Basic Usage Once you have StumpWM up and running, the first thing you might want to do is start @command{emacs}. Type @kbd{C-t e}, or in other words @kbd{Control + t} followed by @kbd{e}. Now perhaps you want an @command{xterm}. Type @kbd{C-t c}. Now you have some programs running. To see a list of windows StumpWM is managing, type @kbd{C-t w}. The highlighted window is the one you're looking at right now. It's the focused window. All of StumpWM's keys are bound to named commands, which can be executed not only by keys but also from the input bar. Type @kbd{C-t ;} to open a command prompt. Now type @command{time} and press return. Note, @command{time} can also be called by typing @kbd{C-t a}. Throughout this manual you'll find definitions for commands, functions, and variables. Any command you see in this manual can be executed from the input bar or bound to a key. At this point you probably want to switch back from your new @command{xterm} to @command{emacs}. Type @kbd{C-t C-t}. This runs the @command{other} command. Type it again and you're back to xterm. Perhaps you'd like to see @command{emacs} and @command{xterm} side-by-side. Type @kbd{C-t s}. You have now split the screen into 2 @command{frames}. For more information see @ref{Frames}. To switch to the empty frame type @kbd{C-t TAB}. Now let's pull the xterm window into this empty frame. Type @kbd{C-t w} for a window listing. Find the @command{xterm} window. See the number beside it? Type @kbd{C-t} followed by @command{xterm}'s window number. Another common activity is browsing the internet. Type @kbd{C-t !}. The input bar pops up again. You can now run a shell command. Let's start a web browser: type @command{firefox} into the input bar and press return. Unfortunately, @command{firefox} probably isn't wide enough because it's in one of the frames. Type @kbd{C-t Q} to remove all frames but the current one and resize it to fit the screen. For a full list of key bindings, see @ref{List of Default Keybindings}. @node Basic Concepts, Manipulating Frames and Windows, Basic Usage, Introduction @section Basic Concepts An introduction to some of the basic concepts used by StumpWM. @menu * Screens and Heads:: * Group Basics:: * Floating Group Basics:: * Frame Basics:: * Window Basics:: * System Trays and the Mode Line:: @end menu @node Screens and Heads, Group Basics, Basic Concepts, Basic Concepts @subsection Screens and Heads A screen is an Xlib concept representing a section of video memory onto which physical monitors, called ``heads'', are mapped. A screen can be thought of as an abstract rectangle containing all the heads arranged in a particular layout. With most modern systems, you'll only have a single screen no matter how many heads are connected to your computer. Each head will have its own frame, and you can move between heads using the normal frame movement commands. The layout of the heads within the screen can be specified in one of two ways: either at startup using your system's Xorg configuration files, or on the fly using tools like XRandR. If the computer is booted with multiple monitors attached, but without specifying a layout for them, they will all show identical output. StumpWM will attempt to detect the layout of the heads once at startup, or any time a RandR command is issued. In rarer setups you may have multiple screens, with one head per screen. That means that you'll move between heads using screen movement commands (`snext', `sprev', and `sother') rather than frame movement commands. @node Group Basics, Floating Group Basics, Screens and Heads, Basic Concepts @subsection Group Basics A group is usually referred to as a ``desktop'' or ``workspace'' in other window managers. StumpWM starts with a single group, called ``Default''. Each group has its own configuration of frames and windows that is separate from and independent of other groups. You can't have different groups display in different monitors: when you switch groups, all monitors switch to that group. Each group contains an ordered list of frames. @node Floating Group Basics, Frame Basics, Group Basics, Basic Concepts @subsection Floating Group Basics Within a floating group, windows behave more like they do in traditional window managers: rather than being arranged into frames, they each have their own box, which can be freely resized and repositioned, and allowed to overlap. Each window has a thicker border at the top. Left click in this border and drag to move the window, or right click and drag to resize it. Most of the window-switching commands listed below do not function in a floating group. You're restricted to `other', the `select-window-*' commands, and `windowlist'. @node Frame Basics, Window Basics, Floating Group Basics, Basic Concepts @subsection Frame Basics Frames are the boxes within which windows are displayed. StumpWM starts with a single frame per head, meaning that each monitor shows a single window, full screen. If you want to see windows side-by-side, you can ``split'' this frame in two, either vertically or horizontally. These frames can be further split, creating nested boxes. Technically speaking, frames live within a ``frame tree''. When you split a frame, the command actually creates @emph{two} new frames side-by-side within the original parent frame. This makes no practical difference, unless you use the `sibling' command, which will move to the other child frame within the parent frame. Within this frame tree model, all frames either contain other frames, or windows. The command `fclear' will hide all a frame's windows and show the background. @node Window Basics, System Trays and the Mode Line, Frame Basics, Basic Concepts @subsection Window Basics Windows are created by programs to display their output. They take the shape of the frame in which they are created. The windows within a frame are ordered by how recently that window was focused. Only the top window in the stack is visible. @node System Trays and the Mode Line, , Window Basics, Basic Concepts @subsection System Trays and the Mode Line Many users choose to sacrifice a little screen real-estate to display some generally useful information: the current time and date, wireless network connections, the names of open windows, etc. StumpWM allows you to display this information in a bar across either the top or the bottom of the screen. There are two ways to do this: using external programs called system trays, or using StumpWM's own mode line. System trays are a special kind of X window. They advertise to running programs that they are available for embedding icons or notifications from those programs. They often also display clickable icons for each open window. Common tray programs include the GNOME panel or KDE's kicker, or simpler programs such as stalonetray. Simply starting one of these programs is usually enough for StumpWM to detect it, place it correctly, and allow it to function normally. The mode line, a concept borrowed from Emacs, is a built-in part of StumpWM. It is essentially a string of text that can include a variety of information about your current session, including the names of current groups and windows. Several modules provide for different types of information. @xref{Mode-line, Mode Line}, (and the modules directory) for more. @node Manipulating Frames and Windows, Interacting with the Lisp process, Basic Concepts, Introduction @section Manipulating Frames and Windows Frames and windows are concepts borrowed from Emacs and the GNU Screen program, and should be familiar to users of those programs. Others may find the terms a little confusing. In other window managers, a ``window'' usually refers to a bounded box on the screen, showing output from a single program. StumpWM splits this into two concepts: the ``frame'' is the bounded box, the ``window'' is the visible output of a program. One frame can contain many windows. As new windows are created, they appear at the top of the window-stack of the current frame. This is also a little different from other tiling window managers, many of which automatically create new frames for new windows. Both frames and windows are ordered by when they were last focused. In the following commands and documentation, the terms ``next'' and ``previous'' refer to this order. ``Other'' refers to the most-recently focused object. Calling ``other'' commands multiple times will bounce back and forth between the two most recent objects. By default, StumpWM starts with a single group, called ``Default'', which contains one full-screen frame per head. You can split individual frames horizontally or vertically using the `hsplit' and `vsplit' commands, bound to ``C-t S'' and ``C-t s'' by default. When a frame is split, the next-most-recently-focused window is pulled into the new frame. @xref{Frames}, and @ref{Windows}, for a complete listing of commands. @menu * Moving Between Frames:: * Manipulating Windows:: @end menu @node Moving Between Frames, Manipulating Windows, Manipulating Frames and Windows, Manipulating Frames and Windows @subsection Moving Between Frames Once you have multiple frames, you can move between them in various ways: @itemize @item @command{fnext} (@kbd{C-t o} or @kbd{C-t TAB}) jumps to the next frame in the current group's frame list. @item @command{fother} (@kbd{C-t M-TAB}) jumps to the last frame that had focus. @item @command{fselect} (@kbd{C-t f}) displays numbers on each visible frame: hit a number key to move to that frame. @item @command{move-focus} (@kbd{C-t }) focus the frame in the direction of the arrow key pressed. @item @command{sibling} (unbound by default) focus the frame from which the current frame was split. @end itemize @node Manipulating Windows, , Moving Between Frames, Manipulating Frames and Windows @subsection Manipulating Windows Some commands change which window is currently focused, some move windows between frames, and some may do both at once. There are two general ways to move focus between windows: either between windows belonging to the current frame, or between all windows within the current group. Within a single frame: @itemize @item @command{next-in-frame} (@kbd{C-t C-M-n}) focus the next window in the current frame's list of windows. @item @command{prev-in-frame} (@kbd{C-t C-M-p}) focus the previous window in the current frame's list of windows. @item @command{other-in-frame} (@kbd{C-t M-t}) focus the most recently focused window in the current frame's list of windows. @item @command{frame-windowlist} (unbound by default) display a menu of windows in the currently-focused frame, and allow the user to choose one. Alternately, the command @command{frame-windows} will simply display the list of window names, with no menu choice available. @end itemize Within the current group, the following commands will go straight to the specified window. They will never move a window from its original frame, and so may result in focus switching frames. @itemize @item @command{next} (@kbd{C-t M-n}) focus the next window in the current group. @item @command{prev} (@kbd{C-t M-p}) focus the previous window in the current group. @item @command{other} or @command{other-window} (unbound by default) focus the most recently focused window in the current group. @item @command{next-urgent} (@kbd{C-t C-u}) focus the next window that has marked itself ``urgent''. @item @command{select} or @command{select-window} (@kbd{C-t '}) prompt for the title of a window and focus it. Works with partial completion of the title. @item @command{select-window-by-name} (unbound by default) prompt for the title of a window and focus it. Requires the window title to be entered exactly. @item @command{select-window-by-number} (@kbd{C-t }) choose a window by number. @item @command{windowlist} (``C-t "") display a menu of windows in the currently-focused group, and allow the user to choose one. @end itemize The following commands always keep the current frame focused. If the selected window is not in the current frame, it will be pulled there from wherever it is (hence the ``pull'' naming scheme). @itemize @item @command{pull} or @command{pull-window-by-number} (@kbd{C-t C-}) pull the numbered window into the current frame. @item @command{pull-hidden-next} (@kbd{C-t n} or @kbd{C-t SPC}) pull the next currently undisplayed window in the window list into the current frame. @item @command{pull-hidden-previous} (@kbd{C-t p}) pull the previous currently undisplayed window in the window list into the current frame. @item @command{pull-hidden-other} (@kbd{C-t C-t}) pull the most recently focused, currently undisplayed window into the current frame. @end itemize The following commands move the current window from one frame to another, bringing focus with them. @itemize @item @command{move-window} (@kbd{C-t M-}) move the currently focused window in the direction indicated by the arrow key. @item @command{exchange-direction} (unbound by default) prompt for a direction, then swap the currently focused window with the top window of the frame in that direction. @end itemize @node Interacting with the Lisp process, Contact the StumpWM developers, Manipulating Frames and Windows, Introduction @section Interacting with the Lisp process Since StumpWM is a Lisp program, there is a way for you to evaluate Lisp code directly, on the same Lisp process that StumpWM is running on. Type @kbd{C-t :} and an input box will appear. Then type some Lisp expression. When you call @command{eval} this way, you will be in the STUMPWM-USER package, which imports all the exported symbols from the main STUMPWM package. @table @code @item *mode-line-border-width* Reads the value of @var{*mode-line-border-width*}. @item (setf *mode-line-border-width* 3) Sets the variable @var{*mode-line-border-width*} to 3. @item (set-prefix-key (kbd "C-M-H-s-z")) Calls the @code{set-prefix-key} function (and sets a new keyboard prefix) @end table @node Contact the StumpWM developers, , Interacting with the Lisp process, Introduction @section Contact the StumpWM developers The StumpWM home page is @url{http://stumpwm.nongnu.org/}. You can reach Shawn Betts at @email{sabetts at vcn.bc.ca}. The StumpWM mailing list is @email{stumpwm-devel@@nongnu.org} which you can subscribe to at @url{http://mail.nongnu.org/mailman/listinfo/stumpwm-devel}. Posting 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}}. @node Key Bindings, Commands, Introduction, 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 @kbd{C-t}. @menu * List of Default Keybindings:: * Binding Keys:: * Modifiers:: @end menu @node List of Default Keybindings, Binding Keys, Key Bindings, Key Bindings @section List of Default Keybindings The following is a list of keybindings. @table @kbd @item C-t @var{d} Select the window with the corresponding digit@tie{}@var{d} @item C-t C-@var{d} Pull the window with the corresponding digit@tie{}@var{d} into the current frame @item C-t n @itemx C-t C-n @itemx C-t Space Go to the next window in the window list @item C-t p @itemx C-t C-p Go to the previous window in the window list @item C-t ' Go to a window by name @item C-t " Select a window from a list and focus the window. @item C-t C-g Abort the current command. This is useful if you accidentally hit @kbd{C-t} @item C-t w List all the windows @item C-t i Display information about the current window. @item C-t f Select a frame by number @item C-t s Split current frame vertically @item C-t S Split current frame horizontally @item C-t k @itemx C-t C-k Sends a kill message to the current frame and the running program. @item C-t K Kills the current frame and running program; like a @command{kill -9}. @item C-t c @itemx C-t C-c Run an X terminal; by default @command{xterm} @item C-t e @itemx C-t C-e Run Emacs or raise it if it is already running. @item C-t t Sends a @kbd{C-t} to the frame; this is useful for applications like Firefox which make heavy use of @kbd{C-t} (in Firefox's case, for opening a new tab). This is similar to how GNU screen uses @kbd{C-a a}. @item C-t w @itemx C-t C-w Prints out a list of the windows, their number, and their name. @item C-t b @itemx C-t C-b Banish the mouse point to the lower right corner of the screen. @item C-t a @itemx C-t C-a Display the current time and date, much like the Unix command @command{date}. @item C-t C-t Switch to the last window to have focus in the current frame. @item C-t ! Prompt for a shell command to run via @file{/bin/sh}. All output is discarded. @item C-t R 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}. @item C-t o @itemx C-t TAB If the screen is split into multiple frames, focus shifts to the @command{next} frame, where it cycles to the right and then down; analogous to @kbd{C-x o} in Emacs. @item C-t F Display ``Current Frame'' in the frame which has focus. @item C-t ; Opens the input box. StumpWM commands can be run from here, and the input history moved through. @item C-t : Opens the input box, but all things typed in here will be sent to the Common Lisp interpreter where they will be ran as Lisp programs; thus, input should be valid Common Lisp. @item C-t C-h @itemx C-t ? The help. @item C-t - Hide all frames and show the root window. @item C-t Q Removes all splits and maximizes the frame with focus. @item C-t Up @itemx C-t Down @itemx C-t Left @itemx C-t Right Shift focus to an adjacent frame in the specified direction. @kbd{C-t Up} will shift focus up, if possible, @kbd{C-t Down} will shift downwards, etc. @item C-t v Prints out the version of the running StumpWM. @item C-t # Toggle the mark on the current window @item C-t m @itemx C-t C-m Display the last message. Hitting this keybinding again displays the message before that, and so on. @item C-t l @itemx C-t C-l redisplay the current window and force it to take up the entire frame. @item C-t G Display all groups and windows in each group. For more information see @ref{Groups}. @item C-t F@var{n} Jump to the corresponding group @var{n}. @kbd{C-t F1} jumps to group 1 and so on. @item C-t g g Show the list of groups. @item C-t g c Create a new group. @item C-t g n @itemx C-t g C-n @itemx C-t g SPC @itemx C-t g C-SPC Go to the next group in the list. @item C-t g N Go to the next group in the list and bring the current window along. @item C-t g p @itemx C-t g C-p Go to the previous group in the list. @item C-t g P Go to the previous group in the list and bring the current window along. @item C-t g ' Select a group by name or by number. @item C-t g " Select a group from a list and switch to it. @item C-t g m Move the current window to the specified group. @item C-t g k Kill the current group. All windows are merged into the next group. @item C-t g A @itemx C-t g r Change the current group's name. @item C-t g @var{d} Go to the group with digit @var{d}. @kbd{C-t g 1} jumps to group 1 and so on. @item C-t + Make frames the same height or width in the current frame's subtree. @item C-t h k Describe the specified key binding. @item C-t h f Describe the specified function. @item C-t h v Describe the specified variable. @item C-t h w List all key sequences that are bound to the specified command @item C-t h c Describe the specified command. @end table @node Binding Keys, Modifiers, List of Default Keybindings, Key Bindings @section Binding Keys @@@ define-key @@@ undefine-key @@@ kbd !!! set-prefix-key @@@ make-sparse-keymap ### *root-map* ### *top-map* ### *groups-map* ### *exchange-window-map* !!! bind @node Modifiers, , Binding Keys, Key Bindings @section Modifiers Many users have had some difficulty with setting up modifiers for StumpWM keybindings. This is caused by a combination of how StumpWM handles modifiers and the default modifiers list for many users' X servers. @itemize @item My ``Super'' key doesn't work! This is most likely caused by having the Hyper and Super keys listed as the same modifier in the modifier list. @example $ xmodmap xmodmap: up to 3 keys per modifier, (keycodes in parentheses): shift Shift_L (0x32), Shift_R (0x3e) lock Caps_Lock (0x42) control Control_L (0x25), Control_R (0x6d) mod1 Alt_L (0x40), Alt_R (0x71), Meta_L (0x9c) mod2 Num_Lock (0x4d) mod3 mod4 Super_L (0x7f), Hyper_L (0x80) mod5 Mode_switch (0x5d), ISO_Level3_Shift (0x7c) @end example The problem is in the line beginning with ``mod4''. The way to set up the modifier list correctly is to have just the Super key as the mod4 modifier. The following @command{xmodmap} commands will do just that. @example # clear out the mod4 modifier $ xmodmap -e 'clear mod4' $ xmodmap xmodmap: up to 3 keys per modifier, (keycodes in parentheses): shift Shift_L (0x32), Shift_R (0x3e) lock Caps_Lock (0x42) control Control_L (0x25), Control_R (0x6d) mod1 Alt_L (0x40), Alt_R (0x71), Meta_L (0x9c) mod2 Num_Lock (0x4d) mod3 mod4 mod5 Mode_switch (0x5d), ISO_Level3_Shift (0x7c) # add Super as a mod4 modifier $ xmodmap -e 'add mod4 = Super_L' $ xmodmap xmodmap: up to 3 keys per modifier, (keycodes in parentheses): shift Shift_L (0x32), Shift_R (0x3e) lock Caps_Lock (0x42) control Control_L (0x25), Control_R (0x6d) mod1 Alt_L (0x40), Alt_R (0x71), Meta_L (0x9c) mod2 Num_Lock (0x4d) mod3 mod4 Super_L (0x73), Super_L (0x7f) mod5 Mode_switch (0x5d), ISO_Level3_Shift (0x7c) @end example You can automate this by storing the commands in a file and calling xmodmap when you start your X session. @example $ cat ~/.Xmodmap clear mod4 add mod4 = Super_L @end example If you use @command{startx}, modify your @file{~/.xsession} or @file{~/.xinitrc} file. @example $ cat ~/.xsession #!/bin/sh xmodmap ~/.Xmodmap exec /usr/bin/stumpwm @end example If you use a settings daemon from one of the major desktop environments (Gnome,KDE, or Unity) you may be able to set keyboard modifiers from their respective configuration GUIs. If not, @command{xmodmap} should always work if invoked at the right place. @item Handling Meta and Alt: when do I use @kbd{M-} and @kbd{A-}? If you have no Meta keys defined (see the output of the @command{xmodmap} command), then StumpWM will treat the @kbd{M-} prefix in keybindings to mean Alt. However, if there are Meta keys defined, then the @kbd{M-} prefix refers to them, and the @kbd{A-} prefix refers to Alt. Most users will simply use @kbd{M-} to refer to their Alt keys. However, users that define separate Meta and Alt keys will use @kbd{M-} to refer to the former, and @kbd{A-} to refer to the latter. @item How can I set up a Hyper key and use it with StumpWM? To set up a Hyper key, you need to do two things: bind a physical key to be a Hyper key, and add that key to the modifiers list. The following example shows how to bind the control key at the bottom-left of most keyboards to be Hyper. This is useful if you've made Caps Lock into a control key, and have no use for the bottom-left key. @example $ xmodmap -e 'keycode 37 = Hyper_L' $ xmodmap -e 'clear mod5' $ xmodmap -e 'add mod5 = Hyper_L' @end example To use a different key for Hyper, replace the keycode ``37'' above. Use the @command{xev} program to see the keycode that any physical key has. Refer to the section above on setting up the Super key to see how to automate setting the Hyper key when you start X. Now you can use @kbd{H-} as a prefix in StumpWM bindings. @example (define-key *top-map* (kbd "H-RET") "fullscreen") (define-key *top-map* (kbd "H-Left") "gprev") (define-key *top-map* (kbd "H-Right") "gnext") (define-key *top-map* (kbd "H-TAB") "other") @end example Since essentially no programs have Hyper bindings, you can safely bind commands to the @var{*top-map*}. @end itemize @node Commands, Message and Input Bar, Key Bindings, Top @chapter Commands If you've used Emacs before you'll find the distinction between commands and functions familiar. Commands are simply functions that can be bound to keys and executed interactively from StumpWM's input bar. Whereas, in Emacs, the special "(interactive)" declaration is used to turn a function into a command, in StumpWM commands are made with a separate @command{defcommand} macro. Once a command is defined, you can call it by invoking the @command{colon} command (@kbd{C-t ;}), and typing the name of the command. This may be sufficient for commands that aren't used very often. To see all the currently-defined commands, invoke the command called @command{commands}: ie press @kbd{C-t ;}, type ``commands'', and hit return. Commonly-used commands can also be bound to a keystroke, which is much more convenient. To do this, use the @command{define-key} function (see @ref{Key Bindings}), giving the name of the command as a string. For example: @example (define-key *root-map* (kbd "d") "exchange-direction") @end example You cannot give the command name as a symbol, nor can you bind a key to a regular function defined with @command{defun}. If the command takes arguments (see @ref{Writing Commands}), you can fix those arguments when defining the key-binding, by including the arguments in the same string as the command name, separated by a space. For instance, the @command{exchange-direction} command, which is unbound by default, requires a direction in which to exchange windows. If you call @command{exchange-direction} directly, it will prompt you for the direction. If you know that you often exchange in left/right directions, and want those actions bound to keys, you can use the following in your customization file: @example (define-key *root-map* (kbd "[") "exchange-direction left") (define-key *root-map* (kbd "]") "exchange-direction right") @end example Multiple arguments can be included by adding them to the command string, separated by spaces. Not all argument types can be represented as strings, but StumpWM will do its best to convert types. StumpWM does not implement the Emacs concept of prefix arguments. @menu * Writing Commands:: * StumpWM Types:: @end menu @node Writing Commands, StumpWM Types, Commands, Commands @section Writing Commands StumpWM commands are written much like any Lisp function. The main difference is in the way command arguments are specified. The @command{defcommand} macro takes a list of arguments as its first form (similar to the @command{defun} macro), and a corresponding list of types as its second form. All arguments must belong to a ``type''. Each type specification has two parts: a keyword specifying the argument type, and a string prompt that will be displayed when asking the user to enter the argument value. A typical @command{defcommand} might look like this: @example (defcommand now-we-are-six (name age) ((:string "Enter your name: ") (:number "Enter your age: ")) (message "~a, in six years you will be ~a" name (+ 6 age))) @end example If @command{now-we-are-six} is called interactively via the @command{colon} command, the user will be prompted for a string and a number, which will then be bound to ``name'' and ``age'', respectively, in the body of the command. When invoking the command via a key-binding, it is possible to provide some or all of the arguments directly: @example (define-key *root-map* (kbd "L") "now-we-are-six John") @end example In this case, hitting @kbd{C-t L} will only prompt for an age (the first string argument is already bound to ``John''). Argument values provided this way always bind to the earliest arguments defined: ie, it is not possible to specify an age, but prompt the user for a name. If the type declaration does not include a prompt (ie, it looks like ``(:type nil)'', or ``(:type)'' or just ``:type''), the argument is considered optional. It can be provided via a key-binding invocation, as above, but if it isn't, the user will not be prompted, and the argument will be bound to nil. Lastly, it is possible to limit the scope under which the command will be usable: a command can be defined to work only in tile groups, or only in floating groups (the only two types of groups that currently exist). This is done by replacing the name of the command with a two-element list: the name of the command as a symbol, and either the symbol tile-group or floating-group. For instance, the @command{next} command, which only functions in tile groups, is defined this way: @example (defcommand (next tile-group) @dots{}) @end example @node StumpWM Types, , Writing Commands, Commands @section StumpWM Types All command arguments must be of a defined ``StumpWM type''. The following types are pre-defined: @table @var @item :y-or-n A yes or no question returning T or NIL. @item :variable A lisp variable @item :function A lisp function @item :command A stumpwm command as a string. @item :key-seq A key sequence starting from *TOP-MAP* @item :window-number An existing window number @item :number An integer number @item :string A string @item :key A single key chord @item :window-name An existing window's name @item :direction A direction symbol. One of :UP :DOWN :LEFT :RIGHT @item :gravity A gravity symbol. One of :center :top :right :bottom :left :top-right :top-left :bottom-right :bottom-left @item :group An existing group @item :frame A frame @item :shell A shell command @item :rest The rest of the input yes to be parsed. @item :module An existing stumpwm module @end table Additional types can be defined using the macro @command{define-stumpwm-type}. Emacs users who are accustomed to writing more complicated interactive declarations using "(interactive (list @dots{}))" forms will find that similar logic can be put into StumpWM type definitions. The macro is called like this: (define-stumpwm-type :type-name (input prompt) body) The keyword :type-name will then be available for use in @command{defcommand} macros. When commands are called, the bodies of these type definitions are called in turn to produce actual argument values. Type definitions produce their value in one of several ways: by reading it from the argument line bound to a keystroke, by prompting the user to enter a value, or by generating it programmatically. Within the body of the type definition, the argument ``input'' is bound to the argument line provided in the command string, and ``prompt'' to the string prompt provided in the @command{defcommand} form. The usual convention is to first check if an argument has been provided in ``input'' and, if it hasn't, to prompt for it using ``prompt''. StumpWM provides several convenience functions for handling the value of ``input'': @itemize @item @command{argument-pop} (input) pop the next space-delimited argument from the argument line. @item @command{argument-pop-rest} (input) return the remainder of the argument line as a single string, leaving input empty @item @command{argument-pop-or-read} (input prompt &optional completions) either pop an argument from the argument line, or if it is empty use ``prompt'' to prompt the user for a value @item @command{argument-pop-rest-or-read} (input prompt &optional completions) either return the remainder of the argument line as a string, leaving input empty, or use ``prompt'' to prompt the user for a value @end itemize As an example, here's a new type called :smart-direction. The existing :direction type simply asks for one of the four directions ``left'', ``right'', ``up'' or ``down'', without checking to see if there's a frame in that direction. Our new type, :smart-direction, will look around the current frame, and only allow the user to choose a direction in which another frame lies. If only one direction is possible it will return that automatically without troubling the user. It signals an error for invalid directions; it could alternately return a ``nil'' value in those cases, and let the command handle that. @example (define-stumpwm-type :smart-direction (input prompt) (let ((valid-dirs (loop ; gather all the directions in which there's a neighbouring frame with values = '(("up" :up) ("down" :down) ("left" :left) ("right" :right)) with frame-set = (group-frames (window-group (current-window))) for dir in values for neighbour = (neighbour (second dir) (window-frame (current-window)) frame-set) if (and neighbour (frame-window neighbour)) collect dir)) (arg (argument-pop input))) ; store a possible argument (cond ((null valid-dirs) ; no directions, bail out (throw 'error "No valid directions")) (arg ; an arg was bound, but is it valid? (or (second (assoc arg valid-dirs :test #'string=)) (throw 'error "Not a valid direction"))) ((= 1 (length valid-dirs)) ; only one valid direction (second (car valid-dirs))) (t ; multiple possibilities, prompt for direction (second (assoc (completing-read input prompt valid-dirs :require-match t) valid-dirs :test #'string=)))))) (defcommand smarty (dir) ((:smart-direction "Pick a direction: ")) ;; `dir' is a keyword here (message "You're going ~a" (string-downcase dir))) (define-key *root-map* (kbd "R") "smarty right") @end example @node Message and Input Bar, Windows, Commands, Top @chapter Message and Input Bar !!! echo !!! colon @menu * Customizing The Bar:: * Using The Input Bar:: * Programming The Message Bar:: * Programming the Input Bar:: @end menu @node Customizing The Bar, Using The Input Bar, Message and Input Bar, Message and Input Bar @section Customizing The Bar The bar's appearance and behavior can be modified with the following functions and variables. See @ref{Colors} for an explanation of how to set these color variables. @@@ set-fg-color @@@ set-bg-color @@@ set-border-color @@@ set-msg-border-width @@@ set-font ### *message-window-padding* ### *message-window-gravity* ### *timeout-wait* ### *input-window-gravity* @node Using The Input Bar, Programming The Message Bar, Customizing The Bar, Message and Input Bar @section Using The Input Bar The following is a list of keybindings for the Input Bar. Users of Emacs will recognize them. @table @kbd @item DEL Delete the character before point (@code{delete-backward-char}). @item M-DEL Kill back to the beginning of the previous word (@code{backward-kill-word}). @item C-d @itemx Delete Delete the character after point (@code{delete-forward-char}). @item M-d Kill forward to the end of the next word (@code{forward-kill-word}). @item C-f @itemx Right Move forward one character (@code{forward-char}). @item M-f Move forward one word (@code{forward-word}). @item C-b @itemx Left Move backward one character (@code{backward-char}). @item M-b Move backward one word (@code{backward-word}). @item C-a @itemx Home Move to the beginning of the current line (@code{move-beginning-of-line}). @item C-e @itemx End Move to the end of the current line (@code{move-end-of-line}). @item C-k Kill to the end of the line (@code{kill-line}). @item C-u Kill to the beginning of the line (@code{kill-to-beginning}), the same as @kbd{C-a C-k}. @item C-p @itemx Up Move to the next earlier entry saved in the command history (@command{history-back}). @item C-n @itemx Down Move to the next later entry saved in the command history (@command{history-forward}). @item RET Submit the entered command (@command{submit}). @item C-g Abort the current action by closing the Input Bar (@command{abort}). @item C-y Paste text from clipboard into the Input Bar (@command{yank-selection}). @item TAB Clockwise tab complete the current string, if possible. Press @kbd{TAB} again to cycle through completions. @item S-TAB Counter-clockwise tab complete the current string, if possible. Press @kbd{S-TAB} again to cycle through completions. @end table @node Programming The Message Bar, Programming the Input Bar, Using The Input Bar, Message and Input Bar @section Programming The Message Bar @@@ echo-string @@@ message ### *input-history-ignore-duplicates* !!! copy-last-message @node Programming the Input Bar, , Programming The Message Bar, Message and Input Bar @section Programming the Input Bar New input behavior can be added to the input bar by creating editing functions and binding them to keys in the @var{*input-map*} using @command{define-key}, just like other key bindings. An input function takes 2 arguments: the input structure and the key pressed. @@@ read-one-line @@@ read-one-char @@@ completing-read @@@ input-insert-string @@@ input-insert-char ### *input-map* @node Windows, Frames, Message and Input Bar, Top @chapter Windows !!! next !!! pull-hidden-next !!! prev !!! pull-hidden-previous !!! delete-window !!! kill-window !!! echo-windows !!! other-window !!! pull-hidden-other !!! renumber !!! meta !!! select-window !!! select-window-by-number !!! title !!! windowlist !!! fullscreen !!! info !!! refresh !!! redisplay ### *window-format* ### *window-name-source* ### *new-window-prefered-frame* @menu * Window Marks:: * Customizing Window Appearance:: * Controlling Raise And Map Requests:: * Programming With Windows:: * Rule Based Window Placement:: @end menu @node Window Marks, Customizing Window Appearance, Windows, Windows @section Window Marks Windows can be marked. A marked window has a # beside it in the window list. Some commands operate only on marked windows. !!! mark !!! clear-window-marks !!! pull-marked @node Customizing Window Appearance, Controlling Raise And Map Requests, Window Marks, Windows @section Customizing Window Appearance ### *maxsize-border-width* ### *transient-border-width* ### *normal-border-width* ### *window-border-style* See @ref{Colors} for an explanation of how to set these color variables. @@@ set-win-bg-color @@@ set-focus-color @@@ set-unfocus-color @@@ set-float-focus-color @@@ set-float-unfocus-color @@@ set-normal-gravity @@@ set-maxsize-gravity @@@ set-transient-gravity !!! gravity @node Controlling Raise And Map Requests, Programming With Windows, Customizing Window Appearance, Windows @section Controlling Raise And Map Requests It is sometimes handy to deny a window's request to be focused. The following variables determine such behavior. A map request occurs when a new or withdrawn window requests to be mapped for the first time. A raise request occurs when a client asks the window manager to give an existing window focus. ### *deny-map-request* ### *deny-raise-request* ### *suppress-deny-messages* Some examples follow. @example ;; Deny the firefox window from taking focus when clicked upon. (push '(:class "gecko") stumpwm:*deny-raise-request*) ;; Deny all map requests (setf stumpwm:*deny-map-request* t) ;; Deny transient raise requests (push '(:transient) stumpwm:*deny-map-request*) ;; Deny the all windows in the xterm class from taking focus. (push '(:class "Xterm") stumpwm:*deny-raise-request*) @end example @node Programming With Windows, Rule Based Window Placement, Controlling Raise And Map Requests, Windows @section Programming With Windows %%% define-window-slot @@@ window-send-string ### *default-window-name* @node Rule Based Window Placement, , Programming With Windows, Windows @section Rule Based Window Placement %%% define-frame-preference @@@ clear-window-placement-rules !!! remember !!! forget !!! dump-window-placement-rules !!! restore-window-placement-rules @node Frames, Mode-line, Windows, Top @chapter Frames Frames contain windows. All windows exist within a frame. Those used to ratpoison will notice that this differs from ratpoison's window pool, where windows and frames are not so tightly connected. !!! pull-window-by-number !!! hsplit !!! vsplit !!! remove-split !!! only !!! curframe !!! fnext !!! sibling !!! fother !!! fselect !!! resize !!! balance-frames !!! fclear !!! move-focus !!! move-window !!! next-in-frame !!! prev-in-frame !!! other-in-frame !!! echo-frame-windows !!! exchange-direction ### *min-frame-width* ### *min-frame-height* ### *new-frame-action* @menu * Interactively Resizing Frames:: * Frame Dumping:: @end menu @node Interactively Resizing Frames, Frame Dumping, Frames, Frames @section Interactively Resizing Frames There is a mode called @code{iresize} that lets you interactively resize the current frame. To enter the mode use the @code{iresize} command or type @key{C-t r}. The following keybindings apply to the mode: @table @kbd @item C-p @itemx Up @itemx k Shrink the frame vertically. @item C-n @itemx Down @itemx j Expand the frame vertically. @item C-f @itemx Right @itemx l Expand the frame horizontally. @item C-b @itemx Left @itemx h Shrink the frame horizontally. @item C-g @itemx ESC Abort the interactive resize. NOTE: This currently doesn't work. @item RET Select the highlighted option. @end table !!! iresize !!! abort-iresize !!! exit-iresize ### *resize-increment* @node Frame Dumping, , Interactively Resizing Frames, Frames @section Frame Dumping The configuration of frames and groups can be saved and restored using the following commands. !!! dump-desktop-to-file !!! dump-group-to-file !!! dump-screen-to-file !!! restore-from-file !!! place-existing-windows @node Mode-line, Groups, Frames, Top @chapter The Mode Line The mode line is a bar that runs across either the top or bottom of a head and is used to display information. By default the mode line displays the list of windows, similar to the output @kbd{C-t w} produces. Alternatively, external panel applications such as the GNOME panel and KDE's kicker may be used. Simply starting one of these programs is enough to set it as the mode line of the head it would like to be on (if the panel is XRandR aware) or whichever head is available. In order to avoid problems displaying menus, configure your panel application for positioning at the top or bottom of the head rather than relying on @var{*mode-line-position*} The mode line can be turned on and off with the @command{mode-line} command or the lisp function @code{stumpwm:toggle-mode-line}. Each head has its own mode line. For example: @example ;; turn on/off the mode line for the current head only. (stumpwm:toggle-mode-line (stumpwm:current-screen) (stumpwm:current-head)) @end example The mode line is updated after every StumpWM command. To display the window list and the current date on the modeline, one might do the following: @example (setf stumpwm:*screen-mode-line-format* (list "%w | " '(:eval (stumpwm:run-shell-command "date" t)))) @end example @code{(stumpwm:run-shell-command "date" t)} runs the command @command{date} and returns its output as a string. !!! mode-line @@@ toggle-mode-line ### *screen-mode-line-format* The following variables control the color, position, and size of the mode line. See @ref{Colors} for an explanation of how to set these color variables. ### *mode-line-position* ### *mode-line-border-width* 1 ### *mode-line-pad-x* ### *mode-line-pad-y* ### *mode-line-background-color* ### *mode-line-foreground-color* ### *mode-line-border-color* ### *mode-line-timeout* @node Groups, Screens, Mode-line, Top @chapter Groups Groups in StumpWM are more commonly known as @dfn{virtual desktops} or @dfn{workspaces}. Why not create a new term for it? !!! gnew !!! gnew-float !!! gnewbg !!! gnewbg-float !!! gnext !!! gprev !!! gnext-with-window !!! gprev-with-window !!! gother !!! gmerge !!! groups !!! vgroups !!! gselect !!! gmove !!! gkill !!! grename !!! grouplist @menu * Customizing Groups:: @end menu @node Customizing Groups, , Groups, Groups @section Customizing Groups ### *group-formatters* ### *group-format* @@@ current-group @node Screens, Interacting With Unix, Groups, Top @chapter Screens StumpWM handles multiple screens. !!! snext !!! sprev !!! sother @menu * External Monitors:: * Programming With Screens:: @end menu @node External Monitors, Programming With Screens, Screens, Screens @section External Monitors StumpWM will attempt to detect external monitors (via @code{xdpyinfo}) at startup. StumpWM refers to each monitor as a head. Heads are logically contained by screens. In a dual-monitor configuration, there will be one screen with two heads. Non-rectangular layouts are supported (frames will not be created in the 'dead zone'.) And message windows will be displayed on the current head--that is, the head to which the currently focused frame belongs. In addition, StumpWM listens for XRandR events and re-configures the heads to match the new monitor configuration. Occasionally StumpWM will miss an XRandR event, use @code{refresh-heads} to synchronize the head configuration. !!! refresh-heads @node Programming With Screens, , External Monitors, Screens @section Programming With Screens @@@ current-screen @@@ screen-current-window @@@ current-window ### *screen-list* @node Interacting With Unix, Interacting With X11, Screens, Top @chapter Interacting With Unix !!! run-shell-command @@@ programs-in-path @@@ pathname-is-executable-p ### *shell-program* @@@ getenv @@@ (setf getenv) @node Interacting With X11, Miscellaneous Commands, Interacting With Unix, Top @chapter Interacting With X11 @@@ set-x-selection @@@ get-x-selection @node Miscellaneous Commands, Colors, Interacting With X11, Top @chapter Miscellaneous Commands The following is a list of commands that don't really fit in any other section. !!! emacs !!! banish !!! ratwarp !!! ratrelwarp !!! ratclick !!! echo-date !!! eval-line !!! window-send-string !!! reload !!! loadrc !!! keyboard-quit !!! quit !!! restart-hard !!! restart-soft !!! getsel !!! putsel !!! command-mode !!! copy-unhandled-error !!! commands !!! lastmsg !!! list-window-properties @@@ run-commands %%% defcommand %%% define-stumpwm-type @@@ run-or-raise @@@ run-or-pull ### *run-or-raise-all-groups* ### *run-or-raise-all-screens* @@@ restarts-menu %%% with-restarts-menu ### *startup-message* ### *suppress-abort-messages* ### *default-package* %%% defprogram-shortcut ### *initializing* @menu * Menus:: * StumpWM's Data Directory:: * Debugging StumpWM:: * Timers:: * Getting Help:: @end menu @node Menus, StumpWM's Data Directory, Miscellaneous Commands, Miscellaneous Commands @section Menus Some commands present the options in a menu. The following are the menu key bindings: @table @kbd @item C-p @itemx Up @itemx k Highlight the previous menu option. @item C-n @itemx Down @itemx j Highlight the next menu option. @item C-g @itemx ESC Abort the menu. @item RET Select the highlighted option. @end table @node StumpWM's Data Directory, Debugging StumpWM, Menus, Miscellaneous Commands @section StumpWM's Data Directory If you want to store StumpWM data between sessions, the recommended method is to store them in @file{~/.stumpwm.d/}. StumpWM supplies some functions to make doing this easier. ### *data-dir* @@@ data-dir-file %%% with-data-file @node Debugging StumpWM, Timers, StumpWM's Data Directory, Miscellaneous Commands @section Debugging StumpWM ### *debug-level* ### *debug-stream* @@@ redirect-all-output @node Timers, Getting Help, Debugging StumpWM, Miscellaneous Commands @section Timers StumpWM has a timer system similar to that of @dfn{Emacs}. @@@ run-with-timer @@@ cancel-timer @defun timer-p @var{timer} Return T if TIMER is a timer structure. @end defun @node Getting Help, , Timers, Miscellaneous Commands @section Getting Help !!! describe-key !!! describe-variable !!! describe-function !!! where-is !!! modifiers @node Colors, Hooks, Miscellaneous Commands, Top @chapter Colors When specifying a color, it is possible to use its X11 Color Name (usually in the file @file{/etc/X11/rgb.txt}). You can also use a six digit hex string prefixed by a '#' character in the same way that you can specify colors in HTML. All text printed by stumpwm is run through a coloring engine before being displayed. All color commands start with a @samp{^} (caret) character and apply to all text after it. @table @code @item ^0-9 A caret followed by a single digit number changes the foreground color to the specified color. A @samp{*} can be used to specify the normal color. See the color listing below. @item ^0-90-9 A caret followed by two digits sets the foreground and background color. The first digit refers to the foreground color and the second digit to the background color. A @samp{*} can be used in place of either digit to specify the normal color. See the color listing below. @item ^B Turn on bright colors. @item ^b Turn off bright colors. @item ^n Use the normal background and foreground color. @item ^R Reverse the foreground and background colors. @item ^r Turn off reverse colors. @item ^[ Push the current colors onto the color stack. The current colors remain unchanged. @item ^] Pop the colors off the color stack. @item ^> Align the rest of the line to the right of the window. @item ^f Sets the current font to the font at index n in the screen's font list. @item ^( &rest arguments) Allows for more complicated color settings: can be one of :fg, :bg, :reverse, :bright, :push, :pop, :font and :>. The arguments for each modifier differ: @itemize @item :fg and :bg take a color as an argument, which can either be a numeric index into the color map or a hexadecimal color in the form of "#fff" or "#ffffff". @item :reverse and :bright take either t or nil as an argument. T enables the setting and nil disables it. @item :push and :pop take no arguments. :push pushes the current settings onto the color stack, leaving the current settings intact. :pop pops color settings off the stack, updating the current settings. @item :font takes an integer that represents an index into the screen's list of fonts, or, possibly, a literal font object that can immediately be used. In a string you'll probably only want to specify an integer. @item :> takes no arguments. It triggers right-alignment for the rest of the line. @end itemize @item ^^ Print a regular caret. @end table The default colors are made to resemble the 16 VGA colors and are: @table @asis @item 0 black @item 1 red @item 2 green @item 3 yellow @item 4 blue @item 5 magenta @item 6 cyan @item 7 white @end table There are only 8 colors by default but 10 available digits. The last two digits are left up to the user. @ref{Behind The Scenes Look At Colors} for information on customizing colors. @menu * Behind The Scenes Look At Colors:: @end menu @node Behind The Scenes Look At Colors, , Colors, Colors @section Behind The Scenes Look At Colors Color indexes are stored in @var{*colors*} as a list. The default list of colors leave 2 slots for the user to choose. If you'd like to use @samp{Papaya Whip} and @samp{Dark Golden Rod 3} you might eval the following: @example (setf *colors* (append *colors* (list "PapayaWhip" "DarkGoldenRod3"))) (update-color-map (current-screen)) @end example Of course, you can change all the colors if you like. @@@ parse-color-string @@@ uncolorify ### *colors* @@@ update-color-map @node Hooks, Modules, Colors, Top @chapter Hooks StumpWM exports a number of hooks you can use to add customizations; like hooks in Emacs, you add to a hook with the @code{add-hook} function. for example: @example (stumpwm:add-hook 'stumpwm:*new-window-hook* 'my-new-window-custos) @end example adds your @code{my-new-window-custos} function to the list of functions called when a new window appears. %%% add-hook %%% remove-hook The following hooks are available: $$$ *new-window-hook* $$$ *destroy-window-hook* $$$ *focus-window-hook* $$$ *place-window-hook* $$$ *start-hook* $$$ *internal-loop-hook* $$$ *focus-frame-hook* $$$ *new-frame-hook* $$$ *message-hook* $$$ *top-level-error-hook* $$$ *focus-group-hook* $$$ *key-press-hook* $$$ *root-click-hook* $$$ *mode-line-click-hook* $$$ *urgent-window-hook* $$$ *event-processing-hook* @node Modules, Hacking, Hooks, Top @chapter Modules A module is a ASDF system that adds additional functionality to StumpWM. StumpWM searches for modules in the @var{*data-dir*}@file{/modules} directory. By default this is @file{~/.stumpwm.d/modules}. Officially supported modules exist in a separate repository within the StumpWM organization on github. You can install the latest copy by issuing @command{make install-modules} from StumpWM's root source directory. This will run: @example git clone git@@github.com:stumpwm/stumpwm-contrib.git ~/.stumpwm.d/modules @end example !!! load-module @@@ list-modules ### *load-path* !!! add-to-load-path @@@ init-load-path @@@ find-module @menu * Writing Modules:: @end menu @node Writing Modules, , Modules, Modules @section Writing Modules Make sure to read the @ref{Hacking}. If you are familiar with writing ASDF then you can jump in and get started. In either case, quicklisp ships a @code{quickproject} package that makes setting up a new module very easy. After installing quicklisp (see the README.md for a link): We're going to put our new module in the @file{modules/} directory of @var{*data-dir*} so that it will be immediately loadable by stumpwm. First make the directory @file{new-module}, then from a REPL issue: @example (ql:quickload "quickproject") (quickproject:make-project #p"~/.stumpwm.d/modules/new-module" :depends-on '(stumpwm) :name "new-module") @end example This will create: @example -rw-rw-r-- 1 dave dave 68 Apr 6 19:38 package.lisp -rw-rw-r-- 1 dave dave 53 Mar 16 2014 README.txt -rw-rw-r-- 1 dave dave 271 Mar 16 2014 new-module.asd -rw-rw-r-- 1 dave dave 1.8K Apr 6 17:51 new-module.lisp @end example The file @file{new-module.lisp} will contain the actual implementation of your module. ASDF requires two other files in order to understand how to load and compile your module. They are @file{new-module.asd} and @file{package.lisp}. In our example, @file{new-module.asd} should contain: @example (asdf:defsystem #:new-module :serial t :description "Describe new-module here" :author "Anne N. O'Nymous" :license "GPLv3" :depends-on (#:stumpwm) :components ((:file "package") (:file "new-module"))) ; any other files you make go here @end example The @file{package.lisp} will contain: @example (defpackage #:new-module (:use #:cl :stumpwm)) @end example With these two files defined, and the implementation written in @file{new-module.lisp}, you should be able to load your module. Before we load it, we have to add the path to our @var{*load-path*}. This can be accomplished by running the following from a REPL: @example (stumpwm:add-to-load-path "~/.stumpwm.d/modules/new-module") @end example You can also run this interactively with @kbd{C-t ;}, which is bound to the @command{colon} command. Because we've put our module in a sub-directory of the default @var{*module-dir*}, it will automatically get added to the @var{*load-path*} the next time StumpWM starts. If you choose to develop your module somewhere else (e.g. @file{~/quicklisp/local-projects}), then you'll have add @example (add-to-load-path "~/quicklisp/local-projects/new-module") @end example to your @file{.stumpwmrc}. When you've finished writing your module, you can distribute it however you see fit. If it becomes very popular, or you would like the StumpWM devs to maintain it (and they agree), you can have your module merged with the stumpwm-contrib repository on github, just open a pull request to start the discussion. @node Hacking, Command and Function Index, Modules, Top @chapter Hacking For those of you who have worked on Free Software projects before, this part should probably be fairly intuitive. @menu * General Advice:: * Using git with StumpWM:: * Sending Patches:: @end menu @node General Advice, Using git with StumpWM, Hacking, Hacking @section Hacking: General Advice @enumerate @item Pay attention to file names and contents. If you're making changes to mode-line related code, don't put it in @file{core.lisp}. If you're introducing some completely new featureset, consider putting all of the new code in a new file. @item Does a command need to be user-visible (``interactive'') or is it just called by other commands? @itemize @item If it's not going to be user-visible, you can just use the familiar @code{(defun foo () ...)} syntax. @item If you want the command to be used interactively, you use StumpWM's @code{defcommand} syntax, as in the examples below. @example (defcommand test (foo bar) ((:string "How you're going to prompt for variable foo: ") (:number "How you want to prompt for variable bar: ")) "This command is a test" (body...)) (defcommand test2 () () "This is also a test" (body...)) (defcommand title (args) (interactive-args) "Doc string" (body...)) @end example So basically, inside the first set of parentheses after the function name, you specify what (if any) arguments will be passed to the command. The second set of parentheses tells StumpWM how to get those arguments if they're not explicitly passed to the command. For example, @example ((:string "What do you want to do: ")) @end example will read a string from the input the user provides. The quoted text is the prompt the user will see. Of course, if you were to, say, call the command test, as defined above, from another piece of code, it wouldn't give the prompt as long as you fed it arguments. @end itemize @item Note that all commands defined using the @code{defcommand} syntax are available both to be called with @kbd{C-t ;} and from within other lisp programs, as though they had been defun-ned (which, in fact, they have). @item Any code that depends on external libraries or programs that some users might not have installed should be packaged as a module and placed in the @file{*data-dir*/modules/} directory. @item Don't be afraid to submit your patches to the StumpWM mailing list! It may not immediately make it into the official git repository, but individual users might find it useful and apply it to their own setup, or might be willing to offer suggestions on how to improve the code. @item Remember: StumpWM is designed to run on many lisp systems. If you must use code specific to one or the other, at the very least warn people that it only works with one lisp implementation. Better yet, 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 #to wrap the code for each lisp. Of course, the best option is to find a way to use the same code for clisp and SBCL. @end enumerate @node Using git with StumpWM, Sending Patches, General Advice, Hacking @section Hacking: Using git with StumpWM For quite a while now, StumpWM has been using the git version control system for development. If you're one using one of the official releases, you can get the bleeding-edge source code from the official git repository with a single command: @example $ git clone git@@github.com:stumpwm/stumpwm.git @end example After this, you'll have a complete git repository, along with the complete revision history since the switch. Feel free to play around; git has some important features that actually make this safe! Before we get to that stuff, though, you're going to want to tell git about yourself so that your information is included in your commits and patches. The very minimum you're going to want to do is: @example $ git config --global user.name "Anne N. O'Nymous" $ git config --global user.email "anonymous@@foo.org" @end example Be sure to check out the manual for @command{git-config}--there are several options you might want to set, such as enabling colorized output or changing the editor and pager you use when making commits and viewing logs. For the sake of argument, let's say you want to make some major changes to both @file{user.lisp} and @file{core.lisp}, add a file called @file{DANGEROUS_EXPERIMENT_DO_NOT_USE_OR_@-ELSE.lisp}, and remove the manual because you're too 1337 for such things. However, you don't want to break your entire StumpWM setup and start over. Thankfully, you don't have to. Before you get started, issue this command from the stumpwm directory: @example $ git checkout -b experimental @end example You should now find yourself in a new branch, called experimental. To confirm this, type @command{git branch}; there should be an asterisk next to the branch you're currently viewing. At any time, you can type @command{git checkout master} to return to your master branch, and at any time you can have as many branches of the project as you like. If you want to create a new branch based not on the master branch but on your experimental branch, for example, you'd type: @example $ git checkout -b new-experiment experimental @end example This will place you in a newly-created branch called ``new-experiment'' which should be identical to your experimental branch as of the last commit (more on that soon). If you're actually typing out the directions, switch back to your old experimental branch like so: @example $ git checkout experimental @end example Anyway, now that you have a new branch, create that new file with the long name, which I'll just call @file{danger.lisp} for brevity. Make whatever changes you want to it, and when you're done, tell git about your new file. @example $ git add dangerous.lisp @end example Now, let's pretend you're done making changes. Tell git you're done for now: @example $ git commit -a @end example This will open up a prompt in your editor of choice for you to describe your changes. Try to keep the first line short, and then add more explanation underneath (for an example, run the command @command{git log} and take a look at some of the longer commit explanations). Save that file and then do this: @example $ git checkout master $ ls @end example Then look for your new file. It's not there! That's because you've done all of your work in another branch, which git is currently hiding from you so that you can ``check out'' the branch called ``master.'' All is as it should be--your master repository is still safe. @example $ git checkout experimental @end example Now, delete @file{manual.lisp} and @file{stumpwm.texi}. That's right. Wipe them off the face of the Earth, or at least off the hard drive of your computer. When you're done, you don't have to tell git you've deleted them; it'll figure it out on its own (though things may not compile properly unless you edit @file{Makefile.in} and @file{stumpwm.asd}. Anyway, go ahead and edit @file{core.lisp} and @file{user.lisp}. Really break 'em. Run free! When you're done, do another commit, as above, and give it a stupid title like ``lolz i b0rked stUmpwm guys wTF!?!?!!111!'' Now try to compile. Just try. It won't work. If it does, you're some kind of savant or something. Keep up the good work. If you've actually managed to break StumpWM like you were supposed to, never fear! You have two options at this point. One is to go back to the master branch (with another git checkout) and just delete your experimental branch, like so: @example $ git branch -D @end example The ``@code{-D}'' means to force a delete, even if the changes you've made aren't available elsewhere. A ``@code{-d}'' means to delete the branch if and only if you've merged the changes in elsewhere. The other option is to create patches for each of your commits so far, delete the branch, and then apply any working/wanted patches in a new branch. Create your patches (after committing) like so: @example $ git format-patch -o patches origin @end example (Before doing that you can review your changes with @command{git log origin..}) You can also use the @command{format-patch} command to create a patch of working code to send in to the mailing list. A developer might ask you to try out something they're working on. To fetch their master branch, you'd do this: @example $ git remote add -f -m master -t master foo git://bar.org/~foo/stumpwm @end example Here, ``foo'' is the shorthand name you'll use to refer to that repository in the future. To checkout a local copy of that repository, you'd then do @example $ git checkout --track -b foo-master foo/master @end example Later you could use @command{git pull foo} to update while looking at that branch (and note that @command{git pull} with no arguments, in the master branch, will update your StumpWM from the official repository). Finally, if you want to move your experimental changes into your master branch, you'd checkout your master branch and run: @example $ git merge experimental @end example If there are file conflicts, @command{git diff} will show you where they are; you have to fix them by hand. When you're done, do another @example $ git commit -a @end example to finalize the changes to your master branch. You can then delete your experimental branch. Alternately, you can wait until your changes (assuming you sent them in) make it into the official repository before deleting your experimental branch. @node Sending Patches, , Using git with StumpWM, Hacking @section Sending Patches While patches are still welcome on the mailing list, StumpWM's development has mostly migrated to github's issue tracker. This means you can open a pull request to submit a patch to StumpWM. The following guidelines apply to pull requests and patches sent to the mailing list. @itemize @item Make sure it applies clean to the main git repository @item Ensure that you aren't introducing tabs, extra blank lines, or whitespace at the end of lines. @item Ensure your patch doesn't contain irrelevant indenting or reformatting changes. @item Try to make your patch address a single issue. If your patch changes two unrelated issues, break them into two seperate patches that can stand on their own. @item Don't send intermediate patches. When you're working on a feature you might make several commits to your local repository as you refine it and work out the bugs. When it's polished and ready to ship, send it as one patch! Sometimes it makes sense to send it as multiple patches if each patch contains a discrete feature or bug fix that can stand on its own. If one of your patches changes code that was added or modified in an earlier patch, consider merging them together and sending them as one. @end itemize @node Command and Function Index, Variable Index, Hacking, Top @unnumbered Command and Function Index @printindex fn @node Variable Index, , Command and Function Index, Top @unnumbered Variable Index @printindex vr @bye stumpwm-0.9.9/test-wm.lisp000066400000000000000000000230051242702317100155350ustar00rootroot00000000000000(defpackage :test-wm (:use :cl)) (in-package :test-wm) (defparameter *current-test-num* 0) (defparameter *tests* nil) (defmacro define-test ((dpy screen) &body body) (let ((name (intern (format nil "TEST-~d" *current-test-num*)))) `(progn (defun ,name (,dpy ,screen) (format t "Starting test ~d~%" ,*current-test-num*) ,@body (format t "Done.~%")) (push ',name *tests*) (incf *current-test-num*)))) (define-test (dpy screen) (let ((w (xlib:create-window :parent (xlib:screen-root screen) :x 10 :y 10 :width 100 :height 100 :border-width 1))) (xlib:map-window w) (xlib:display-finish-output dpy) (xlib:destroy-window w) (xlib:display-finish-output dpy))) (define-test (dpy screen) (let ((w (xlib:create-window :parent (xlib:screen-root screen) :x 10 :y 10 :width 100 :height 100 :border-width 1))) (xlib:map-window w) (xlib:display-finish-output dpy) (sleep 1) (setf (xlib:window-priority w) :above) ;; (setf (xlib:drawable-border-width w) 3) (xlib:display-finish-output dpy) (xlib:destroy-window w) (xlib:display-finish-output dpy))) (define-test (dpy screen) (let ((windows (loop for i from 0 to 100 collect (let ((w (xlib:create-window :parent (xlib:screen-root screen) :x 10 :y 10 :width 100 :height 100 :border-width 1))) (xlib:map-window w) (xlib:display-finish-output dpy) (setf (xlib:window-priority w) :above) w)))) (xlib:display-finish-output dpy) (loop for i in windows do (xlib:unmap-window i)) (xlib:display-finish-output dpy) (sleep 3) (loop for i in windows do (xlib:destroy-window i)))) ;; (define-test (dpy screen) ;; (let ((windows (loop for i from 0 to 100 ;; collect (let ((w (xlib:create-window :parent (xlib:screen-root screen) ;; :x 10 :y 10 :width 100 :height 100 :border-width 1))) ;; (xlib:map-window w) ;; (xlib:display-finish-output dpy) ;; (setf (xlib:window-priority w) :above) ;; w)))) ;; (xlib:display-finish-output dpy) ;; (loop for i in windows do ;; (xlib:unmap-window i)) ;; (xlib:display-finish-output dpy) ;; (sleep 3) ;; (loop for i in windows do ;; (xlib:destroy-window i)))) (define-test (dpy screen) (let ((w (xlib:create-window :parent (xlib:screen-root screen) :x 10 :y 10 :width 100 :height 100 :border-width 1))) (xlib:map-window w) (setf (xlib:window-priority w) :above) (xlib:display-finish-output dpy) (xlib:unmap-window w) (setf (xlib:drawable-x w) 5) (xlib:display-finish-output dpy))) (define-test (dpy screen) ;; create a window and set its role after being mapped (let ((w (xlib:create-window :parent (xlib:screen-root screen) :x 10 :y 10 :width 100 :height 100 :border-width 1))) (xlib:map-window w) (xlib:display-finish-output dpy) (sleep 1) (xlib:change-property w :WM_WINDOW_ROLE (map 'list 'char-code "rad dude") :string 8) (xlib:display-finish-output dpy) (sleep 10))) (defun break-display-xid-cache () (labels ((make-win (dpy) (xlib:create-window :parent (xlib:screen-root (first (xlib:display-roots dpy))) :x 0 :y 0 :width 50 :height 50)) (make-pixmap (window) (xlib:create-pixmap :width (random 100) :height (random 100) :depth 8 :drawable window)) (first-pass (dpy) ;; Open a fresh connection. Create a window and a pixmap. (let* ((dpy2 (xlib:open-default-display)) (window (make-win dpy2)) (pixmap (make-pixmap window))) ;; make the pixmap the window's icon pixmap hint. (setf (xlib:wm-hints window) (xlib:make-wm-hints :icon-pixmap pixmap)) (format t "Window ID: ~s pixmap ID: ~s~%" (xlib:window-id window) (xlib:pixmap-id pixmap)) (xlib:map-window window) (xlib:display-finish-output dpy2) (sleep 1) ;; On the old connection, list the root window children ;; and the icon pixmap hint to cache their XIDs. (loop for w in (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy)))) for hints = (xlib:wm-hints w) when hints do (format t "top level window id: ~s | icon pixmap hint: ~s~%" (xlib:window-id w) (xlib:wm-hints-icon-pixmap hints))) (xlib:close-display dpy2))) (second-pass (dpy) ;; Open a fresh connection and create 2 windows. (let* ((dpy2 (xlib:open-default-display)) (window1 (make-win dpy2)) (window2 (make-win dpy2))) (format t "Window#1 ID: ~s Window#2 ID: ~s~%" (xlib:window-id window1) (xlib:window-id window2)) (xlib:display-finish-output dpy2) ;; On the old connection, list the root window children ;; and note the second window is erroneously a pixmap ;; due to too agressive caching in clx. (loop for w in (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy)))) do (format t "window: ~s~%" w)) (xlib:close-display dpy2)))) (let ((dpy (xlib:open-default-display))) (first-pass dpy) (second-pass dpy) (xlib:close-display dpy)))) (defun test-wm-class (map-p) "Test the robustness of CLX's wm-class function. If MAP-P is T then map the window. Useful if you want to test the running window manager." (labels ((test-it (w &rest strings) (xlib:change-property w :WM_CLASS (apply #'concatenate '(vector xlib:card8) strings) :string 8) (print (multiple-value-list (xlib:get-wm-class w))) ;; give the wm a chance to try out the value (when map-p (sleep 1))) (convert (s) (map '(vector xlib:card8) #'xlib:char->card8 s))) (let* ((dpy (xlib:open-default-display)) (screen (first (xlib:display-roots dpy))) (root (xlib:screen-root screen)) (win (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100 :background (xlib:screen-white-pixel screen)))) (unwind-protect (when map-p (xlib:map-window win)) (progn (test-it win (convert "string 1") #(0) (convert "string 2") #(0)) (test-it win (convert "Manifold X") #(0) (convert "Powercoupling Y") #(0) (convert "Magistrate Z") #(0)) (test-it win #(0)) (test-it win) (test-it win #(0) (convert "checkity checkfoo")) (test-it win (convert "ohh bother") #(0) (convert "Magic Fudge")) (test-it win (convert "You Gellin?") #(0)) (test-it win (convert "Blinky The Cloon"))) (xlib:close-display dpy)) (values)))) (defun get-wm-hints () "simias reports that on sbcl the wm-hints property is all screwed up when he runs an x server on 32 or 64bit freebsd and runs any x client on a fedora 32bit, connecting through an ssh tunnel. clisp works fine. so run this function on clisp and sbcl and compare the numbers. This assumes you're running a reparenting wm." (let ((dpy (xlib:open-default-display))) (write-line "you gotta have some windows open for this to work.") (dolist (top (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy))))) (dolist (w (xlib:query-tree top)) (format t "~s ~s: ~s~%" w (xlib:wm-name w) (xlib:get-property w :WM_HINTS :type :WM_HINTS :result-type 'vector)))) (xlib:close-display dpy))) (defun parse-display-string (display) "Parse an X11 DISPLAY string and return the host and display from it." (let* ((colon (position #\: display)) (host (subseq display 0 colon)) (rest (subseq display (1+ colon))) (dot (position #\. rest)) (num (parse-integer (subseq rest 0 dot)))) (values host num))) (defvar *dpy* nil) (defun test-wm (display-str) (multiple-value-bind (host display) (parse-display-string display-str) (setf *dpy* (xlib:open-display host :display display :protocol nil)) (let* ((dpy *dpy*) (screen (first (xlib:display-roots dpy)))) (unwind-protect (progn ;; (dolist (i *tests*) ;; (funcall i dpy screen)) (funcall (car *tests*) dpy screen) ) (xlib:close-display *dpy*))))) stumpwm-0.9.9/tile-group.lisp000066400000000000000000001314371242702317100162350ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Frame functions ;; ;; Code: (in-package #:stumpwm) (export '(save-frame-excursion)) (defclass tile-group (group) ((frame-tree :accessor tile-group-frame-tree) (last-frame :initform nil :accessor tile-group-last-frame) (current-frame :accessor tile-group-current-frame))) (defmethod initialize-instance :after ((group tile-group) &key &allow-other-keys) (let* ((heads (copy-heads (group-screen group)))) (setf (tile-group-frame-tree group) heads (tile-group-current-frame group) (first heads)))) (defmethod group-startup ((group tile-group)) (let ((window (first (group-windows group)))) (if window (focus-frame group (window-frame window)) (focus-frame group (tile-group-current-frame group))))) (defmethod group-wake-up ((group tile-group)) (focus-frame group (tile-group-current-frame group)) ;; doesn't get called by focus-frame (show-frame-indicator group)) (defmethod group-delete-window ((group tile-group) window) (let ((f (window-frame window))) ;; maybe pick a new window for the old frame (when (eq (frame-window f) window) (frame-raise-window group f (first (frame-windows group f)) nil)))) (defmethod group-add-window ((group tile-group) window &key frame raise &allow-other-keys) ;; This is important to get the frame slot (change-class window 'tile-window) ;; Try to put the window in the appropriate frame for the group. (setf (window-frame window) (or frame (when *processing-existing-windows* (find-frame group (xlib:drawable-x (window-parent window)) (xlib:drawable-y (window-parent window)))) (pick-preferred-frame window))) (when *processing-existing-windows* (setf (frame-window (window-frame window)) window)) (when (and frame raise) (setf (tile-group-current-frame group) frame (frame-window frame) nil)) (sync-frame-windows group (window-frame window)) ;; maybe show the window in its new frame (when (null (frame-window (window-frame window))) (really-raise-window window))) (defmethod group-current-window ((group tile-group)) (frame-window (tile-group-current-frame group))) (defmethod group-current-head ((group tile-group)) (frame-head group (tile-group-current-frame group))) (defmethod group-move-request ((group tile-group) window x y relative-to) (when *honor-window-moves* (dformat 3 "Window requested new position ~D,~D relative to ~S~%" x y relative-to) (let* ((pos (if (eq relative-to :parent) (list (+ (xlib:drawable-x (window-parent window)) x) (+ (xlib:drawable-y (window-parent window)) y)) (list x y))) (frame (apply #'find-frame group pos))) (when frame (pull-window window frame))))) (defmethod group-resize-request ((group tile-group) window width height) ;; it's important to grant the resize request first so that resize ;; increment hints use the proper base size to resize from. (set-window-geometry window :width width :height height) (maximize-window window)) (defmethod group-raise-request ((group tile-group) window stack-mode) (when (window-in-current-group-p window) (case stack-mode (:map (maybe-map-window window)) (:above (maybe-raise-window window))))) (defmethod group-lost-focus ((group tile-group)) ;; If this window had the focus, try to avoid losing it. (let ((frame (tile-group-current-frame group))) (setf (frame-window frame) (first (remove-if 'window-hidden-p (frame-windows group frame)))) (focus-frame group frame))) (defmethod group-indicate-focus ((group tile-group)) (show-frame-indicator group)) (defmethod group-focus-window ((group tile-group) win) (frame-raise-window group (window-frame win) win)) (defmethod group-button-press ((group tile-group) x y (where (eql :root))) (when *root-click-focuses-frame* (let* ((frame (find-frame group x y))) (when frame (focus-frame group frame) (update-all-mode-lines))))) (defmethod group-button-press ((group tile-group) x y (where window)) (declare (ignore x y)) (when (eq *mouse-focus-policy* :click) (focus-all where) (update-all-mode-lines))) (defmethod group-root-exposure ((group tile-group)) (show-frame-outline group nil)) (defmethod group-add-head ((group tile-group) head) (let ((new-frame-num (find-free-frame-number group))) (setf (tile-group-frame-tree group) (insert-before (tile-group-frame-tree group) (copy-frame head) (head-number head))) ;; Try to put something in the new frame and give it an unused number (let ((frame (tile-group-frame-head group head))) (setf (frame-number frame) new-frame-num) (choose-new-frame-window frame group) (when (frame-window frame) (unhide-window (frame-window frame)))))) (defmethod group-remove-head ((group tile-group) head) (let ((windows (head-windows group head))) ;; Remove it from the frame tree. (setf (tile-group-frame-tree group) (delete (tile-group-frame-head group head) (tile-group-frame-tree group))) ;; Just set current frame to whatever. (let ((frame (first (group-frames group)))) (setf (tile-group-current-frame group) frame (tile-group-last-frame group) nil) ;; Hide its windows. (dolist (window windows) (hide-window window) (setf (window-frame window) frame)))) ;; Try to do something with the orphaned windows (populate-frames group)) (defmethod group-resize-head ((group tile-group) oh nh) (resize-tree (tile-group-frame-head group oh) (head-width nh) (head-height nh) (head-x nh) (head-y nh))) (defmethod group-sync-all-heads ((group tile-group)) (sync-all-frame-windows group)) (defmethod group-sync-head ((group tile-group) head) (dolist (f (head-frames group head)) (sync-frame-windows group f))) ;;;;; (defun tile-group-frame-head (group head) (elt (tile-group-frame-tree group) (position head (group-heads group)))) (defun (setf tile-group-frame-head) (frame group head) (setf (elt (tile-group-frame-tree group) (position head (group-heads group))) frame)) (defun populate-frames (group) "Try to fill empty frames in GROUP with hidden windows" (dolist (f (group-frames group)) (unless (frame-window f) (choose-new-frame-window f group) (when (frame-window f) (maximize-window (frame-window f)) (unhide-window (frame-window f)))))) (defun frame-by-number (group n) (unless (eq n nil) (find n (group-frames group) :key 'frame-number :test '=))) (defun find-frame (group x y) "Return the frame of GROUP containing the pixel at X Y" (dolist (f (group-frames group)) (let* ((fy (frame-y f)) (fx (frame-x f)) (fwx (+ fx (frame-width f))) (fhy (+ fy (frame-height f)))) (when (and (>= y fy) (<= y fhy) (>= x fx) (<= x fwx) (return f)))))) (defun frame-set-x (frame v) (decf (frame-width frame) (- v (frame-x frame))) (setf (frame-x frame) v)) (defun frame-set-y (frame v) (decf (frame-height frame) (- v (frame-y frame))) (setf (frame-y frame) v)) (defun frame-set-r (frame v) (setf (frame-width frame) (- v (frame-x frame)))) (defun frame-set-b (frame v) (setf (frame-height frame) (- v (frame-y frame)))) (defun frame-r (frame) (+ (frame-x frame) (frame-width frame))) (defun frame-b (frame) (+ (frame-y frame) (frame-height frame))) (defun frame-display-y (group frame) "Return a Y for frame that doesn't overlap the mode-line." (let* ((head (frame-head group frame)) (ml (head-mode-line head)) (head-y (frame-y head)) (rel-frame-y (- (frame-y frame) head-y))) (if (and ml (not (eq (mode-line-mode ml) :hidden))) (case (mode-line-position ml) (:top (+ head-y (+ (mode-line-height ml) (round (* rel-frame-y (mode-line-factor ml)))))) (:bottom (+ head-y (round (* rel-frame-y (mode-line-factor ml)))))) (frame-y frame)))) (defun frame-display-height (group frame) "Return a HEIGHT for frame that doesn't overlap the mode-line." (let* ((head (frame-head group frame)) (ml (head-mode-line head))) (if (and ml (not (eq (mode-line-mode ml) :hidden))) (round (* (frame-height frame) (mode-line-factor ml))) (frame-height frame)))) (defun frame-intersect (f1 f2) "Return a new frame representing (only) the intersection of F1 and F2. WIDTH and HEIGHT will be <= 0 if there is no overlap" (let ((r (copy-frame f1))) (when (> (frame-x f2) (frame-x f1)) (frame-set-x r (frame-x f2))) (when (< (+ (frame-x f2) (frame-width f2)) (+ (frame-x f1) (frame-width f1))) (frame-set-r r (frame-r f2))) (when (> (frame-y f2) (frame-y f1)) (frame-set-y r (frame-y f2))) (when (< (+ (frame-y f2) (frame-height f2)) (+ (frame-y f1) (frame-height f1))) (frame-set-b r (frame-b f2))) (values r))) (defun frames-overlap-p (f1 f2) "Returns T if frames F1 and F2 overlap at all" (check-type f1 frame) (check-type f2 frame) (and (and (frame-p f1) (frame-p f2)) (let ((frame (frame-intersect f1 f2))) (values (and (plusp (frame-width frame)) (plusp (frame-height frame))))))) (defun frame-raise-window (g f w &optional (focus t)) "Raise the window w in frame f in group g. if FOCUS is T (default) then also focus the frame." (let ((oldw (frame-window f))) ;; nothing to do when W is nil (setf (frame-window f) w) (unless (and w (eq oldw w)) (if w (raise-window w) (mapc 'hide-window (frame-windows g f)))) ;; If raising a window in the current frame we must focus it or ;; the group and screen will get out of sync. (when (or focus (eq (tile-group-current-frame g) f)) (focus-frame g f)) (when (and w (not (window-modal-p w))) (raise-modals-of w)))) (defun focus-frame (group f) (let ((w (frame-window f)) (last (tile-group-current-frame group)) (show-indicator nil)) (setf (tile-group-current-frame group) f) ;; record the last frame to be used in the fother command. (unless (eq f last) (setf (tile-group-last-frame group) last) (run-hook-with-args *focus-frame-hook* f last) (setf show-indicator t)) (if w (focus-window w) (no-focus group (frame-window last))) (if show-indicator (show-frame-indicator group) (show-frame-outline group)))) (defun frame-windows (group 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)) (sort-windows group))) (defun copy-frame-tree (tree) "Return a copy of the frame tree." (cond ((null tree) tree) ((typep tree 'frame) (copy-structure tree)) (t (mapcar #'copy-frame-tree tree)))) (defun group-frames (group) (tree-accum-fn (tile-group-frame-tree group) 'nconc 'list)) (defun head-frames (group head) (tree-accum-fn (tile-group-frame-head group head) 'nconc 'list)) (defun find-free-frame-number (group) (find-free-number (mapcar 'frame-number (group-frames group)))) (defun choose-new-frame-window (frame group) "Find out what window should go in a newly created frame." (let ((win (case *new-frame-action* (:last-window (other-hidden-window group)) (t nil)))) (setf (frame-window frame) win) (when win (setf (window-frame win) frame)))) (defun split-frame-h (group p ratio) "Return 2 new frames. The first one stealing P's number and window" (let* ((w (ratio-or-pixel (frame-width p) ratio)) (h (frame-height p)) (f1 (make-frame :number (frame-number p) :x (frame-x p) :y (frame-y p) :width w :height h :window (frame-window p))) (f2 (make-frame :number (find-free-frame-number group) :x (+ (frame-x p) w) :y (frame-y p) ;; gobble up the modulo :width (- (frame-width p) w) :height h :window nil))) (run-hook-with-args *split-frame-hook* p f1 f2) (run-hook-with-args *new-frame-hook* f2) (values f1 f2))) (defun split-frame-v (group p ratio) "Return 2 new frames. The first one stealing P's number and window" (let* ((w (frame-width p)) (h (ratio-or-pixel (frame-height p) ratio)) (f1 (make-frame :number (frame-number p) :x (frame-x p) :y (frame-y p) :width w :height h :window (frame-window p))) (f2 (make-frame :number (find-free-frame-number group) :x (frame-x p) :y (+ (frame-y p) h) :width w ;; gobble up the modulo :height (- (frame-height p) h) :window nil))) (run-hook-with-args *split-frame-hook* p f1 f2) (run-hook-with-args *new-frame-hook* f2) (values f1 f2))) (defun ratio-or-pixel (length ratio) "Return a ratio of length unless ratio is an integer. If ratio is an integer return the number of pixel desired." (if (integerp ratio) ratio (truncate (* length ratio)))) (defun funcall-on-leaf (tree leaf fn) "Return a new tree with LEAF replaced with the result of calling FN on LEAF." (cond ((atom tree) (if (eq leaf tree) (funcall fn leaf) tree)) (t (mapcar (lambda (sib) (funcall-on-leaf sib leaf fn)) tree)))) (defun funcall-on-node (tree fn match) "Call fn on the node where match returns t." (if (funcall match tree) (funcall fn tree) (cond ((atom tree) tree) (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))) (defun sibling-internal (tree leaf fn) "helper for next-sibling and prev-sibling." (cond ((atom tree) nil) ((find leaf tree) (let* ((rest (cdr (member leaf (funcall fn tree)))) (pick (car (if (null rest) (funcall fn tree) rest)))) (unless (eq pick leaf) pick))) (t (find-if (lambda (x) (sibling-internal x leaf fn)) tree)))) (defun next-sibling (tree leaf) "Return the sibling of LEAF in TREE." (sibling-internal tree leaf 'identity)) (defun prev-sibling (tree leaf) (sibling-internal tree leaf 'reverse)) (defun closest-sibling (tree leaf) "Return the sibling to the right/below of leaf or left/above if leaf is the most right/below of its siblings." (let* ((parent (tree-parent tree leaf)) (lastp (= (position leaf parent) (1- (length parent))))) (if lastp (prev-sibling parent leaf) (next-sibling parent leaf)))) (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))) (group-windows group))) (defun tree-accum-fn (tree acc fn) "Run an accumulator function on fn applied to each leaf" (cond ((null tree) nil) ((atom tree) (funcall 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)))) (defun tree-x (tree) (tree-accum-fn tree 'min 'frame-x)) (defun tree-y (tree) (tree-accum-fn tree 'min 'frame-y)) (defun tree-width (tree) (cond ((atom tree) (frame-width tree)) ((tree-row-split tree) ;; in row splits, all children have the same width, so use the ;; first one. (tree-width (first tree))) (t ;; for column splits we add the width of each child (reduce '+ tree :key 'tree-width)))) (defun tree-height (tree) (cond ((atom tree) (frame-height tree)) ((tree-column-split tree) ;; in row splits, all children have the same width, so use the ;; first one. (tree-height (first tree))) (t ;; for column splits we add the width of each child (reduce '+ tree :key 'tree-height)))) (defun tree-parent (top node) "Return the list in TOP that contains NODE." (cond ((atom top) nil) ((find node top) top) (t (loop for i in top thereis (tree-parent i node))))) (defun tree-leaf (top) "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) (car siblings)) #'identity)) (defun tree-row-split (tree) "Return t if the children of tree are stacked vertically" (loop for i in (cdr tree) with head = (car tree) always (= (tree-x head) (tree-x i)))) (defun tree-column-split (tree) "Return t if the children of tree are side-by-side" (loop for i in (cdr tree) with head = (car tree) always (= (tree-y head) (tree-y i)))) (defun tree-split-type (tree) "return :row or :column" (cond ((tree-column-split tree) :column) ((tree-row-split tree) :row) (t (error "tree-split-type unknown")))) (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)))) (defun offset-tree-dir (tree amount dir) (ecase dir (:left (offset-tree tree (- amount) 0)) (:right (offset-tree tree amount 0)) (:top (offset-tree tree 0 (- amount))) (:bottom (offset-tree tree 0 amount)))) (defun expand-tree (tree amount dir) "expand the frames in tree by AMOUNT in DIR direction. DIR can be :top :bottom :left :right" (labels ((expand-frame (f amount dir) (ecase dir (:left (decf (frame-x f) amount) (incf (frame-width f) amount)) (:right (incf (frame-width f) amount)) (:top (decf (frame-y f) amount) (incf (frame-height f) amount)) (:bottom (incf (frame-height f) amount))))) (cond ((null tree) nil) ((atom tree) (expand-frame tree amount dir)) ((or (and (find dir '(:left :right)) (tree-row-split tree)) (and (find dir '(:top :bottom)) (tree-column-split tree))) (dolist (i tree) (expand-tree i amount dir))) (t (let* ((children (if (find dir '(:left :top)) (reverse tree) tree)) (sz-fn (if (find dir '(:left :right)) 'tree-width 'tree-height)) (total (funcall sz-fn tree)) (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))) (ofs 0)) ;; spread the remainder out as evenly as possible (assert (< remainder (length amt-list))) (loop for i upfrom 0 while (> remainder 0) do (incf (nth i amt-list)) (decf remainder)) ;; resize proportionally (loop for i in children for amt in amt-list do (expand-tree i amt dir) (offset-tree-dir i ofs dir) (incf ofs amt))))))) (defun join-subtrees (tree leaf) "expand the children of tree to occupy the space of LEAF. Return tree with leaf removed." (let* ((others (remove leaf tree)) (newtree (if (= (length others) 1) (car others) others)) (split-type (tree-split-type tree)) (dir (if (eq split-type :column) :right :bottom)) (ofsdir (if (eq split-type :column) :left :top)) (amt (if (eq split-type :column) (tree-width leaf) (tree-height leaf))) (after (cdr (member leaf tree)))) ;; align all children after the leaf with the edge of the ;; frame before leaf. (offset-tree-dir after amt ofsdir) (expand-tree newtree amt dir) newtree)) (defun resize-tree (tree w h &optional (x (tree-x tree)) (y (tree-y tree))) "Scale TREE to width W and height H, ignoring aspect. If X and Y are provided, reposition the TREE as well." (let* ((tw (tree-width tree)) (th (tree-height tree)) (tx (tree-x tree)) (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)))) (dformat 4 "resize-tree ~Dx~D -> ~Dx~D~%" tw th (tree-width tree) (tree-height tree)))) (defun remove-frame (tree leaf) "Return a new tree with LEAF and it's sibling merged into one." (cond ((atom tree) tree) ((find leaf tree) (join-subtrees tree 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))) (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))))) (defun sync-head-frame-windows (group head) "synchronize all frames in GROUP and HEAD." (dolist (f (head-frames group head)) (sync-frame-windows group f))) (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))))) (defun resize-frame (group frame amount dim) "Resize FRAME by AMOUNT in DIM dimension, DIM can be either :width or :height" (check-type group group) (check-type frame frame) (check-type amount integer) ;; (check-type dim (member :width :height)) (labels ((max-amount (parent node min dim-fn) (let ((right-sibling (cadr (member node parent))) (left-sibling (cadr (member node (reverse parent))))) (dformat 10 "max ~@{~a~^ ~}~%" parent node min dim-fn right-sibling left-sibling) (if parent (cond (right-sibling (max 0 (- (funcall dim-fn right-sibling) min))) (left-sibling (max 0 (- (funcall dim-fn left-sibling) min))) (t 0)) ;; no parent means the frame can't get any bigger. 0)))) (let* ((tree (tile-group-frame-tree group)) (parent (tree-parent tree frame)) (gparent (tree-parent tree parent)) (split-type (tree-split-type parent))) (dformat 10 "~s ~s parent: ~s ~s width: ~s h: ~s~%" dim amount split-type parent (tree-width parent) (tree-height parent)) ;; normalize amount (let* ((max (ecase dim (:width (if (>= (frame-width frame) (frame-width (frame-head group frame))) 0 (if (eq split-type :column) (max-amount parent frame *min-frame-width* 'tree-width) (max-amount gparent parent *min-frame-width* 'tree-width)))) (:height (if (>= (frame-height frame) (frame-height (frame-head group frame))) 0 (if (eq split-type :row) (max-amount parent frame *min-frame-height* 'tree-height) (max-amount gparent parent *min-frame-height* 'tree-height)))))) (min (ecase dim ;; Frames taking up the entire HEAD in one ;; dimension can't be resized in that dimension. (:width (if (and (eq split-type :row) (or (null gparent) (>= (frame-width frame) (frame-width (frame-head group frame))))) 0 (- *min-frame-width* (frame-width frame)))) (:height (if (and (eq split-type :column) (or (null gparent) (>= (frame-height frame) (frame-height (frame-head group frame))))) 0 (- *min-frame-height* (frame-height frame))))))) (setf amount (max (min amount max) min)) (dformat 10 "bounds ~d ~d ~d~%" amount max min)) ;; if FRAME is taking up the whole DIM or if AMOUNT = 0, do nothing (unless (zerop amount) (let* ((resize-parent (or (and (eq split-type :column) (eq dim :height)) (and (eq split-type :row) (eq dim :width)))) (to-resize (if resize-parent parent frame)) (to-resize-parent (if resize-parent gparent parent)) (lastp (= (position to-resize to-resize-parent) (1- (length to-resize-parent)))) (to-shrink (if lastp (prev-sibling to-resize-parent to-resize) (next-sibling to-resize-parent to-resize)))) (expand-tree to-resize amount (ecase dim (:width (if lastp :left :right)) (:height (if lastp :top :bottom)))) (expand-tree to-shrink (- amount) (ecase dim (:width (if lastp :right :left)) (: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))) (tree-iterate to-shrink (lambda (leaf) (sync-frame-windows group leaf))))))))) (defun balance-frames-internal (group tree) "Resize all the children of tree to be of equal width or height depending on the tree's split direction." (let* ((split-type (tree-split-type tree)) (fn (if (eq split-type :column) 'tree-width 'tree-height)) (side (if (eq split-type :column) :right :bottom)) (total (funcall fn tree)) size rem) (multiple-value-setq (size rem) (truncate total (length tree))) (loop for i in tree for j = rem then (1- j) for totalofs = 0 then (+ totalofs ofs) for ofs = (+ (- size (funcall fn i)) (if (plusp j) 1 0)) do (expand-tree i ofs side) (offset-tree-dir i totalofs side) (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 it succeeded. NIL otherwise. RATIO is a fraction of the screen to allocate to the new split window. If ratio is an integer then the number of pixels will be used. This can be handy to setup the desktop when starting." (check-type how (member :row :column)) (let* ((frame (tile-group-current-frame group)) (head (frame-head group frame))) ;; don't create frames smaller than the minimum size (when (or (and (eq how :row) (>= (frame-height frame) (* *min-frame-height* 2))) (and (eq how :column) (>= (frame-width frame) (* *min-frame-width* 2)))) (multiple-value-bind (f1 f2) (funcall (if (eq how :column) 'split-frame-h 'split-frame-v) group frame ratio) (setf (tile-group-frame-head group head) (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)))))) (migrate-frame-windows group frame f1) (choose-new-frame-window f2 group) (if (eq (tile-group-current-frame group) frame) (setf (tile-group-current-frame group) f1)) (setf (tile-group-last-frame group) f2) (sync-frame-windows group f1) (sync-frame-windows group f2) ;; we also need to show the new window in the other frame (when (frame-window f2) (unhide-window (frame-window f2))) (frame-number f2))))) (defun draw-frame-outline (group f tl br) "Draw an outline around FRAME." (let* ((screen (group-screen group)) (win (if (frame-window f) (window-xwin (frame-window f)) (screen-root screen))) (width (screen-frame-outline-width screen)) (gc (screen-frame-outline-gc screen)) (halfwidth (/ width 2))) (when (> width 0) (let ((x (frame-x f)) (y (frame-display-y group f)) (w (frame-width f)) (h (frame-display-height group f))) (when tl (xlib:draw-line win gc x (+ halfwidth y) w 0 t) (xlib:draw-line win gc (+ halfwidth x) y 0 h t)) (when br (xlib:draw-line win gc (+ x (- w halfwidth)) y 0 h t) (xlib:draw-line win gc x (+ y (- h halfwidth)) w 0 t)))))) (defun draw-frame-outlines (group &optional head) "Draw an outline around all frames in GROUP." (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))))) (defun clear-frame-outlines (group) "Clear the outlines drawn with DRAW-FRAME-OUTLINES." (xlib:clear-area (screen-root (group-screen group)))) (defun draw-frame-numbers (group) "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)) (group-frames group)))) (defmacro save-frame-excursion (&body body) "Execute body and then restore the current frame." (let ((oframe (gensym "OFRAME")) (ogroup (gensym "OGROUP"))) `(let ((,oframe (tile-group-current-frame (current-group))) (,ogroup (current-group))) (unwind-protect (progn ,@body) (focus-frame ,ogroup ,oframe))))) ;;; Frame commands (defun split-frame-in-dir (group dir &optional (ratio 1/2)) (let ((f (tile-group-current-frame group))) (if (split-frame group dir ratio) (progn (when (frame-window f) (update-decoration (frame-window f))) (show-frame-indicator group)) (message "Cannot split smaller than minimum size.")))) (defcommand (hsplit tile-group) (&optional (ratio "1/2")) (:string) "Split the current frame into 2 side-by-side frames." (split-frame-in-dir (current-group) :column (read-from-string ratio))) (defcommand (vsplit tile-group) (&optional (ratio "1/2")) (:string) "Split the current frame into 2 frames, one on top of the other." (split-frame-in-dir (current-group) :row (read-from-string ratio))) (defcommand (remove-split tile-group) (&optional (group (current-group)) (frame (tile-group-current-frame group))) () "Remove the specified frame in the specified group (defaults to current group, current frame). Windows in the frame are migrated to the frame taking up its space." (let* ((head (frame-head group frame)) (current (tile-group-current-frame group)) (tree (tile-group-frame-head group head)) (s (closest-sibling (list tree) frame)) ;; grab a leaf of the siblings. The siblings doesn't have to be ;; a frame. (l (tree-accum-fn s (lambda (&rest siblings) (car siblings)) #'identity))) ;; Only remove the current frame if it has a sibling (if (atom tree) (message "No more frames!") (when s (when (frame-is-head group frame) (setf (frame-number l) (frame-number frame))) ;; Move the windows from the removed frame to its sibling (migrate-frame-windows group frame l) ;; If the frame has no window, give it the current window of ;; the current frame. (unless (frame-window l) (setf (frame-window l) (frame-window frame))) ;; Unsplit (setf (tile-group-frame-head group head) (remove-frame tree frame)) ;; update the current frame and sync all windows (when (eq frame current) (setf (tile-group-current-frame group) l)) (tree-iterate tree (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))) (when (eq frame current) (show-frame-indicator group)))))) (defcommand-alias remove remove-split) (defcommand (only tile-group) () () "Delete all the frames but the current one and grow it to take up the entire head." (let* ((screen (current-screen)) (group (screen-current-group screen)) (win (group-current-window group)) (head (current-head group)) (frame (copy-frame head))) (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)) (head-windows group head)) (setf (frame-window frame) win (tile-group-frame-head group head) frame (tile-group-current-frame group) frame) (focus-frame group frame) (if (frame-window frame) (update-decoration (frame-window frame)) (show-frame-indicator group)) (sync-frame-windows group (tile-group-current-frame group)))))) (defcommand (curframe tile-group) () () "Display a window indicating which frame is focused." (show-frame-indicator (current-group) t)) (defun focus-frame-next-sibling (group) (let* ((sib (next-sibling (tile-group-frame-tree group) (tile-group-current-frame group)))) (when sib (focus-frame group (tree-accum-fn sib (lambda (x y) (declare (ignore y)) x) 'identity)) (show-frame-indicator group)))) (defun focus-last-frame (group) ;; make sure the last frame still exists in the frame tree (when (and (tile-group-last-frame group) (find (tile-group-last-frame group) (group-frames group))) (focus-frame group (tile-group-last-frame group)))) (defun focus-frame-after (group frames) "Given a list of frames focus the next one in the list after the current frame." (let ((rest (cdr (member (tile-group-current-frame group) frames :test 'eq)))) (focus-frame group (if (null rest) (car frames) (car rest))))) (defun focus-next-frame (group) (focus-frame-after group (group-frames group))) (defun focus-prev-frame (group) (focus-frame-after group (nreverse (group-frames group)))) (defcommand (fnext tile-group) () () "Cycle through the frame tree to the next frame." (focus-next-frame (current-group))) (defcommand (sibling tile-group) () () "Jump to the frame's sibling. If a frame is split into two frames, these two frames are siblings." (focus-frame-next-sibling (current-group))) (defcommand (fother tile-group) () () "Jump to the last frame that had focus." (focus-last-frame (current-group))) (defun choose-frame-by-number (group) "show a number in the corner of each frame and wait for the user to select one. Returns the selected frame or nil if aborted." (let* ((wins (progn (draw-frame-outlines group) (draw-frame-numbers group))) (ch (read-one-char (group-screen group))) (num (read-from-string (string ch) nil nil))) (dformat 3 "read ~S ~S~%" ch num) (mapc #'xlib:destroy-window wins) (clear-frame-outlines group) (find ch (group-frames group) :test 'char= :key 'get-frame-number-translation))) (defcommand (fselect tile-group) (frame-number) ((:frame t)) "Display a number in the corner of each frame and let the user to select a frame by number. If @var{frame-number} is specified, just jump to that frame." (let ((group (current-group))) (focus-frame group frame-number))) (defcommand (resize tile-group) (width height) ((:number "+ Width: ") (:number "+ Height: ")) "Resize the current frame by @var{width} and @var{height} pixels" (let* ((group (current-group)) (f (tile-group-current-frame group))) (if (atom (tile-group-frame-tree group)) (message "No more frames!") (progn (clear-frame-outlines group) (resize-frame group f width :width) (resize-frame group f height :height) (draw-frame-outlines group (current-head)))))) (defun clear-frame (frame group) "Clear the given frame." (frame-raise-window group frame nil (eq (tile-group-current-frame group) frame))) (defcommand (fclear tile-group) () () "Clear the current frame." (clear-frame (tile-group-current-frame (current-group)) (current-group))) (defun get-edge (frame edge) "Returns the specified edge of FRAME. Valid values for EDGE are :TOP, :BOTTOM, :LEFT, and :RIGHT. An edge is a START, END, and OFFSET. For horizontal edges, START is the left coordinate, END is the right coordinate, and OFFSET is the Y coordinate. Similarly, for vertical lines, START is top, END is bottom, and OFFSET is X coordinate." (let* ((x1 (frame-x frame)) (y1 (frame-y frame)) (x2 (+ x1 (frame-width frame))) (y2 (+ y1 (frame-height frame)))) (ecase edge (:top (values x1 x2 y1)) (:bottom (values x1 x2 y2)) (:left (values y1 y2 x1)) (:right (values y1 y2 x2))))) (defun neighbour (direction frame frameset) "Returns the best neighbour of FRAME in FRAMESET on the DIRECTION edge. Valid directions are :UP, :DOWN, :LEFT, :RIGHT. eg: (NEIGHBOUR :UP F FS) finds the frame in FS that is the 'best' neighbour above F." (let ((src-edge (ecase direction (:up :top) (:down :bottom) (:left :left) (:right :right))) (opposite (ecase direction (:up :bottom) (:down :top) (:left :right) (:right :left))) (best-frame nil) (best-overlap 0)) (multiple-value-bind (src-s src-e src-offset) (get-edge frame src-edge) (dolist (f frameset) (multiple-value-bind (s e offset) (get-edge f opposite) (let ((overlap (- (min src-e e) (max src-s s)))) ;; Two edges are neighbours if they have the same offset and their starts and ends ;; overlap. We want to find the neighbour that overlaps the most. (when (and (= src-offset offset) (> overlap best-overlap)) (setf best-frame f) (setf best-overlap overlap)))))) best-frame)) (defun move-focus-and-or-window (dir &optional win-p) (declare (type (member :up :down :left :right) dir)) (let* ((group (current-group)) (new-frame (neighbour dir (tile-group-current-frame group) (group-frames group))) (window (current-window))) (when new-frame (if (and win-p window) (pull-window window new-frame) (focus-frame group new-frame))))) (defcommand (move-focus tile-group) (dir) ((:direction "Direction: ")) "Focus the frame adjacent to the current one in the specified direction. The following are valid directions: @table @asis @item up @item down @item left @item right @end table" (move-focus-and-or-window dir)) (defcommand (move-window tile-group) (dir) ((:direction "Direction: ")) "Just like move-focus except that the current is pulled along." (move-focus-and-or-window dir t)) (defcommand (next-in-frame tile-group) () () "Go to the next window in the current frame." (let ((group (current-group))) (if (group-current-window group) (focus-forward group (frame-sort-windows group (tile-group-current-frame group))) (other-window-in-frame group)))) (defcommand (prev-in-frame tile-group) () () "Go to the previous window in the current frame." (let ((group (current-group))) (if (group-current-window group) (focus-forward group (reverse (frame-sort-windows group (tile-group-current-frame group)))) (other-window-in-frame group)))) (defcommand (other-in-frame tile-group) () () "Go to the last accessed window in the current frame." (other-window-in-frame (current-group))) (defcommand (balance-frames tile-group) () () "Make frames the same height or width in the current frame's subtree." (let* ((group (current-group)) (tree (tree-parent (tile-group-frame-head group (current-head)) (tile-group-current-frame group)))) (if tree (balance-frames-internal (current-group) tree) (message "There's only one frame.")))) stumpwm-0.9.9/tile-window.lisp000066400000000000000000000463741242702317100164150ustar00rootroot00000000000000;;; a dumping spot for window stuff that has tiling stuff in it (in-package :stumpwm) (export '(*ignore-wm-inc-hints*)) (defvar *ignore-wm-inc-hints* nil "Set this to T if you never want windows to resize based on incremental WM_HINTs, like xterm and emacs.") (defclass tile-window (window) ((frame :initarg :frame :accessor window-frame))) (defmethod update-decoration ((window tile-window)) ;; give it a colored border but only if there are more than 1 frames. (let* ((group (window-group window)) (screen (group-screen group))) (let ((c (if (and (> (length (group-frames group)) 1) (eq (group-current-window group) window)) (screen-focus-color screen) (screen-unfocus-color screen)))) (setf (xlib:window-border (window-parent window)) c ;; windows that dont fill the entire screen have a transparent background. (xlib:window-background (window-parent window)) (if (eq (window-type window) :normal) (if (eq *window-border-style* :thick) c (screen-win-bg-color screen)) :none)) ;; get the background updated (xlib:clear-area (window-parent window))))) (defmethod window-sync ((window tile-window) hint) (case hint ((:normal-hints :type) (maximize-window window)))) (defmethod window-visible-p ((window tile-window)) ;; In this case, visible means the window is the top window in the ;; frame. This is not entirely true when it doesn't take up the ;; entire frame and there's a window below it. (eq window (frame-window (window-frame window)))) (defmethod window-head ((window tile-window)) (frame-head (window-group window) (window-frame window))) (defmethod (setf window-fullscreen) :after (val (window tile-window)) (if val (maximize-window window) (progn (setf (xlib:drawable-border-width (window-parent window)) (default-border-width-for-type window)) (maximize-window window)))) ;;;; (defun really-raise-window (window) (frame-raise-window (window-group window) (window-frame window) window)) (defun raise-modals-of (window) (mapc 'really-raise-window (modals-of window))) (defun raise-modals-of-gang (window) (mapc 'really-raise-window (only-modals (window-gang window)))) (defun raise-transients-of-gang (window) (mapc 'really-raise-window (only-transients (window-gang window)))) ;;; (defun geometry-hints (win) "Return hints for max width and height and increment hints. These hints have been modified to always be defined and never be greater than the root window's width and height." (let* ((f (window-frame win)) (x (frame-x f)) (y (frame-display-y (window-group win) f)) (border (xlib:drawable-border-width (window-parent win))) (fwidth (- (frame-width f) (* 2 border))) (fheight (- (frame-display-height (window-group win) f) (* 2 border))) (width fwidth) (height fheight) (hints (window-normal-hints win)) (hints-min-width (and hints (xlib:wm-size-hints-min-width hints))) (hints-min-height (and hints (xlib:wm-size-hints-min-height hints))) (hints-max-width (and hints (xlib:wm-size-hints-max-width hints))) (hints-max-height (and hints (xlib:wm-size-hints-max-height hints))) (hints-width (and hints (xlib:wm-size-hints-base-width hints))) (hints-height (and hints (xlib:wm-size-hints-base-height hints))) (hints-inc-x (and hints (xlib:wm-size-hints-width-inc hints))) (hints-inc-y (and hints (xlib:wm-size-hints-height-inc hints))) (hints-min-aspect (and hints (xlib:wm-size-hints-min-aspect hints))) (hints-max-aspect (and hints (xlib:wm-size-hints-max-aspect hints))) (border (case *window-border-style* (:none 0) (t (default-border-width-for-type win)))) center) ;; (dformat 4 "hints: ~s~%" hints) ;; determine what the width and height should be (cond ;; handle specially fullscreen windows. ((window-fullscreen win) (let ((head (frame-head (window-group win) f))) (setf x (frame-x head) y (frame-y head) width (frame-width head) height (frame-height head) (xlib:window-priority (window-parent win)) :above)) (return-from geometry-hints (values x y 0 0 width height 0 t))) ;; Adjust the defaults if the window is a transient_for window. ((find (window-type win) '(:transient :dialog)) (setf center t width (min (max (or hints-width 0) (or hints-min-width 0) (window-width win)) width) height (min (max (or hints-height 0) (or hints-min-height 0) (window-height win)) height))) ;; aspect hints are handled similar to max size hints ((and hints-min-aspect hints-max-aspect) (let ((ratio (/ width height))) (cond ((< ratio hints-min-aspect) (setf height (ceiling width hints-min-aspect))) ((> ratio hints-max-aspect) (setf width (ceiling (* height hints-max-aspect))))) (setf center t))) ;; Update our defaults if the window has the maxsize hints ((or hints-max-width hints-max-height) (when (and hints-max-width (< hints-max-width width)) (setf width hints-max-width)) (when (and hints-max-height (< hints-max-height height)) (setf height hints-max-height)) (setf center t)) (t ;; if they have inc hints then start with the size and adjust ;; based on those increments until the window fits in the frame (when (and (not *ignore-wm-inc-hints*) hints-inc-x (plusp hints-inc-x)) (let ((w (or hints-width (window-width win)))) (setf width (+ w (* hints-inc-x (+ (floor (- fwidth w) hints-inc-x))))))) (when (and (not *ignore-wm-inc-hints*) hints-inc-y (plusp hints-inc-y)) (let ((h (or hints-height (window-height win)))) (setf height (+ h (* hints-inc-y (+ (floor (- fheight h -1) hints-inc-y))))))))) ;; adjust for gravity (multiple-value-bind (wx wy) (gravity-coords (gravity-for-window win) width height 0 0 fwidth fheight) (when (or center (find *window-border-style* '(:tight :none))) (setf x (+ wx (frame-x f)) y (+ wy (frame-display-y (window-group win) f)) wx 0 wy 0)) ;; Now return our findings (values x y wx wy width height border center)))) (defun maximize-window (win) "Maximize the window." (multiple-value-bind (x y wx wy width height border stick) (geometry-hints win) (dformat 4 "maximize window ~a x: ~d y: ~d width: ~d height: ~d border: ~d stick: ~s~%" win x y width height border stick) ;; This is the only place a window's geometry should change (set-window-geometry win :x wx :y wy :width width :height height :border-width 0) (xlib:with-state ((window-parent win)) ;; FIXME: updating the border doesn't need to be run everytime ;; the window is maximized, but only when the border style or ;; window type changes. The overhead is probably minimal, ;; though. (setf (xlib:drawable-x (window-parent win)) x (xlib:drawable-y (window-parent win)) y (xlib:drawable-border-width (window-parent win)) border) ;; the parent window should stick to the size of the window ;; unless it isn't being maximized to fill the frame. (if (or stick (find *window-border-style* '(:tight :none))) (setf (xlib:drawable-width (window-parent win)) (window-width win) (xlib:drawable-height (window-parent win)) (window-height win)) (let ((frame (window-frame win))) (setf (xlib:drawable-width (window-parent win)) (- (frame-width frame) (* 2 (xlib:drawable-border-width (window-parent win)))) (xlib:drawable-height (window-parent win)) (- (frame-display-height (window-group win) frame) (* 2 (xlib:drawable-border-width (window-parent win))))))) ;; update the "extents" (xlib:change-property (window-xwin win) :_NET_FRAME_EXTENTS (list wx wy (- (xlib:drawable-width (window-parent win)) width wx) (- (xlib:drawable-height (window-parent win)) height wy)) :cardinal 32)) (update-configuration win))) ;;; (defun focus-next-window (group) (focus-forward group (sort-windows group))) (defun focus-prev-window (group) (focus-forward group (reverse (sort-windows group)))) (defcommand (next tile-group) () () "Go to the next window in the window list." (let ((group (current-group))) (if (group-current-window group) (focus-next-window group) (other-window group)))) (defcommand (prev tile-group) () () "Go to the previous window in the window list." (let ((group (current-group))) (if (group-current-window group) (focus-prev-window group) (other-window group)))) (defun pull-window (win &optional (to-frame (tile-group-current-frame (window-group win)))) (let ((f (window-frame win)) (group (window-group win))) (unless (eq (frame-window to-frame) win) (xwin-hide win) (setf (window-frame win) to-frame) (maximize-window win) (when (eq (window-group win) (current-group)) (xwin-unhide (window-xwin win) (window-parent win))) ;; We have to restore the focus after hiding. (when (eq win (screen-focus (window-screen win))) (screen-set-focus (window-screen win) win)) (frame-raise-window group to-frame win) ;; if win was focused in its old frame then give the old ;; frame the frame's last focused window. (when (eq (frame-window f) win) ;; the current value is no longer valid. (setf (frame-window f) nil) (frame-raise-window group f (first (frame-windows group f)) nil))))) ;; In the future, this window will raise the window into the current ;; frame. (defun focus-forward (group window-list &optional pull-p (predicate (constantly t))) "Set the focus to the next item in window-list from the focused window. If PULL-P is T then pull the window into the current frame." ;; The window with focus is the "current" window, so find it in the ;; list and give that window focus (let* ((w (group-current-window group)) (wins (remove-if-not predicate (cdr (member w window-list)))) (nw (if (null wins) ;; If the last window in the list is focused, then ;; focus the first one. (car (remove-if-not predicate window-list)) ;; Otherwise, focus the next one in the list. (first wins)))) ;; there's still the case when the window is the only one in the ;; list, so make sure its not the same as the current window. (if (and nw (not (eq w nw))) (if pull-p (pull-window nw) (frame-raise-window group (window-frame nw) nw)) (message "No other window.")))) (defcommand (pull-window-by-number tile-group) (n &optional (group (current-group))) ((:window-number "Pull: ")) "Pull window N from another frame into the current frame and focus it." (let ((win (find n (group-windows group) :key 'window-number :test '=))) (when win (pull-window win)))) (defcommand-alias pull pull-window-by-number) (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)))) (first wins))) (defun pull-other-hidden-window (group) "pull the last accessed hidden window from any frame into the current frame and raise it." (let ((win (other-hidden-window group))) (if win (pull-window win) (echo-string (group-screen group) "No other window.")))) (defun other-window-in-frame (group) (let* ((f (tile-group-current-frame group)) (wins (frame-windows group f)) (win (if (frame-window f) (second wins) (first wins)))) (if win (frame-raise-window group (window-frame win) win) (echo-string (group-screen group) "No other window.")))) (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)))))) (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)))))) (defcommand (pull-hidden-other tile-group) () () "Pull the last focused, hidden window into the current frame." (let ((group (current-group))) (pull-other-hidden-window group))) (defun exchange-windows (win1 win2) "Exchange the windows in their respective frames." (let ((f1 (window-frame win1)) (f2 (window-frame win2))) (unless (eq f1 f2) (pull-window win1 f2) (pull-window win2 f1) (focus-frame (window-group win1) f2)))) (defcommand (exchange-direction tile-group) (dir &optional (win (current-window))) ((:direction "Direction: ")) "Exchange the current window (by default) with the top window of the frame in specified direction. (bound to @kbd{C-t x} by default) @table @asis @item up @item down @item left @item right @end table" (if win (let* ((frame-set (group-frames (window-group win))) (neighbour (neighbour dir (window-frame win) frame-set))) (if (and neighbour (frame-window neighbour)) (exchange-windows win (frame-window neighbour)) (message "No window in direction ~A!" dir))) (message "No window in current frame!"))) (defcommand (echo-frame-windows tile-group) (&optional (fmt *window-format*)) (:rest) "Display a list of all the windows in the current frame." (echo-windows fmt (current-group) (frame-windows (current-group) (tile-group-current-frame (current-group))))) (defcommand-alias frame-windows echo-frame-windows) (defcommand (fullscreen tile-group) () () "Toggle the fullscreen mode of the current widnow. Use this for clients with broken (non-NETWM) fullscreen implemenations, such as any program using SDL." (update-fullscreen (current-window) 2)) (defcommand (gravity tile-group) (gravity) ((:gravity "Gravity: ")) "Set a window's gravity within its frame. Gravity controls where the window will appear in a frame if it is smaller that the frame. Possible values are: @table @var @item center @item top @item right @item bottom @item left @item top-right @item top-left @item bottom-right @item bottom-left @end table" (when (current-window) (setf (window-gravity (current-window)) gravity) (maximize-window (current-window)))) (defcommand (pull-marked tile-group) () () "Pull all marked windows into the current frame and clear the marks." (let ((group (current-group))) (dolist (i (marked-windows group)) (pull-window i)) (clear-window-marks group))) ;;; window placement commands (defun make-rule-for-window (window &optional lock title) "Guess at a placement rule for WINDOW and add it to the current set." (let* ((group (window-group window)) (group-name (group-name group)) (frame-number (frame-number (window-frame window))) (role (window-role window))) (push (list group-name frame-number t lock :class (window-class window) :instance (window-res window) :title (and title (window-name window)) :role (and (not (equal role "")) role)) *window-placement-rules*))) (defcommand (remember tile-group) (lock title) ((:y-or-n "Lock to group? ") (:y-or-n "Use title? ")) "Make a generic placement rule for the current window. Might be too specific/not specific enough!" (make-rule-for-window (current-window) (first lock) (first title))) (defcommand (forget tile-group) () () "Forget the window placement rule that matches the current window." (let* ((window (current-window)) (match (rule-matching-window window))) (if match (progn (setf *window-placement-rules* (delete match *window-placement-rules*)) (message "Rule forgotten")) (message "No matching rule")))) (defcommand (dump-window-placement-rules tile-group) (file) ((:rest "Filename: ")) "Dump *window-placement-rules* to FILE." (dump-to-file *window-placement-rules* file)) (defcommand-alias dump-rules dump-window-placement-rules) (defcommand (restore-window-placement-rules tile-group) (file) ((:rest "Filename: ")) "Restore *window-placement-rules* from FILE." (setf *window-placement-rules* (read-dump-from-file file))) (defcommand-alias restore-rules restore-window-placement-rules) (defcommand (redisplay tile-group) () () "Refresh current window by a pair of resizes, also make it occupy entire frame." (let ((window (current-window))) (when window (with-slots (width height frame) window (set-window-geometry window :width (- width (window-width-inc window)) :height (- height (window-height-inc window))) ;; make sure the first one goes through before sending the second (xlib:display-finish-output *display*) (set-window-geometry window :width (+ width (* (window-width-inc window) (floor (- (frame-width frame) width) (window-width-inc window)))) :height (+ height (* (window-height-inc window) (floor (- (frame-height frame) height) (window-height-inc window))))) (maximize-window window))))) (defcommand frame-windowlist (&optional (fmt *window-format*)) (:rest) "Allow the user to select a window from the list of windows in the current frame and focus the selected window. The optional argument @var{fmt} can be specified to override the default window formatting." (let* ((group (current-group)) (frame (tile-group-current-frame group))) (if (null (frame-windows group frame)) (message "No Managed Windows") (let ((window (select-window-from-menu (frame-sort-windows group frame) fmt))) (if window (group-focus-window group window) (throw 'error :abort)))))) stumpwm-0.9.9/time.lisp000066400000000000000000000153721242702317100151030ustar00rootroot00000000000000;; Copyright (C) 2003-2008 Ivy Foster ;; ;; 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, see ;; . ;; Commentary: ;; ;; This file contains code relating to the display of time. ;; ;; When setting `*time-format-string-default*' to look like you want, the ;; options are exactly the same as those in the output of date --help (with date ;; 6.12), with the exception of a few unimplemented functions (see the comments ;; in *time-format-string-alist*, below). `*time-modeline-string*' is also ;; customizable; it defaults to the same value as *time-format-string-default*. ;; ;; TODO: ;; ;; - Implement all options from date. ;; - Simplify code (fewer helper functions somehow?) ;; Code: (in-package :stumpwm) (export '(*time-format-string-default* *time-modeline-string* time-format echo-date time)) (defvar *time-format-string-default* "%a %b %e %k:%M:%S" "The default value for `echo-date', (e.g, Thu Mar 3 23:05:25 2005).") (defvar *time-modeline-string* "%a %b %e %k:%M:%S" "The default time value to pass to the modeline.") (defvar *time-month-names* #("January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December")) (defvar *time-day-names* #("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")) ;; `date --help` with date_6.12 (defvar *time-format-string-alist* '((#\a time-dow-shortname) (#\A time-dow-name) (#\b time-month-shortname) (#\B time-month-name) (#\c time-date-and-time) (#\C time-century) (#\d time-day-of-month) (#\D time-date) (#\e time-day-of-month-zero) (#\F time-date-full) ;; (#\g) last two digits of year of ISO week number (see %G) ;; (#\G) year of ISO week number (see %V); normally useful only with %V (#\h time-month-shortname) (#\H time-hour-zero) (#\I time-hour-12hr-zero) ;; (#\j) day of year (001..366) (#\k time-hour) (#\l time-hour-12hr) (#\m time-month) (#\M time-minute) (#\n time-newline) ;; (#\N) nanoseconds (000000000..999999999) (#\p time-am-pm) (#\P time-am-pm-caps) (#\r time-12hr-time) (#\R time-24hr-and-minute) (#\s time-unix-era) (#\S time-second) (#\t time-tab) (#\T time-24hr-time) (#\u time-day-of-week) ;; (#\U) week number of year, with Sunday as first day of week (00..53) ;; (#\V) ISO week number, with Monday as first day of week (01..53) (#\w time-day-of-week-sun-start) ;; (#\W) week number of year, with Monday as first day of week (00..53) ;; (#\x) locale's date representation (e.g., 12/31/99) ;; (#\X) locale's time representation (e.g., 23:13:48) (#\y time-year-short) (#\Y time-year) (#\z time-tz) ;; (#\:z) +hh:mm numeric timezone (e.g., -04:00) ;; (#\::z) +hh:mm:ss numeric time zone (e.g., -04:00:00) ;; (#\:::z) numeric time zone with : to necessary precision (e.g., -04, +05:30) ;; %Z alphabetic time zone abbreviation (e.g., EDT) )) (defcommand echo-date () () "Display the date and time." (message "~a" (time-format *time-format-string-default*))) (defcommand-alias time echo-date) ;;; ------------------------------------------------------------------ ;;; Helper functions ;;; ------------------------------------------------------------------ (defun time-plist (&optional time) (multiple-value-bind (sec min hour dom mon year dow dstp tz) (or time (get-decoded-time)) (list :second sec :minute min :hour hour :dom dom :month mon :year year :dow dow :dlsavings-p dstp :tz tz))) (defun time-second () (format nil "~2,'0D" (getf (time-plist) :second))) (defun time-minute () (format nil "~2,'0D" (getf (time-plist) :minute))) (defun time-hour () (format nil "~2,D" (getf (time-plist) :hour))) (defun time-hour-zero () (format nil "~2,'0D" (getf (time-plist) :hour))) (defun time-hour-12hr () (let ((hour (rem (getf (time-plist) :hour) 12))) (format nil "~2,D" (if (zerop hour) 12 hour)))) (defun time-hour-12hr-zero () (let ((hour (rem (getf (time-plist) :hour) 12))) (format nil "~2,'0D" (if (zerop hour) 12 hour)))) (defun time-day-of-month-zero () (format nil "~2,'0D" (getf (time-plist) :dom))) (defun time-day-of-month () (format nil "~2,' D" (getf (time-plist) :dom))) (defun time-month () (format nil "~2,'0D" (getf (time-plist) :month))) (defun time-month-name () (aref *time-month-names* (1- (getf (time-plist) :month)))) (defun time-month-shortname () (subseq (time-month-name) 0 3)) (defun time-year () (write-to-string (getf (time-plist) :year))) (defun time-century () (subseq (time-year) 0 2)) (defun time-year-short () (subseq (time-year) 2)) (defun time-day-of-week () (write-to-string (1+ (getf (time-plist) :dow)))) (defun time-day-of-week-sun-start () (let ((dow (getf (time-plist) :dow))) (write-to-string (if (= dow 6) 0 (1+ dow))))) (defun time-dow-name () (aref *time-day-names* (getf (time-plist) :dow))) (defun time-dow-shortname () (subseq (time-dow-name) 0 3)) (defun time-newline () (format nil "~a" #\newline)) (defun time-tab () (format nil "~T")) (defun time-am-pm () (if (>= (getf (time-plist) :hour) 12) "pm" "am")) (defun time-am-pm-caps () (if (>= (getf (time-plist) :hour) 12) "PM" "AM")) (defun time-tz () (let ((tz (getf (time-plist) :tz)) (dlsave (if (getf (time-plist) :dlsavings-p) 1 0))) (multiple-value-bind (hour-local decimal-local) (truncate (+ (* (float tz) -1) (if dlsave 1 0))) (format nil "~A~2,'0D~2,'0D" (if (> hour-local 0) '+ '-) (abs hour-local) (truncate (if (/= decimal-local 0) (* 60 decimal-local) 0)))))) (defun time-unix-era () (format nil "~D" (- (get-universal-time) (encode-universal-time 0 0 0 1 1 1970 0)))) (defun time-date-and-time () (time-format "%a %h %d %H:%M:%S %Y")) (defun time-date () (time-format "%m/%d/%y")) (defun time-date-full () (time-format "%Y-%m-%d")) (defun time-12hr-time () (time-format "%I:%M:%S %P")) (defun time-24hr-and-minute () (time-format "%H:%M")) (defun time-24hr-time () (time-format "%H:%M:%S")) (defun time-format (str) (format-expand *time-format-string-alist* str)) ;;; End of file stumpwm-0.9.9/user.lisp000066400000000000000000000423471242702317100151250ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Window Manager commands that users can use to manipulate stumpwm. ;; ;; Code: (in-package :stumpwm) (export '(defprogram-shortcut pathname-is-executable-p programs-in-path restarts-menu run-or-raise run-or-pull run-shell-command window-send-string)) (defun restarts-menu (err) "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)))))) (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)" (let* ((screen (current-screen)) (group (current-group)) (head (current-head)) (frame (tile-group-current-frame group)) (window (frame-window frame)) (x (1- (+ (frame-x frame) (frame-width frame)))) (y (1- (+ (frame-display-y group frame) (frame-display-height group frame))))) (ecase where (:screen (setf x (1- (+ (screen-x screen) (screen-width screen))) y (1- (+ (screen-y screen) (screen-height screen))))) (:head (setf x (1- (+ (head-x head) (head-width head))) y (1- (+ (head-y head) (head-height head))))) (:frame) (:window (when window (let ((win (window-parent window))) (setf x (1- (+ (xlib:drawable-x win) (xlib:drawable-width win))) y (1- (+ (xlib:drawable-y win) (xlib:drawable-height win)))))))) (warp-pointer (group-screen group) x y))) (defcommand banish (&optional where) (:rest) "Warp the mouse the lower right corner of the current head." (if where (banish-pointer (intern1 where :keyword)) (banish-pointer))) (defcommand ratwarp (x y) ((:number "X: ") (:number "Y: ")) "Warp the mouse to the specified location." (warp-pointer (current-screen) x y)) (defcommand ratrelwarp (dx dy) ((:number "Delta X: ") (:number "Delta Y: ")) "Warp the mouse by the specified amount from its current position." (warp-pointer-relative dx dy)) (defcommand ratclick (&optional (button 1)) (:number) "Simulate a pointer button event at the current pointer location. Note: this function is unlikely to work unless your X server and CLX implementation support XTEST." (when (current-window) (send-fake-click (current-window) button))) (defun programs-in-path (&optional full-path (path (split-string (getenv "PATH") ":"))) "Return a list of programs in the path. if @var{full-path} is @var{t} then return the full path, otherwise just return the filename. @var{path} is by default the @env{PATH} evironment variable but can be specified. It should be a string containing each directory seperated by a colon." (sort (loop for p in path for dir = (probe-path p) when dir nconc (loop for file in (union ;; SBCL doesn't match files with types if type ;; is not wild and CLISP won't match files ;; without a type when type is wild. So cover all the bases (directory-no-deref (merge-pathnames (make-pathname :name :wild) dir)) (directory-no-deref (merge-pathnames (make-pathname :name :wild :type :wild) dir)) :test 'equal) for namestring = (file-namestring file) when (pathname-is-executable-p file) collect (if full-path (namestring file) namestring))) #'string<)) (defstruct path-cache programs modification-dates paths) (defvar *path-cache* nil "A cache containing the programs in the path, used for completion.") (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))) paths))) (finish-output) (unless (and *path-cache* (equal (path-cache-paths *path-cache*) paths) (equal (path-cache-modification-dates *path-cache*) dates)) (setf *path-cache* (make-path-cache :programs (programs-in-path nil paths) :modification-dates dates :paths paths))))) (defun complete-program (base) "return the list of programs in @var{*path-cache*} whose names begin with base. Automagically update the cache." (rehash) (remove-if-not #'(lambda (p) (when (<= (length base) (length p)) (string= base p :end1 (length base) :end2 (length base)))) (path-cache-programs *path-cache*))) (defcommand run-shell-command (cmd &optional collect-output-p) ((:shell "/bin/sh -c ")) "Run the specified shell command. If @var{collect-output-p} is @code{T} then run the command synchonously and collect the output. Be careful. If the shell command doesn't return, it will hang StumpWM. In such a case, kill the shell command to resume StumpWM." (if collect-output-p (run-prog-collect-output *shell-program* "-c" cmd) (run-prog *shell-program* :args (list "-c" cmd) :wait nil))) (defcommand-alias exec run-shell-command) (defcommand eval-line (cmd) ((:rest "Eval: ")) "Evaluate the s-expression and display the result(s)." (handler-case (if cmd (message "^20~{~a~^~%~}" (mapcar 'prin1-to-string (multiple-value-list (eval (read-from-string cmd))))) (throw 'error :abort)) (error (c) (err "^B^1*~A" c)))) (defcommand-alias eval eval-line) (defcommand echo (string) ((:rest "Echo: ")) "Display @var{string} in the message bar." ;; The purpose of echo is always to pop up a message window. (let ((*executing-stumpwm-command* nil)) (message "~a" string))) (defun send-meta-key (screen key) "Send the key to the current window on the specified screen." (when (screen-current-window screen) (send-fake-key (screen-current-window screen) key))) (defcommand meta (key) ((:key "Key: ")) "Send a fake key to the current window. @var{key} is a typical StumpWM key, like @kbd{C-M-o}." (send-meta-key (current-screen) key)) (defcommand loadrc () () "Reload the @file{~/.stumpwmrc} file." (handler-case (progn (with-restarts-menu (load-rc-file nil))) (error (c) (message "^1*^BError loading rc file: ^n~A" c)) (:no-error (&rest args) (declare (ignore args)) (message "rc file loaded successfully.")))) (defcommand keyboard-quit () () "" ;; This way you can exit from command mode (let ((in-command-mode (eq *top-map* *root-map*))) (when (pop-top-map) (if in-command-mode (run-hook *command-mode-end-hook*) (message "Exited."))))) (defcommand-alias abort keyboard-quit) (defcommand quit () () "Quit StumpWM." (throw :top-level :quit)) (defcommand restart-soft () () "Soft Restart StumpWM. The lisp process isn't restarted. Instead, control jumps to the very beginning of the stumpwm program. This differs from RESTART, which restarts the unix process. Since the process isn't restarted, existing customizations remain after the restart." (throw :top-level :restart)) (defcommand restart-hard () () "Restart stumpwm. This is handy if a new stumpwm executable has been made and you wish to replace the existing process with it. Any run-time customizations will be lost after the restart." (throw :top-level :hup-process)) (defun find-matching-windows (props all-groups all-screens) "Returns list of windows matching @var{props} (see run-or-raise documentation for details). @var{all-groups} will find windows on all groups. Same for @{all-screens}. Result is sorted by group and window number, with group being more significant (think radix sort)." (let* ((screens (if all-screens *screen-list* (list (current-screen)))) (winlist (if all-groups (mapcan (lambda (s) (screen-windows s)) screens) (group-windows (current-group)))) (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)))))) (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 matches @var{props}. @var{props} is a property list with the following keys: @table @code @item :class Match the window's class. @item :instance Match the window's instance or resource-name. @item :role Match the window's @code{WM_WINDOW_ROLE}. @item :title Match the window's title. @end table By default, the global @var{*run-or-raise-all-groups*} decides whether to search all groups or the current one for a running instance. @var{all-groups} overrides this default. Similarily for @var{*run-or-raise-all-screens*} and @var{all-screens}." (labels ;; Raise the window win and select its frame. For now, it ;; does not select the screen. ((goto-win (win) (let* ((group (window-group win)) (frame (window-frame win)) (old-frame (tile-group-current-frame group))) (focus-all win) (unless (eq frame old-frame) (show-frame-indicator group))))) (let* ((matches (find-matching-windows props all-groups all-screens)) ;; other-matches is list of matches "after" the current ;; win, if current win matches. getting 2nd element means ;; skipping over the current win, to cycle through matches (other-matches (member (current-window) matches)) (win (if (> (length other-matches) 1) (second other-matches) (first matches)))) (if win (if (eq (type-of (window-group win)) 'float-group) (focus-all win) (goto-win win)) (run-shell-command cmd))))) (defun run-or-pull (cmd props &optional (all-groups *run-or-raise-all-groups*) (all-screens *run-or-raise-all-screens*)) "Similar to run-or-raise, but move the matching window to the current frame instead of switching to the window." (let* ((matches (find-matching-windows props all-groups all-screens)) ;; other-matches is for cycling through matches (other-matches (member (current-window) matches)) (win (if (> (length other-matches) 1) (second other-matches) (first matches)))) (if win (progn (move-window-to-group win (current-group)) (pull-window win)) (run-shell-command cmd)))) (defcommand reload () () "Reload StumpWM using @code{asdf}." (message "Reloading StumpWM...") #+asdf (with-restarts-menu (asdf:operate 'asdf:load-op :stumpwm)) #-asdf (message "^B^1*Sorry, StumpWM can only be reloaded with asdf (for now.)") #+asdf (message "Reloading StumpWM...^B^2*Done^n.")) (defcommand emacs () () "Start emacs unless it is already running, in which case focus it." (run-or-raise "emacs" '(:class "Emacs"))) (defcommand copy-unhandled-error () () "When an unhandled error occurs, StumpWM restarts and attempts to continue. Unhandled errors should be reported to the mailing list so they can be fixed. Use this command to copy the unhandled error and backtrace to the X11 selection so you can paste in your email when submitting the bug report." (if *last-unhandled-error* (progn (set-x-selection (format nil "~a~%~a" (first *last-unhandled-error*) (second *last-unhandled-error*))) (message "Copied to clipboard.")) (message "There was no unhandled error!"))) (defmacro defprogram-shortcut (name &key (command (string-downcase (string name))) (props `'(:class ,(string-capitalize command))) (map *top-map*) (key (kbd (concat "H-" (subseq command 0 1)))) (pullp nil) (pull-name (intern1 (concat (string name) "-PULL"))) (pull-key (kbd (concat "H-M-" (subseq command 0 1))))) "Define a command and key binding to run or raise a program. If @var{pullp} is set, also define a command and key binding to run or pull the program." `(progn (defcommand ,name () () (run-or-raise ,command ,props)) (define-key ,map ,key ,(string-downcase (string name))) (when ,pullp (defcommand (,pull-name tile-group) () () (run-or-pull ,command ,props)) (define-key ,map ,pull-key ,(string-downcase (string pull-name)))))) (defcommand show-window-properties () () "Shows the properties of the current window. These properties can be used for matching windows with run-or-raise or window placement rules." (let ((w (current-window))) (message-no-timeout "class: ~A~%instance: ~A~%type: :~A~%role: ~A~%title: ~A" (window-class w) (window-res w) (string (window-type w)) (window-role w) (window-title w)))) (defcommand list-window-properties () () "List all the properties of the current window and their values, like xprop." (message-no-timeout "~{~30a: ~a~^~%~}" (let ((win (if (current-window) (window-xwin (current-window)) (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))))))) stumpwm-0.9.9/version.lisp000066400000000000000000000027271242702317100156320ustar00rootroot00000000000000;; Copyright (C) 2006-2008 Martin Bishop, Ivy Foster ;; ;; 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, see ;; . ;; Commentary: ;; ;; This file contains version information. ;; ;; Code: (in-package :stumpwm) (export '(*version* version)) (defparameter *version* #.(concatenate 'string (let* ((sys (asdf:find-system :stumpwm)) (git-dir (probe-path (asdf:system-relative-pathname sys ".git")))) (if git-dir (string-trim '(#\Newline) (run-shell-command (format nil "GIT_DIR=~a git describe --tags" git-dir) t)) (asdf:component-version sys))) " Compiled On " (format-expand *time-format-string-alist* *time-format-string-default*))) (defcommand version () () "Print version information and compilation date." (message *version*)) ;; End of file stumpwm-0.9.9/window-placement.lisp000066400000000000000000000206131242702317100174140ustar00rootroot00000000000000;;; Window placement routines (in-package :stumpwm) (defun xwin-to-window (xwin) "Build a window for XWIN" (make-instance 'window :xwin xwin :width (xlib:drawable-width xwin) :height (xlib:drawable-height xwin) :x (xlib:drawable-x xwin) :y (xlib:drawable-y xwin) :title (xwin-name xwin) :class (xwin-class xwin) :res (xwin-res-name xwin) :role (xwin-role xwin) :type (xwin-type xwin) :normal-hints (get-normalized-normal-hints xwin) :state +iconic-state+ :plist (make-hash-table) :unmap-ignores 0)) (defvar *rule-scanners-cache* (make-hash-table :test 'equal) "A cache for the ppcre scanners") (defun get-or-create-rule-scanner (regex) (or (gethash regex *rule-scanners-cache*) (setf (gethash regex *rule-scanners-cache*) (ppcre:create-scanner regex)))) (defun string-match (string pat) (ppcre:scan (get-or-create-rule-scanner pat) string)) (defun window-matches-properties-p (window &key class instance type role title) "Returns T if window matches all the given properties" (and (if class (string-match (window-class window) class) t) (if instance (string-match (window-res window) instance) t) (if type (string-match (window-type window) type) t) (if role (string-match (window-role window) role) t) (if title (string-match (window-title window) title) t) t)) (defun window-matches-rule-p (w rule) "Returns T if window matches rule" (destructuring-bind (group-name frame raise lock &key create restore class instance type role title) rule (declare (ignore frame raise create restore)) (if (or lock (equal group-name (group-name (or (when (slot-boundp w 'group) (window-group w)) (current-group))))) (window-matches-properties-p w :class class :instance instance :type type :role role :title title)))) (defun rule-matching-window (window) (dolist (rule *window-placement-rules*) (when (window-matches-rule-p window rule) (return rule)))) (defun get-window-placement (screen window) "Returns the ideal group and frame that WINDOW should belong to and whether the window should be raised." (let ((match (rule-matching-window window))) (if match (destructuring-bind (group-name frame raise lock &key create restore class instance type role title) match (declare (ignore lock class instance type role title)) (let ((group (find-group screen group-name))) (cond (group (when (and restore (stringp restore)) (let ((restore-file (data-dir-file restore))) (if (probe-file restore-file) (restore-group group (read-dump-from-file restore-file)) (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"." group-name restore-file)))) (values group (frame-by-number group frame) raise)) (create (let ((new-group (add-group (current-screen) group-name)) (restore-file (if (stringp create) (data-dir-file create) (data-dir-file group-name)))) (if (and new-group (probe-file restore-file)) (restore-group new-group (read-dump-from-file restore-file)) (when (stringp create) (message "^B^1*Can't restore group \"^b~a^B\" with \"^b~a^B\"." group-name restore-file))) (values new-group (frame-by-number new-group frame) raise))) (t (message "^B^1*Error placing window, group \"^b~a^B\" does not exist." group-name) (values))))) (values)))) (defun sync-window-placement () "Re-arrange existing windows according to placement rules" (dolist (screen *screen-list*) (dolist (window (screen-windows screen)) (multiple-value-bind (to-group frame raise) (with-current-screen screen (get-window-placement screen window)) (declare (ignore raise)) (when to-group (unless (eq (window-group window) to-group) (move-window-to-group window to-group))) (when frame (unless (eq (window-frame window) frame) (pull-window window frame))))))) (defun assign-window (window group &optional (where :tail)) "Assign the window to the specified group and perform the necessary housekeeping." (setf (window-group window) group (window-number window) (find-free-window-number group)) (if (eq where :head) (push window (group-windows group)) (setf (group-windows group) (append (group-windows group) (list window)))) (setf (xwin-state (window-xwin window)) +iconic-state+) (netwm-set-group window)) (defun place-window (screen window) "Pick a group WINDOW and return the group-specific placement hints, if any." (let* ((netwm-group (netwm-group window screen)) (placement (multiple-value-list (get-window-placement screen window))) (placement-group (first placement)) (group (or (when *processing-existing-windows* netwm-group) placement-group netwm-group (screen-current-group screen)))) (assign-window window group (if *processing-existing-windows* :head :tail)) ;; if we're using the placement group, then return the extra data. (when (eq group placement-group) (list :frame (second placement) :raise (third placement))))) (defun pick-preferred-frame (window) (let* ((group (window-group window)) (frames (group-frames group)) (default (tile-group-current-frame group)) (preferred-frame (or *new-window-preferred-frame* default))) (when (or (functionp *new-window-preferred-frame*) (and (symbolp *new-window-preferred-frame*) (fboundp *new-window-preferred-frame*))) (setq preferred-frame (handler-case (funcall *new-window-preferred-frame* window) (t (c) (message "^1*^BError while calling ^b^3**new-window-preferred-frame*^1*^B: ^n~a" c) default)))) (cond ;; If we already have a frame use it. ((frame-p preferred-frame) preferred-frame) ;; If `preferred-frame' is a list of keyword use it to determine the ;; frame. The sanity check doesn't cover not recognized keywords. We ;; simply fall back to the default then. ((and (listp preferred-frame) (every #'keywordp preferred-frame)) (or (loop for i in preferred-frame thereis (case i (:last ;; last-frame can be stale (and (> (length frames) 1) (tile-group-last-frame group))) (:unfocused (find-if (lambda (f) (not (eq f (tile-group-current-frame group)))) frames)) (:empty (find-if (lambda (f) (null (frame-window f))) frames)) (:choice ;; Transient windows sometimes specify a location ;; relative to the TRANSIENT_FOR window. Just ignore ;; these hints. (unless (find (window-type window) '(:transient :dialog)) (let ((hints (window-normal-hints window))) (when (and hints (xlib:wm-size-hints-user-specified-position-p hints)) (find-frame group (window-x window) (window-y window)))))))) default)) ;; Not well formed `*new-window-preferred-frame*'. Message an error and ;; return the default. (t (message "^1*^BInvalid ^b^3**new-window-preferred-frame*^1*^B: ^n~a" preferred-frame) default)))) stumpwm-0.9.9/window.lisp000066400000000000000000001267161242702317100154610ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; Window functionality. ;; ;; Code: (in-package #:stumpwm) (export '(*default-window-name* define-window-slot set-normal-gravity set-maxsize-gravity set-transient-gravity set-window-geometry)) (export '( window-xwin window-width window-height window-x window-y window-gravity window-group window-number window-parent window-title window-user-title window-class window-type window-res window-role window-unmap-ignores window-state window-normal-hints window-marked window-plist window-fullscreen)) (defvar *default-window-name* "Unnamed" "The name given to a window that does not supply its own name.") (defclass window () ((xwin :initarg :xwin :accessor window-xwin) (width :initarg :width :accessor window-width) (height :initarg :height :accessor window-height) ;; these are only used to hold the requested map location. (x :initarg :x :accessor window-x) (y :initarg :y :accessor window-y) (gravity :initform nil :accessor window-gravity) (group :initarg :group :accessor window-group) (number :initarg :number :accessor window-number) (parent :accessor window-parent) (title :initarg :title :accessor window-title) (user-title :initform nil :accessor window-user-title) (class :initarg :class :accessor window-class) (type :initarg :type :accessor window-type) (res :initarg :res :accessor window-res) (role :initarg :role :accessor window-role) (unmap-ignores :initarg :unmap-ignores :accessor window-unmap-ignores) (state :initarg :state :accessor window-state) (normal-hints :initarg :normal-hints :accessor window-normal-hints) (marked :initform nil :accessor window-marked) (plist :initarg :plist :accessor window-plist) (fullscreen :initform nil :accessor window-fullscreen))) (defmethod print-object ((object window) stream) (format stream "#S(~a ~s #x~x)" (type-of object) (window-name object) (window-id object))) ;;; Window Management API (defgeneric update-decoration (window) (:documentation "Update the window decoration.")) (defgeneric focus-window (window) (:documentation "Give the specified window keyboard focus.")) (defgeneric raise-window (window) (:documentation "Bring the window to the top of the window stack.")) (defgeneric window-visible-p (window) (:documentation "Return T if the window is visible")) (defgeneric window-sync (window what-changed) (:documentation "Some window slot has been updated and the window may need to sync itself. WHAT-CHANGED is a hint at what changed.")) (defgeneric window-head (window) (:documentation "Report what window the head is currently on.")) ;; Urgency / demands attention (defun register-urgent-window (window) "Add WINDOW to its screen's list of urgent windows" (if (eq (screen-current-window (window-screen window)) window) ;; window is already current, clear the urgent state to let it know we know. (window-clear-urgency window) (progn (push window (screen-urgent-windows (window-screen window))) (update-mode-lines (window-screen window)) (values t)))) (defun unregister-urgent-window (window) "Remove WINDOW to its screen's list of urgent windows" (setf (screen-urgent-windows (window-screen window)) (delete window (screen-urgent-windows (window-screen window)))) (update-mode-lines (window-screen window))) (defun window-clear-urgency (window) "Clear the urgency bit and/or _NET_WM_STATE_DEMANDS_ATTENTION on WINDOW" (let* ((hints (xlib:wm-hints (window-xwin window))) (flags (when hints (xlib:wm-hints-flags hints)))) (when flags (setf (xlib:wm-hints-flags hints) ;; XXX: as of clisp 2.46 flags is a list, not a number. (if (listp flags) (remove :urgency flags) (logand (lognot 256) flags))) (setf (xlib:wm-hints (window-xwin window)) hints))) (remove-wm-state (window-xwin window) :_NET_WM_STATE_DEMANDS_ATTENTION) (unregister-urgent-window window)) (defun window-urgent-p (window) "Returns T if WINDOW has the urgency bit and/or _NET_WM_STATE_DEMANDS_ATTENTION set" (let* ((hints (xlib:wm-hints (window-xwin window))) (flags (when hints (xlib:wm-hints-flags hints)))) ;; XXX: as of clisp 2.46 flags is a list, not a number. (or (and flags (if (listp flags) (find :urgency flags) (logtest 256 flags))) (find-wm-state (window-xwin window) :_NET_WM_STATE_DEMANDS_ATTENTION)))) (defun only-urgent (windows) "Return a list of all urgent windows on SCREEN" (remove-if-not 'window-urgent-p (copy-list windows))) (defcommand next-urgent () () "Jump to the next urgent window" (and (screen-urgent-windows (current-screen)) (focus-all (first (screen-urgent-windows (current-screen)))))) ;; Since StumpWM already uses the term 'group' to refer to Virtual Desktops, ;; we'll call the grouped windows of an application a 'gang' ;; maybe follow transient_for to find leader. (defun window-leader (window) (when window (or (first (window-property window :WM_CLIENT_LEADER)) (let ((id (window-transient-for window))) (when id (window-leader (window-by-id id))))))) ;; A modal dialog can either shadow a single window, or all windows ;; in its gang, depending on the value of WM_TRANSIENT_FOR ;; If a window is shadowed by a modal dialog, so are any other ;; transients belonging to that window. (defun window-transient-for (window) (first (window-property window :WM_TRANSIENT_FOR))) (defun window-modal-p (window) (find-wm-state (window-xwin window) :_NET_WM_STATE_MODAL)) (defun window-transient-p (window) (find (window-type window) '(:transient :dialog))) ;; FIXME: use WM_HINTS.group_leader (defun window-gang (window) "Return a list of other windows in WINDOW's gang." (let ((leader (window-leader window)) (screen (window-screen window))) (when leader (loop for w in (screen-windows screen) as l = (window-leader w) if (and (not (eq w window)) l (= leader l)) collect w)))) (defun only-modals (windows) "Out of WINDOWS, return a list of those which are modal." (remove-if-not 'window-modal-p (copy-list windows))) (defun x-of (window filter) (let* ((root (screen-root (window-screen window))) (root-id (xlib:drawable-id root)) (win-id (xlib:window-id (window-xwin window)))) (loop for w in (funcall filter (window-gang window)) as tr = (window-transient-for w) when (or (not tr) ; modal for group (eq tr root-id) ; ditto (eq tr win-id)) ; modal for win collect w))) ;; The modals of a transient are the modals of the window ;; the transient belongs to. (defun modals-of (window) "Given WINDOW return the modal dialogs which are shadowing it, if any." (loop for m in (only-modals (window-gang window)) when (find window (shadows-of m)) collect m)) (defun transients-of (window) "Return the transient dialogs belonging to WINDOW" (x-of window 'only-transients)) (defun shadows-of (window) "Given modal window WINDOW return the list of windows in its shadow." (let* ((root (screen-root (window-screen window))) (root-id (xlib:drawable-id root)) (tr (window-transient-for window))) (cond ((or (not tr) (eq tr root-id)) (window-gang window)) (t (let ((w (window-by-id tr))) (append (list w) (transients-of w))))))) (defun only-transients (windows) "Out of WINDOWS, return a list of those which are transient." (remove-if-not 'window-transient-p (copy-list windows))) (defun all-windows () (mapcan (lambda (s) (copy-list (screen-windows s))) *screen-list*)) (defun visible-windows () "Return a list of visible windows (on all screens)" (loop for s in *screen-list* nconc (delete-if 'window-hidden-p (copy-list (group-windows (screen-current-group s)))))) (defun top-windows () "Return a list of semantically visible windows (on all screens)" (loop for s in *screen-list* nconc (delete-if-not 'window-visible-p (copy-list (group-windows (screen-current-group s)))))) (defun window-name (window) (or (window-user-title window) (case *window-name-source* (:resource-name (window-res window)) (:class (window-class window)) (t (window-title window))) *default-window-name*)) (defun window-id (window) (xlib:window-id (window-xwin window))) (defun window-in-current-group-p (window) (eq (window-group window) (screen-current-group (window-screen window)))) (defun window-screen (window) (group-screen (window-group window))) (defun send-client-message (window type &rest data) "Send a client message to a client's window." (xlib:send-event (window-xwin window) :client-message nil :window (window-xwin window) :type type :format 32 :data data)) (defun window-map-number (window) (princ-to-string (let ((num (window-number window))) (or (and (< num (length *window-number-map*)) (elt *window-number-map* num)) num)))) (defun fmt-window-status (window) (let ((group (window-group window))) (cond ((eq window (group-current-window group)) #\*) ((and (typep (second (group-windows group)) 'window) (eq window (second (group-windows group)))) #\+) (t #\-)))) (defun fmt-window-marked (window) (if (window-marked window) #\# #\Space)) ;; (defun update-window-mark (window) ;; "Called when we need to draw or clear the mark." ;; ;; FIXME: This doesn't work at all. I'd like to have little squares ;; ;; that look like clamps on the corners of the window, likes its ;; ;; sorta grabbed. But i dunno how to properly draw them. ;; (let* ((screen (window-screen window))) ;; (if (window-marked window) ;; (xlib:draw-rectangle (window-parent window) (screen-marked-gc (window-screen window)) ;; 0 0 300 200 t) ;; (xlib:clear-area (window-parent window))))) (defun escape-caret (str) "Escape carets by doubling them" (let (buf) (map nil #'(lambda (ch) (push ch buf) (when (char= ch #\^) (push #\^ buf))) str) (coerce (reverse buf) 'string))) (defun get-normalized-normal-hints (xwin) (macrolet ((validate-hint (fn) (setf fn (intern1 (concatenate 'string (string '#:wm-size-hints-) (string fn)) :xlib)) `(setf (,fn hints) (and (,fn hints) (plusp (,fn hints)) (,fn hints))))) (let ((hints (xlib:wm-normal-hints xwin))) (when hints (validate-hint :min-width) (validate-hint :min-height) (validate-hint :max-width) (validate-hint :max-height) (validate-hint :base-width) (validate-hint :base-height) (validate-hint :width-inc) (validate-hint :height-inc) (validate-hint :min-aspect) (validate-hint :max-aspect)) hints))) (defun xwin-net-wm-name (win) "Return the netwm wm name" (let ((name (xlib:get-property win :_NET_WM_NAME))) (when name (utf8-to-string name)))) (defun xwin-name (win) (escape-caret (or (xwin-net-wm-name win) (xlib:wm-name win)))) (defun window-fullscreen-locked-p (win) (let* ((xwin (window-xwin win)) (hints (xlib:wm-normal-hints xwin))) (with-accessors ((min-width xlib:wm-size-hints-min-width) (max-width xlib:wm-size-hints-max-width) (min-height xlib:wm-size-hints-min-height) (max-height xlib:wm-size-hints-max-height) (x xlib:wm-size-hints-x) (y xlib:wm-size-hints-y)) hints (and hints x y max-height min-height max-width min-width (= x 0) (= y 0) (= min-height max-height) (= min-width max-width))))) ;; FIXME: should we raise the window or its parent? (defmethod raise-window (win) "Map the window if needed and bring it to the top of the stack. Does not affect focus." (let ((maxmin-notequal (not (window-fullscreen-locked-p win)))) (when (window-urgent-p win) (window-clear-urgency win)) (when (window-hidden-p win) (unhide-window win) (if maxmin-notequal (update-configuration win))) (when (and maxmin-notequal (window-in-current-group-p win)) (setf (xlib:window-priority (window-parent win)) :top-if)))) ;; some handy wrappers (defun xwin-border-width (win) (xlib:drawable-border-width win)) (defun (setf xwin-border-width) (width win) (setf (xlib:drawable-border-width win) width)) (defun default-border-width-for-type (window) (or (and (window-maxsize-p window) *maxsize-border-width*) (ecase (window-type window) (:dock 0) (:normal *normal-border-width*) ((:transient :dialog) *transient-border-width*)))) (defun xwin-class (win) (multiple-value-bind (res class) (xlib:get-wm-class win) (declare (ignore res)) class)) (defun xwin-res-name (win) (multiple-value-bind (res class) (xlib:get-wm-class win) (declare (ignore class)) res)) (defun xwin-role (win) "Return WM_WINDOW_ROLE" (let ((name (xlib:get-property win :WM_WINDOW_ROLE))) (dformat 10 "role: ~a~%" name) (if name (utf8-to-string name) ""))) (defmacro define-window-slot (attr) "Create a new window attribute and corresponding get/set functions." (let ((win (gensym)) (val (gensym))) `(progn (defun ,(intern1 (format nil "WINDOW-~a" attr)) (,win) (gethash ,attr (window-plist ,win))) (defun (setf ,(intern1 (format nil "WINDOW-~a" attr))) (,val ,win) (setf (gethash ,attr (window-plist ,win)) ,val))))) (defun sort-windows (group) "Return a copy of the screen's window list sorted by number." (sort1 (group-windows group) '< :key 'window-number)) (defun marked-windows (group) "Return the marked windows in the specified group." (loop for i in (sort-windows group) when (window-marked i) collect i)) (defun (setf xwin-state) (state xwin) "Set the state (iconic, normal, withdrawn) of a window." (xlib:change-property xwin :WM_STATE (list state) :WM_STATE 32)) (defun xwin-state (xwin) "Get the state (iconic, normal, withdraw of a window." (first (xlib:get-property xwin :WM_STATE))) (defun window-hidden-p (window) (eql (window-state window) +iconic-state+)) (defun add-wm-state (xwin state) (xlib:change-property xwin :_NET_WM_STATE (list (xlib:find-atom *display* state)) :atom 32 :mode :append)) (defun remove-wm-state (xwin state) (xlib:change-property xwin :_NET_WM_STATE (delete (xlib:find-atom *display* state) (xlib:get-property xwin :_NET_WM_STATE)) :atom 32)) (defun window-property (window prop) (xlib:get-property (window-xwin window) prop)) (defun find-wm-state (xwin state) (find (xlib:find-atom *display* state) (xlib:get-property xwin :_NET_WM_STATE) :test #'=)) (defun xwin-unhide (xwin parent) (xlib:map-subwindows parent) (xlib:map-window parent) (setf (xwin-state xwin) +normal-state+)) (defun unhide-window (window) (when (window-in-current-group-p window) (xwin-unhide (window-xwin window) (window-parent window))) (setf (window-state window) +normal-state+) ;; Mark window as unhiden (remove-wm-state (window-xwin window) :_NET_WM_STATE_HIDDEN)) ;; Despite the naming convention, this function takes a window struct, ;; not an xlib:window. (defun xwin-hide (window) (declare (type window window)) (unless (eq (xlib:window-map-state (window-xwin window)) :unmapped) (setf (xwin-state (window-xwin window)) +iconic-state+) (incf (window-unmap-ignores window)) (xlib:unmap-window (window-parent window)) (xlib:unmap-subwindows (window-parent window)))) (defun hide-window (window) (dformat 2 "hide window: ~s~%" window) (unless (eql (window-state window) +iconic-state+) (setf (window-state window) +iconic-state+) ;; Mark window as hidden (add-wm-state (window-xwin window) :_NET_WM_STATE_HIDDEN) (when (window-in-current-group-p window) (xwin-hide window) (when (eq window (current-window)) (group-lost-focus (window-group window)))))) (defun window-maxsize-p (win) "Returns T if WIN specifies maximum dimensions." (let ((hints (window-normal-hints win))) (and hints (or (xlib:wm-size-hints-max-width hints) (xlib:wm-size-hints-max-height hints) (xlib:wm-size-hints-min-aspect hints) (xlib:wm-size-hints-max-aspect hints))))) (defun xwin-type (win) "Return one of :desktop, :dock, :toolbar, :utility, :splash, :dialog, :transient, and :normal. Right now only :dock, :dialog, :normal, and :transient are actually returned; see +NETWM-WINDOW-TYPES+." (or (let ((net-wm-window-type (xlib:get-property win :_NET_WM_WINDOW_TYPE))) (when net-wm-window-type (dolist (type-atom net-wm-window-type) (when (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+) (return (cdr (assoc (xlib:atom-name *display* type-atom) +netwm-window-types+))))))) (and (xlib:get-property win :WM_TRANSIENT_FOR) :transient) :normal)) (defun xwin-strut (screen win) "Return the area that the window wants to reserve along the edges of the screen. Values are left, right, top, bottom, left_start_y, left_end_y, 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) (let ((net-wm-strut (xlib:get-property win :_NET_WM_STRUT))) (if (= (length net-wm-strut) 4) (apply 'values (concatenate 'list net-wm-strut (list 0 (screen-height screen) 0 (screen-height screen) 0 (screen-width screen) 0 (screen-width screen)))) (values 0 0 0 0 0 0 0 0 0 0 0 0)))))) ;; Stolen from Eclipse (defun xwin-send-configuration-notify (xwin x y w h bw) "Send a synthetic configure notify event to the given window (ICCCM 4.1.5)" (xlib:send-event xwin :configure-notify nil :event-window xwin :window xwin :x x :y y :width w :height h :border-width bw :propagate-p nil)) (defun update-window-gravity () (dolist (s *screen-list*) (dolist (g (screen-groups s)) (mapc 'maximize-window (group-windows g))))) (defun set-normal-gravity (gravity) "Set the default gravity for normal windows. Possible values are @code{:center} @code{:top} @code{:left} @code{:right} @code{:bottom} @code{:top-left} @code{:top-right} @code{:bottom-left} and @code{:bottom-right}." (setf *normal-gravity* gravity) (update-window-gravity)) (defun set-maxsize-gravity (gravity) "Set the default gravity for maxsize windows." (setf *maxsize-gravity* gravity) (update-window-gravity)) (defun set-transient-gravity (gravity) "Set the default gravity for transient/pop-up windows." (setf *transient-gravity* gravity) (update-window-gravity)) (defun gravity-for-window (win) (or (window-gravity win) (and (window-maxsize-p win) *maxsize-gravity*) (ecase (window-type win) (:dock *normal-gravity*) (:normal *normal-gravity*) ((:transient :dialog) *transient-gravity*)))) (defun window-width-inc (window) "Find out what is the correct step to change window width" (or (xlib:wm-size-hints-width-inc (window-normal-hints window)) 1)) (defun window-height-inc (window) "Find out what is the correct step to change window height" (or (xlib:wm-size-hints-height-inc (window-normal-hints window)) 1)) (defun set-window-geometry (win &key x y width height border-width) (macrolet ((update (xfn wfn v) `(when ,v ;; (/= (,wfn win) ,v)) (setf (,xfn (window-xwin win)) ,v) ,(when wfn `(setf (,wfn win) ,v))))) (xlib:with-state ((window-xwin win)) (update xlib:drawable-x nil x) (update xlib:drawable-y nil y) (update xlib:drawable-width window-width width) (update xlib:drawable-height window-height height) (update xlib:drawable-border-width nil border-width) ))) (defun find-free-window-number (group) "Return a free window number for GROUP." (find-free-number (mapcar 'window-number (group-windows group)))) (defun reparent-window (screen window) ;; apparently we need to grab the server so the client doesn't get ;; the mapnotify event before the reparent event. that's what fvwm ;; says. (xlib:with-server-grabbed (*display*) (let ((master-window (xlib:create-window :parent (screen-root screen) :x (xlib:drawable-x (window-xwin window)) :y (xlib:drawable-y (window-xwin window)) :width (window-width window) :height (window-height window) :background (if (eq (window-type window) :normal) (screen-win-bg-color screen) :none) :border (screen-unfocus-color screen) :border-width (default-border-width-for-type window) :event-mask *window-parent-events*))) (unless (eq (xlib:window-map-state (window-xwin window)) :unmapped) (incf (window-unmap-ignores window))) (xlib:reparent-window (window-xwin window) master-window 0 0) (xwin-grab-buttons master-window) ;; ;; we need to update these values since they get set to 0,0 on reparent ;; (setf (window-x window) 0 ;; (window-y window) 0) (xlib:add-to-save-set (window-xwin window)) (setf (window-parent window) master-window)))) (defun process-existing-windows (screen) "Windows present when stumpwm starts up must be absorbed by stumpwm." (let ((children (xlib:query-tree (screen-root screen))) (*processing-existing-windows* t) (stacking (xlib:get-property (screen-root screen) :_NET_CLIENT_LIST_STACKING :type :window))) (when stacking (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))))) (dolist (win children) (let ((map-state (xlib:window-map-state win)) (wm-state (xwin-state win))) ;; Don't process override-redirect windows. (unless (or (eq (xlib:window-override-redirect win) :on) (internal-window-p screen win)) (if (eq (xwin-type win) :dock) (progn (dformat 1 "Window ~S is dock-type. Placing in mode-line.~%" win) (place-mode-line-window screen win)) (if (or (eql map-state :viewable) (eql wm-state +iconic-state+)) (progn (dformat 1 "Processing ~S ~S~%" (xwin-name win) win) (process-mapped-window screen win)))))))) (dolist (w (screen-windows screen)) (setf (window-state w) +normal-state+) (xwin-hide w))) (defun xwin-grab-keys (win group) (labels ((add-shift-modifier (key) ;; don't butcher the caller's structure (let ((key (copy-structure key))) (setf (key-shift key) t) key)) (grabit (w key) (loop for code in (multiple-value-list (xlib:keysym->keycodes *display* (key-keysym key))) do ;; some keysyms aren't mapped to keycodes so just ignore them. (when code ;; Some keysyms, such as upper case letters, need the ;; shift modifier to be set in order to grab properly. (let ((key (if (and (not (eql (key-keysym key) (xlib:keycode->keysym *display* code 0))) (eql (key-keysym key) (xlib:keycode->keysym *display* code 1))) (add-shift-modifier key) key))) (xlib:grab-key w code :modifiers (x11-mods key) :owner-p t :sync-pointer-p nil :sync-keyboard-p nil) ;; Ignore capslock and numlock by also grabbing the ;; keycombos with them on. (xlib:grab-key w code :modifiers (x11-mods key nil t) :owner-p t :sync-keyboard-p nil :sync-keyboard-p nil) (when (modifiers-numlock *modifiers*) (xlib:grab-key w code :modifiers (x11-mods key t nil) :owner-p t :sync-pointer-p nil :sync-keyboard-p nil) (xlib:grab-key w code :modifiers (x11-mods key t t) :owner-p t :sync-keyboard-p nil :sync-keyboard-p nil))))))) (dolist (map (dereference-kmaps (top-maps group))) (dolist (i (kmap-bindings map)) (grabit win (binding-key i)))))) (defun grab-keys-on-window (win) (xwin-grab-keys (window-xwin win) (window-group win))) (defun xwin-ungrab-keys (win) (xlib:ungrab-key win :any :modifiers :any)) (defun ungrab-keys-on-window (win) (xwin-ungrab-keys (window-xwin win))) (defun xwin-grab-buttons (win) ;; FIXME: Why doesn't grabbing button :any work? We have to ;; grab them one by one instead. (xwin-ungrab-buttons win) (loop for i from 1 to 7 do (xlib:grab-button win i '(:button-press) :modifiers :any :owner-p nil :sync-pointer-p t :sync-keyboard-p nil))) (defun xwin-ungrab-buttons (win) (xlib:ungrab-button win :any :modifiers :any)) (defun sync-keys () "Any time *top-map* is modified this must be called." (loop for i in *screen-list* do (xwin-ungrab-keys (screen-focus-window i)) do (loop for j in (screen-mapped-windows i) do (xwin-ungrab-keys j)) do (xlib:display-finish-output *display*) do (loop for j in (screen-mapped-windows i) do (xwin-grab-keys j (window-group (find-window j)))) do (xwin-grab-keys (screen-focus-window i) (screen-current-group i))) (xlib:display-finish-output *display*)) (defun netwm-remove-window (window) (xlib:delete-property (window-xwin window) :_NET_WM_DESKTOP)) (defun process-mapped-window (screen xwin) "Add the window to the screen's mapped window list and process it as needed." (let ((window (xwin-to-window xwin))) (screen-add-mapped-window screen xwin) ;; windows always have border width 0. Their parents provide the ;; border. (set-window-geometry window :border-width 0) (setf (xlib:window-event-mask (window-xwin window)) *window-events*) (register-window window) (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) ;; 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 ;; one (if it isn't already) if :raise is T. (when placement-data (if (getf placement-data :raise) (switch-to-group (window-group window)) (unless *suppress-window-placement-indicator* (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))) ;; 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 (update-all-mode-lines) ;; Run the new window hook on it. (run-hook-with-args *new-window-hook* window) window)) (defun find-withdrawn-window (xwin) "Return the window and screen for a withdrawn window." (declare (type xlib:window xwin)) (dolist (i *screen-list*) (let ((w (find xwin (screen-withdrawn-windows i) :key 'window-xwin :test 'xlib:window-equal))) (when w (return-from find-withdrawn-window (values w i)))))) (defun restore-window (window) "Restore a withdrawn window" (declare (type window window)) ;; put it in a valid group (let* ((screen (window-screen window)) (group (get-window-placement screen window))) (unless (find (window-group window) (screen-groups screen)) (setf (window-group window) (or group (screen-current-group screen)))) ;; FIXME: somehow it feels like this could be merged with group-add-window (setf (window-title window) (xwin-name (window-xwin window)) (window-class window) (xwin-class (window-xwin window)) (window-res window) (xwin-res-name (window-xwin window)) (window-role window) (xwin-role (window-xwin window)) (window-type window) (xwin-type (window-xwin window)) (window-normal-hints window) (get-normalized-normal-hints (window-xwin window)) (window-number window) (find-free-window-number (window-group window)) (window-state window) +iconic-state+ (xwin-state (window-xwin window)) +iconic-state+ (screen-withdrawn-windows screen) (delete window (screen-withdrawn-windows screen)) ;; put the window at the end of the list (group-windows (window-group window)) (append (group-windows (window-group window)) (list window))) (screen-add-mapped-window screen (window-xwin window)) (register-window window) (group-add-window (window-group window) window) (netwm-set-group window) ;; It is effectively a new window in terms of the window list. (run-hook-with-args *new-window-hook* window) ;; FIXME: only called frame-raise-window instead of this function ;; which will likely call focus-all. (group-raise-request (window-group window) window :map))) (defun withdraw-window (window) "Withdrawing a window means just putting it in a list til we get a destroy event." (declare (type window window)) ;; This function cannot request info about WINDOW from the xserver as it may not exist anymore. (let ((group (window-group window)) (screen (window-screen window))) (dformat 1 "withdraw window ~a~%" screen) ;; Save it for later since it is only withdrawn, not destroyed. (push window (screen-withdrawn-windows screen)) (setf (window-state window) +withdrawn-state+ (xwin-state (window-xwin window)) +withdrawn-state+) (xlib:unmap-window (window-parent window)) ;; Clean up the window's entry in the screen and group (setf (group-windows group) (delete window (group-windows group))) (screen-remove-mapped-window screen (window-xwin window)) (when (window-in-current-group-p window) ;; since the window doesn't exist, it doesn't have focus. (setf (screen-focus screen) nil)) (netwm-remove-window window) (group-delete-window group window) ;; quite often the modeline displays the window list, so update it (update-all-mode-lines) ;; Run the destroy hook on the window (run-hook-with-args *destroy-window-hook* window))) (defun destroy-window (window) (declare (type window window)) "The window has been destroyed. clean up our data structures." ;; This function cannot request info about WINDOW from the xserver (let ((screen (window-screen window))) (unless (eql (window-state window) +withdrawn-state+) (withdraw-window window)) ;; now that the window is withdrawn, clean up the data structures (setf (screen-withdrawn-windows screen) (delete window (screen-withdrawn-windows screen))) (setf (screen-urgent-windows screen) (delete window (screen-urgent-windows screen))) (dformat 1 "destroy window ~a~%" screen) (dformat 3 "destroying parent window~%") (dformat 7 "parent window is ~a~%" (window-parent window)) (xlib:destroy-window (window-parent window)))) (defun move-window-to-head (group window) "Move window to the head of the group's window list." (declare (type group group)) (declare (type window window)) ;(assert (member window (screen-mapped-windows screen))) (move-to-head (group-windows group) window) (netwm-update-client-list-stacking (group-screen group))) (defun no-focus (group last-win) "don't focus any window but still read keyboard events." (dformat 3 "no-focus~%") (let* ((screen (group-screen group))) (when (eq group (screen-current-group screen)) (xlib:set-input-focus *display* (screen-focus-window screen) :POINTER-ROOT) (setf (screen-focus screen) nil) (move-screen-to-head screen)) (when last-win (update-decoration last-win)))) (defmethod focus-window (window) "Make the window visible and give it keyboard focus." (dformat 3 "focus-window: ~s~%" window) (let* ((group (window-group window)) (screen (group-screen group)) (cw (screen-focus screen)) (xwin (window-xwin window))) (cond ((eq window cw) ;; If window to focus is already focused then our work is done. ) ((and *current-event-time* (member :WM_TAKE_FOCUS (xlib:wm-protocols xwin) :test #'eq)) (raise-window window) (let ((hints (xlib:wm-hints xwin))) (when (or (null hints) (eq (xlib:wm-hints-input hints) :on)) (screen-set-focus screen window) (update-decoration window) (when cw (update-decoration cw)))) (move-window-to-head group window) (send-client-message window :WM_PROTOCOLS (xlib:intern-atom *display* :WM_TAKE_FOCUS) *current-event-time*) (run-hook-with-args *focus-window-hook* window cw)) (t (raise-window window) (screen-set-focus screen window) (update-decoration window) (when cw (update-decoration cw)) ;; Move the window to the head of the mapped-windows list (move-window-to-head group window) (run-hook-with-args *focus-window-hook* window cw))))) (defun xwin-kill (window) "Kill the client associated with window." (dformat 3 "Kill client~%") (xlib:kill-client *display* (xlib:window-id window))) (defun select-window-from-menu (windows fmt) "Allow the user to select a window from the list passed in @var{windows}. The @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)) windows) nil (or (position (current-window) windows) 0)))) ;;; Window commands (defcommand delete-window (&optional (window (current-window))) () "Delete a window. By default delete the current window. This is a request sent to the window. The window's client may decide not to grant the request or may not be able to if it is unresponsive." (when window (send-client-message window :WM_PROTOCOLS (xlib:intern-atom *display* :WM_DELETE_WINDOW)))) (defcommand-alias delete delete-window) (defcommand kill-window (&optional (window (current-window))) () "Tell X to disconnect the client that owns the specified window. Default to the current window. if @command{delete-window} didn't work, try this." (when window (xwin-kill (window-xwin window)))) (defcommand-alias kill kill-window) (defcommand title (title) ((:rest "Set window's title to: ")) "Override the current window's title." (if (current-window) (setf (window-user-title (current-window)) title) (message "No Focused Window"))) (defcommand select-window (query) ((:window-name "Select: ")) "Switch to the first window that starts with @var{query}." (let (match) (labels ((match (win) (let* ((wname (window-name win)) (end (min (length wname) (length query)))) (string-equal wname query :end1 end :end2 end)))) (unless (null query) (setf match (find-if #'match (group-windows (current-group))))) (when match (group-focus-window (current-group) match))))) (defcommand-alias select select-window) (defcommand select-window-by-name (name) ((:window-name "Select: ")) "Switch to the first window whose name is exactly @var{name}." (let ((win (find name (group-windows (current-group)) :test #'string= :key #'window-name))) (when win (group-focus-window (current-group) win)))) (defcommand select-window-by-number (num &optional (group (current-group))) ((:window-number "Select: ")) "Find the window with the given number and focus it in its frame." (labels ((match (win) (= (window-number win) num))) (let ((win (find-if #'match (group-windows group)))) (when win (group-focus-window group win))))) (defcommand other-window (&optional (group (current-group))) () "Switch to the window last focused." (let* ((wins (group-windows group)) ;; the frame could be empty (win (if (group-current-window group) (second wins) (first wins)))) (if win (group-focus-window group win) (echo-string (group-screen group) "No other window.")))) (defcommand-alias other other-window) (defcommand renumber (nt &optional (group (current-group))) ((:number "Number: ")) "Change the current window's number to the specified number. If another window is using the number, then the windows swap numbers. Defaults to current group." (let ((nf (window-number (group-current-window group))) (win (find-if #'(lambda (win) (= (window-number win) nt)) (group-windows group)))) ;; Is it already taken? (if win (progn ;; swap the window numbers (setf (window-number win) nf) (setf (window-number (group-current-window group)) nt)) ;; Just give the window the number (setf (window-number (group-current-window group)) nt)))) (defcommand-alias number renumber) (defcommand repack-window-numbers (&optional preserved) () "Ensure that used window numbers do not have gaps; ignore PRESERVED window numbers." (let* ((group (current-group)) (windows (sort-windows group))) (loop for w in windows do (unless (find (window-number w) preserved) (setf (window-number w) (find-free-number (remove (window-number w) (mapcar 'window-number windows)) 0)))))) (defcommand windowlist (&optional (fmt *window-format*)) (:rest) "Allow the user to Select a window from the list of windows and focus the selected window. For information of menu bindings @xref{Menus}. The optional argument @var{fmt} can be specified to override the default window formatting." (if (null (group-windows (current-group))) (message "No Managed Windows") (let* ((group (current-group)) (window (select-window-from-menu (sort-windows group) fmt))) (if window (group-focus-window group window) (throw 'error :abort))))) (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))))) string))) (defcommand-alias insert window-send-string) (defcommand mark () () "Toggle the current window's mark." (let ((win (current-window))) (when win (setf (window-marked win) (not (window-marked win))) (message (if (window-marked win) "Marked!" "Unmarked!"))))) (defcommand clear-window-marks (&optional (group (current-group)) (windows (group-windows group))) () "Clear all marks in the current group." (dolist (w windows) (setf (window-marked w) nil))) (defcommand-alias clear-marks clear-window-marks) (defcommand echo-windows (&optional (fmt *window-format*) (group (current-group)) (windows (group-windows group))) (:rest) "Display a list of managed windows. The optional argument @var{fmt} can 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))) (if (null wins) (echo-string (group-screen group) "No Managed Windows") (echo-string-list (group-screen group) names highlight)))) (defcommand-alias windows echo-windows) (defcommand info (&optional (fmt *window-info-format*)) (:rest) "Display information about the current window." (if (current-window) (message "~a" (format-expand *window-formatters* fmt (current-window))) (message "No Current Window"))) (defcommand refresh () () "Refresh current window without changing its size." (let* ((window (current-window)) (w (window-width window)) (h (window-height window))) (set-window-geometry window :width (- w (window-width-inc window)) :height (- h (window-height-inc window))) ;; make sure the first one goes through before sending the second (xlib:display-finish-output *display*) (set-window-geometry window :width w :height h))) stumpwm-0.9.9/workarounds.lisp000066400000000000000000000076501242702317100165230ustar00rootroot00000000000000;;; workarounds for bugs in clx (in-package :xlib) ;;; Both clisp and SBCL can't handle incompliant (and in clisp's case, ;;; even compliant) wm-class strings. See test-wm-class in test-wm.lisp. #+sbcl (defun get-wm-class (window) (declare (type window window)) (declare (clx-values (or null name-string) (or null class-string))) (let ((value (get-property window :WM_CLASS :type :STRING :result-type '(vector card8)))) (declare (type (or null (vector card8)) value)) (when value ;; Buggy clients may not comply with the format, so deal with ;; the unexpected. (let* ((first-zero (position 0 (the (vector card8) value))) (second-zero (and first-zero (position 0 (the (vector card8) value) :start (1+ first-zero)))) (name (subseq (the (vector card8) value) 0 first-zero)) (class (and first-zero (subseq (the (vector card8) value) (1+ first-zero) second-zero)))) (values (and (plusp (length name)) (map 'string #'card8->char name)) (and (plusp (length class)) (map 'string #'card8->char class))))))) ;; This redefines decod-wm-size-hints in clisp because "It seems clisp ;; tries to be sneaky and represent the min and max aspect ratios as a ;; ratio number, which works except when the 0/0 is how you specify ;; that there is no aspect ratio, as mplayer/mpv/mplayer2 does." ;; http://lists.gnu.org/archive/html/stumpwm-devel/2009-08/msg00025.html #+clisp (defun decode-wm-size-hints (vector) (declare (type (or null (simple-vector *)) vector)) (declare (values (or null wm-size-hints))) (when vector (let ((flags (aref vector 0)) (hints (make-wm-size-hints))) (declare (type card16 flags) (type wm-size-hints hints)) (setf (wm-size-hints-user-specified-position-p hints) (logbitp 0 flags)) (setf (wm-size-hints-user-specified-size-p hints) (logbitp 1 flags)) (setf (wm-size-hints-program-specified-position-p hints) (logbitp 2 flags)) (setf (wm-size-hints-program-specified-size-p hints) (logbitp 3 flags)) (when (logbitp 4 flags) (setf (wm-size-hints-min-width hints) (aref vector 5) (wm-size-hints-min-height hints) (aref vector 6))) (when (logbitp 5 flags) (setf (wm-size-hints-max-width hints) (aref vector 7) (wm-size-hints-max-height hints) (aref vector 8))) (when (logbitp 6 flags) (setf (wm-size-hints-width-inc hints) (aref vector 9) (wm-size-hints-height-inc hints) (aref vector 10))) (when (logbitp 7 flags) (setf (wm-size-hints-min-aspect hints) (ignore-errors (/ (aref vector 11) (aref vector 12))) (wm-size-hints-max-aspect hints) (ignore-errors (/ (aref vector 13) (aref vector 14))))) (when (> (length vector) 15) ;; This test is for backwards compatibility since old Xlib programs ;; can set a size-hints structure that is too small. See ICCCM. (when (logbitp 8 flags) (setf (wm-size-hints-base-width hints) (aref vector 15) (wm-size-hints-base-height hints) (aref vector 16))) (when (logbitp 9 flags) (setf (wm-size-hints-win-gravity hints) (decode-type (member :unmap :north-west :north :north-east :west :center :east :south-west :south :south-east :static) (aref vector 17))))) ;; Obsolete fields (when (or (logbitp 0 flags) (logbitp 2 flags)) (setf (wm-size-hints-x hints) (aref vector 1) (wm-size-hints-y hints) (aref vector 2))) (when (or (logbitp 1 flags) (logbitp 3 flags)) (setf (wm-size-hints-width hints) (aref vector 3) (wm-size-hints-height hints) (aref vector 4))) hints))) stumpwm-0.9.9/wrappers.lisp000066400000000000000000000374021242702317100160060ustar00rootroot00000000000000;; 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, see ;; . ;; Commentary: ;; ;; portability wrappers. Any code that must run different code for ;; different lisps should be wrapped up in a function and put here. ;; ;; Code: (in-package #:stumpwm) (export '(getenv)) (define-condition not-implemented (stumpwm-error) () (:documentation "A function has been called that is not implemented yet.")) (defun run-prog (prog &rest opts &key args output (wait t) &allow-other-keys) "Common interface to shell. Does not return anything useful." #+(or clisp ccl ecl gcl) ;; Arg. We can't pass in an environment so just set the DISPLAY ;; variable so it's inherited by the child process. (when (current-screen) (setf (getenv "DISPLAY") (screen-display-string (current-screen) nil))) (setq opts (remove-plist opts :args :output :wait)) #+allegro (apply #'excl:run-shell-command (apply #'vector prog prog args) :output output :wait wait :environment (when (current-screen) (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))) args) :wait wait :output (if output output t) :error t) #+clisp (let ((stream (apply #'ext:run-program prog :arguments args :wait wait :output (if output :stream :terminal) opts))) (when output (loop for ch = (read-char stream nil stream) until (eq ch stream) do (write-char ch output)))) #+cmu (let ((env ext:*environment-list*)) (when (current-screen) (setf env (cons (cons "DISPLAY" (screen-display-string (current-screen) nil)) env))) (apply #'ext:run-program prog args :output (if output output t) :env env :error t :wait wait opts)) #+ecl (if output (let ((stream (ext:run-program prog args :input nil))) (loop for line = (read-line stream nil) while line do (format output "~A~%" line))) (ext:system (format nil "~a~{ '~a'~}~@[ &~]" prog args (not wait)))) #+gcl (let ((stream (apply #'si:run-process prog args))) (when wait (loop for ch = (read-char stream nil stream) until (eq ch stream) do (write-char ch output)))) #+liquid (apply #'lcl:run-program prog :output output :wait wait :arguments args opts) #+lispworks (let ((cmdline (format nil "~@[~A ~]~A~{ '~A'~}" (and (current-screen) (screen-display-string (current-screen) t)) prog args))) (sys:call-system-showing-output cmdline :show-cmd nil :prefix nil :wait wait :output-stream output)) #+sbcl (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)))) env)))) (apply #'sb-ext:run-program prog args :output (if output output t) :error t :wait wait :environment env opts)) #-(or allegro ccl clisp cmu ecl gcl liquid lispworks sbcl) (error 'not-implemented)) (defun run-prog-collect-output (prog &rest args) "run a command and read its output." (with-output-to-string (s) (run-prog prog :args args :output s :wait t))) (defun getenv (var) "Return the value of the environment variable." #+allegro (sys::getenv (string var)) #+clisp (ext:getenv (string var)) #+(or cmu scl) (cdr (assoc (string var) ext:*environment-list* :test #'equalp :key #'string)) #+gcl (si:getenv (string var)) #+lispworks (lw:environment-variable (string var)) #+lucid (lcl:environment-variable (string var)) #+mcl (ccl::getenv var) #+sbcl (sb-posix:getenv (string var)) #+openmcl (ccl:getenv (string var)) #+ecl (ext:getenv (string var)) #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl scl openmcl ecl) (error 'not-implemented)) (defun (setf getenv) (val var) "Set the value of the environment variable, @var{var} to @var{val}." #+allegro (setf (sys::getenv (string var)) (string val)) #+clisp (setf (ext:getenv (string var)) (string val)) #+(or cmu scl) (let ((cell (assoc (string var) ext:*environment-list* :test #'equalp :key #'string))) (if cell (setf (cdr cell) (string val)) (push (cons (intern (string var) "KEYWORD") (string val)) ext:*environment-list*))) #+gcl (si:setenv (string var) (string val)) #+lispworks (setf (lw:environment-variable (string var)) (string val)) #+lucid (setf (lcl:environment-variable (string var)) (string val)) #+sbcl (sb-posix:putenv (format nil "~A=~A" (string var) (string val))) #+openmcl (ccl:setenv (string var) (string val)) #+ecl (ext:setenv (string var) (string val)) #-(or allegro clisp cmu gcl lispworks lucid sbcl scl openmcl ecl) (error 'not-implemented)) (defun pathname-is-executable-p (pathname) "Return T if the pathname describes an executable file." (declare (ignorable pathname)) #+sbcl (let ((filename (coerce (sb-ext:native-namestring pathname) 'string))) (and (or (pathname-name pathname) (pathname-type pathname)) (sb-unix:unix-access filename sb-unix:x_ok))) ;; FIXME: this is not exactly perfect #+clisp (logand (posix:convert-mode (posix:file-stat-mode (posix:file-stat pathname))) (posix:convert-mode '(:xusr :xgrp :xoth))) #-(or sbcl clisp) t) (defun probe-path (path) "Return the truename of a supplied path, or nil if it does not exist." (handler-case (truename (let ((pathname (pathname path))) ;; If there is neither a type nor a name, we have a directory ;; pathname already. Otherwise make a valid one. (if (and (not (pathname-name pathname)) (not (pathname-type pathname))) pathname (make-pathname :directory (append (or (pathname-directory pathname) (list :relative)) (list (file-namestring pathname))) :name nil :type nil :defaults pathname)))) (file-error () nil))) (defun portable-file-write-date (pathname) ;; clisp errors out if you run file-write-date on a directory. #+clisp (posix:file-stat-mtime (posix:file-stat pathname)) #-clisp (file-write-date pathname)) (defun print-backtrace (&optional (frames 100)) "print a backtrace of FRAMES number of frames to standard-output" #+sbcl (sb-debug:backtrace frames *standard-output*) #+clisp (ext:show-stack 1 frames (sys::the-frame)) #+ccl (ccl:print-call-history :count frames :stream *standard-output* :detailed-p nil) ;; borrowed from 'trivial-backtrace' #+lispworks (let ((dbg::*debugger-stack* (dbg::grab-stack nil :how-many frames)) (*debug-io* *standard-output*) (dbg:*debug-print-level* nil) (dbg:*debug-print-length* nil)) (dbg:bug-backtrace nil)) #-(or sbcl clisp ccl lispworks) (write-line "Sorry, no backtrace for you.")) (defun bytes-to-string (data) "Convert a list of bytes into a string." #+sbcl (handler-bind ((sb-impl::octet-decoding-error #'(lambda (c) (declare (ignore c)) (invoke-restart 'use-value "?")))) (sb-ext:octets-to-string (make-array (length data) :element-type '(unsigned-byte 8) :initial-contents data))) #+clisp (ext:convert-string-from-bytes (make-array (length data) :element-type '(unsigned-byte 8) :initial-contents data) custom:*terminal-encoding*) #+lispworks (ef:decode-external-string (make-array (length data) :element-type '(unsigned-byte 8) :initial-contents data) :ascii) #-(or sbcl clisp lispworks) (map 'string #'code-char data)) (defun string-to-bytes (string) "Convert a string to a vector of octets." #+sbcl (sb-ext:string-to-octets string) #+clisp (ext:convert-string-to-bytes string custom:*terminal-encoding*) #+lispworks (ef:encode-lisp-string string :ascii) #-(or sbcl clisp lispworks) (map 'list #'char-code string)) (defun utf8-to-string (octets) "Convert the list of octets to a string." (let ((octets (coerce octets '(vector (unsigned-byte 8))))) #+ccl (ccl:decode-string-from-octets octets :external-format :utf-8) #+clisp (ext:convert-string-from-bytes octets charset:utf-8) #+sbcl (handler-bind ((sb-impl::octet-decoding-error #'(lambda (c) (declare (ignore c)) (invoke-restart 'use-value "?")))) (sb-ext:octets-to-string octets :external-format :utf-8)) #+lispworks (ef:decode-external-string (make-array (length octets) :element-type '(unsigned-byte 8) :initial-contents octets) :utf-8) #-(or ccl clisp sbcl lispworks) (map 'string #'code-char octets))) (defun string-to-utf8 (string) "Convert the string to a vector of octets." #+ccl (ccl:encode-string-to-octets string :external-format :utf-8) #+clisp (ext:convert-string-to-bytes string charset:utf-8) #+sbcl (sb-ext:string-to-octets string :external-format :utf-8) #+lispworks (ef:encode-lisp-string string :utf-8) #-(or ccl clisp sbcl lispworks) (map 'list #'char-code string)) (defun make-xlib-window (xobject) "For some reason the clx xid cache screws up returns pixmaps when they should be windows. So use this function to make a window out of them." #+clisp (make-instance 'xlib:window :id (slot-value xobject 'xlib::id) :display *display*) #+(or sbcl ecl openmcl lispworks) (xlib::make-window :id (slot-value xobject 'xlib::id) :display *display*) #-(or sbcl clisp ecl openmcl lispworks) (error 'not-implemented)) ;; Right now clisp and sbcl both work the same way (defun lookup-error-recoverable-p () #+(or clisp sbcl) (find :one (compute-restarts) :key 'restart-name) #-(or clisp sbcl) nil) (defun recover-from-lookup-error () #+(or clisp sbcl) (invoke-restart :one) #-(or clisp sbcl) (error 'not-implemented)) (defun directory-no-deref (pathspec) "Call directory without dereferencing symlinks in the results" #+(or cmu scl) (directory pathspec :truenamep nil) #+clisp (mapcar #'car (directory pathspec :full t)) #+lispworks (directory pathspec :link-transparency nil) #+openmcl (directory pathspec :follow-links nil) ;; FIXME: seems like there ought to be a less cumbersome way to run ;; different code based on the version. #+sbcl (macrolet ((dir (p) (if (>= (parse-integer (third (split-seq (lisp-implementation-version) '(#\.))) :junk-allowed t) 24) `(directory ,p :resolve-symlinks nil) `(directory ,p)))) (dir pathspec)) #-(or clisp cmu lispworks openmcl sbcl scl) (directory pathspec) ) ;;; CLISP does not include features to distinguish different Unix ;;; flavours (at least until version 2.46). Until this is fixed, use a ;;; hack to determine them. #+ (and clisp (not (or linux freebsd))) (eval-when (eval load compile) (let ((osname (posix:uname-sysname (posix:uname)))) (cond ((string= osname "Linux") (pushnew :linux *features*)) ((string= osname "FreeBSD") (pushnew :freebsd *features*)) (t (warn "Your operating system is not recognized."))))) ;;; On GNU/Linux some contribs use sysfs to figure out useful info for ;;; the user. SBCL upto at least 1.0.16 (but probably much later) has ;;; a problem handling files in sysfs caused by SBCL's slightly ;;; unusual handling of files in general and Linux' sysfs violating ;;; POSIX. When this situation is resolved, this function may be removed. #+ linux (export '(read-line-from-sysfs)) #+ linux (defun read-line-from-sysfs (stream &optional (blocksize 80)) "READ-LINE, but with a workaround for a known SBCL/Linux bug regarding files in sysfs. Data is read in chunks of BLOCKSIZE bytes." #- sbcl (declare (ignore blocksize)) #- sbcl (read-line stream) #+ sbcl (let ((buf (make-array blocksize :element-type '(unsigned-byte 8) :initial-element 0)) (fd (sb-sys:fd-stream-fd stream)) (string-filled 0) (string (make-string blocksize)) bytes-read pos (stringlen blocksize)) (loop ;; Read in the raw bytes (setf bytes-read (sb-unix:unix-read fd (sb-sys:vector-sap buf) blocksize)) ;; Why does SBCL return NIL when an error occurs? (when (or (null bytes-read) (< bytes-read 0)) (error "UNIX-READ failed.")) ;; This is # bytes both read and in the correct line. (setf pos (or (position (char-code #\Newline) buf) bytes-read)) ;; Resize the string if necessary. (when (> (+ pos string-filled) stringlen) (setf stringlen (max (+ pos string-filled) (* 2 stringlen))) (let ((new (make-string stringlen))) (replace new string) (setq string new))) ;; Translate read bytes to string (setf (subseq string string-filled) (sb-ext:octets-to-string (subseq buf 0 pos))) (incf string-filled pos) (if (< pos blocksize) (return (subseq string 0 string-filled)))))) (defun argv () #+sbcl (copy-list sb-ext:*posix-argv*) #+clisp (coerce (ext:argv) 'list) #+lispworks (copy-list sys:*line-arguments-list*) #-(or sbcl clisp lispworks) (error "unimplemented")) (defun execv (program &rest arguments) (declare (ignorable program arguments)) ;; FIXME: seems like there should be a way to do this in sbcl the way it's done in clisp. -sabetts #+sbcl (sb-alien:with-alien ((prg sb-alien:c-string program) (argv (array sb-alien:c-string 256))) (loop for i in arguments for j below 255 do (setf (sb-alien:deref argv j) i)) (setf (sb-alien:deref argv (length arguments)) nil) (sb-alien:alien-funcall (sb-alien:extern-alien "execv" (function sb-alien:int sb-alien:c-string (* sb-alien:c-string))) prg (sb-alien:cast argv (* sb-alien:c-string)))) ;; FIXME: Using unexported and undocumented functionality isn't nice #+clisp (funcall (ffi::find-foreign-function "execv" (ffi:parse-c-type '(ffi:c-function (:arguments (prg ffi:c-string) (args (ffi:c-array-ptr ffi:c-string)) ) (:return-type ffi:int))) nil nil nil nil) program (coerce arguments 'array)) #-(or sbcl clisp) (error "Unimplemented")) ;;; EOF stumpwm-0.9.9/wse.lisp000066400000000000000000000116661242702317100147450ustar00rootroot00000000000000;; Copyright 2011 Michael Raskin ;; ;; Maintainer: Michael Raskin ;; ;; 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 ;; Window Selection Expressions (in-package :stumpwm) (export '(move-windows-to-group act-on-matching-windows)) (defun move-windows-to-group (windows &optional (arggroup nil)) "Move all windows from the list to the group" (let* ((group (if (stringp arggroup) (or (find-group (current-screen) arggroup) (add-group (current-screen) arggroup)) (or arggroup (current-group))))) (mapcar (lambda (w) (move-window-to-group w group)) windows))) (defgeneric list-windows (range) (:documentation "List all the windows in a set.")) (defmethod list-windows ((range t)) (error "Unknown kind of window set")) (defmethod list-windows ((range (eql :screen))) (list-windows (current-screen))) (defmethod list-windows ((range (eql :group))) (list-windows (current-group))) (defmethod list-windows ((range (eql :frame))) (list-windows (tile-group-current-frame (current-group)))) (defmethod list-windows ((range screen)) (screen-windows range)) (defmethod list-windows ((range group)) (group-windows range)) (defmethod list-windows ((range frame)) (frame-windows (current-group) range)) (defmethod list-windows ((range list)) range) (defmacro act-on-matching-windows ((var &optional (range '(current-screen))) condition &rest code) "Run code on all windows matching condition; var is the shared lambda variable. Range can be any screen/group/frame or :screen/:group/:frame for the current instance. Condition is just the code to evaluate." `(let ((range ,range)) (loop for ,var in (cond ((typep range 'screen) (screen-windows range)) ((typep range 'group) (group-windows range)) ((typep range 'frame) (frame-windows (current-group) range)) ((typep range 'list) range) ((eq range :screen) (screen-windows (current-screen))) ((eq range :group) (group-windows (current-group))) ((eq range :frame) (frame-windows (current-group) (tile-group-current-frame (current-group)))) (t (error "Unknown kind of window set"))) when ,condition collect (progn ,@code)))) (defun pull-w (w &optional g) "Pull the window w: to the current group or to the specified group g." (move-windows-to-group (list w) (or g (current-group)))) (defun titled-p (w title) "Check whether window title of the window w is equal to the string title." (equal (window-title w) title)) (defun title-re-p (w tre) "Check whether the window title of the window w matches the regular expression tre." (cl-ppcre:scan tre (window-title w))) (defun classed-p (w class) "Check whether the window class of the window w is equal to the string class." (equal (window-class w) class)) (defun class-re-p (w cre) "Check whether the window class of the window w matches the regular expression cre." (cl-ppcre:scan cre (window-class w))) (defun typed-p (w type) "Check whether the window type of the window w is equal to the string type." (equal (window-type w) type)) (defun type-re-p (w tre) "Check whether the window type of the window w matches the regular expression tre." (cl-ppcre:scan tre (window-type w))) (defun roled-p (w role) "Check whether the window role of the window w is equal to the string role." (equal (window-role w) role)) (defun role-re-p (w rre) "Check whether the window role of the window w matches the regular expression rre." (cl-ppcre:scan rre (window-role w))) (defun resed-p (w res) "Check whether the window resource of the window w is equal to the string res." (equal (window-res w) res)) (defun res-re-p (w rre) "Check whether the window resource of the window w matches the regular expression rre." (cl-ppcre:scan rre (window-res w))) (defun grouped-p (w &optional name) "Check whether the window w belongs to the group name or the current group if name is not specified." (if name (equal name (group-name (window-group w))) (equal (window-group w) (current-group)))) (defun in-frame-p (w &optional f) "Check whether the window w belongs to the frame f or to the current frame if the frame is not specified." (eq (window-frame w) (or f (tile-group-current-frame (current-group (current-screen))))))