diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_Q2hhbmdlTG9n --- /dev/null +++ b/ChangeLog @@ -0,0 +1,42 @@ +2004-02-15 Zajcev Evgeny <zevlg@yandex.ru> + + * XWEM: Many improvements, window configurations, keyboard macros, + etc. I think we are ready for beta or even for pre-release. + + * addons/xwem-register.el (new): Registers for XWEM added. + + * addons/xwem-framei.el (new): Frame indicator added. + + * xwem-sound.el (new): Sound support added. + +2004-01-23 Zajcev Evgeny <zevlg@yandex.ru> + + * addons/xwem-osd.el (Bugs): Some bug fixes. + + * addons/xwem-holer.el (interactive): More interactive support + added, now it is possible to create/move/resize/delete holers + interactively. + + * addons/xwem-edmacro.el (xwem-edmacro-can-edit-unbinded): Now it + is possible to edit(create) even unbinded keyboard macros. + + * xwem-keymacro.el (xwem-keymacro-show-macro): Added new + customizable variable. + + * xwem-macros.el (xwem-cursor-shape-choice): Added new shapes. + + * xwem-misc.el (xwem-make-cursor): Moved here from xwem-macros.el. + + * xwem-minibuffer.el (xwem-minibuffer-init): Work around + `menubar-visible-p' specifier problem. + +2004-01-21 Zajcev Evgeny <zevlg@yandex.ru> + + * xwem-keyboard.el (xwem-kbd-process-after-lookup): Bug fix. check + for `xwem-kbd-reading-keyseq' added when lkm is nil. + +2004-01-21 Zajcev Evgeny <zevlg@yandex.ru> + + * ChangeLog (Revision): ChangeLog in new XWEM layout created. + +;; $Id$ diff --git a/Makefile b/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_TWFrZWZpbGU= --- /dev/null +++ b/Makefile @@ -0,0 +1,50 @@ +# Makefile for xwem lisp code + +# This file is part of XEmacs. + +# XEmacs 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. + +# XEmacs 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 XEmacs; see the file COPYING. If not, write to +# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +# Boston, MA 02111-1307, USA. + +VERSION = 1.00 +AUTHOR_VERSION = 0.1 +MAINTAINER = Zajcev Evgeny +PACKAGE = xwem +PKG_TYPE = regular +REQUIRES = xemacs-base xlib strokes edit-utils text-modes time slider +CATEGORY = standard + +ELCS = lisp/xwem-compat.elc lisp/xwem-clients.elc lisp/xwem-events.elc lisp/xwem-frame.elc \ + lisp/xwem-faces.elc lisp/xwem-help.elc lisp/xwem-focus.elc lisp/xwem-keyboard.elc \ + lisp/xwem-keymacro.elc lisp/xwem-keydefs.elc \ + lisp/xwem-launcher.elc lisp/xwem-main.elc lisp/xwem-manage.elc lisp/xwem-minibuffer.elc \ + lisp/xwem-misc.elc lisp/xwem-mouse.elc lisp/xwem-interactive.elc lisp/xwem-root.elc \ + lisp/xwem-special.elc lisp/xwem-strokes.elc lisp/xwem-tray.elc lisp/xwem-win.elc \ + lisp/xwem-icons.elc lisp/xwem-tabbing.elc lisp/xwem-sound.elc lisp/xwem-load.elc + +ELCS_1 = lisp/addons/xwem-edmacro.elc lisp/addons/xwem-clswi.elc lisp/addons/xwem-time.elc \ + lisp/addons/xwem-osd.elc lisp/addons/xwem-holer.elc lisp/addons/xwem-framei.elc \ + lisp/addons/xwem-register.elc lisp/addons/xwem-gamma.elc + +ELCS_1_DEST = $(PACKAGE)/addons +ELCS_1_FILES = $(ELCS_1) $(ELCS_1:.elc=.el) + +DATA_FILES = $(wildcard icons/*.x[bp]m) logo.xpm +DATA_DEST = $(PACKAGE) + +AUTOLOAD_PATH = lisp + +PRELOADS = -eval '(progn (push "./lisp" load-path) (push "./lisp/addons" load-path) (push (concat (package-name-to-directory "xlib") "/ext") load-path))' -l lisp/auto-autoloads.el + +include ../../XEmacs.rules diff --git a/TODO b/TODO new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_VE9ETw== --- /dev/null +++ b/TODO @@ -0,0 +1,47 @@ +Thu Feb 19 09:16:05 MSK 2004: + + - Focusing manage (according to ICCCM)! very needed. (mostly done) + + - More ICCCM stuff to support, like WM_PROTOCOL, DELETE_WINDOW, + etc. (mostly done) + + - Write some documentation. + + - Configuration file handling. (I think it is done). + + - More hookenization. + + - Session management. save-window-configuration, + set-window-configuration, save-frame-configuration, + set-frame-configuration, etc. (window configurations done) + + - kbd macros. i.e. save keypress sequence and then play it with + XSendEvent. (Done, using xtest extension) + + - Strokes: + * Support for dymanic strokes types. i.e. you can register + new types of strokes. + + * Kanji strokes database + + - CL switcher, something like `iswitchb' or `buqis'.(Done mostly) + + - Programs launcher.(done) + + - Summarize mode. i.e. make buffer with xwem information like + frames setup, clients online, etc.(Done `xwem-help') + + - Multiple visible frames(partly done), frame should reguard his + properties changes on fly, i.e. resize x window, when frame-width + and such changes. + + - Extensions support: + * Xinerama + * Record (may be clones could be done with it?) + * MiscKbd + * XTrap (may be play with it to implement X window clones). + + - Ubering. i.e. you can run other window manager in xwem frame. + Maybe implement using Xnest's -parent feature? + +# $Id$ diff --git a/icons/README b/icons/README new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvUkVBRE1F --- /dev/null +++ b/icons/README @@ -0,0 +1,56 @@ + CREATING NEW ICONS: + + If you are going to add icon in this directory please check your + icon to correspond next xpm format: + + Required: + + * icon filename must begin with 'mini-' if size of icon < 32 in + both directions. + + * icon filename must begin with 'miniWxH-'(where W and H is + width and height of icon), when one of size is great or equal + to 32, but less then 48. + + * icon filename must have no beggining if it's on of its size is + greater or equal to 48. + + * icon name(pointer variable name) must be the same as filename, + but substitute '-' and '.' with '_'. For example if icon's + filename is "mini-apm.xpm" then variable name must be + "mini_apm_xpm". + + * mini icons(W and H < 32) must have no more then 32 colors. + + * 16x16 icons must have no more then 18 colors. + + * After variable name icon must have comment: + + /* columns rows colors chars-per-pixel */ + + And after colors declation icon must have comment: + + /* pixels */ + + * Chars per pixel value must be 1. + + * "};" must be on its own line at the end of file. + + * ' ' must be used for None color. + + + Recommended, but not required: + + * Use only 'c' in colors specification. + + * Use 'None' instead of 'none' in colors specifications. + + * Use '#' for black color. + + * Use '.' for white color. + + * Use 'r' for red color. + + * Use 'g' for green color. + + * use 'b' for blue color. diff --git a/icons/mini-acroread.xpm b/icons/mini-acroread.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1hY3JvcmVhZC54cG0= --- /dev/null +++ b/icons/mini-acroread.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char *mini_acroread_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 7 1", +" c None", +"# c black", +". c #6b100f", +"X c #b21b1c", +"o c #e40512", +"O c #e8738f", +"+ c #e08b98", +/* pixels */ +" X. ", +" +o X ", +" Oo o## ", +" O. .## ", +" ## . o ## ", +" ## Ooo ## ", +" oX+ ", +" . XO +O+ ", +" ## oO. oooXXoX", +" ## XOooXo o", +" +XoX.O OooXXo", +" O. oO ## ", +"+. OX ## ", +". X## ## ", +"X .O## ## ", +"o.O " +}; + + + diff --git a/icons/mini-bitchx.xpm b/icons/mini-bitchx.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1iaXRjaHgueHBt --- /dev/null +++ b/icons/mini-bitchx.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_bitchx_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c blue", +/* pixels */ +".. . . . . . ", +". . . . . . . ", +". ... .. ... ", +". . . . . . ", +".. ... . . . . ", +" ", +" ... . ", +" ... . ", +" ... . ", +" ... . ", +" . . ", +" . ... ", +" . ... ", +" . ... ", +" . ... ", +" " +}; diff --git a/icons/mini-calc.xpm b/icons/mini-calc.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1jYWxjLnhwbQ== --- /dev/null +++ b/icons/mini-calc.xpm @@ -0,0 +1,23 @@ +/* XPM */ +static char *mini_calc_xpm[] = { +"15 14 5 1", +" c None", +". c gray50", +"X c White", +"o c Black", +"O c gray85", +" ..............", +".XXXXXXXXXXXXXo", +".XOOoooooooooOo", +".XOOoXXXXXXX.Oo", +".XOO.........Oo", +".XOOOOOOOOOOOOo", +".X.oO.oO.oO.oOo", +".XooOooOooOooOo", +".X.oO.oO.oO.oOo", +".XooOooOooOooOo", +".X.oO.oO.oO.oOo", +".XooOooOooOooOo", +".OOOOOOOOOOOOOo", +" ooooooooooooo " +}; diff --git a/icons/mini-cd.xpm b/icons/mini-cd.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1jZC54cG0= --- /dev/null +++ b/icons/mini-cd.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char *mini_cd_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 8 1", +" c None", +"# c black", +"* c #808080", +"X c #FFFF00", +"o c #c0c0c0", +"+ c #00FFFF", +"@ c #00FF00", +". c white", +/* pixels */ +" ***** ", +" **XXooo## ", +" *+XXXooooo# ", +" *@++XXoooo.o# ", +" *@@+XXooo.oo# ", +"*oo@@+Xoo.oooo# ", +"*ooo@+*#*ooooo# ", +"*oooo@# #ooooo# ", +"*oooo.*#*+oooo# ", +"*ooo.oo.@X+ooo# ", +" *o.oooo@X++o# ", +" *.ooooo@XX++# ", +" *ooooo@@XX# ", +" **ooo@@## ", +" **### ", +" " +}; diff --git a/icons/mini-clock.xpm b/icons/mini-clock.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1jbG9jay54cG0= --- /dev/null +++ b/icons/mini-clock.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_clock_xpm[] = { +/* width height num_colors chars_per_pixel */ +"13 13 4 1", +/* colors */ +" c None s None", +"# c Black", +". c White", +"* c gray85", +/* pixels */ +" ##### ", +" ##.....## ", +" #*...#...*# ", +" #....#....# ", +"#.....#.....#", +"#.....#.....#", +"#....##.....#", +"#.....##....#", +"#.....#.#...#", +" #.........# ", +" #*.......*# ", +" ##.....## ", +" ##### " +}; diff --git a/icons/mini-colors.xpm b/icons/mini-colors.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1jb2xvcnMueHBt --- /dev/null +++ b/icons/mini-colors.xpm @@ -0,0 +1,29 @@ +/* XPM */ +static char *mini_colors_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 7 1", +" c None", +"# c black", +"* c gray50", +"X c red", +"o c yellow", +"O c blue", +". c white", +/* pixels */ +" ", +" ", +" ************** ", +" *XXXXooooOOOO*#", +" *XXXXooooOOOO*#", +" *XXXXooooOOOO*#", +" *XXXXooooOOOO*#", +" *....****####*#", +" *....****####*#", +" *....****####*#", +" *....****####*#", +" **************#", +" ##############", +" ", +" ", +" " +}; diff --git a/icons/mini-cross.xpm b/icons/mini-cross.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1jcm9zcy54cG0= --- /dev/null +++ b/icons/mini-cross.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_cross_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 4 1", +" c None", +"# c black", +"r c red", +"X c gray50", +/* pixels */ +" ", +" r ", +" rrX rrr ", +" rrX rrrrr ", +" rrrrrrr## ", +" rrrrr# ", +" rrrr# ", +" rrrrrr ", +" rr# rrr ", +" rr# rrr ", +" r# rrX ", +" r# r# ", +" # # ", +" ", +" ", +" " +}; diff --git a/icons/mini-daemon.xpm b/icons/mini-daemon.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kYWVtb24ueHBt --- /dev/null +++ b/icons/mini-daemon.xpm @@ -0,0 +1,37 @@ +/* XPM */ +static char *mini_daemon_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 15 1", +" c None", +". c #2f141e", +"X c #293041", +"o c #384f6f", +"O c #551c26", +"+ c #503948", +"@ c #63555b", +"# c #728fa3", +"$ c #831e28", +"% c #8e5961", +"& c #907b81", +"* c #a1979c", +"- c #d0a6a6", +"; c #607060", +": c #c9c700", +/* pixels */ +" -; ", +" * ***+ ", +" O%@.$%%- ", +" &.OO-:;; ", +" %.O-*X% ", +" ;.O%%O$:: ", +" @.OOO**::", +" OO+*@*::", +" ;.O$..: ", +" ;.O$O- ", +" ;...% ", +" &...- ", +" *@.OO* ", +" *@+@@X.o###; ", +" #+***+.XXo##: ", +" *++@- " +}; diff --git a/icons/mini-diskete.xpm b/icons/mini-diskete.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kaXNrZXRlLnhwbQ== --- /dev/null +++ b/icons/mini-diskete.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_diskete_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 6 1", +" c None", +"# c black", +"* c #00007b", +"o c #0000ff", +"O c #bdbdbd", +". c white", +/* pixels */ +" ", +" ############## ", +" #o#OOOOOOO#oo# ", +" #o#.......#oo# ", +" #o#.......#oo# ", +" #o#.......#oo# ", +" #o#.......#oo# ", +" #oo#######ooo# ", +" #oooooooooooo# ", +" #ooo******ooo# ", +" #oo*OOOOOO*oo# ", +" #oo*OooOOO*oo# ", +" #oo*OooOOO*oo# ", +" #oo*OooOOO*oo# ", +" O############# ", +" " +}; diff --git a/icons/mini-diskete2.xpm b/icons/mini-diskete2.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kaXNrZXRlMi54cG0= --- /dev/null +++ b/icons/mini-diskete2.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_diskete2_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 6 1", +"# c black", +"* c #0000ff", +"o c #7b7b7b", +"O c #bdbdbd", +"c c #ff0000", +". c white", +/* pixels */ +"**#*#OOOOOO**#OO", +"*O#*#OOO**O*O*#o", +"*O#*#OOO**O*O*#o", +"**#*#OOO**O***#o", +"**###OOOOOO***#o", +"**************#o", +"**##########**#o", +"*#..........#*#o", +"*#..........#*#o", +"*#cccccccccc#*#o", +"*#..........#*#o", +"*#..........#*#o", +"*#cccccccccc#O#o", +"*#cccccccccc#*#o", +"###############o", +"Oooooooooooooooo" +}; diff --git a/icons/mini-diskette.xpm b/icons/mini-diskette.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kaXNrZXR0ZS54cG0= --- /dev/null +++ b/icons/mini-diskette.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char *mini_diskette_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 7 1", +/* colors */ +" c None", +"* c #000080", +"# c black", +"o c yellow", +"O c #e0e0e0", +"@ c #C0C0C0", +". c white", +/* pixels */ +"**###########** ", +"**ooooooooooo**#", +"**OOOOOOOOOOO**#", +"**...........**#", +"**OOOOOOOOOOO**#", +"**...........**#", +"**OOOOOOOOOOO**#", +"**...........**#", +"***************#", +"****@@@@@@@****#", +"****@**@@@@****#", +"****@**@@@@****#", +"****@**@@@@****#", +"****@**@@@@****#", +" ***@@@@@@@****#", +" ##############" +}; diff --git a/icons/mini-display.xpm b/icons/mini-display.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kaXNwbGF5LnhwbQ== --- /dev/null +++ b/icons/mini-display.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_display_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 6 1", +" c None", +". c gray50", +"X c white", +"o c black", +"O c blue", +"+ c gray85", +/* pixels */ +" ", +" ............ ", +" .XXXXXXXXXXXXo ", +" .Xooooooooo.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOXOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .XoOOOOOOOO.Xo ", +" .Xo.........Xo ", +" .XXXXXXXXXXXXo ", +" oooooooooooo ", +" .XXXX+.o ", +" oooooooooooo ", +" " +}; diff --git a/icons/mini-doc1.xpm b/icons/mini-doc1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1kb2MxLnhwbQ== --- /dev/null +++ b/icons/mini-doc1.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_doc_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 4 1", +" c None", +"# c black", +". c white", +"o c #808080", +/* pixels */ +" ", +" ####### ", +" #.....## ", +" #.ooo.#.# ", +" #.....#### ", +" #.oooo.oo#o ", +" #........#o ", +" #.oooooo.#o ", +" #........#o ", +" #.oooooo.#o ", +" #........#o ", +" #.oooooo.#o ", +" #........#o ", +" ##########o ", +" oooooooooo ", +" " +}; diff --git a/icons/mini-ethereal.xpm b/icons/mini-ethereal.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1ldGhlcmVhbC54cG0= --- /dev/null +++ b/icons/mini-ethereal.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_ethereal_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #221c17", +"X c #2c252d", +"o c #59534f", +"O c #635a5d", +"+ c #717370", +"@ c #7e827e", +"# c #83857e", +"$ c #909189", +"% c #a29e97", +"& c #aea99a", +"* c #b8b1a8", +"= c #c4bcb4", +"- c #cdc4bd", +"; c #d8d2d1", +": c #e7e1de", +/* pixels */ +" @@@@@+ ", +" $%$%%%$++@ ", +" @%*;:=*-*@O@ ", +" @%-:@XXX.%*%O@ ", +" $*:oo;;;**=&@O ", +"@$;+o::;*o$**%O@", +"@$;X*:*o.o&**%++", +"+%=X;o.O&**&&%@O", +"#$*.-+*==**&&%@+", +"@#=.&====*&&&#@+", +"++&OX==***&%%#o@", +" +#&oX$*&#%%$#O ", +" ++$&O....+$#o@ ", +" +O@%$##$$$+@ ", +" +OO+@@++O@ ", +" +++O++ " +}; diff --git a/icons/mini-font.xpm b/icons/mini-font.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1mb250LnhwbQ== --- /dev/null +++ b/icons/mini-font.xpm @@ -0,0 +1,21 @@ +/* XPM */ +static char * mini_font_xpm[] = { +/* width height num_colors chars_per_pixel */ +"10 11 3 1", +/* colors */ +" c None s None", +"# c black", +"X c #808080", +/* pixels */ +" ## ", +" ###X", +" ####X", +" ##X##X", +" ##XX##X", +" ##XX ##X", +" #######X", +" ##XXXX##X", +"##XX ##X", +"##X ##X", +" XX XX", +}; diff --git a/icons/mini-freedesk.xpm b/icons/mini-freedesk.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1mcmVlZGVzay54cG0= --- /dev/null +++ b/icons/mini-freedesk.xpm @@ -0,0 +1,34 @@ +/* XPM */ +static char *mini_freedesk_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 12 1", +" c #3b80ae", +". c #508db6", +"X c #6199be", +"o c #6a9ec1", +"O c #74a5c5", +"+ c gray73", +"@ c #93b9d2", +"# c #a7c6db", +"$ c #bad3e2", +"% c #d5e4ee", +"& c #fcfdfe", +"* c None", +/* pixels */ +"++++++++++++++++", +"+ +", +"+ +", +"+ . .XO+", +"+.o#%X .#&&&+", +"+&&&&# ....%&&&+", +"+&&&&%oOoX.@&&&+", +"+&&&&&X X#o.+", +"+&&%$O. O. +", +"+OX. oX o. +", +"+ OX .o +", +"+ .@%X +", +"+ @&&O +", +"+ X$O. +", +"+ . +", +"++++++++++++++++" +}; diff --git a/icons/mini-ftp.xpm b/icons/mini-ftp.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1mdHAueHBt --- /dev/null +++ b/icons/mini-ftp.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_ftp_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 5 1", +/* colors */ +" c None", +"# c black", +"* c #0000ff", +"o c #7b7b7b", +"Q c #ffffff", +/* pixels */ +" ", +"oooooooooooooooo", +"################", +"################", +"QQQQQQQQQQQQQQQQ", +"Q****Q****Q****Q", +"Q****Q****Q****Q", +"Q**QQQQ**QQ*QQ*Q", +"Q**QQ Q**QQ*QQ*Q", +"Q***Q Q**QQ****Q", +"Q***Q Q**QQ****Q", +"Q**QQ Q**QQ**QQQ", +"Q**Q Q**QQ**Q ", +"Q**Q Q**QQ**Q ", +"QQQQ QQQQQQQQ ", +" ", +}; diff --git a/icons/mini-gnus.xpm b/icons/mini-gnus.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1nbnVzLnhwbQ== --- /dev/null +++ b/icons/mini-gnus.xpm @@ -0,0 +1,21 @@ +/* XPM */ +static char *mini_gnus_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 12 2 1", +/* colors */ +" c None", +"* c cyan", +/* pixels */ +" ** ** ", +" ******** ", +"* * ** *** ", +"*** * *** *", +"** * ****", +" * ** ", +" * ", +" * * ** ", +" ** * ", +" **** * ", +" ** * ", +" * " +}; diff --git a/icons/mini-graph.xpm b/icons/mini-graph.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1ncmFwaC54cG0= --- /dev/null +++ b/icons/mini-graph.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char *mini_graph_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 7 1", +" c None", +"# c black", +"m c magenta", +"b c blue", +"g c green", +"r c red", +"@ c #808080", +/* pixels */ +" ### ", +" mm# ", +" mm# ", +" ### mm# ", +" bb# mm# ", +" bb# mm# ", +" bb# mm# ", +" ### bb# mm# ", +" gg# bb# mm# ", +" gg# bb# mm# ###", +" gg# bb# mm# rr#", +" gg# bb# mm# rr#", +" gg# bb# mm# rr#", +"################", +" @@@@@@@@@@@@@@@", +" " +}; + + \ No newline at end of file diff --git a/icons/mini-gv.xpm b/icons/mini-gv.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1ndi54cG0= --- /dev/null +++ b/icons/mini-gv.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *mini_gv_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 3 1", +" c None", +"# c black", +". c white", +/* pixels */ +" ", +" #### ", +" #....# ", +" #......# ", +" #......# ", +" ##.#..#.### ", +" #...#..#.#..# ", +" #...........# ", +" #.........# ", +" #.......# ", +" #.......# ", +" #.......# ", +" #.........# ", +" #...#...#...# ", +" #### ### ## ", +" " +}; diff --git a/icons/mini-info.xpm b/icons/mini-info.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1pbmZvLnhwbQ== --- /dev/null +++ b/icons/mini-info.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_info_xpm[] = { +/* width height num_colors chars_per_pixel */ +"12 14 3 1", +/* colors */ +" c None", +". c #cccc00", +"# c #dddd00", +/* pixels */ +" .#. ", +" ### ", +" .#. ", +" ", +" ... ", +".###. ", +"..##. ", +" .##. ", +".### ", +".##. .# .# ", +".##. ######", +"###.. #. #.", +"####. ####. ", +".#.. .# ##." +}; diff --git a/icons/mini-keyboard.xpm b/icons/mini-keyboard.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1rZXlib2FyZC54cG0= --- /dev/null +++ b/icons/mini-keyboard.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char *mini_keyboard_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 5 1", +" c None", +"# c black", +". c white", +"r c #808080", +"O c #C0C0C0", +/* pixels */ +" rrrrrrrrrrrrrr ", +"r.............r#", +"r.rrrrrrrrrrrrr#", +"r.r.O#.O#.O#.Or#", +"r.rOr#Or#Or#Orr#", +"r.O###########r#", +"r.O#.O#.O#...Or#", +"r.O#Or#OO#OOOrr#", +"r.O###########r#", +"r.r.O#....O#.Or#", +"r.rOr#OOOOr#Orr#", +"r.r###########r#", +"rrrrrrrrrrrrrrr#", +" ############## ", +" ", +" " +}; diff --git a/icons/mini-lower.xpm b/icons/mini-lower.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1sb3dlci54cG0= --- /dev/null +++ b/icons/mini-lower.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_lower_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c red", +/* pixels */ +" ", +" . . . ", +" . ", +" . .. ", +" . . ", +" .. .. ", +" . ... ", +" ... . ", +" ..... ", +" ..... ", +" ......... ", +" ....... ", +" ..... ", +" ... ", +" . ", +" " +}; diff --git a/icons/mini-measure.xpm b/icons/mini-measure.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1tZWFzdXJlLnhwbQ== --- /dev/null +++ b/icons/mini-measure.xpm @@ -0,0 +1,32 @@ +/* XPM */ +static char *mini_measure_xpm[] = { +/* width height num_colors chars_per_pixel */ +"15 16 9 1", +/* colors */ +" c None", +"# c black", +"* c #800000", +"a c #008000", +"b c #c0c0c0", +"c c #808080", +"d c #ff0000", +"e c #00ff00", +". c white", +/* pixels */ +" cccccccccccc#", +" cbbbbbbbbbbbc#", +"c...........cc#", +"c.bbbbbbbbbbcc#", +"c.baaaaaaabbcc#", +"c.baeeeee.bbcc#", +"c.b.......bbcc#", +"c.bbbbbbbbbbcc#", +"c.baaaaaaabbcc#", +"c.baeeeee.bbcc#", +"c.b.......bbcc#", +"c.bbbbbbbbbbcc#", +"c.b*******.bcc#", +"c.b*dddddd.bcc#", +"c.b........bc# ", +"############# " +}; diff --git a/icons/mini-mozilla.xpm b/icons/mini-mozilla.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1tb3ppbGxhLnhwbQ== --- /dev/null +++ b/icons/mini-mozilla.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char *mini_mozilla_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 14 1", +" c None", +"M c #020205", +". c #240e00", +"X c #272727", +"o c #490000", +"O c #710000", +"+ c #663333", +"@ c #676767", +"# c #8b0000", +"$ c #991919", +"% c #ad0000", +"& c #d40000", +"* c #d6280a", +"= c #f90000", +/* pixels */ +" ", +" XoX ", +" Xo&%=ooo ", +" Mo%oO*OoXM ", +" MMo=%*%O&@X% ", +"M M%==#o*%&&%O ", +" Mo*=#===O%&==%X", +"M #==O===.M@==&+", +" X.%=o#==Ooo@+$O", +"M M#=&=##=&#O@M@", +" MM%===*X.@@$. ", +"M o#==&.@ ", +" @o==#$X ", +" X%=&o+ ", +" #OM@ ", +" " +}; diff --git a/icons/mini-mozilla1.xpm b/icons/mini-mozilla1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1tb3ppbGxhMS54cG0= --- /dev/null +++ b/icons/mini-mozilla1.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_mozilla1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 6 1", +" c None", +"# c black", +". c gray50", +"X c #fe2a04", +"o c gray74", +"O c white", +/* pixels */ +"##### ", +"X#O### ", +"X###O## ", +"XX###X### ", +"X#XXXXXX### ", +"XX##XXXXXX### ", +"#XXXXXXXXXXX### ", +"##XXXXXXXXXXXX##", +"####XXXXXXXXXX##", +"#####XXXXXXXX###", +"#######XXXXXX#X#", +"####O###XXXXXXX#", +"####.#O#####XXX#", +"#XX###.#O#.#####", +"XXXXX#####O#O#O#", +"X###XXXXX###### " +}; diff --git a/icons/mini-mozilla2.xpm b/icons/mini-mozilla2.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1tb3ppbGxhMi54cG0= --- /dev/null +++ b/icons/mini-mozilla2.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_mozilla2_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c DarkRed", +/* pixels */ +" ", +" ", +" .. .. ", +" ... ... ", +" .... .... ", +" .. .. .. .. ", +" .. .. .. .. ", +" .. ... .. ", +" .. . .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" .. .. ", +" ", +" ", +" " +}; diff --git a/icons/mini-mozilla3.xpm b/icons/mini-mozilla3.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1tb3ppbGxhMy54cG0= --- /dev/null +++ b/icons/mini-mozilla3.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_mozilla3_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c DarkRed", +/* pixels */ +" .. ", +" .. ", +" .. ", +" .. ", +" .. ", +"....... .......", +"....... .......", +" . . ", +" ...... ", +" ... ... ", +" ... ... ", +" ... ... ", +" ... ... ", +"... ...", +" ", +" " +}; diff --git a/icons/mini-netscape.xpm b/icons/mini-netscape.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1uZXRzY2FwZS54cG0= --- /dev/null +++ b/icons/mini-netscape.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char *mini_netscape_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 5 1", +" c None", +"# c black", +"* c gray50", +"O c blue", +". c white", +/* pixels */ +" ", +" ", +" *** ****# ", +" *..* *...# ", +" *..* *.# ", +" *...* *.# ", +" *.#..* *.# ", +" *.#*..* *.# ", +" *.# *..**.# ", +" *.# *..*.# ", +" *.# *...# ", +" *.#OOOO#..# ", +" O#.#########O ", +" O#...#########O", +" ###############", +" " +}; diff --git a/icons/mini-netscape1.xpm b/icons/mini-netscape1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1uZXRzY2FwZTEueHBt --- /dev/null +++ b/icons/mini-netscape1.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_netscape1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +"M c #171616", +". c #173834", +"X c #4a4e41", +"o c #646b65", +"O c #047d84", +"+ c #198188", +"@ c #4c9699", +"# c #6daeb1", +"% c #8e816f", +"& c #85b4b2", +"* c #aeafae", +"= c #add0d3", +"- c #cbcece", +"; c #d7e8e7", +": c #f9fafa", +/* pixels */ +" .....M ", +" Mo=;;;=&oM ", +" .*=#@OOO#=XM ", +" M=@@@OOOOOO#*M ", +" o=#::+OO&:;@*o ", +"M##O#:;+OO=@.#*M", +".;@O@;:=OO=@Xo-M", +".;OO@=#:-O&@XX;M", +".;OO@=O&:&&@XX;M", +".-OO@=OO&::oXX;M", +"M*--;:::-::-%**M", +" *:-::*MMMMMX-% ", +" MX%XMMMMMM.-XM ", +" .**%XMMX%*XM ", +" M%-;-;-*oM ", +" MM.MMM " +}; diff --git a/icons/mini-netscape2.xpm b/icons/mini-netscape2.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1uZXRzY2FwZTIueHBt --- /dev/null +++ b/icons/mini-netscape2.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_netscape2_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c blue", +/* pixels */ +" ", +" .. ... ", +" ... ... ", +" .... ... ", +" ..... ... ", +" ...... ... ", +" ... ... ... ", +" ... ... ... ", +" ... ... ... ", +" ... ... ... ", +" ... ...... ", +" ... ..... ", +" ... .... ", +" ... ... ", +" ... .. ", +" " +}; diff --git a/icons/mini-pager.xpm b/icons/mini-pager.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1wYWdlci54cG0= --- /dev/null +++ b/icons/mini-pager.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *mini_pager_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +"# c black", +/* pixels */ +" ", +" # # ", +" # # ", +" # # ", +" # # ", +" # # ", +"################", +" # # ", +" # # ", +" # # ", +"################", +" # # ", +" # # ", +" # # ", +" # # ", +" # # ", +" " +}; diff --git a/icons/mini-penguin.xpm b/icons/mini-penguin.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1wZW5ndWluLnhwbQ== --- /dev/null +++ b/icons/mini-penguin.xpm @@ -0,0 +1,31 @@ +/* XPM */ +static char * mini_penguin_xpm[] = { +/* width height num_colors chars_per_pixel */ +"18 18 7 1", +" c None", +"# c black", +"* c #808080", +"o c #c0c0c0", +"O c #101010", +"r c #e0a008", +". c white", +/* pixels */ +" *##* ", +" *####* ", +" #o#o## ", +" #O##.# ", +" #rrro# ", +" #rrro#* ", +" #rr..## ", +" #*.....#* ", +" *#......*#* ", +" #...o....## ", +" #..oo....##* ", +" #o..o.....### ", +" ro..o.....### ", +" rrr.......r##r ", +" rrrrr.....orrrrr ", +" rrrrr.....#rrrrr ", +" rrrrr..###rrrr ", +" rrr*#####*rr " +}; diff --git a/icons/mini-raise.xpm b/icons/mini-raise.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1yYWlzZS54cG0= --- /dev/null +++ b/icons/mini-raise.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_raise_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c red", +/* pixels */ +" ", +" . ", +" ... ", +" ..... ", +" ....... ", +" ......... ", +" ..... ", +" ..... ", +" ... . ", +" . ... ", +" .. .. ", +" . . ", +" . .. ", +" . ", +" . . . ", +" " +}; diff --git a/icons/mini-ray.xpm b/icons/mini-ray.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1yYXkueHBt --- /dev/null +++ b/icons/mini-ray.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_ray_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 4 1", +" c None", +". c black", +"X c yellow", +"o c gray50", +/* pixels */ +" ", +" ......... ", +" .XXXXXX.o ", +" .XXXXXX.o ", +" .XXXXX.o ", +" .XXXXX.o ", +" .XXXX..... ", +" .XXXXXXXX.o ", +" .....XXX.o ", +" oo.XXX.o ", +" .XX.o ", +" .XX.o ", +" .X.o ", +" .X.o ", +" ..o ", +" " +}; diff --git a/icons/mini-redhat.xpm b/icons/mini-redhat.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1yZWRoYXQueHBt --- /dev/null +++ b/icons/mini-redhat.xpm @@ -0,0 +1,46 @@ +/* XPM */ +static char *mini_redhat_xpm[] = { +/* width height num_colors chars_per_pixel */ +"24 24 15 1", +/* colors */ +" c None", +"# c white", +"a c #c60021", +"b c #4a0008", +"c c #840018", +"e c #adadad", +"f c #636363", +"g c #424242", +"h c #101010", +"i c #848484", +"j c #180000", +"k c #ad0021", +"l c #525252", +"m c #84525a", +"n c #b52139", +/* pixels */ +" ", +" elhhhggf ", +" ei########ge ", +" eh##jb##jb###l ", +" f###aaaaaa#ja##ge ", +" i####ccaaaacaa###h ", +" h#####b caaaa####g ", +" ##jbbjaaaaaaaaak####g", +" h#baaabbcaaaaaaaa####h", +" h#caaab caaaaaa#####", +" i##caaaacj kaaaccakj#", +" i###aaaaaabjbaaaaaaab#", +" i###baaaaaaaaaaaaaaab#", +" i###f caaaaaaaaaaac##", +" e###i imcaaaaaaaaa###", +" fif#e gbccaaaacb###", +" ee h#### ", +" e ##### ", +" ge #### ", +" he ", +" lg ", +" i ", +" ", +" " +}; diff --git a/icons/mini-sh1.xpm b/icons/mini-sh1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1zaDEueHBt --- /dev/null +++ b/icons/mini-sh1.xpm @@ -0,0 +1,27 @@ +/* XPM */ +static char *mini_sh1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 5 1", +" c None", +"# c black", +"X c blue", +"o c gray50", +". c white", +/* pixels */ +" ", +" ", +"############### ", +"#XXXXXXXXXXXXX#o", +"#XXXXXXXXXXXXX#o", +"#.............#o", +"#.#...........#o", +"#..#..........#o", +"#.#...........#o", +"#.............#o", +"#.............#o", +"#.............#o", +"#.............#o", +"###############o", +" ooooooooooooooo", +" " +}; diff --git a/icons/mini-stroke.xpm b/icons/mini-stroke.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS1zdHJva2UueHBt --- /dev/null +++ b/icons/mini-stroke.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_stroke_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 3 1", +/* colors */ +" c None", +". c #000000", +"a c #ff0000", +/* pixels */ +" aa ", +"aaaaaaaaaaaaaaa ", +" ......a........", +" a. ", +" a aaaaaaa a ", +" a. a..a..a. a. ", +" a. a. a. a. a. ", +" a. aaaaaaa. a. ", +" a. a..a..a. a. ", +" a. a. a. a. a. ", +" a. aaaaaaa. a. ", +" a. a.....a. a. ", +" a. a. ", +" aaaaaaaaaaaaa. ", +" a...........a. ", +" a. a. " +}; diff --git a/icons/mini-term.xpm b/icons/mini-term.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS10ZXJtLnhwbQ== --- /dev/null +++ b/icons/mini-term.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char *mini_term_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 6 1", +" c None", +"# c black", +"* c gray50", +"a c blue", +"c c gray85", +". c white", +/* pixels */ +" ", +" ********* ", +" *cccccccc*# ", +" *........**# ", +" *.######.**# ", +" *.#aaaaa.**# ", +" *.#aaaaa.**# ", +" *.#aaaaa.**# ", +" *........*#**", +" *#########*c#", +" *.........*c*#", +" **#*#*#*#*#**#", +" *c#c#c#c#c#c## ", +"*...........c# ", +"############# ", +" " +}; diff --git a/icons/mini-tex.xpm b/icons/mini-tex.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS10ZXgueHBt --- /dev/null +++ b/icons/mini-tex.xpm @@ -0,0 +1,21 @@ +/* XPM */ +static char *tex.xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 12 3 1", +" c None", +". c white", +"# c black", +/* pixels */ +"................", +"#######..##...##", +"#..#..#...#...#.", +"...#.......#.#..", +"...#..####..#...", +"...#..#....#.#..", +"...#..#...#...#.", +"..###.##.##...##", +"......#.........", +"......#.........", +"......####......", +"................", +}; diff --git a/icons/mini-turn.xpm b/icons/mini-turn.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS10dXJuLnhwbQ== --- /dev/null +++ b/icons/mini-turn.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *mini_turn_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 3 1", +" c None", +"# c black", +"* c gray50", +/* pixels */ +" ", +" **###* ", +" *####### ", +" *##* *# ", +" ##* ", +" ### # ", +"####### ### ", +" ##### ##### ", +" ### #######", +" # ### ", +" *## ", +" #* *##* ", +" #######* ", +" *###** ", +" ", +" " +}; diff --git a/icons/mini-x.xpm b/icons/mini-x.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14LnhwbQ== --- /dev/null +++ b/icons/mini-x.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_x_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c red", +/* pixels */ +" ", +" ", +" ", +" .... . ", +" .... . ", +" .... . ", +" .... . ", +" ... . ", +" . .. ", +" . .... ", +" . .... ", +" . .... ", +" . .... ", +" . .... ", +" ", +" " +}; diff --git a/icons/mini-x2.xpm b/icons/mini-x2.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14Mi54cG0= --- /dev/null +++ b/icons/mini-x2.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *mini_x2_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c red", +/* pixels */ +" ", +" ", +" ", +" ..... . ", +" ..... . ", +" ..... . ", +" ..... . ", +" ... . ", +" . ... ", +" . ..... ", +" . ..... ", +" . ..... ", +" . ..... ", +" ", +" ", +" ", +" " +}; diff --git a/icons/mini-xchat.xpm b/icons/mini-xchat.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14Y2hhdC54cG0= --- /dev/null +++ b/icons/mini-xchat.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_xchat1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #2f2116", +"X c #5c2a11", +"o c #795803", +"O c #676664", +"+ c #932f02", +"@ c #947202", +"# c #976745", +"$ c #e33b00", +"% c #eb5707", +"& c #ab8d77", +"* c #c79839", +"= c #f0a104", +"- c #fdd600", +"; c #a6a19d", +": c #decec3", +/* pixels */ +" ... ... ", +" ..o.. ..o.. ", +"..*-@.. ..@-@..", +".@---@....@---@.", +"..=---@..@-=-=..", +" ..=-=-+o-===.. ", +" ..@======%.. ", +" ...:==%=*...O ", +"O:;OO:&:*:;;OO: ", +"O;..&:%:&:%#:O: ", +" ;;&*&%&*:;%&O; ", +" ..%%%+..+$$$.. ", +"..%%%+....+$$$..", +"..$$+.. ..+$$..", +" ..X.. ..X.. ", +" ... ... " +}; diff --git a/icons/mini-xchat1.xpm b/icons/mini-xchat1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14Y2hhdDEueHBt --- /dev/null +++ b/icons/mini-xchat1.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_xchat_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +". c DarkGreen", +/* pixels */ +" ... . ", +" ... . ", +" ... . ", +" ... . ", +" . . ", +" . ... ", +" . ... ", +" . ... ", +" . ... ", +" ", +" ... . . . ... ", +" . . . . . . ", +" . ... ... . ", +" . . . . . . ", +" ... . . . . . ", +" " +}; diff --git a/icons/mini-xdvi.xpm b/icons/mini-xdvi.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZHZpLnhwbQ== --- /dev/null +++ b/icons/mini-xdvi.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_xdvi_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +"M c #030303", +". c #382205", +"o c #7e4c00", +"O c #7a5920", +"+ c #5b6477", +"@ c #6c6c6e", +"# c #906823", +"$ c #987c51", +"% c #ad8948", +"& c #e0a536", +"* c #cea55c", +"= c #f7bb44", +"- c #fecf47", +"; c #d0c5ba", +": c #f2efed", +/* pixels */ +"@M.M@ +M@", +" @.MM+-- & ;M@ ", +" @M.MO#&-O&MO; ", +" @MM;:&#&-&-##", +" +M;M::*=O=# ", +" *%&*-o:M*&=O=O", +" *-$---=*#*=&&O=", +" -$-%====-==O==O", +" &.#&%===#=O=O=$", +" -#%====#==&O=O=", +" -%###%=====O=O", +" -----==O.--O=", +" @M+ *+MMM-O$", +" @M@ @MMM+ ", +"@M@ @M.M@", +"M@ +MM." +}; diff --git a/icons/mini-xemacs.xpm b/icons/mini-xemacs.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3MueHBt --- /dev/null +++ b/icons/mini-xemacs.xpm @@ -0,0 +1,36 @@ +/* XPM */ +static char *mini_xemacs_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 14 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +": c #f2f2f2", +/* pixels */ +":::::::::::::::&", +":-:&--&--&&-&-&&", +":--&::::::::::&&", +"-::&:::----:::&&", +":@+XOO-+++o-::&&", +":-OO+X=+O%$##=&&", +":-@++%=+++.##$&&", +":-OO+X-+O%&=::&&", +":@+%OO-+++o&&:&&", +":&%&&%%&%&%&--&&", +":----:::---:::&&", +"::---@O---::::&&", +"--:--:-::---::&&", +":-:--::::::--:&&", +":---&&&&&&&&&&&&", +"&&&&&&&&&&&&&&&%" +}; diff --git a/icons/mini-xemacs1.xpm b/icons/mini-xemacs1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3MxLnhwbQ== --- /dev/null +++ b/icons/mini-xemacs1.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_xemacs_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" s None c None", +". c #ff2200", +/* pixels */ +" ", +"... . ", +" ... . ....", +" ... . . ", +" .. . . ", +" . .. .... ", +" . ... . ", +" . ... . ", +". ... ....", +" ", +". . . .. ...", +".. .. . . . . ", +". . . ... . ...", +". . . . . .", +". . . . .. ...", +" " +}; diff --git a/icons/mini-xemacsC.xpm b/icons/mini-xemacsC.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3NDLnhwbQ== --- /dev/null +++ b/icons/mini-xemacsC.xpm @@ -0,0 +1,39 @@ +/* XPM */ +static char *mini_xemacsC_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 17 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +"; c #f3d7d7", +": c #f2f2f2", +"c c #555555", +"C c black", +/* pixels */ +":::::::::::::::&", +":-:&--&--&&-&-:&", +":--&:::::::::::&", +"-::&::;----::::&", +":@+XOO-+++o-:::&", +":-OO+X=+O%$##=:&", +":-@++%=+++.##$:&", +":-OO+X-+O%&=;::&", +":@+%OO-+CCCC&::&", +":&%&&%%Cc&%&C-:&", +";----::Cc--::::&", +"::---;;Cc-:::::&", +"--:--:;Cc;--C::&", +":-:--:::CCCC-::&", +":-------------:&", +"&&&&&&&&&&&&&&&%" +}; \ No newline at end of file diff --git a/icons/mini-xemacsgnus.xpm b/icons/mini-xemacsgnus.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3NnbnVzLnhwbQ== --- /dev/null +++ b/icons/mini-xemacsgnus.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_xemacsgnus_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +"; c #f3d7d7", +": c #f2f2f2", +"* c blue", +/* pixels */ +":::::::::::::::&", +":-:&--&--&&-&-:&", +":--&:::::::::::&", +"-::&::;----::::&", +":@+XOO-+++o-:::&", +":-OO+X=+O%$##=:&", +":-@++%=+++.##$:&", +":-OO+X=*%%*;;::&", +":@+%OO******:::&", +":&%*&**&*&%**-*&", +";--**::*---:***&", +"::---@*;-**::*:&", +"--:--*-**;*-:::&", +":-:--***::*--::&", +":---------*---:&", +"&&&&&&&&&&&&&&&%" +}; \ No newline at end of file diff --git a/icons/mini-xemacsinfo.xpm b/icons/mini-xemacsinfo.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3NpbmZvLnhwbQ== --- /dev/null +++ b/icons/mini-xemacsinfo.xpm @@ -0,0 +1,40 @@ +/* XPM */ +static char *mini_xemacsinfo_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +": c #f2f2f2", +"i c #000055", +"I c blue", +/* pixels */ +":::::::::::::::&", +":-:&--&--&&-&-:&", +":--&:::::::::::&", +"-::&:::-iI-::::&", +":@+XOO-+iIo-:::&", +":-OO+X=+iI$##=:&", +":-@++%=+++.##$:&", +":-OO+X-iII&=:::&", +":@+%OO-iIIo&&::&", +":&%&&%iII&%&--:&", +":----:iII--::::&", +"::---@iII-:::::&", +"--:--iII:iI-I::&", +":-:--iIII:iIiI:&", +":-----iI-iI-I-:&", +"&&&&&&&&&&&&&&&%" +}; + + \ No newline at end of file diff --git a/icons/mini-xemacspy.xpm b/icons/mini-xemacspy.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3NweS54cG0= --- /dev/null +++ b/icons/mini-xemacspy.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_xemacspy_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +": c #f2f2f2", +"p c #003300", +"P c #00cc00", +/* pixels */ +"::p::::::::::::&", +":-:pP-&--&&-&-:&", +":--&pP:::::::::&", +"-::&pPp----::::&", +":@+XOpPp++o-:::&", +":-OO+XpPPPp##=:&", +":-@++%=pppPp#$:&", +":-OO+X-+O%pPp::&", +":@+%OO-++pPp&::&", +":&%&&%%&pPp&--:&", +":----::pPp-::::&", +"::---:pPp-:::::&", +"--:--:pPpp:-:::&", +":-:--::pPppp-::&", +":-------pp:pp++&", +"&&&&&&&&&&pp&&&%" +}; \ No newline at end of file diff --git a/icons/mini-xemacstex.xpm b/icons/mini-xemacstex.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZW1hY3N0ZXgueHBt --- /dev/null +++ b/icons/mini-xemacstex.xpm @@ -0,0 +1,38 @@ +/* XPM */ +static char *mini_xemacstex_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 16 1", +" c None", +". c #b76229", +"X c #9a6f6f", +"o c #a65151", +"O c #de1e1e", +"+ c #fd0303", +"@ c #f17272", +"# c #e2e22a", +"$ c #dada69", +"% c #939393", +"& c #acacac", +"= c #dfdf98", +"- c #d3d3d3", +": c #f2f2f2", +"t c #555555", +"T c black", +/* pixels */ +":::::::::::::::&", +":-:&--&--&&-&-:&", +":--&:::::::::::&", +"-::&:::----::::&", +":@+XOO-+++o-:::&", +":-OO+X=+O%$##=:&", +":-@++%=+++.##$:&", +":-OO+X-+O%&=:::&", +":TTTTT-+++Tt&:T&", +":&%Tt%%&%&%TtTt&", +":--Tt:TTTt-:Tt:&", +"::-Tt:Tt--:TtTt&", +"--:Tt:TTTtTt::Tt", +":-:tt:Tt:::--::&", +":-----TTTt----:&", +"&&&&&&&&&&&&&&&%" +}; \ No newline at end of file diff --git a/icons/mini-xfig.xpm b/icons/mini-xfig.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14ZmlnLnhwbQ== --- /dev/null +++ b/icons/mini-xfig.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_xfig_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 4 1", +" c None", +"# c black", +"o c #808080", +". c white", +/* pixels */ +" ## ", +" #.# ", +" #..# ", +" #.o.# ", +" #.o#.# ", +" #.o##.# ", +" #.o# #.# ", +" o## #.o# #.# ", +" #o##.o#####.# ", +" #.#.........# ", +"#o.#############", +"#..o...........#", +"#o.#############", +" #.# ", +" #o# ", +" o## " +}; diff --git a/icons/mini-xkeycaps.xpm b/icons/mini-xkeycaps.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14a2V5Y2Fwcy54cG0= --- /dev/null +++ b/icons/mini-xkeycaps.xpm @@ -0,0 +1,29 @@ +/* XPM */ +static char *mini_xkeycaps_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 6 1", +/* colors */ +" c None", +". c red", +"X c black", +"o c white", +"O c #C0C0C0", +"+ c #808080", +/* pixels */ +" ... . ", +" ... . ", +" ... . ", +" . . ", +" . ... ", +" . ... ", +" . ... ", +" ", +"XXXXXXXXXXXXXXXX", +"XoOXoOXoOXoOXoOX", +"XO+XO+XO+XO+XO+X", +"XXXXXXXXXXXXXXXX", +" XoOXoOXoOXoOX ", +" XO+XO+XO+XO+X ", +" XXXXXXXXXXXXX ", +" " +}; diff --git a/icons/mini-xterm.xpm b/icons/mini-xterm.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14dGVybS54cG0= --- /dev/null +++ b/icons/mini-xterm.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_xterm_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +"# c red", +/* pixels */ +" ", +" ", +" ", +" ", +" ### # ", +" ### # ", +" ### # ", +" ### # ", +" # # ", +" # ### ", +" # ### ", +" # ### ", +" # ### ", +" ", +" ", +" " +}; diff --git a/icons/mini-xterm1.xpm b/icons/mini-xterm1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14dGVybTEueHBt --- /dev/null +++ b/icons/mini-xterm1.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_xterm1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" c None", +"# c black", +/* pixels */ +" ", +" ", +" ", +" ##### # ", +" ##### # ", +" ##### # ", +" ##### # ", +" ### # ", +" # ### ", +" # ##### ", +" # ##### ", +" # ##### ", +" # ##### ", +" ", +" ", +" " +}; diff --git a/icons/mini-xv.xpm b/icons/mini-xv.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14di54cG0= --- /dev/null +++ b/icons/mini-xv.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_xv_xpm[] = { +/* width height num_colors chars_per_pixel */ +"16 16 4 1", +" c None", +"# c black", +"r c red", +". c white", +/* pixels */ +" ", +" ", +" ", +" ", +" ### ", +" rrrrrr# ", +"rrr..rrrrrrr # ", +"rrrrrrrrrrrrr## ", +" rrr##rrrrrrrr# ", +" rr#rrrrrrr## ", +" ## ## ", +" # # ", +" ", +" ", +" ", +" " +}; diff --git a/icons/mini-xv1.xpm b/icons/mini-xv1.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14djEueHBt --- /dev/null +++ b/icons/mini-xv1.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *mini_xv1_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 2 1", +" s None c None", +"# c black", +/* pixels */ +" ", +" ", +" ", +"### # ", +" ### # ", +" ### # #", +" ### # ##", +" # # ## ", +" # ### ## ", +" # ### ## ", +" # ##### ", +"# ### ", +" ", +" ", +" ", +" " +}; diff --git a/icons/mini-xwem.xpm b/icons/mini-xwem.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS14d2VtLnhwbQ== --- /dev/null +++ b/icons/mini-xwem.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *mini_xwem_xpm[] = { +/* width height num_colors chars_per_pixel */ +"34 13 7 1", +/* colors */ +" c None", +". c black", +"W c red", +"E c green", +"M c blue", +"o c yellow", +"c c cyan", +/* pixels */ +"..... W . WEWEWcMM M M", +" ..... W . WEWEWccMMM M M ", +" ..... W . WEWoWccEcMMM M M ", +" ..... W . WEWoWMMEEEcMMM M ", +" ..... . WEWEWMM EEEcM M ", +" ... . WEWEWcc EEEEM ", +" W. ... WEWoWccEE EEM ", +" W. .....EWoWMMEEEE M ", +" W. W .....EWMM EEEE M ", +" W. WWW .....EM EEEEM ", +" W. WWWWWE.....E EEM ", +"W. W WWWWE.....E M ", +".WW WWWWE.....E M "}; diff --git a/icons/mini-zoom.xpm b/icons/mini-zoom.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaS16b29tLnhwbQ== --- /dev/null +++ b/icons/mini-zoom.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *mini_zoom_xpm[] = { +/* columns rows colors chars-per-pixel */ +"16 16 3 1", +" c None", +"# c black", +". c white", +/* pixels */ +" ", +" ", +" #### ", +" # # ", +" # . # ", +" # . # ", +" # # ", +" # # ", +" # ## ", +" ####### ", +" ### ", +" ### ", +" ### ", +" ## ", +" ", +" " +}; diff --git a/icons/mini32x32-help.xpm b/icons/mini32x32-help.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_aWNvbnMvbWluaTMyeDMyLWhlbHAueHBt --- /dev/null +++ b/icons/mini32x32-help.xpm @@ -0,0 +1,46 @@ +/* XPM */ +static char *mini32x32_help_xpm[] = { +/* columns rows colors chars-per-pixel */ +"32 32 8 1", +" c None s None", +". c #800080", +"X c #000000", +"o c #808080", +"O c #808000", +"+ c #FFFF00", +"@ c #C0C0C0", +"# c #FFFFFF", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ..X ", +" .o..XX ", +" .o.....XX ", +" .o........XX ", +" .o....O++O...XX ", +" .o....++++++....XX ", +" .o......O..++O....X ", +" .o.........O++O...X ", +" .o.......O++++O...XX ", +" .o.......O++OO....XoX ", +" .o.........OO.....Xo@X ", +" .XXX.....O+O......Xo@@X ", +" .XooXX...O+O.....Xo@@@XX ", +" .X@@ooXX........Xo@@@o.X ", +" .X@###ooXX.....Xo@@@o.X ", +" .X@#####ooXX..Xo@@@o.X ", +" ...oo#####ooXXo@@@o.X ", +" XX..oo#####oo@@@o.X ", +" XX..oo#####@@o.X ", +" XX..oo###@o.X ", +" XX..oo#o.X ", +" XX..o.X ", +" XX.X ", +" X ", +" ", +" ", +" " +}; diff --git a/lisp/addons/xwem-clswi.el b/lisp/addons/xwem-clswi.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1jbHN3aS5lbA== --- /dev/null +++ b/lisp/addons/xwem-clswi.el @@ -0,0 +1,134 @@ +;;; xwem-clswi.el --- Client switching package. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is NOT part of XEmacs. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; To use this package add something like: +;; +;; (autoload 'xwem-clswi-enable "xwem-clswi" "Enable client switching." t) +;; (add-hook 'xwem-load-hook 'xwem-clswi-enable) +;; +;; to your xwemrc.el. It will install new bindings `H-]' for +;; switching to next client and `H-[' for switching to previous +;; client. + +;;; Code: + +(defgroup xwem-clswi nil + "Group to customize clients switcher." + :prefix "xwem-clswi-" + :group 'xwem) + +(defcustom xwem-clswi-beep-on-error nil + "*Non-nil mean beep on any error." + :type 'boolean + :group 'xwem-clswi) + +(defcustom xwem-clswi-show-info nil + "*Non-nil mean show info about client in xwem minibuffer after switch." + :type 'boolean + :group 'xwem-clswi) + +(defvar xwem-clswi-enabled nil + "Non-nil means that xwem-clswi is enabled. +Do not change this value directly, use `xwem-clswi-enable', +`xwem-clswi-disable' or `xwem-clswi-toggle' instead.") + + +(define-xwem-command xwem-clswi-enable () + "Enables xwem-clswi." + (xwem-interactive) + + (unless xwem-clswi-enabled + (if xwem-started + (progn + (xwem-global-set-key (xwem-kbd "H-]") 'xwem-clswi-next) + (xwem-global-set-key (xwem-kbd "H-[") 'xwem-clswi-prev)) + + (define-key xwem-global-map (xwem-kbd "H-]") 'xwem-clswi-next) + (define-key xwem-global-map (xwem-kbd "H-[") 'xwem-clswi-prev)) + + (setq xwem-clswi-enabled t))) + +(define-xwem-command xwem-clswi-disable () + "Disables xwem-clswi, uninstalls default keybindings." + (xwem-interactive) + + (when xwem-clswi-enabled + (if xwem-started + (progn + (xwem-global-set-key (xwem-kbd "H-]") nil) + (xwem-global-set-key (xwem-kbd "H-[") nil)) + + (define-key xwem-global-map (xwem-kbd "H-]") nil) + (define-key xwem-global-map (xwem-kbd "H-[") nil)) + + (setq xwem-clswi-enabled nil))) + +(define-xwem-command xwem-clswi-toggle () + "Toggle xwem-clswi." + (xwem-interactive) + + (if xwem-clswi-enabled + (xwem-clswi-enable) + (xwem-clswi-disable) + )) + +(define-xwem-command xwem-clswi-next (arg &optional win) + "Switch to ARG next client in WIN. +If WIN is ommited then in selected window." + (xwem-interactive "p") + + (let* ((swin (or win (xwem-win-selected))) + (ccl (xwem-win-cl swin)) ;currently selected client + (cls (xwem-win-make-cl-list swin)) + cclinx num scl) + (if cls + (progn + (setq cclinx (- (length cls) (length (memq ccl cls)))) + (setq num (% (+ cclinx arg) (length cls))) + (setq scl (nth (if (natnump num) num (+ (length cls) num)) cls)) + + (xwem-manda-fun-run (xwem-cl-manda scl) 'manage scl) + + (when xwem-clswi-show-info + (xwem-client-info scl))) + + (xwem-message (if xwem-clswi-beep-on-error 'warn 'warn-nobeep) + "No clients to switch.")))) + +(define-xwem-command xwem-clswi-prev (arg &optional win) + "Switch to ARG previous client in WIN. +If WIN is ommited then in selected window." + (xwem-interactive "p") + + (xwem-clswi-next (- arg) win)) + + +(provide 'xwem-clswi) + +;;; xwem-clswi.el ends here diff --git a/lisp/addons/xwem-edmacro.el b/lisp/addons/xwem-edmacro.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1lZG1hY3JvLmVs --- /dev/null +++ b/lisp/addons/xwem-edmacro.el @@ -0,0 +1,156 @@ +;;; xwem-edmacro.el --- Keyboard macro editor for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 11:19:50 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Macro editing package. Allow you to edit XWEM keyboard macros like +;; `edmacro' allow you to edit Emacs keyboard macros. Uses xwem +;; special frame, so you can edit keyboard macro from any point. + +;; You might change `xwem-edmacro-can-edit-unbinded' to non-nil to +;; allow edition of non-macro keys. + +;;; Code: + + +(eval-and-compile + (require 'edmacro)) + +(defgroup xwem-edmacro nil + "Group to customize `xwem-edmacro' addon." + :prefix "xwem-edmacro-" + :group 'xwem-keyboard) + +(defcustom xwem-edmacro-can-edit-unbinded t + "*Non-nil mean that `xwem-edmacro' allows edit unbinded keys." + :type 'boolean + :group 'xwem-edmacro) + +(defcustom xwem-edmacro-can-edit-nonmacro nil + "*Non-nil allow you to edit keys binded to non-macro commands. +USE WITH CAUTION, if this variable is non-nil you can override any +binding in `xwem-global-map'!" + :type 'boolean + :group 'xwem-edmacro) + +;; Variables +(defvar xwem-edmacro-prefix-arg nil + "Value of prefix argument. +Internal variable, do not modify.") + +(defvar xwem-edmacro-store-place nil + "Place where to store new keyboard macro after editing. +Internal variable, do not use.") + + +;; Functions +(defun xwem-edmacro-store (mac) + "Store new keyboard macro MAC." + (setq mac (key-sequence-list-description mac)) + (cond ((eq xwem-edmacro-store-place 'xwem-keymacro-last-kbd-macro) + (setq xwem-keymacro-last-kbd-macro mac) + (xwem-message 'info "New keymacro stored to `%S'" xwem-edmacro-store-place)) + + (t + ;; redefine key in user macros map + (define-key xwem-global-map xwem-edmacro-store-place mac))) + + (setq xwem-edmacro-store-place nil) + ) + +(define-xwem-command xwem-edmacro-edit-kbd-macro (xwem-keys &optional arg) + "Edit XWEM keyboard macro specified by XWEM-KEYS. +With a prefix ARG, format the macro in a more concise way." + (xwem-interactive + (list + (xwem-read-key-sequence + (substitute-command-keys + (concat "Enter \\<xwem-global-map>\\[xwem-keymacro-play-last] " + "or one of \\<xwem-global-map>\\[xwem-user-keymacros-prefix] XXX: "))) + (prefix-numeric-value xwem-prefix-arg))) + + (xwem-kbd-stop-grabbing) + + (let ((xwem-cmd (xwem-kbd-key-binding xwem-keys)) + xwem-evs) + + (setq xwem-evs (cond ((eq xwem-cmd 'xwem-keymacro-play-last) + (setq xwem-edmacro-store-place 'xwem-keymacro-last-kbd-macro) + xwem-keymacro-last-kbd-macro) + + ((vectorp xwem-cmd) + (setq xwem-edmacro-store-place xwem-keys) + xwem-cmd) + + ((and xwem-edmacro-can-edit-unbinded (null xwem-cmd)) + (setq xwem-edmacro-store-place xwem-keys) + []) + + (xwem-edmacro-can-edit-nonmacro + (setq xwem-edmacro-store-place xwem-keys) + []) + + (t nil))) + + (if (null xwem-evs) + (cond ((and (null xwem-edmacro-can-edit-unbinded) (null xwem-cmd)) + (xwem-message 'warn (concat "Dissalowed to edit unbinded key " + (key-description xwem-keys) + " by `xwem-edmacro-can-edit-unbinded'"))) + ((null xwem-edmacro-can-edit-nonmacro) + (xwem-message 'warn (concat "Dissalowed to edit non-macro key " + (key-description xwem-keys) + " by `xwem-edmacro-can-edit-nonmacro'."))) + (t (xwem-message 'warn "Invalid keyboard macro given."))) + + ;; XXX + (when xwem-edmacro-store-place + (xwem-special-popup-frame (get-buffer-create "*Edit Macro*") t) + + ;; Add some info in *Edit Macro* buffer + (let ((edmacro-format-hook + (lambda () + (save-excursion + (re-search-backward "Macro:") + (previous-line 1) + (insert (format "\n;; Key: %s\n" (key-description xwem-keys))) + (insert (format ";; Type: %s\n" (if xwem-cmd + (if (vectorp xwem-cmd) + "binded macro" + "binded command") + "unbinded"))) + (when (not (vectorp xwem-cmd)) + (insert (format ";; Cmd: %S\n" xwem-cmd))))))) + + (edit-kbd-macro xwem-evs arg 'xwem-special-revert-focus 'xwem-edmacro-store))) + ))) + + +(provide 'xwem-edmacro) + +;;; xwem-edmacro.el ends here diff --git a/lisp/addons/xwem-framei.el b/lisp/addons/xwem-framei.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1mcmFtZWkuZWw= --- /dev/null +++ b/lisp/addons/xwem-framei.el @@ -0,0 +1,116 @@ +;;; xwem-framei.el --- Frame indicator. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Tue Jan 27 08:01:43 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; When switching frames indicate frame number using xwem-osd. +;; +;; Add something like this to your xwemrc.el to start using frame +;; indicator: +;; +;; (autoload 'xwem-framei-init "xwem-framei") +;; (add-hook 'xwem-after-init-hook 'xwem-framei-init) +;; + +;;; Code: + +(require 'xwem-osd) + +(defgroup xwem-framei nil + "*Group to customize xwem frame indicator." + :prefix "xwem-framei-" + :group 'xwem-frame) + +(defcustom xwem-framei-showtime 1 + "Period of time in second while xwem framei is shown." + :type 'number + :group 'xwem-framei) + +(defcustom xwem-framei-xoffset 20 + "*X Offset from top left frame corner in pixels, where to show framei." + :type 'number + :group 'xwem-framei) + +(defcustom xwem-framei-yoffset 20 + "*Y Offset from top left frame corner in pixels, where to show framei." + :type 'number + :group 'xwem-framei) + +(defface xwem-framei-face + `((t (:foreground "green2" :size 128 :family "helvetica"))) + "*Face used to draw frame number." + :group 'xwem-framei) + + +;;; Internal variables +(defvar xwem-framei-osd nil + "Osd") + +(defvar xwem-framei-itimer nil + "Hidder itimer.") + +(defun xwem-framei-hidder () + (xwem-osd-hide xwem-framei-osd)) + + +;;; Functions +(defun xwem-framei-handle-switch (ofr nfr) + "Handle frame switching." + (let ((frgeom (xwem-frame-xgeom nfr))) + + (xwem-osd-move xwem-framei-osd (+ xwem-framei-xoffset (X-Geom-x frgeom)) + (+ xwem-framei-yoffset (X-Geom-y frgeom))) + (xwem-osd-text xwem-framei-osd (format "%d" (xwem-frame-num nfr))) + (xwem-osd-show xwem-framei-osd) + + (delete-itimer xwem-framei-itimer) + (set-itimer-value xwem-framei-itimer xwem-framei-showtime) + (activate-itimer xwem-framei-itimer) + )) + +(defun xwem-framei-init (&optional xdpy) + "Initialize xwem frame indicator on display XDPY." + (unless xdpy + (setq xdpy (xwem-dpy))) + + (let (xwem-osd-always-ontop) + (setq xwem-framei-osd (xwem-osd-create xdpy 0 0 400 200))) + + (setq xwem-framei-itimer (list "xwem-framei-timer" xwem-framei-showtime + nil 'xwem-framei-hidder nil nil nil + (list 0 0 0))) + + (xwem-osd-set-color xwem-framei-osd (face-foreground-name 'xwem-framei-face)) + (xwem-osd-set-font xwem-framei-osd (face-font-name 'xwem-framei-face)) + + (add-hook 'xwem-frame-switch-hook 'xwem-framei-handle-switch)) + + +(provide 'xwem-framei) + +;;; xwem-framei.el ends here diff --git a/lisp/addons/xwem-gamma.el b/lisp/addons/xwem-gamma.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1nYW1tYS5lbA== --- /dev/null +++ b/lisp/addons/xwem-gamma.el @@ -0,0 +1,75 @@ +;;; xwem-gamma.el --- XWEM addon used to adjust gamma. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Tue Jan 20 13:10:28 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; `xwem-gamma' uses uses `xlib-vidmode' Xlib extension and +;; `color-selector' package. + +;; To use it do something like: +;; +;; (xwem-gamma-widget (xwem-dpy)) + +;;; Code: + +(require 'xlib-vidmode) +(require 'color-selector) + +(defface xwem-gamma-face + `((t (:foreground "#1a1a1a" :background "black"))) + "Face used to adjust gamma.") + +(defvar xwem-gamma-display nil + "X Display.") + +(defvar xwem-gamma-screen 0 + "Screen number.") + + +;;; Functions +(defun xwem-gamma-corector (selector) + "Using SELECTOR adjust gamma." + (let* ((k (/ 9.9 256)) + (clist (color-selector-get-color selector)) + (rg (+ 0.1 (* k (car clist)))) + (gg (+ 0.1 (* k (cadr clist)))) + (bg (+ 0.1 (* k (caddr clist))))) + (X-XF86VidModeSetGamma xwem-gamma-display rg gg bg xwem-gamma-screen) + (xwem-message 'nolog "New gamma: r=%f g=%f b=%f" rg gg bg))) + +(defun xwem-gamma-widget (xdpy &optional screen-num) + "Start correcting gama on display XDPY and screen SCREEN-NUM." + (setq xwem-gamma-display xdpy) + (setq xwem-gamma-screen (or (and (numberp screen-num) screen-num) 0)) + (color-selector-make-selector 'xwem-gamma-face 'foreground + 'xwem-gamma-corector)) + + +(provide 'xwem-gamma) + +;;; xwem-gamma.el ends here diff --git a/lisp/addons/xwem-holer.el b/lisp/addons/xwem-holer.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1ob2xlci5lbA== --- /dev/null +++ b/lisp/addons/xwem-holer.el @@ -0,0 +1,543 @@ +;;; xwem-holer.el --- Making holes in xwem frames. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Jan 15 12:39:04 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; This XWEM addon allow you to create/manipulate holes in XWEM +;; frames. +;; +;; Add something following to your ~/.xwem/xwemrc.el to start using +;; holer: + +;; (autoload 'xwem-holer-imove-or-create "xwem-holer" +;; "Interactively move or create holer." t) +;; (autoload 'xwem-holer-idestroy "xwem-holer" +;; "Interactively destroy holer." t) +;; (autoload 'xwem-holer-iresize "xwem-holer" +;; "Interactively resize holer." t) + +;; (define-key xwem-global-map [(hyper ?x) ?h button1] +;; 'xwem-holer-imove-or-create) +;; (define-key xwem-global-map [(hyper ?x) ?h button2] +;; 'xwem-holer-idestroy) +;; (define-key xwem-global-map [(hyper ?x) ?h button3] +;; 'xwem-holer-iresize) + +;;; BUGS: +;; +;; - You can create/manipulate holes only on selected frame. + +;;; Code: +(require 'xlib-xshape) + + +(defgroup xwem-holer nil + "Group to customize xwem holer." + :prefix "xwem-holer-" + :group 'xwem) + +(defcustom xwem-holer-outline-width 3 + "Width of outliner." + :type 'number + :group 'xwem-holer) + +(defcustom xwem-holer-outline-color "blue2" + "*Color of holer outliner." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-holer) + +(defcustom xwem-holer-move-cursor-shape 'X-XC-fleur + "*Shape of cursor when moving holer." + :type (xwem-cursor-shape-choice) + :group 'xwem-holer) + +(defcustom xwem-holer-move-cursor-foreground "#0000AA" + "*Cursor's foreground when moving holer." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-holer) + +(defcustom xwem-holer-move-cursor-background "#000088" + "*Cursor's background when moving holer." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-holer) + +(defcustom xwem-holer-resize-cursor-foreground "#0000AA" + "*Cursor's foreground when resizing holer." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-holer) + +(defcustom xwem-holer-resize-cursor-background "#000088" + "*Cursor's background when resizing holer." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-holer) + +(defcustom xwem-holer-min-pixels 10 + "*Minimum pixels to change holer geometry. +Set it higher value to speed up moving/resizing." + :type 'number + :group 'xwem-holer) + + +;;; Define holer prefix map +(xwem-define-prefix-command 'xwem-holer-prefix t) +(defvar xwem-holer-map (symbol-function 'xwem-holer-prefix) + "Keymap for holer (\\<xwem-global-map>\\[xwem-holer-prefix]) commands. +Bindings: +\\{xwem-holer-map}") + +(define-key xwem-holer-map [button1] 'xwem-holer-imove-or-create) +(define-key xwem-holer-map [button2] 'xwem-holer-idestroy) +(define-key xwem-holer-map [button3] 'xwem-holer-iresize) +(define-key xwem-holer-map (xwem-kbd "h") 'xwem-holer-ihide) +(define-key xwem-holer-map (xwem-kbd "s") 'xwem-holer-ishow) + + +(defvar xwem-holers-list nil "List of all holers.") + +(defstruct xwem-holer + frame + x y width height + + click-xoff click-yoff ; offset within holer where click occured + + outliner-win ; + xmask xmask-gc xmask-bgc + + mode ; nil, 'move, 'resize-bl, + ; 'resize-br, 'resize-tl or + ; 'resize-tr, 'hidden + + ;; cursors + move-cursor + resize-bl-cursor resize-br-cursor + resize-tl-cursor resize-tr-cursor + ) + +(defmacro xwem-holer-xdpy (holer) + "Return HOLER's display." + `(X-Win-dpy (xwem-frame-xwin (xwem-holer-frame holer)))) + +(defsubst xwem-holer-add (holer) + "Add HOLER to the `xwem-holers-list'." + (pushnew holer xwem-holers-list)) + +(defsubst xwem-holer-del (holer) + "Remove HOLER from `xwem-holers-list'." + (setq xwem-holers-list (delete holer xwem-holers-list))) + +(defsubst xwem-holer-find-by-frame (frame) + "Find holer by FRAME. +Return list of holers for FRAME." + (let (holers) + (mapc (lambda (h) + (when (eq (xwem-holer-frame h) frame) + (setq holers (cons h holers)))) + xwem-holers-list) + holers)) + + +(defun xwem-holer-clear (holer) + "Clear HOLER's xmask." + (let* ((xgeom (xwem-frame-xgeom (xwem-holer-frame holer))) + (width (X-Geom-width xgeom)) + (height (X-Geom-height xgeom))) + (XFillRectangle (xwem-holer-xdpy holer) (xwem-holer-xmask holer) + (xwem-holer-xmask-gc holer) 0 0 width height))) + +(defun xwem-holer-create (frame x y width height) + "Create new holer for FRAME with geometry +X+Y+WIDTHxHEIGHT." + + (let* ((holer (make-xwem-holer :frame frame :x x :y y :width width :height height)) + (xdpy (xwem-holer-xdpy holer)) + (xgeom (xwem-frame-xgeom frame))) + + (setf (xwem-holer-xmask holer) + (XCreatePixmap xdpy + (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + (xwem-frame-xwin frame) 1 + (X-Geom-width xgeom) (X-Geom-height xgeom))) + (setf (xwem-holer-xmask-gc holer) + (XCreateGC xdpy (xwem-holer-xmask holer) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :foreground 1.0 + :background 0.0))) + (setf (xwem-holer-xmask-bgc holer) + (XCreateGC xdpy (xwem-holer-xmask holer) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :foreground 0.0 + :background 1.0))) + + (xwem-holer-clear holer) + + (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer) + x y width height) + (X-XShapeMask xdpy (xwem-frame-xwin frame) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer)) + + ;; Create cursors + (setf (xwem-holer-move-cursor holer) + (xwem-make-cursor (eval xwem-holer-move-cursor-shape) + xwem-holer-move-cursor-foreground + xwem-holer-move-cursor-background)) + (setf (xwem-holer-resize-bl-cursor holer) + (xwem-make-cursor X-XC-bottom_left_corner + xwem-holer-resize-cursor-foreground + xwem-holer-resize-cursor-background)) + (setf (xwem-holer-resize-br-cursor holer) + (xwem-make-cursor X-XC-bottom_right_corner + xwem-holer-resize-cursor-foreground + xwem-holer-resize-cursor-background)) + (setf (xwem-holer-resize-tl-cursor holer) + (xwem-make-cursor X-XC-top_left_corner + xwem-holer-resize-cursor-foreground + xwem-holer-resize-cursor-background)) + (setf (xwem-holer-resize-tr-cursor holer) + (xwem-make-cursor X-XC-top_right_corner + xwem-holer-resize-cursor-foreground + xwem-holer-resize-cursor-background)) + + ;; Outline holer + (setf (xwem-holer-outliner-win holer) + (XCreateWindow xdpy (xwem-frame-xwin frame) + (- x xwem-holer-outline-width) + (- y xwem-holer-outline-width) + width height xwem-holer-outline-width + nil nil nil (make-X-Attr :override-redirect t + :border-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy) + xwem-holer-outline-color (make-X-Color))))) + (X-Win-put-prop (xwem-holer-outliner-win holer) 'xwem-holer holer) + (XMapWindow xdpy (xwem-holer-outliner-win holer)) + + ;; Finally add to `xwem-holers-list' + (xwem-holer-add holer) + + holer)) + +(defun xwem-holer-move (holer x y) + "Move HOLER to X Y." + (let ((xdpy (xwem-holer-xdpy holer))) + (setf (xwem-holer-x holer) x) + (setf (xwem-holer-y holer) y) + + (xwem-holer-clear holer) + (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer) + (xwem-holer-x holer) (xwem-holer-y holer) + (xwem-holer-width holer) (xwem-holer-height holer)) + (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer)) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer)) + + (XMoveWindow xdpy (xwem-holer-outliner-win holer) + (- x xwem-holer-outline-width) + (- y xwem-holer-outline-width)))) + +(defun xwem-holer-resize (holer width height) + "Resize HOLER to WIDTH HEIGHT." + ) + +(defun xwem-holer-move-resize (holer x y width height) + "Move and resize HOLER to X Y WIDTH HEIGHT geometry." + (let ((xdpy (xwem-holer-xdpy holer))) + (setf (xwem-holer-x holer) x) + (setf (xwem-holer-y holer) y) + (setf (xwem-holer-width holer) width) + (setf (xwem-holer-height holer) height) + + (xwem-holer-clear holer) + (XFillRectangle xdpy (xwem-holer-xmask holer) (xwem-holer-xmask-bgc holer) + (xwem-holer-x holer) (xwem-holer-y holer) + (xwem-holer-width holer) (xwem-holer-height holer)) + (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer)) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask holer)) + + (XMoveResizeWindow xdpy (xwem-holer-outliner-win holer) + (- x xwem-holer-outline-width) + (- y xwem-holer-outline-width) + (xwem-holer-width holer) + (xwem-holer-height holer)))) + + +(defun xwem-holer-destroy (holer) + "Destroy HOLER." + (let ((xdpy (xwem-holer-xdpy holer))) + (xwem-holer-del holer) ; remove from `xwem-holers-list' + + (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame holer)) + X-XShape-Bounding X-XShapeSet 0 0 nil) + (XFreePixmap xdpy (xwem-holer-xmask holer)) + (XFreeGC xdpy (xwem-holer-xmask-gc holer)) + (XFreeGC xdpy (xwem-holer-xmask-bgc holer)) + + ;; Finally destroy outliner window + (X-Win-rem-prop (xwem-holer-outliner-win holer) 'xwem-holer) + (XDestroyWindow xdpy (xwem-holer-outliner-win holer)))) + +;;; Subroutines using when resizing +(defun xwem-holer-change-mode-to-opposite (holer &optional width-p) + "Change HOLER's resize mode to opposite when resizing." + (let ((ww '(resize-tr resize-br resize-tl resize-bl)) + (hh '(resize-bl resize-tl resize-br resize-tr)) + (c (member (xwem-holer-mode holer) '(resize-tl resize-bl resize-tr resize-br)))) + (when c + (setf (xwem-holer-mode holer) (nth (- 4 (length c)) (if width-p ww hh)))))) + +(defun xwem-holer-calculate-new-geom (hl frx fry) + "Return list '(x y width height) represented new geometry for holer HL." + (let ((mode (xwem-holer-mode hl)) + x y w h) + (cond ((eq mode 'resize-tl) + (setq x frx + y fry + w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl)) + h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl)))) + ((eq mode 'resize-bl) + (setq x frx + y (xwem-holer-y hl) ; didnt affected + h (- fry (xwem-holer-y hl)) + w (+ (- (xwem-holer-x hl) x) (xwem-holer-width hl)))) + ((eq mode 'resize-tr) + (setq x (xwem-holer-x hl) + y fry + w (- frx x) + h (+ (- (xwem-holer-y hl) y) (xwem-holer-height hl)))) + ((eq mode 'resize-br) + (setq x (xwem-holer-x hl) + y (xwem-holer-y hl) + w (- frx (xwem-holer-x hl)) + h (- fry (xwem-holer-y hl)))) + ) + (list x y w h))) + +(defun xwem-holer-event-handler (xdpy win xev) + "Handle events come from root window." + (X-Event-CASE xev + (:X-MotionNotify + (let ((hl (X-Win-get-prop win 'xwem-holer)) + frxgeom frx fry) + (when (xwem-holer-p hl) + (setq frxgeom (xwem-frame-xgeom (xwem-holer-frame hl))) + (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom))) + (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom))) + (cond ((eq (xwem-holer-mode hl) 'move) + ;; Translate root coordinates to frame coordinates. + ;; Using XTranslateCoordinates will slow down. + (let ((x (- frx (xwem-holer-click-xoff hl))) + (y (- fry (xwem-holer-click-yoff hl)))) + (when (or (>= (abs (- x (xwem-holer-x hl))) xwem-holer-min-pixels) + (>= (abs (- y (xwem-holer-y hl))) xwem-holer-min-pixels)) + (xwem-holer-move hl x y)))) + + ;; Interactively resize holer + ((member (xwem-holer-mode hl) '(resize-bl resize-br resize-tl resize-tr)) + ;; Calculate new geometry + (let* ((ngeom (xwem-holer-calculate-new-geom hl frx fry)) + (x (nth 0 ngeom)) + (y (nth 1 ngeom)) + (w (nth 2 ngeom)) + (h (nth 3 ngeom))) + + ;; When width or height is less then zero check is + ;; there need to change resize mode. + (when (or (< w 0) (< h 0)) + (when (< w 0) + (xwem-holer-change-mode-to-opposite hl t)) + (when (< h 0) + (xwem-holer-change-mode-to-opposite hl)) + (setq ngeom (xwem-holer-calculate-new-geom hl frx fry) + x (nth 0 ngeom) + y (nth 1 ngeom) + w (nth 2 ngeom) + h (nth 3 ngeom))) + + (when (and x y (> w 0) (> h 0) + (or (>= (abs (- w (xwem-holer-width hl))) + xwem-holer-min-pixels) + (>= (abs (- h (xwem-holer-height hl))) + xwem-holer-min-pixels))) + (xwem-holer-move-resize hl x y w h)) + )) + )))) + + (:X-ButtonRelease + (XUngrabPointer xdpy) + (X-Win-EventHandler-rem (X-Event-xmotion-event xev) 'xwem-holer-event-handler) + (let ((hl (X-Win-get-prop win 'xwem-holer))) + (when (xwem-holer-p hl) + (setf (xwem-holer-mode hl) nil))) + ) + + (:X-Expose + (let ((hl (X-Win-get-prop win 'xwem-holer))) + (when (xwem-holer-p hl) + (X-XShapeMask xdpy (xwem-frame-xwin (xwem-holer-frame hl)) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask hl))))) + )) + +(defun xwem-holer-find-frame (xev) + "Using ButtonPress XEV find out xwem frame." + ;; XXX + (xwem-frame-selected)) + +(defun xwem-holer-find-holer (xev) + "Using ButtonPress XEV find out holer under pointer." + (when (= (X-Event-type xev) X-ButtonPress) + (let* ((xdpy (X-Event-dpy xev)) + (frame (xwem-holer-find-frame xev)) + (xt (and (xwem-frame-p frame) + (XTranslateCoordinates xdpy (XDefaultRootWindow xdpy) + (xwem-frame-xwin frame) + (X-Event-xbutton-root-x xev) + (X-Event-xbutton-root-y xev)))) + (chw (nth 3 xt)) + (hl (and (X-Win-p chw) (X-Win-get-prop chw 'xwem-holer)))) + (when (xwem-holer-p hl) + (let ((hlxt (XTranslateCoordinates + xdpy (XDefaultRootWindow xdpy) + (xwem-holer-outliner-win hl) + (X-Event-xbutton-root-x xev) (X-Event-xbutton-root-y xev)))) + (setf (xwem-holer-click-xoff hl) (nth 4 hlxt)) + (setf (xwem-holer-click-yoff hl) (nth 5 hlxt)) + + hl))))) + +(define-xwem-command xwem-holer-imove () + "Move holer." + (xwem-interactive "_") + + (let* ((xev xwem-last-xevent) + (hl (xwem-holer-find-holer xev))) + (when (xwem-holer-p hl) + (setf (xwem-holer-mode hl) 'move) + (XGrabPointer (X-Event-dpy xev) + (xwem-holer-outliner-win hl) + (truncate (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) + (xwem-holer-move-cursor hl)) + (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl) 'xwem-holer-event-handler) + ))) + +(define-xwem-command xwem-holer-imove-or-create () + "Move already existing holer or create new." + (xwem-interactive "_") + + (let* ((xev xwem-last-xevent) + (hl (xwem-holer-find-holer xev))) + (if (xwem-holer-p hl) + (call-interactively 'xwem-holer-imove) + + ;; Create new holer + (let ((frame (xwem-holer-find-frame xev)) + frxgeom frx fry) + + (when (xwem-frame-p frame) + (setq frxgeom (xwem-frame-xgeom frame)) + (setq frx (- (X-Event-xmotion-root-x xev) (X-Geom-x frxgeom))) + (setq fry (- (X-Event-xmotion-root-y xev) (X-Geom-y frxgeom))) + + (xwem-holer-create frame (- frx 1) (- fry 1) 1 1) + ;; After this resizing should appear in 'resize-br mode + (call-interactively 'xwem-holer-iresize)))))) + +(define-xwem-command xwem-holer-iresize () + "Resize holer." + (xwem-interactive "_") + + (let* ((xev xwem-last-xevent) + (hl (xwem-holer-find-holer xev))) + (when (xwem-holer-p hl) + (let ((cx (xwem-holer-click-xoff hl)) + (cy (xwem-holer-click-yoff hl)) + (hw (/ (xwem-holer-width hl) 2)) ; half of width + (hh (/ (xwem-holer-height hl) 2)) ; half of height + cursor) + (cond ((and (> cx hw) (> cy hh)) + (setf (xwem-holer-mode hl) 'resize-br) + (setq cursor (xwem-holer-resize-br-cursor hl))) + + ((> cx hw) + (setf (xwem-holer-mode hl) 'resize-tr) + (setq cursor (xwem-holer-resize-tr-cursor hl))) + + ((and (<= cx hw) (> cy hh)) + (setf (xwem-holer-mode hl) 'resize-bl) + (setq cursor (xwem-holer-resize-bl-cursor hl))) + + ((<= cx hw) + (setf (xwem-holer-mode hl) 'resize-tl) + (setq cursor (xwem-holer-resize-tl-cursor hl)))) + + (XGrabPointer (X-Event-dpy xev) + (xwem-holer-outliner-win hl) + (truncate (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) + cursor) + (X-Win-EventHandler-add-new (xwem-holer-outliner-win hl) 'xwem-holer-event-handler) + )))) + +(define-xwem-command xwem-holer-idestroy () + "Destroy holer." + (xwem-interactive) + + (let* ((xev xwem-last-xevent) + (hl (xwem-holer-find-holer xev))) + (when (xwem-holer-p hl) + (xwem-holer-destroy hl) + + (xwem-message 'info "Holler at %dx%d destroyed." + (X-Event-xbutton-root-x xev) + (X-Event-xbutton-root-y xev))))) + +(define-xwem-command xwem-holer-ihide (frame) + "Hide all holers for FRAME. +If FRAME is ommited - `xwem-frame-selected' assumed." + (xwem-interactive (list (xwem-frame-selected))) + + (let* ((xwin (xwem-frame-xwin frame)) + (xdpy (X-Win-dpy xwin))) + + (mapc (lambda (h) + (XUnmapWindow xdpy (xwem-holer-outliner-win h))) + (xwem-holer-find-by-frame frame)) + + (X-XShapeMask xdpy xwin X-XShape-Bounding X-XShapeSet 0 0 nil))) + +(define-xwem-command xwem-holer-ishow (frame) + "Show all holers for FRAME. +If FRAME is ommited - `xwem-frame-selected' assumed." + (xwem-interactive (list (xwem-frame-selected))) + + (let* ((xwin (xwem-frame-xwin frame)) + (xdpy (X-Win-dpy xwin))) + + (mapc (lambda (h) + (XMapWindow xdpy (xwem-holer-outliner-win h)) + (X-XShapeMask xdpy xwin + X-XShape-Bounding X-XShapeSet 0 0 (xwem-holer-xmask h))) + (xwem-holer-find-by-frame frame)))) + + +(provide 'xwem-holer) + +;;; xwem-holer.el ends here diff --git a/lisp/addons/xwem-keytt.el b/lisp/addons/xwem-keytt.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1rZXl0dC5lbA== --- /dev/null +++ b/lisp/addons/xwem-keytt.el @@ -0,0 +1,74 @@ +;;; xwem-keytt.el --- Keypress translation table. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 19:33:35 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +;; Translation table +(defcustom xwem-key-tt-alist nil + "*Keypresses translation table. +Alist in where keys is source keypress and value is destination keypress. +Each keypresses is in form returned from `kbd'." + :type 'alist + :group 'xwem-keyboard) + + + +;; Functions +(define-xwem-command xwem-key-tt-command () + "Command to perform keypress translation." + (xwem-interactive) + + (let* ((prk xwem-this-command-keys) + (tte (assoc prk xwem-key-tt-alist))) + (if tte + (X-Dpy-send-excursion (xwem-dpy) + (xwem-key-send-ekeys (cdr tte))) + + (xwem-message 'warn "Can't find tt entry for: %S" prk)))) + +(defun xwem-key-tt-init () + "Initialize translation table. +Translation table is alist with elements in form: + (issued-key . send-key) + +i.e. tt substitutes pressed key ISSUED-KEY with SEND-KEY actually it +will looks like you press SEND-KEY." + (mapcar (lambda (el) + (xwem-define-key (car el) 'xwem-key-tt-command)) + xwem-key-tt-alist)) + + + + +(provide 'xwem-keytt) + +;;; xwem-keytt.el ends here diff --git a/lisp/addons/xwem-osd.el b/lisp/addons/xwem-osd.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1vc2QuZWw= --- /dev/null +++ b/lisp/addons/xwem-osd.el @@ -0,0 +1,511 @@ +;;; xwem-osd.el --- On Screen Display implementation for XWEM. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Mon Jan 12 13:14:32 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Support for on screen display in XWEM. xwem-osd can display text, +;; processing bar, other stuff using shaped window. The main feature +;; of this OSD implementation that it uses OSD instances to display +;; stuff, so it does not need to handle expose events. + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'xlib-xshape) + +(defconst xwem-osd-instance-types '(text line arc rect) + "List of valid types of osd instance.") + + +(defstruct xwem-osd-instance + type ; instance type, see `xwem-osd-instance-types' + osd ; back reference to osd + (depth 0) ; depth + + xwin xmask + color) ; instance background color + +(defmacro xwem-osd-instance-xdpy (osin) + "Return display of OSIN osd instance." + `(xwem-osd-xdpy (xwem-osd-instance-osd osin))) + +(defstruct xwem-osd + state ; 'destroyed, 'hided or 'shown + x y + width height + + xdpy + xwin + xmask + + gc ; GC used to draw + mask-gc ; GC used to draw mask + + instances ; list of xwem-osd-instance structs sorted by depth + + plist) ; User defined plist + +(defcustom xwem-osd-default-font "fixed" + "Default font for text drawed in osd.") + +(defcustom xwem-osd-default-color "black" + "Default color used to draw.") + +(defcustom xwem-osd-always-ontop t + "*Non-nil mean that OSD's winow will be always on top.") + + +;;; Functions +(defun xwem-osd-event-handler (xdpy xwin xev) + "On X display XDPY and window XWIN handle X Event XEV." + (let ((osd (xwem-osd-get-osd xwin))) + (when (xwem-osd-p osd) + (X-Event-CASE xev + (:X-DestroyNotify + (xwem-osd-destroy osd t)) + )))) + +(defun xwem-osd-root-event-handler (xdpy xwin xev) + "Root window event handler for OSD." + (X-Event-CASE xev + (:X-ConfigureNotify + (let ((osd (xwem-osd-get-osd (X-Event-xconfigure-above-sibling xev)))) + (when (xwem-osd-p osd) + ;; OSD's window is above sibling for some other window, so it + ;; is (osd's window) obscured and we need to pop it back. + (xwem-osd-show osd) + ))) + )) + +;;; Instances operations +(defun xwem-osd-instance-destroy (osin) + "Destroy osd instance OSIN." + (XDestroyWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin)) + (XFreePixmap (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xmask osin)) + ) + +(defun xwem-osd-add-instance (osd depth color) + "In OSD add osd instance with background COLOR. +Return newly created osd instance." + (let ((xdpy (xwem-osd-xdpy osd)) + (osin (make-xwem-osd-instance :osd osd :depth depth + :color color))) + (setf (xwem-osd-instance-xwin osin) + (XCreateWindow xdpy (xwem-osd-xwin osd) + 0 0 (xwem-osd-width osd) (xwem-osd-height osd) + 0 nil nil nil + (make-X-Attr :override-redirect t + :background-pixel (XAllocNamedColor xdpy (XDefaultColormap xdpy) + color (make-X-Color))))) + (setf (xwem-osd-instance-xmask osin) + (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + (xwem-osd-instance-xwin osin) 1 + (xwem-osd-width osd) (xwem-osd-height osd))) + (xwem-osd-instance-clear osin) + + (push osin (xwem-osd-instances osd)) + ;; TODO: - sort instances according to depth + + osin)) + +(defun xwem-osd-instance-clear (osin) + "Clear mask area of OSD instance." + (let ((osd (xwem-osd-instance-osd osin))) + (xwem-osd-mask-fgbg osd) + (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + 0 0 (xwem-osd-width osd) (xwem-osd-height osd)) + (xwem-osd-mask-fgbg osd))) + +(defun xwem-osd-instance-show (osin) + "Show osd instance OSIN." + (XMapWindow (xwem-osd-instance-xdpy osin) (xwem-osd-instance-xwin osin))) + +(defun xwem-osd-instance-set-color (osin new-color) + "Set new color." + (let ((xdpy (xwem-osd-instance-xdpy osin))) + (setf (xwem-osd-instance-color osin) new-color) + (XSetWindowBackground xdpy (xwem-osd-instance-xwin osin) + (XAllocNamedColor xdpy (XDefaultColormap xdpy) + new-color (make-X-Color))) + (XClearArea xdpy (xwem-osd-instance-xwin osin) + 0 0 (xwem-osd-width (xwem-osd-instance-osd osin)) + (xwem-osd-height (xwem-osd-instance-osd osin)) nil))) + +;;; OSD functions +(defun xwem-osd-create (xdpy x y width height &optional x-parent) + "On X display XDPY create new xwem osd context with +X+Y/WIDTHxHEIGHT geometry on X-PARENT." + (let ((osd (make-xwem-osd :xdpy xdpy :x x :y y :width width :height height))) + (setf (xwem-osd-xwin osd) + (XCreateWindow xdpy (or x-parent (XDefaultRootWindow xdpy)) + x y width height 0 nil nil nil + (make-X-Attr :override-redirect t + :background-pixel (XBlackPixel xdpy) + :event-mask (Xmask-or XM-StructureNotify)))) + ;; Create gc + (setf (xwem-osd-gc osd) + (XCreateGC xdpy (xwem-osd-xwin osd) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :foreground (XAllocNamedColor xdpy (XDefaultColormap xdpy) + xwem-osd-default-color (make-X-Color)) + :font (X-Font-get xdpy xwem-osd-default-font)))) + + (X-Win-put-prop (xwem-osd-xwin osd) 'osd-ctx osd) + (X-Win-EventHandler-add-new (xwem-osd-xwin osd) 'xwem-osd-event-handler) + + (when xwem-osd-always-ontop + (X-Win-EventHandler-add-new (XDefaultRootWindow xdpy) 'xwem-osd-root-event-handler)) + + (xwem-osd-create-mask osd) + osd)) + +(defun xwem-osd-get-osd (xwin) + "Get osd context associated with XWIN." + (and (X-Win-p xwin) (X-Win-get-prop xwin 'osd-ctx))) + +(defun xwem-osd-mask-fgbg (osd) + "Exchange foreground and background colors in OSD's mask gc." + (let* ((mgc (xwem-osd-mask-gc osd)) + (fg (X-Gc-foreground mgc)) + (bg (X-Gc-background mgc))) + (setf (X-Gc-foreground mgc) bg) + (setf (X-Gc-background mgc) fg) + + (XChangeGC (xwem-osd-xdpy osd) mgc))) + +(defun xwem-osd-clear-mask (osd) + "Clear mask area of OSD context." + (xwem-osd-mask-fgbg osd) + (XFillRectangle (xwem-osd-xdpy osd) (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + 0 0 (xwem-osd-width osd) (xwem-osd-height osd)) + (xwem-osd-mask-fgbg osd)) + +(defun xwem-osd-create-mask (osd) + "For xwem osd context OSD create mask pixmap." + (let ((xdpy (xwem-osd-xdpy osd))) + (setf (xwem-osd-xmask osd) + (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + (xwem-osd-xwin osd) 1 (xwem-osd-width osd) + (xwem-osd-height osd))) + + (setf (xwem-osd-mask-gc osd) + (XCreateGC xdpy (xwem-osd-xmask osd) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :foreground 1.0 + :background 0.0 + :font (X-Font-get xdpy xwem-osd-default-font)))) + (xwem-osd-clear-mask osd) + )) + +(defun xwem-osd-set-height (osd new-height) + "Set OSD's window height to NEW-HEIGHT." + (setf (xwem-osd-height osd) new-height) + (XResizeWindow (xwem-osd-xdpy osd) + (xwem-osd-xwin osd) + (xwem-osd-width osd) + (xwem-osd-height osd)) + + (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd)) + (xwem-osd-create-mask osd)) + +(defun xwem-osd-set-width (osd new-width) + "Set OSD's window width to NEW-WIDTH." + (setf (xwem-osd-width osd) new-width) + (XResizeWindow (xwem-osd-xdpy osd) + (xwem-osd-xwin osd) + (xwem-osd-width osd) + (xwem-osd-height osd)) + + (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd)) + (xwem-osd-create-mask osd)) + +(defun xwem-osd-move (osd new-x new-y) + "Change OSD's window position to NEW-X, NEW-Y." + (XMoveWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd) + new-x new-y)) + +(defun xwem-osd-set-xwin-color (osd color-name) + "Set background for OSD's window to COLOR-NAME." + (let ((xdpy (xwem-osd-xdpy osd))) + (XSetWindowBackground xdpy (xwem-osd-xwin osd) + (XAllocNamedColor xdpy (XDefaultColormap xdpy) + color-name (make-X-Color))))) + +(defun xwem-osd-set-gc-color (osd color-name) + "Set OSD's gc foreground color to COLOR-NAME." + (let ((xdpy (xwem-osd-xdpy osd))) + (setf (X-Gc-foreground (xwem-osd-gc osd)) + (XAllocNamedColor xdpy (XDefaultColormap xdpy) + color-name (make-X-Color))) + (XChangeGC xdpy (xwem-osd-gc osd)))) + +(defun xwem-osd-set-color (osd color-name) + "Set both OSD's background and OSD's gc foreground color to COLOR-NAME." + (let* ((xdpy (xwem-osd-xdpy osd)) + (col (XAllocNamedColor xdpy (XDefaultColormap xdpy) + color-name (make-X-Color)))) + (XSetWindowBackground xdpy (xwem-osd-xwin osd) col) + (xwem-osd-clear-xwin osd) + (setf (X-Gc-foreground (xwem-osd-gc osd)) col) + (XChangeGC xdpy (xwem-osd-gc osd)))) + +(defun xwem-osd-show (osd) + "Show OSD's window." + (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)) + (XMapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd)) + (XRaiseWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))) + +(defun xwem-osd-hide (osd) + "Hide OSD's window." + (XUnmapWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))) + +(defun xwem-osd-destroy-instances (osd) + "Destroy all instances in OSD." + (mapcar (lambda (osin) + (xwem-osd-instance-destroy osin)) + (xwem-osd-instances osd)) + (setf (xwem-osd-instances osd) nil)) + +(defun xwem-osd-destroy (osd &optional already-destroyed) + "Destroy OSD context." + (xwem-osd-destroy-instances osd) + + (X-Win-EventHandler-rem (xwem-osd-xwin osd) 'xwem-osd-event-handler) + (X-Win-EventHandler-rem (XDefaultRootWindow (xwem-osd-xdpy osd)) 'xwem-osd-root-event-handler) + + (unless already-destroyed + (XDestroyWindow (xwem-osd-xdpy osd) (xwem-osd-xwin osd))) + (XFreePixmap (xwem-osd-xdpy osd) (xwem-osd-xmask osd))) + +(defun xwem-osd-set-font (osd font-name) + "In OSD's context set font to be FONT-NAME." + (let* ((xdpy (xwem-osd-xdpy osd)) + (gc (xwem-osd-gc osd)) + (mgc (xwem-osd-mask-gc osd)) + (font (X-Font-get xdpy font-name))) + (setf (X-Gc-font mgc) font) + (XChangeGC xdpy mgc) + + (setf (X-Gc-font gc) font) + (XChangeGC xdpy gc))) + +(defun xwem-osd-char-width (osd) + "Return width of OSD's window in characters." + ;; XXX assumes that font is width fixed + (/ (xwem-osd-width osd) + (X-Text-width (xwem-osd-xdpy osd) (X-Gc-font (xwem-osd-mask-gc osd)) "_"))) + +(defun xwem-osd-clear-xwin (osd) + "Clear contents of OSD's window." + (XClearArea (xwem-osd-xdpy osd) (xwem-osd-xwin osd) 0 0 + (xwem-osd-width osd) (xwem-osd-height osd) nil)) + +(defun xwem-osd-clear (osd) + "Clear OSD window." + (xwem-osd-destroy-instances osd) + (xwem-osd-clear-mask osd) + + (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd))) + +(defun xwem-osd-text (osd string) + "In OSD's context show string. +When MASK-ONLY is non-nil, do not performe any real drawing." + (let* ((xdpy (xwem-osd-xdpy osd)) + (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string) + (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string)))) + + ;; Update window shape + (xwem-osd-clear-mask osd) + (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + 0 yoff string) + (X-XShapeMask xdpy (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)) + )) + +(defun xwem-osd-color-text (osd strspec-list) + "In OSD's win draw colored text specified by STRSPEC-LIST." + (xwem-osd-clear osd) + (let ((curstr "")) + (X-Dpy-send-excursion (xwem-osd-xdpy osd) + (mapcar (lambda (strspec) + (let* ((xdpy (xwem-osd-xdpy osd)) + (str (concat curstr (car strspec))) + (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str) + (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) str)))) + (xwem-osd-set-xwin-color osd (cdr strspec)) + (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + 0 yoff str) + (X-XShapeMask xdpy (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-xmask osd)) + + (setq curstr (concat curstr (car strspec))))) + strspec-list)))) + +(defun xwem-osd-text-add (osd x y string &optional color) + "In OSD's context at X Y coordinates add STRING colored with COLOR." + (let* ((xdpy (xwem-osd-xdpy osd)) + (yoff (- (X-Text-height xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string) + (X-Text-descent xdpy (X-Gc-font (xwem-osd-mask-gc osd)) string))) + osin) + + ;; Setup OSD instance + (setq osin (xwem-osd-add-instance osd 0 color)) + (setf (xwem-osd-instance-type osin) 'text) + (XDrawString xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + x (+ y yoff) string) + (X-XShapeMask xdpy (xwem-osd-instance-xwin osin) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin)) + (xwem-osd-instance-show osin) + + ;; Update window shape + (XDrawString xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + x (+ y yoff) string) + (X-XShapeMask xdpy (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) + )) + +(defun xwem-osd-set-line-width (osd new-line-width) + "Set OSD's gc line width to NEW-LINE-WIDTH." + (setf (X-Gc-line-width (xwem-osd-gc osd)) new-line-width) + (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-gc osd)) + + (setf (X-Gc-line-width (xwem-osd-mask-gc osd)) new-line-width) + (XChangeGC (xwem-osd-xdpy osd) (xwem-osd-mask-gc osd)) + ) + +(defun xwem-osd-line-add (osd x0 y0 x1 y1 &optional color) + "In OSD's window add line." + (let ((xdpy (xwem-osd-xdpy osd)) + osin) + + ;; Create OSD line instance + (setq osin (xwem-osd-add-instance osd 0 color)) + (setf (xwem-osd-instance-type osin) 'line) + (XDrawLine xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + x0 y0 x1 y1) + (X-XShapeMask xdpy (xwem-osd-instance-xwin osin) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin)) + (xwem-osd-instance-show osin) + + ;; Update OSD window shape + (XDrawLine xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + x0 y0 x1 y1) + (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) + )) + +(defun xwemw-osd-arc-add (osd xarc &optional color) + "In OSD's window draw arc specified by XARC." + (let ((xdpy (xwem-osd-xdpy osd)) + osin) + + ;; Create OSD arc instance + (setq osin (xwem-osd-add-instance osd 0 color)) + (setf (xwem-osd-instance-type osin) 'arc) + (XDrawArcs xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + (list xarc)) + (X-XShapeMask xdpy (xwem-osd-instance-xwin osin) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin)) + + ;; Update OSD shape + (XDrawArcs xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + (list xarc)) + (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) + )) + +(defun xwem-osd-rect-add (osd x y width height &optional color) + "In OSD's window add rectangle specified by X Y WIDTH and HEIGHT." + (let ((xdpy (xwem-osd-xdpy osd)) + osin) + + ;; Created OSD rect instance + (setq osin (xwem-osd-add-instance osd 0 color)) + (setf (xwem-osd-instance-type osin) 'rect) + (XDrawRectangle xdpy (xwem-osd-instance-xmask osin) (xwem-osd-mask-gc osd) + x y width height) + (X-XShapeMask xdpy (xwem-osd-instance-xwin osin) + X-XShape-Bounding X-XShapeSet 0 0 (xwem-osd-instance-xmask osin)) + + ;; Update OSD shape + (XDrawRectangle xdpy (xwem-osd-xmask osd) (xwem-osd-mask-gc osd) + x y width height) + (X-XShapeMask (xwem-osd-xdpy osd) (xwem-osd-xwin osd) + X-XShape-Bounding X-XShapeUnion 0 0 (xwem-osd-xmask osd)) + )) + +;;; You might consider more powerfull `working' package, which is part +;;; of CEDET. +(defun xwem-osd-working-bar-display (tot-len percents) + "Return a string with a bar-graph end percentile showing percentage. +TOT-LEN is the total length of bar. PERCENTS is percentage state." + (let* ((prstr (int-to-string percents)) + (len (- tot-len (+ 10 (length prstr)))) + (dcs (truncate (* len (/ percents 100.0)))) + (tlen (- len dcs))) + (concat ": [" + (make-string (if (> dcs 0) dcs 0) ?#) + (make-string (if (> tlen 0) tlen 0) ?.) + "] ... " prstr "%"))) + +(defun xwem-osd-working-percent-bar (osd prompt percents) + "Display percentage with PERCENTS done bar prompting PROMPT." + (require 'working) + + (let ((osdcw (xwem-osd-char-width osd))) + (xwem-osd-text osd (concat prompt (xwem-osd-working-bar-display (- osdcw (length prompt)) percents))))) + + +;;; Testing: +;;(setq mosd (xwem-osd-create (xwem-dpy) 10 20 400 200)) +;;(xwem-osd-set-color mosd "green4") +;;(xwem-osd-set-font mosd "10x20") +;;(xwem-osd-text mosd "test") +;;(xwem-osd-show mosd) + +;;(progn +;; (setq i 0) +;; (xwem-osd-show mosd) +;; (xwem-osd-set-color mosd "red4") +;; (while (< i 100) +;; (cond ((= i 60) (xwem-osd-set-color mosd "green4")) +;; ((= i 30) (xwem-osd-set-color mosd "yellow4"))) +;; (xwem-osd-working-percent-bar mosd "Processing" i) +;; (sleep-for 0.01) +;; (incf i 1)) +;; (xwem-osd-set-color mosd "red4") +;; (xwem-osd-text mosd "Processing done.")) + +;;(xwem-osd-destroy mosd) + + +(provide 'xwem-osd) + +;;; xwem-osd.el ends here diff --git a/lisp/addons/xwem-register.el b/lisp/addons/xwem-register.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1yZWdpc3Rlci5lbA== --- /dev/null +++ b/lisp/addons/xwem-register.el @@ -0,0 +1,109 @@ +;;; xwem-register.el --- Registers support for XWEM. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Feb 6 08:04:24 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Just like `register' packege for Emacs, but for XWEM. +;; +;; To start using it add: +;; +;; (require 'xwem-register) +;; (xwem-register-install-bindings) +;; +;; to your xwemrc. That will add bonus bindings to `xwem-global-map', +;; such as `H-6' to store current window configuration to register, +;; `H-x /' to store current client to register and `H-x j' to jump to +;; register, i.e. set saved window config or pop to saved client + +;;; Code: + + +(defvar xwem-registers nil + "XWEM registers alist. +Each element in form \(NAME . VALUE\), one for each register. +NAME is a character. VALUE is a string, number, client or a list. +A list in form (XWEM-WIN-CONFIG CONFIG) represent a window +configuration.") + +(defun xwem-register-set (register value) + "Set contents of XWEM register named REGISTER to VALUE. +Return VALUE, see documentation for `xwem-registers' for possible VALUE." + (let ((aelt (assq register xwem-registers))) + (if aelt + (setcdr aelt value) + (setq aelt (cons register value)) + (setq xwem-registers (cons aelt xwem-registers))) + value)) + +(defun xwem-register-get (reg) + "Return contents of XWEM register named REG, or nil if none." + (cdr (assq reg xwem-registers))) + +(define-xwem-command xwem-register-client (register) + "Store selected client to REGISTER." + (xwem-interactive "kClient to register: ") + + (let ((reg (event-key register))) + (xwem-register-set reg (xwem-cl-selected)))) + +(define-xwem-command xwem-register-win-config (register) + "Store window configuration in REGISTER." + (xwem-interactive "kWindow Configuration to register: ") + + (let ((reg (event-key register))) + (xwem-register-set reg (list 'XWEM-WIN-CONFIG + (xwem-window-configuration))))) + +(define-xwem-command xwem-register-jump (register) + "Jump to REGISTER. +If prefix ARG is supplied remove REGISTER from `xwem-registers' alist." + (xwem-interactive "kJump to register: ") + + (let* ((reg (event-key register)) + (rval (xwem-register-get reg))) + (cond ((xwem-cl-p rval) + (xwem-cl-pop-to-client rval)) + + ((and (listp rval) (eq 'XWEM-WIN-CONFIG (car rval))) + (xwem-set-window-configuration (cadr rval))) + + (t (xwem-message 'todo "Hanle register value: %S" rval))) + + )) + +(defun xwem-register-install-bindings () + "Install default register bindings in `xwem-global-map'." + (define-key xwem-global-map (xwem-kbd "H-6") 'xwem-register-win-config) + + (define-key xwem-global-map (xwem-kbd "H-x /") 'xwem-register-client) + (define-key xwem-global-map (xwem-kbd "H-x j") 'xwem-register-jump)) + + +(provide 'xwem-register) + +;;; xwem-register.el ends here diff --git a/lisp/addons/xwem-smartmods.el b/lisp/addons/xwem-smartmods.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS1zbWFydG1vZHMuZWw= --- /dev/null +++ b/lisp/addons/xwem-smartmods.el @@ -0,0 +1,128 @@ +;;; xwem-smartmods.el --- Smart modifiers for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 18:42:05 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + + +;; Smart modifiers: +;; smart modifiers is modifiers which can work as normal modifier and +;; as key if it is not used with some other key(when you just +;; click[press and release modifier]). +(defcustom xwem-use-smart-modifiers nil + "*Non-nil mean use smart modifiers feature." + :type 'boolean + :group 'xwem-keyboard) + +(defcustom xwem-kbd-smart-modifiers + (list (vector XK-Control-L XK-Space nil nil)) + "Smart modifiers list in form [mod-sym key-sym mod-code key-code]. +mod-code and key-code will be filled in `xwem-kbd-grab-smartmods'." + :type 'list + :group 'xwem-keyboard) + +;; Variables +(defvar xwem-key-curr-smamod nil + "Modifier that waits release. +Internal variable, do not modify.") + + +;;; Functions +(defun xwem-kbd-sm-install-grab () + "Begin to grab smart modifiers." + (mapcar (lambda (el) + (aset el 2 (car (xwem-xksym2kcode (aref el 0)))) + (aset el 3 (car (xwem-xksym2kcode (aref el 1)))) + (XGrabKey (xwem-dpy) (aref el 2) 0 (xwem-rootwin))) + xwem-kbd-smart-modifiers) + nil) + +(defun xwem-kbd-sm-uninstall-grab () + "Stop grabbing smart modifiers." + (mapcar (lambda (el) + (XUngrabKey (xwem-dpy) (aref el 2) 0 (xwem-rootwin))) + xwem-kbd-smart-modifiers) + nil) + +(defun xwem-kbd-sm-init () + "Initialize smart modifiers." + (xwem-kbd-sm-install-grab) + + (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-kbd-sm-keypress 0 (list X-KeyPress)) + (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-kbd-sm-keyrelease 0 (list X-KeyRelease))) + +(defun xwem-kbd-sm-fini () + "Finialize smart modifiers." + (X-Win-EventHandler-rem (xwem-rootwin) 'xwem-kbd-sm-keypress) + (X-Win-EventHandler-rem (xwem-rootwin) 'xwem-kbd-sm-keyrelease) + + (xwem-kbd-sm-uninstall-grab)) + +(defun xwem-kbd-sm-smartmodifier-p (kcode) + "Return non-nil if key code KCODE is actually smart modifier. +I.e. if KCODE is in `xwem-kbd-smart-modifiers' list." + (xwem-message 'error "`xwem-kbd-sm-smartmodifier-p' not implemented yet") + nil) + +;; Event handlers +(defun xwem-kbd-sm-keyrelease (xdpy win xev) + "On XDPY and window WIN handle KeyRelease event XEV." + ;; check for smart modifier + (when (and xwem-key-curr-smamod + (= (X-Event-xkey-keycode xev) xwem-key-curr-smamod)) + (let ((smml xwem-kbd-smart-modifiers)) + (while smml + (if (= xwem-key-curr-smamod (aref (car smml) 2)) + (progn + ;; TODO: + ;; * Grab keyboard in sync mode than XAllowEvent + ;; with repeat keyboard. + (xwem-key-sendseq (list (cons X-Xtest-KeyPress (aref (car smml) 3)) + (cons X-Xtest-KeyRelease (aref (car smml) 3)))) + (setq xwem-key-curr-smamod nil) + (setq smml nil)) + (setq smml (cdr smml)))))) + nil) + + +(defun xwem-kbd-sm-keypress (xdpy win xev) + "Handle keypress of smart modifier." + (if (and (xwem-kbd-sm-smartmodifier-p (X-Event-xkey-keycode xev)) + (not xwem-kbd-now-grabbing)) + (setq xwem-key-curr-smamod kobcode) + + (setq xwem-key-curr-smamod nil))) + + + +(provide 'xwem-smartmods) + +;;; xwem-smartmods.el ends here diff --git a/lisp/addons/xwem-time.el b/lisp/addons/xwem-time.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC9hZGRvbnMveHdlbS10aW1lLmVs --- /dev/null +++ b/lisp/addons/xwem-time.el @@ -0,0 +1,1107 @@ +;;; xwem-time.el --- Time Date Load and Mail display in tray. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Mon Dec 8 09:53:42 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; `display-time' like application, which starts in system tray and +;; shows current time, load average and mail status. +;; +;; To start using it, add: +;; +;; (autoload 'xwem-time "xwem-time" "Start `display-time' like app in system tray.") +;; (add-hook 'xwem-after-init-hook 'xwem-time) +;; +;; to your xwemrc. + +;;; Code: + +(eval-when-compile + (require 'itimer)) + +(require 'time) + +(require 'xlib-xshape) +(require 'xlib-xpm) +(require 'xlib-img) +(require 'xlib-tray) + +(defgroup xwem-time nil + "Group to customize XWEM time display." + :prefix "xwem-time-" + :group 'xwem) + +(defcustom xwem-time-display-time t + "*Non-nil mean display current time." + :type 'boolean + :group 'xwem-time) + +(defcustom xwem-time-display-load t + "*Non-nil mean display current CPU load." + :type 'boolean + :group 'xwem-time) + +(defcustom xwem-time-display-mail t + "*Non-nil mean display current mail box status." + :type 'boolean + :group 'xwem-time) + +(defcustom xwem-time-time-color "#CA1E1C" + "Foreground color to display time." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-time) + +(defcustom xwem-time-load-list + (list 0.2 0.5 0.8 1.1 1.8 2.6) + "*A list giving six thresholds for the load +which correspond to the six different icons to be displayed +as a load indicator." + :type '(list (number :tag "Threshold 1") + (number :tag "Threshold 2") + (number :tag "Threshold 3") + (number :tag "Threshold 4") + (number :tag "Threshold 5") + (number :tag "Threshold 6")) + :group 'xwem-time) + +(defcustom xwem-time-interval 20 + "*Seconds between updates of xwem time window." + :type 'integer + :group 'xwem-time) + + +;;; Internal variables +(defconst xwem-time-window-mask (list XM-Exposure XM-StructureNotify XM-ButtonPress XM-ButtonRelease)) +(defvar xwem-time-window "Window of to show time, load and mail.") +(defvar xwem-time-mask-gc "GC used to operate with mask pixmap.") +(defvar xwem-time-gc "GC used to operate with pixmaps.") + + +;;; Icons +(defvar xwem-time-xpm-time0 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"```a````a\",\n" + "\"```a````a\",\n" + "\"``a````a`\",\n" + "\"``a````a`\",\n" + "\"`````````\",\n" + "\"`a````a``\",\n" + "\"`a````a``\",\n" + "\"a````a```\",\n" + "\"a````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defvar xwem-time-xpm-time1 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"````````a\",\n" + "\"````````a\",\n" + "\"```````a`\",\n" + "\"```````a`\",\n" + "\"`````````\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"`````````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time2 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"````````a\",\n" + "\"````````a\",\n" + "\"```````a`\",\n" + "\"```````a`\",\n" + "\"``aaaaa``\",\n" + "\"`a```````\",\n" + "\"`a```````\",\n" + "\"a````````\",\n" + "\"a````````\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time3 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"````````a\",\n" + "\"````````a\",\n" + "\"```````a`\",\n" + "\"```````a`\",\n" + "\"``aaaaa``\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time4 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"```a````a\",\n" + "\"```a````a\",\n" + "\"``a````a`\",\n" + "\"``a````a`\",\n" + "\"``aaaaa``\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"`````````\",\n" + "\"`````````\"\n" + "};\n")) + + +(defconst xwem-time-xpm-time5 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"```a`````\",\n" + "\"```a`````\",\n" + "\"``a``````\",\n" + "\"``a``````\",\n" + "\"``aaaaa``\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time6 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"```a`````\",\n" + "\"```a`````\",\n" + "\"``a``````\",\n" + "\"``a``````\",\n" + "\"``aaaaa``\",\n" + "\"`a````a``\",\n" + "\"`a````a``\",\n" + "\"a````a```\",\n" + "\"a````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time7 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"````````a\",\n" + "\"````````a\",\n" + "\"```````a`\",\n" + "\"```````a`\",\n" + "\"`````````\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"`````````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time8 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"```a````a\",\n" + "\"```a````a\",\n" + "\"``a````a`\",\n" + "\"``a````a`\",\n" + "\"``aaaaa``\",\n" + "\"`a````a``\",\n" + "\"`a````a``\",\n" + "\"a````a```\",\n" + "\"a````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-time9 '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"````aaaaa\",\n" + "\"```a````a\",\n" + "\"```a````a\",\n" + "\"``a````a`\",\n" + "\"``a````a`\",\n" + "\"``aaaaa``\",\n" + "\"``````a``\",\n" + "\"``````a``\",\n" + "\"`````a```\",\n" + "\"`````a```\",\n" + "\"aaaaa````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-am '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"4 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"````\",\n" + "\"``aa\",\n" + "\"``aa\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\"\n" + "};\n")) + +(defconst xwem-time-xpm-dp '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"9 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"````a````\",\n" + "\"````a````\",\n" + "\"`````````\",\n" + "\"```a`````\",\n" + "\"```a`````\",\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"`````````\",\n" + "\"`````````\"\n" + "};\n")) + +(defconst xwem-time-xpm-pm '(concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"4 13 2 1\",\n" + "/* colors */\n" + "\"` c None s ledbg\",\n" + "\"a c " xwem-time-time-color " s ledfg\",\n" + "/* pixels */\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"````\",\n" + "\"aa``\",\n" + "\"aa``\",\n" + "\"````\"\n" + "};\n")) +;; load icons +(defconst xwem-time-xpm-load00 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 2 1\",\n" + "/* colors */\n" + "\"` s None c None\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"``````....\",\n" + "\"``````....\",\n" + "\"`````.....\",\n" + "\"`````.....\",\n" + "\"````......\",\n" + "\"````......\",\n" + "\"```.......\",\n" + "\"```.......\",\n" + "\"``........\",\n" + "\"``........\",\n" + "\"`.........\",\n" + "\"`.........\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load05 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 3 1,\"\n" + "\/* colors \*/\n" + "\"` s None c None\",\n" + "\"a c #0AB224\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"``````....\",\n" + "\"``````....\",\n" + "\"`````.....\",\n" + "\"`````.....\",\n" + "\"````......\",\n" + "\"````......\",\n" + "\"```.......\",\n" + "\"```.......\",\n" + "\"``........\",\n" + "\"``........\",\n" + "\"`.........\",\n" + "\"`aaaaaaaaa\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load10 (concat "/* XPM */" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 3 1\",\n" + "\/* colors \*/\n" + "\"` s None c None\",\n" + "\"a c #0AB224\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"``````....\",\n" + "\"``````....\",\n" + "\"`````.....\",\n" + "\"`````.....\",\n" + "\"````......\",\n" + "\"````......\",\n" + "\"```.......\",\n" + "\"```.......\",\n" + "\"``........\",\n" + "\"``aaaaaaaa\",\n" + "\"`.........\",\n" + "\"`aaaaaaaaa\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load15 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 4 1\",\n" + "/* colors */\n" + "\"` s None c None\",\n" + "\"a c #2AD244\",\n" + "\"b c #DEE614\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"``````....\",\n" + "\"``````....\",\n" + "\"`````.....\",\n" + "\"`````.....\",\n" + "\"````......\",\n" + "\"````......\",\n" + "\"```.......\",\n" + "\"```bbbbbbb\",\n" + "\"``........\",\n" + "\"``aaaaaaaa\",\n" + "\"`.........\",\n" + "\"`aaaaaaaaa\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load20 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 4 1\",\n" + "/* colors */\n" + "\"` s None c None\",\n" + "\"a c #0AB224\",\n" + "\"b c #DEE614\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"``````....\",\n" + "\"``````....\",\n" + "\"`````.....\",\n" + "\"`````.....\",\n" + "\"````......\",\n" + "\"````bbbbbb\",\n" + "\"```.......\",\n" + "\"```bbbbbbb\",\n" + "\"``........\",\n" + "\"``aaaaaaaa\",\n" + "\"`.........\",\n" + "\"`aaaaaaaaa\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load25 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 5 1\",\n" + "/* colors */\n" + "\"a s None c None\",\n" + "\"` c #FE0204\",\n" + "\"b c #0AB224\",\n" + "\"c c #DEE614\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"aaaaaa....\",\n" + "\"aaaaaa....\",\n" + "\"aaaaa.....\",\n" + "\"aaaaa`````\",\n" + "\"aaaa......\",\n" + "\"aaaacccccc\",\n" + "\"aaa.......\",\n" + "\"aaaccccccc\",\n" + "\"aa........\",\n" + "\"aabbbbbbbb\",\n" + "\"a.........\",\n" + "\"abbbbbbbbb\",\n" + "\"..........\"\n" + "};\n")) + +(defconst xwem-time-xpm-load30 (concat "/* XPM */\n" + "static char *noname[] = {\n" + "/* width height ncolors chars_per_pixel */\n" + "\"10 13 5 1\",\n" + "/* colors */\n" + "\"a s None c None\",\n" + "\"` c #FE0204\",\n" + "\"b c #0AB224\",\n" + "\"c c #DEE614\",\n" + "\". s pad-color c #606060\",\n" + "/* pixels */\n" + "\"aaaaaa....\",\n" + "\"aaaaaa````\",\n" + "\"aaaaa.....\",\n" + "\"aaaaa`````\",\n" + "\"aaaa......\",\n" + "\"aaaacccccc\",\n" + "\"aaa.......\",\n" + "\"aaaccccccc\",\n" + "\"aa........\",\n" + "\"aabbbbbbbb\",\n" + "\"a.........\",\n" + "\"abbbbbbbbb\",\n" + "\"..........\"\n" + "};\n")) + +;; Mail icons +(defconst xwem-time-xpm-letter (concat "/* XPM */\n" + "static char * jmail_xpm[] = {\n" + "\"18 13 4 1\",\n" + "\" s None c None\",\n" + "\". c gray85\",\n" + "\"X c yellow\",\n" + "\"o c black\",\n" + "\" \",\n" + "\" \",\n" + "\" .XXXXXXXXXXX. \",\n" + "\" XoXXXXXXXXXoXoo\",\n" + "\" XXoXXXXXXXoXXoo\",\n" + "\" XXXoXXXXXoXXXoo\",\n" + "\" XXX.oXXXo.XXXoo\",\n" + "\" XXXo.oXo.oXXXoo\",\n" + "\" XXoXXXoXXXoXXoo\",\n" + "\" XoXXXXXXXXXoXoo\",\n" + "\" .XXXXXXXXXXX.oo\",\n" + "\" ooooooooooooo\",\n" + "\" ooooooooooooo\"};\n")) + +(defconst xwem-time-xpm-no-letter (concat "/* XPM */\n" + "static char * jmail_xpm[] = {\n" + "\"18 13 4 1\",\n" + "\" s None c None\",\n" + "\". c gray55\",\n" + "\"o c black\",\n" + "\"x c gray95\",\n" + "\" \",\n" + "\" \",\n" + "\" ooooooooooooox \",\n" + "\" o.xxxxxxxxx.ox \",\n" + "\" oxox oxox \",\n" + "\" ox ox ox ox \",\n" + "\" ox ox ox ox \",\n" + "\" ox oxoxoxox ox \",\n" + "\" oxox ox oxox \",\n" + "\" o.x .ox \",\n" + "\" ooooooooooooox \",\n" + "\" xxxxxxxxxxxxxx \",\n" + "\" \"};\n")) + + + +;;; Functions +(defsubst xwem-time-get-image (win img-type img-name) + "In WIN's list of IMG-TYPE images get image with name IMG-NAME." + (plist-get (X-Win-get-prop win img-type) img-name)) + +(defsubst xwem-time-get-mask (win mask-type mask-name) + "In WIN's list of MASK-TYPE masks get mask with name MASK-NAME." + (plist-get (X-Win-get-prop win mask-type) mask-name)) + +(defsubst xwem-time-get-time-image (win name) + "In WIN's time images list get image with NAME." + (xwem-time-get-image win 'xwem-time-images name)) + +(defsubst xwem-time-get-time-mask (win name) + "In WIN's time masks list get mask with NAME." + (xwem-time-get-mask win 'xwem-time-masks name)) + +(defsubst xwem-time-get-load-image (win name) + "In WIN's load images list get image with NAME." + (xwem-time-get-image win 'xwem-load-images name)) + +(defsubst xwem-time-get-load-mask (win name) + "In WIN's load masks list get mask with NAME." + (xwem-time-get-mask win 'xwem-load-masks name)) + +(defsubst xwem-time-get-mail-image (win name) + "In WIN's mail images list get image with NAME." + (xwem-time-get-image win 'xwem-mail-images name)) + +(defsubst xwem-time-get-mail-mask (win name) + "In WIN's mail masks list get mask with NAME." + (xwem-time-get-mask win 'xwem-mail-masks name)) + +(defsubst xwem-time-put-image (win img-type img-name img-data) + (X-Win-put-prop win img-type + (plist-put (X-Win-get-prop win img-type) img-name img-data))) + +(defsubst xwem-time-put-time-image (win name img) + "In WIN's images list put parsed image with NAME. +Parsed image is IMG." + (xwem-time-put-image win 'xwem-time-images name img)) + +(defsubst xwem-time-put-load-image (win name img) + "In WIN's images list put parsed image with NAME. +Parsed image is IMG." + (xwem-time-put-image win 'xwem-load-images name img)) + +(defsubst xwem-time-put-mail-image (win name img) + "In WIN's images list put parsed image with NAME. +Parsed image is IMG." + (xwem-time-put-image win 'xwem-mail-images name img)) + +(defun xwem-time-clear-mask (win) + "Get WIN's mask pixmap and clear it's area." + (let ((xdpy (X-Win-dpy win)) + (mask-pix (X-Win-get-prop win 'mask-pixmap)) + mgc) + (setq mgc (XCreateGC xdpy mask-pix + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :foreground 0.0 + :background 1.0))) + (XFillRectangle xdpy mask-pix mgc 0 0 88 15) + (XFreeGC xdpy mgc))) + +(defun xwem-time-init (xdpy) + (let ((gc-cons-threshold most-positive-fixnum) ; inhibit gcing + win time-images load-images mail-images + time-masks load-masks mail-masks + mask-pix) + (setq win (XCreateWindow xdpy (XDefaultRootWindow xdpy) + 0 0 88 15 0 nil nil nil + (make-X-Attr :background-pixel (XWhitePixel xdpy) + :border-pixel (XBlackPixel xdpy) + :override-redirect t + ))) + + (setq time-images (list 'time0 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time0)) + 'time1 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time1)) + 'time2 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time2)) + 'time3 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time3)) + 'time4 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time4)) + 'time5 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time5)) + 'time6 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time6)) + 'time7 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time7)) + 'time8 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time8)) + 'time9 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time9)) + 'time-am (X:xpm-img-from-data xdpy (eval xwem-time-xpm-am)) + 'time-pm (X:xpm-img-from-data xdpy (eval xwem-time-xpm-pm)) + 'time-dp (X:xpm-img-from-data xdpy (eval xwem-time-xpm-dp)))) + (setq load-images (list 'load00 (X:xpm-img-from-data xdpy xwem-time-xpm-load00) + 'load05 (X:xpm-img-from-data xdpy xwem-time-xpm-load05) + 'load10 (X:xpm-img-from-data xdpy xwem-time-xpm-load10) + 'load15 (X:xpm-img-from-data xdpy xwem-time-xpm-load15) + 'load20 (X:xpm-img-from-data xdpy xwem-time-xpm-load20) + 'load25 (X:xpm-img-from-data xdpy xwem-time-xpm-load25) + 'load30 (X:xpm-img-from-data xdpy xwem-time-xpm-load30))) + (setq mail-images (list 'letter (X:xpm-img-from-data xdpy xwem-time-xpm-letter) + 'no-letter (X:xpm-img-from-data xdpy xwem-time-xpm-no-letter))) + + (X-Win-put-prop win 'xwem-time-images time-images) + (X-Win-put-prop win 'xwem-load-images load-images) + (X-Win-put-prop win 'xwem-mail-images mail-images) + + ;; Create masks + (setq time-masks (list 'time0 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time0) t) + 'time1 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time1) t) + 'time2 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time2) t) + 'time3 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time3) t) + 'time4 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time4) t) + 'time5 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time5) t) + 'time6 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time6) t) + 'time7 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time7) t) + 'time8 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time8) t) + 'time9 (X:xpm-img-from-data xdpy (eval xwem-time-xpm-time9) t) + 'time-am (X:xpm-img-from-data xdpy (eval xwem-time-xpm-am) t) + 'time-pm (X:xpm-img-from-data xdpy (eval xwem-time-xpm-pm) t) + 'time-dp (X:xpm-img-from-data xdpy (eval xwem-time-xpm-dp) t))) + (setq load-masks (list 'load00 (X:xpm-img-from-data xdpy xwem-time-xpm-load00 t) + 'load05 (X:xpm-img-from-data xdpy xwem-time-xpm-load05 t) + 'load10 (X:xpm-img-from-data xdpy xwem-time-xpm-load10 t) + 'load15 (X:xpm-img-from-data xdpy xwem-time-xpm-load15 t) + 'load20 (X:xpm-img-from-data xdpy xwem-time-xpm-load20 t) + 'load25 (X:xpm-img-from-data xdpy xwem-time-xpm-load25 t) + 'load30 (X:xpm-img-from-data xdpy xwem-time-xpm-load30 t))) + (setq mail-masks (list 'letter (X:xpm-img-from-data xdpy xwem-time-xpm-letter t) + 'no-letter (X:xpm-img-from-data xdpy xwem-time-xpm-no-letter t))) + + (X-Win-put-prop win 'xwem-time-masks time-masks) + (X-Win-put-prop win 'xwem-load-masks load-masks) + (X-Win-put-prop win 'xwem-mail-masks mail-masks) + + (setq mask-pix (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win 1 88 15)) + (setq xwem-time-mask-gc (XCreateGC xdpy mask-pix + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :function X-GXCopy + :foreground 1.0 + :background 0.0))) + (X-Win-put-prop win 'mask-pixmap mask-pix) + (xwem-time-clear-mask win) + + ;; Now create pixmaps + (let (depth gc mgc time-pix load-pix mail-pix) + (setq depth (XDefaultDepth xdpy)) + + (setq xwem-time-gc (XCreateGC xdpy win + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :function X-GXCopy))) + (setq gc xwem-time-gc) + (setq mgc xwem-time-mask-gc) + ;; Time + (setq time-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win depth 107 13) + (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win 1 107 13))) + (XImagePut xdpy gc (car time-pix) 0 0 (xwem-time-get-time-image win 'time0)) + (XImagePut xdpy gc (car time-pix) 9 0 (xwem-time-get-time-image win 'time1)) + (XImagePut xdpy gc (car time-pix) 18 0 (xwem-time-get-time-image win 'time2)) + (XImagePut xdpy gc (car time-pix) 27 0 (xwem-time-get-time-image win 'time3)) + (XImagePut xdpy gc (car time-pix) 36 0 (xwem-time-get-time-image win 'time4)) + (XImagePut xdpy gc (car time-pix) 45 0 (xwem-time-get-time-image win 'time5)) + (XImagePut xdpy gc (car time-pix) 54 0 (xwem-time-get-time-image win 'time6)) + (XImagePut xdpy gc (car time-pix) 63 0 (xwem-time-get-time-image win 'time7)) + (XImagePut xdpy gc (car time-pix) 72 0 (xwem-time-get-time-image win 'time8)) + (XImagePut xdpy gc (car time-pix) 81 0 (xwem-time-get-time-image win 'time9)) + (XImagePut xdpy gc (car time-pix) 90 0 (xwem-time-get-time-image win 'time-dp)) + (XImagePut xdpy gc (car time-pix) 99 0 (xwem-time-get-time-image win 'time-am)) ; 4 pixels width + (XImagePut xdpy gc (car time-pix) 103 0 (xwem-time-get-time-image win 'time-pm)) ; 4 pixels width + + (XImagePut xdpy mgc (cdr time-pix) 0 0 (xwem-time-get-time-mask win 'time0)) + (XImagePut xdpy mgc (cdr time-pix) 9 0 (xwem-time-get-time-mask win 'time1)) + (XImagePut xdpy mgc (cdr time-pix) 18 0 (xwem-time-get-time-mask win 'time2)) + (XImagePut xdpy mgc (cdr time-pix) 27 0 (xwem-time-get-time-mask win 'time3)) + (XImagePut xdpy mgc (cdr time-pix) 36 0 (xwem-time-get-time-mask win 'time4)) + (XImagePut xdpy mgc (cdr time-pix) 45 0 (xwem-time-get-time-mask win 'time5)) + (XImagePut xdpy mgc (cdr time-pix) 54 0 (xwem-time-get-time-mask win 'time6)) + (XImagePut xdpy mgc (cdr time-pix) 63 0 (xwem-time-get-time-mask win 'time7)) + (XImagePut xdpy mgc (cdr time-pix) 72 0 (xwem-time-get-time-mask win 'time8)) + (XImagePut xdpy mgc (cdr time-pix) 81 0 (xwem-time-get-time-mask win 'time9)) + (XImagePut xdpy mgc (cdr time-pix) 90 0 (xwem-time-get-time-mask win 'time-dp)) + (XImagePut xdpy mgc (cdr time-pix) 99 0 (xwem-time-get-time-mask win 'time-am)) ; 4 pixels width + (XImagePut xdpy mgc (cdr time-pix) 103 0 (xwem-time-get-time-mask win 'time-pm)) ; 4 pixels width + (X-Win-put-prop win 'time-pixmap time-pix) + + ;; Load + (setq load-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win depth 70 13) + (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win 1 70 13))) + (XImagePut xdpy gc (car load-pix) 0 0 (xwem-time-get-load-image win 'load00)) + (XImagePut xdpy gc (car load-pix) 10 0 (xwem-time-get-load-image win 'load05)) + (XImagePut xdpy gc (car load-pix) 20 0 (xwem-time-get-load-image win 'load10)) + (XImagePut xdpy gc (car load-pix) 30 0 (xwem-time-get-load-image win 'load15)) + (XImagePut xdpy gc (car load-pix) 40 0 (xwem-time-get-load-image win 'load20)) + (XImagePut xdpy gc (car load-pix) 50 0 (xwem-time-get-load-image win 'load25)) + (XImagePut xdpy gc (car load-pix) 60 0 (xwem-time-get-load-image win 'load30)) + + (XImagePut xdpy mgc (cdr load-pix) 0 0 (xwem-time-get-load-mask win 'load00)) + (XImagePut xdpy mgc (cdr load-pix) 10 0 (xwem-time-get-load-mask win 'load05)) + (XImagePut xdpy mgc (cdr load-pix) 20 0 (xwem-time-get-load-mask win 'load10)) + (XImagePut xdpy mgc (cdr load-pix) 30 0 (xwem-time-get-load-mask win 'load15)) + (XImagePut xdpy mgc (cdr load-pix) 40 0 (xwem-time-get-load-mask win 'load20)) + (XImagePut xdpy mgc (cdr load-pix) 50 0 (xwem-time-get-load-mask win 'load25)) + (XImagePut xdpy mgc (cdr load-pix) 60 0 (xwem-time-get-load-mask win 'load30)) + (X-Win-put-prop win 'load-pixmap load-pix) + + ;; Mail + (setq mail-pix (cons (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win depth 36 13) + (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + win 1 36 13))) + (XImagePut xdpy gc (car mail-pix) 0 0 (xwem-time-get-mail-image win 'letter)) + (XImagePut xdpy gc (car mail-pix) 18 0 (xwem-time-get-mail-image win 'no-letter)) + + (XImagePut xdpy mgc (cdr mail-pix) 0 0 (xwem-time-get-mail-mask win 'letter)) + (XImagePut xdpy mgc (cdr mail-pix) 18 0 (xwem-time-get-mail-mask win 'no-letter)) + (X-Win-put-prop win 'mail-pixmap mail-pix) + + ) + + win)) + +;; Offsets calculators +(defsubst xwem-time-time-offset (num) + (* num 9)) +(defsubst xwem-time-timeam-offset () + (* 10 9)) +(defsubst xwem-time-timepm-offset () + (+ (* 10 9) 4)) + +(defsubst xwem-time-load-offset (load) + (truncate (* load 20))) + +(defsubst xwem-time-mail-offset (letter-p) + (if letter-p 0 18)) + +;; Showers +(defun xwem-time-show (win x y type x-off y-off width height) + (let ((pixmap (X-Win-get-prop win type)) + (mask-pixmap (X-Win-get-prop win 'mask-pixmap))) + + (let* ((xdpy (X-Pixmap-dpy mask-pixmap))) + (XSelectInput xdpy win (apply 'Xmask-or (delete XM-Exposure xwem-time-window-mask))) + + (XCopyArea xdpy (cdr pixmap) mask-pixmap xwem-time-mask-gc + x-off y-off width height x y) + (X-XShapeMask xdpy win X-XShape-Bounding X-XShapeSet 0 0 mask-pixmap) + (XCopyArea (X-Win-dpy win) (car pixmap) win xwem-time-gc + x-off y-off width height x y) + + (XSelectInput xdpy win (apply 'Xmask-or xwem-time-window-mask)) + ))) + +(defsubst xwem-time-show-time0 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 0 0 9 13)) + +(defsubst xwem-time-show-time1 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 9 0 9 13)) + +(defsubst xwem-time-show-time2 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 18 0 9 13)) + +(defsubst xwem-time-show-time3 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 27 0 9 13)) + +(defsubst xwem-time-show-time4 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 36 0 9 13)) + +(defsubst xwem-time-show-time5 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 45 0 9 13)) + +(defsubst xwem-time-show-time6 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 54 0 9 13)) + +(defsubst xwem-time-show-time7 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 63 0 9 13)) + +(defsubst xwem-time-show-time8 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 72 0 9 13)) + +(defsubst xwem-time-show-time9 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 81 0 9 13)) + +(defsubst xwem-time-show-time-dp (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 90 0 9 13)) + +(defsubst xwem-time-show-time-am (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 99 0 4 13)) + +(defsubst xwem-time-show-time-pm (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'time-pixmap 103 0 4 13)) + +(defsubst xwem-time-show-load-00 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 0 0 10 13)) + +(defsubst xwem-time-show-load-05 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 10 0 10 13)) + +(defsubst xwem-time-show-load-10 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 20 0 10 13)) + +(defsubst xwem-time-show-load-15 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 30 0 10 13)) + +(defsubst xwem-time-show-load-20 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 40 0 10 13)) + +(defsubst xwem-time-show-load-25 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 50 0 10 13)) + +(defsubst xwem-time-show-load-30 (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'load-pixmap 60 0 10 13)) + +(defsubst xwem-time-show-letter (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'mail-pixmap 00 0 18 13)) + +(defsubst xwem-time-show-no-letter (win x y) + "Show 0 at WIN's X Y." + (xwem-time-show win x y 'mail-pixmap 18 0 18 13)) + +(defun xwem-time-show-load (win x y load-string) + "In WIN at X Y show load average represented by LOAD-STRING. +Return how many pixels used." + (let ((load-number (string-to-number load-string)) + (alist (list (cons "00" 0.0) + (cons "05" (car xwem-time-load-list)) + (cons "10" (cadr xwem-time-load-list)) + (cons "15" (caddr xwem-time-load-list)) + (cons "20" (cadddr xwem-time-load-list)) + (cons "25" (cadr (cdddr xwem-time-load-list))) + (cons "30" (caddr (cdddr xwem-time-load-list))) + (cons "100000" 100000))) + elem load-elem) + (while (>= load-number (cdr (setq elem (pop alist)))) + (setq load-elem elem)) + (funcall (intern-soft (concat "xwem-time-show-load-" (car load-elem))) win x y)) + 10) + +(defun xwem-time-show-time (win x y time-string) + "In WIN at X Y show time represented by TIME-STRING. +Return how may pixels used." + (let ((off 0) + el) + (while (> (length time-string) 0) + (setq el (substring time-string 0 1)) + (cond ((string= el ":") + (xwem-time-show-time-dp win (+ x off) y) + (setq off (+ off 9))) + ((string= el "a") + (xwem-time-show-time-am win (+ x off) y) + (setq off (+ off 4))) + ((string= el "p") + (xwem-time-show-time-pm win (+ x off) y) + (setq off (+ off 4))) + ((string= el " ") + (setq off (+ off 9))) + (t (funcall (intern-soft (concat "xwem-time-show-time" el)) win (+ x off) y) + (setq off (+ off 9)))) + (setq time-string (substring time-string 1))) + off)) + +(defun xwem-time-show-mail (win x y mail) + "In WIN at X Y show current mail status. +Return how many pixels used." + (if mail + (xwem-time-show-letter win x y) + (xwem-time-show-no-letter win x y)) + 18) + +(defun xwem-time-win-update (win) + "Show current time at X Y." + (let* ((now (current-time)) + (nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) + (time (substring (current-time-string now) 11 16)) + (load (condition-case () + (if (zerop (car (load-average))) "" + (let ((str (format " %03d" (car (load-average))))) + (concat (substring str 0 -2) "." (substring str -2)))) + (error ""))) + (mail-spool-file (or display-time-mail-file + (getenv "MAIL") + (concat rmail-spool-directory + (user-login-name)))) + (mail (and (stringp mail-spool-file) + (or (null display-time-server-down-time) + ;; If have been down for 20 min, try again. + (> (- (+ (nth 1 now) nowhigh) + display-time-server-down-time) + 1200)) + (let ((start-time (current-time))) + (prog1 + (display-time-file-nonempty-p mail-spool-file) + (setq now (current-time) + nowhigh (* (- (nth 0 now) (* (/ (nth 0 now) 10) 10)) 65536)) + (if (> (- (+ (nth 1 now) nowhigh) + (+ (nth 1 start-time) + (* (- (nth 0 start-time) (* (/ (nth 0 start-time) 10) 10)) 65536))) + 20) + ;; Record that mail file is not accessible. + (setq display-time-server-down-time + (+ (nth 1 now) nowhigh)) + ;; Record that mail file is accessible. + (setq display-time-server-down-time nil)))))) + off) + + (X-Dpy-send-excursion (X-Win-dpy win) + (xwem-time-clear-mask win) + (setq off (+ 5 (xwem-time-show-time win 0 0 time))) + (setq off (+ off 5 (xwem-time-show-load win off 0 load))) + (xwem-time-show-mail win off 0 mail)) + )) + +(defun xwem-time-event-handler (xdpy win xev) + "On display XDPY and window WIN handle event XEV." + (X-Event-CASE xev + (:X-Expose + (xwem-time-win-update win)) + + (:X-DestroyNotify + (xwem-message 'info "xwem-time: destroy-notify") + (delete-itimer "xwem-time")) + + (:X-ButtonPress + (xwem-message 'info "xwem-time: ButtonPress")) + (:X-ButtonRelease + (xwem-message 'info "xwem-time: ButtonRelease")) + + )) + +(defun xwem-time (&optional dpyname) + "Start xwem time window in system tray." + (let ((xdpy (XOpenDisplay (or dpyname (getenv "DISPLAY"))))) + (unless (X-Dpy-p xdpy) + (error "Can't open display")) + + (setq xwem-time-window + (xwem-time-init xdpy)) + + (unless (X-Win-p xwem-time-window) + (error "Can't create xwem time window")) + + (XSelectInput xdpy xwem-time-window (apply 'Xmask-or xwem-time-window-mask)) + (X-Win-EventHandler-add xwem-time-window 'xwem-time-event-handler nil + (list X-Expose X-ButtonPress X-ButtonRelease + X-DestroyNotify)) + + (XTrayInit xdpy xwem-time-window) + + ;; Wait for Exposure event + (while (not (X-Event-p + (XIfEvent xdpy (lambda (xev) + (and (equal (X-Event-win xev) xwem-time-window) + (= (X-Event-type xev) X-Expose))))))) + + (xwem-time-win-update xwem-time-window) + + (start-itimer "xwem-time" 'xwem-time-win-update + xwem-time-interval xwem-time-interval nil t xwem-time-window) + )) + + +(provide 'xwem-time) + +;;; xwem-time.el ends here diff --git a/lisp/xwem-clients.el b/lisp/xwem-clients.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWNsaWVudHMuZWw= --- /dev/null +++ b/lisp/xwem-clients.el @@ -0,0 +1,1464 @@ +;;; xwem-clients.el --- Clients manage. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 2 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; This file used to manage X clients windows(move/resize/configure). +;; +;; Client window is vector in form: +;; [XWEM-Client (win) (xwem-win) (mw-hints-list) (cfg) +;; (graphical contexts) manda-element state (transients-list)] +;; +;; STATE is one of: 'managed 'demanaged or 'unknown +;; +;;; Code + +(eval-when-compile + ;; Shutup compiler + (require 'xwem-macros) + (defvar iswitchb-buflist nil) + (autoload 'subtract-time "time-date") + (autoload 'iswitchb-read-buffer "iswitchb") + ) + +;;; Variables +(defgroup xwem-cl nil + "Group to customize XWEM Clients handling." + :prefix "xwem-cl-" + :group 'xwem) + +(defcustom xwem-cl-other-strategy 'samewin + "*Strategy to be used to select other CL. +One of 'any 'samewin 'sameframe. +TODO: add more strategies." + :type '(choice (const :tag "Same Window" samewin) + (const :tag "Same Frame" sameframe) + (const :tag "Any" any)) + :group 'xwem-cl) + +(defcustom xwem-cl-other-on-split t + "Non-nil mean manage other client when split occurs in new window. +Minor mode." + :type 'boolean + :group 'xwem-cl) + +(defcustom xwem-cl-use-set-focus t + "*Non-nil mean that managed clients takes focus. +NOTE: installs hook into `xwem-cl-manage-hook'." + :type 'boolean + :group 'xwem-cl) + +(defcustom xwem-cl-use-recent-cl-on-top nil + "*Non-nil mean that most recent client is on top in `xwem-clients' list." + :type 'boolean + :group 'xwem-cl) + +(defcustom xwem-cl-new-client-hook nil + "Hook to call when managing new client." + :type 'hook + :group 'xwem-cl) + +(defcustom xwem-cl-mark-ring-max 16 + "*Maximum size of `xwem-cl-mark-ring'. +Start discarding off end if gets this big." + :type 'number + :group 'xwem-cl) + +;;;###autoload +(defcustom xwem-cl-manage-hook nil + "*Hooks to be called with just setuped CL as argument." + :type 'hook + :group 'xwem-hooks) + +;;;###autoload +(defcustom xwem-cl-demanage-hook nil + "*Hooks to be called with just desetuped CL as argument." + :type 'hook + :group 'xwem-hooks) + +;;;###autoload +(defcustom xwem-cl-state-change-hook nil + "*Hooks to run when state of client changes. +Every hook called with three args - CL OLD-STATE NEW-STATE." + :type 'hook + :group 'xwem-hooks) + +;;;###autoload +(defvar xwem-clients nil "Clients Windows list") + +;;;###autoload +(defvar xwem-cl-mark-ring nil + "The list of marked clients.") + +;;;###autoload +(defstruct xwem-hints + ;; TODO: add more + wm-normal-hints + wm-hints + wm-class + wm-command + wm-name + wm-transient-for + wm-protocols) + +;;;###autoload +(defconst xwem-client-ev-mask (Xmask-or XM-ColormapChange + XM-PropertyChange + XM-FocusChange + XM-EnterWindow + XM-LeaveWindow + XM-StructureNotify + XM-ResizeRedirect) + "Event mask for xwem's client.") + +;;;###autoload +(defstruct (xwem-cl (:predicate xwem-iscl-p)) + xwin ; X-Win + saved-name ; saved WM_NAME + xgeom ; X-Geom etry for cl + xattrs ; X-Attr ibutes + + win ; xwem-win dow + hints ; xwem-hints + manda ; xwem-manda entry + transient-for ; non-nil if client is transient for window + (ev-mask xwem-client-ev-mask) ; event mask for certain client + + (state 'unknown) ; state of client, 'managed, 'iconified, 'unknown, etc + start-time ; start-time + recency ; last time when CL was active + translist ; list of transient-for windows for this client + + tabitem ; reference to tab item + plist ; user defined plist + ) + + +;;; Functions +;;;###autoload +(defun xwem-cl-p (cl &optional sig) + "Returns t if CL is XWEM client window." + (let ((iscl (xwem-iscl-p cl))) + (if (and (not iscl) sig) + (signal 'wrong-type-argument (list sig 'xwem-cl-p cl)) + iscl))) + +;;;###autoload +(defun xwem-cl-marked-p (cl) + "Return non-nil if client CL is marked, i.e. in `xwem-cl-mark-ring' list." + (member cl xwem-cl-mark-ring)) + +;;;###autoload +(defsubst xwem-cl-put-prop (cl prop val) + "In CL's property list put property PROP with value VAL." + (setf (xwem-cl-plist cl) (plist-put (xwem-cl-plist cl) prop val))) + +;;;###autoload +(defsubst xwem-cl-get-prop (cl prop) + "From CL's property list get property PROP." + (plist-get (xwem-cl-plist cl) prop)) + +;;;###autoload +(defsubst xwem-cl-rem-prop (cl prop) + "From CL's property list remove property PROP." + (setf (xwem-cl-plist cl) (plist-remprop (xwem-cl-plist cl) prop))) + +;;;###autoload +(defun xwem-client-name (cl &optional clist) + "Returns unique name for CL. +If CLIST is ommited, `xwem-clients' will be used. +If CL is string, return it." + (if (stringp cl) + cl + (let ((cll (or clist xwem-clients)) + (cln (xwem-hints-wm-name (xwem-cl-hints cl))) + (cnt 0)) + (while cll + (cond ((string= (xwem-hints-wm-name (xwem-cl-hints (car cll))) cln) + (if (eq cl (car cll)) + (setq cll nil) + (setq cnt (1+ cnt)))) + (t nil)) + (setq cll (cdr cll))) + (if (> cnt 0) + (format "%s<%d>" cln cnt) + cln)))) + +;;;###autoload +(defun xwem-find-client (win-or-id) + "Find WIN-OR-ID in client windows list. +WIN-OR-ID can be X-Win or id of window." + (let ((winid (if (X-Win-p win-or-id) (X-Win-id win-or-id) win-or-id)) + (cl xwem-clients) + (rc nil)) + (while cl + (if (= (X-Win-id (xwem-cl-xwin (car cl))) winid) + (progn + (setq rc (car cl)) + (setq cl nil)) + (setq cl (cdr cl)))) + rc)) + +;;;###autoload +(defun xwem-remove-client (cl) + "Delete WIN from clients list." +; (when (X-Win-p (xwem-cl-xwin cl)) +; (X-Win-invalidate (xwem-cl-xwin cl))) + (setq xwem-clients (delete cl xwem-clients))) + +(defun xwem-cl-do-gravity (cl step) + "Gravity changing." + ) + +;;;###autoload +(defun xwem-cl-send-config (cl) + "Send config info to window." + (xwem-cl-p cl 'xwem-cl-send-config) + + (let ((clgeom (xwem-cl-xgeom cl)) + (win (xwem-cl-xwin cl))) + + (XSendEvent (xwem-dpy) win nil XM-StructureNotify + (X-Create-message + (list [1 X-ConfigureNotify] ;type + [1 nil] ;detail + [2 2806] ;seq + [4 (X-Win-id win)] ;event + [4 (X-Win-id win)] ;window + [4 X-None] ;above sibling + (vector 2 (X-Geom-x clgeom)) ; shutup compiler + [2 (X-Geom-y clgeom)] + [2 (X-Geom-width clgeom)] + [2 (X-Geom-height clgeom)] + [2 (X-Geom-border-width clgeom)] ;XXX + [1 nil] ;pad override + [1 nil] ;pad + ))) + )) + + +;; cl predicates +;;;###autoload +(defun xwem-cl-inwin-p (cl) + "Return non-nil if CL is currently displayed in some xwem's window." + (xwem-cl-p cl 'xwem-cl-inwin-p) + (and (xwem-win-p (xwem-cl-win cl)) + (eq cl (xwem-win-cl (xwem-cl-win cl))))) + +(defun xwem-cl-alive-p (cl) + "Return non-nil if CL is alive i.e. in `xwem-clients' list." + (memq cl xwem-clients)) + +(defun xwem-cl-exclude-p (cl) + "Return non-nil if CL should be excluded from clients list." + (and (xwem-cl-manda cl) (xwem-manda-exclude-p (xwem-cl-manda cl)))) + + +;;;###autoload +(defun xwem-cl-normal-list (clients &optional predic) + "Return list of normal clients. +CLIENTS is list of xwem clients frome which we should exclude. +If PREDIC given it will be called on each client and should return nil to exclude client." + (let ((cls nil)) + (while clients + (when (and (not (xwem-cl-exclude-p (car clients))) + (if predic (funcall predic (car clients)) t)) + (setq cls (nconc cls (list (car clients))))) + (setq clients (cdr clients))) + cls)) + +(defun xwem-cl-other (cl &optional visible) + "Return other xwem's client from list of clients where is CL. +Clients not visible in window are preferred to visible, unless VISIBLE +is non-nil. Special clients excluded. + +If CL is not actually xwem client, nil returned." + (if (xwem-cl-p cl) + (let ((cll (cond ((eq xwem-cl-other-strategy 'any) xwem-clients) + + ((eq xwem-cl-other-strategy 'samewin) + (xwem-win-make-cl-list-sort-by-recency (xwem-cl-win cl))) + + ((eq xwem-cl-other-strategy 'sameframe) + (xwem-frame-make-cl-list (xwem-cl-frame cl))) + + (t xwem-clients))) + (rcl nil) + (notgoodcl nil)) ;not so good candidate as rcl + + (while cll + (when (not (eq (car cll) cl)) ;skip ourself + (if (and (not (xwem-cl-exclude-p (car cll))) + (or visible (not (xwem-cl-inwin-p (car cll))))) + (progn + (setq rcl (car cll)) + (setq cll nil)) + + (when (and visible (null notgoodcl)) + (setq notgoodcl (car cll))))) + (setq cll (cdr cll))) + + (or rcl notgoodcl)) + + ;; [else] invalid CL + nil)) + +(defun xwem-cl-bury (cl) + "Put CL to the and of clients list. +Maybe used in `xwem-cl-manage-hook' or `xwem-cl-demanage-hook'." + (setq xwem-clients + (nconc (delete cl xwem-clients) (list cl))) + nil) ; continue hooks processing + + +;;; Manda functions begin +;;;###autoload +(defun xwem-cl-correct-size-for-size (cl new-geom &optional x-type y-type) + "Make CL's geometry as close to NEW-GEOM as possible. +X-TYPE is one of 'center 'left or 'right, default is 'center. +Y-TYPE is one of 'center 'top or 'bottom, default is 'center." + (let* ((hthi (X-Geom-border-width new-geom)) + (clgmt (xwem-cl-xgeom cl)) + (wi-rmd 0) + (he-rmd 0) + wmnh bw bh wi-st he-st wi he) + + (setq he (- (X-Geom-height new-geom) (* 2 hthi))) + (setq wi (- (X-Geom-width new-geom) (* 2 hthi))) + + (setq wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl))) + + (when wmnh + (setq bw (X-WMSize-width wmnh)) + (setq bh (X-WMSize-height wmnh)) + + (when (X-WMSize-presizeinc-p wmnh) + (setq wi-st (X-WMSize-width-inc wmnh)) ;width step + (setq he-st (X-WMSize-height-inc wmnh)) ;height step + ) + + ;; - Calculate size reminders + ;; - Adjust wi-rmd and he-rmd if needed + (when wi-st + (setq wi-rmd (% (abs (- wi bw)) wi-st)) + (when (> bw wi) + (setq wi-rmd (- wi-st wi-rmd)))) + + (when he-st + (setq he-rmd (% (abs (- he bh)) he-st)) + (when (> bh he) + (setq he-rmd (- he-st he-rmd))))) + + (unless (X-Geom-p clgmt) + (setf (xwem-cl-xgeom cl) (make-X-Geom)) + (setq clgmt (xwem-cl-xgeom cl))) + + ;; Now adjust geometry according to X-TYPE and Y-TYPE layout + (cond ((eq x-type 'left) + (setf (X-Geom-x clgmt) (X-Geom-x new-geom))) + ((eq x-type 'right) + (setf (X-Geom-x clgmt) (+ (X-Geom-x new-geom) hthi wi-rmd))) + (t ; 'center or any other + (setf (X-Geom-x clgmt) (+ (X-Geom-x new-geom) hthi (/ wi-rmd 2))))) + (cond ((eq y-type 'top) + (setf (X-Geom-y clgmt) (X-Geom-y new-geom))) + ((eq y-type 'bottom) + (setf (X-Geom-y clgmt) (+ (X-Geom-y new-geom) hthi he-rmd))) + (t + (setf (X-Geom-y clgmt) (+ (X-Geom-y new-geom) hthi (/ he-rmd 2))))) + (setf (X-Geom-width clgmt) (- wi wi-rmd)) + (setf (X-Geom-height clgmt) (- he he-rmd)))) + +(defun xwem-cl-correct-size (cl) + "Corect CL's xgeom according to WM_NORMAL_HINTS and other stuff." + (let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl))) + (clgeom (xwem-cl-xgeom cl))) + (when (xwem-cl-transient-for cl) + ;; Program specified size + (when (X-WMSize-ussize-p wmnh) + (setf (X-Geom-width clgeom) (X-WMSize-width wmnh)) + (setf (X-Geom-height clgeom) (X-WMSize-height wmnh))) + + ;; Program specified position + (when (X-WMSize-uspos-p wmnh) + (setf (X-Geom-x clgeom) (X-WMSize-x wmnh)) + (setf (X-Geom-y clgeom) (X-WMSize-y wmnh))) + ))) + +(defun xwem-cl-manage (cl &optional sfwin) + "Setup CL to be used in SFWIN. +If SFWIWN is ommited `xwem-win-selected' will be used. +TODO: Handle special clients in different way." + (xwem-cl-p cl 'xwem-cl-manage) + (when sfwin + (xwem-win-p sfwin 'xwem-cl-manage)) + + (let ((old-win (xwem-cl-win cl)) + (xwem-win (or sfwin (xwem-win-selected)))) + ;; XXX -- should we check is window already setuped? + (if (eq (xwem-win-cl xwem-win) cl) + ;; CL already in XWEM-WIN - only refiting needed + (xwem-manda-fun-run (xwem-cl-manda cl) 'refit cl) + + ;; else CL in some other window + (let ((old-cl (xwem-win-cl xwem-win))) + ;; When client moves from frame to other frame, state should + ;; be unknown + (when (not (eq (xwem-cl-frame cl) + (xwem-win-frame xwem-win))) + (xwem-client-change-state cl 'unknown)) + + ;; First of all demanage client CL + (unless (eq old-win xwem-win) + (let ((xwem-cl-demanage-hook nil)) + (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl))) + + (setf (xwem-cl-win cl) xwem-win) + (setf (xwem-win-cl (xwem-cl-win cl)) cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'refit cl t) + + (xwem-client-show cl) + + ;; Demanage client which is currently in XWEM-WIN + (when (xwem-cl-p old-cl) + (xwem-manda-fun-run (xwem-cl-manda old-cl) 'demanage old-cl)) + + ;; Regeom tabbers if client moves from other window + (unless (eq old-win xwem-win) + (when (xwem-win-p old-win) + (xwem-tabber-regeom-window old-win (xwem-win-selected-p old-win (xwem-win-frame old-win)))) + (when (xwem-win-p xwem-win) + (xwem-tabber-regeom-window xwem-win (xwem-win-selected-p xwem-win (xwem-win-frame xwem-win))))) + )) + + ;; Update recency field + (setf (xwem-cl-recency cl) (current-time)) + + ;; Finally run hooks + (run-hook-with-args 'xwem-cl-manage-hook cl) + )) + +(defun xwem-cl-demanage (cl &optional winclr clclr) + "Desetup CL from xwem win. +Used when deleting window or frame. +When CLEAR is non-nil then xwem window client for CL will be setted to nil." + (xwem-client-hide cl 'managed) + + (when (and winclr (xwem-cl-win cl)) + (setf (xwem-win-cl (xwem-cl-win cl)) nil)) + (when (and clclr (xwem-cl-p cl)) + (setf (xwem-cl-win cl) nil)) + + ;; Try to manage other xwem-client + (let* ((vis-p (xwem-cl-inwin-p cl)) + (old-win (if vis-p (xwem-cl-win cl) nil)) + (oth-cl (if vis-p (xwem-cl-other cl) nil))) + + ;; Switch to other client in old CL's window + (when (xwem-win-p old-win) + (setf (xwem-win-cl old-win) nil) + (if (xwem-cl-p oth-cl) + (xwem-manda-fun-run (xwem-cl-manda oth-cl) 'manage oth-cl old-win) + (setf (xwem-win-cl old-win) nil)) + )) + + ;; Now run hooks + (run-hook-with-args 'xwem-cl-demanage-hook cl) + ) + +(defun xwem-cl-refit (cl &optional need-reparent) + "Refit CL in its window frame. +If NEED-REPARENT is non-nil than also reparent it to some frame." + (xwem-win-p (xwem-cl-win cl) 'xwem-cl-refit) + + (let* ((frame (xwem-cl-frame cl)) + (xwem-win (xwem-cl-win cl)) + (swwidth (xwem-face-tag 'xwem-face-frame-selected-win-selected :line-width)) + (nwwidth (xwem-face-tag 'xwem-face-frame-selected-win-nonselected :line-width)) + (hthi (max (if (numberp swwidth) swwidth 0) + (if (numberp nwwidth) nwwidth 0))) + (clgmt (xwem-cl-xgeom cl)) + (wi-rmd 0) + (he-rmd 0) + wmnh bw bh wi-st he-st wi he) + + (setq he (- (xwem-win-height xwem-win) (* 2 hthi))) + (setq wi (- (xwem-win-width xwem-win) (* 2 hthi))) + + (setq wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl))) + (X-Dpy-log (xwem-dpy) "Get wmnh = %S\n" 'wmnh) + (when wmnh + (setq bw (X-WMSize-width wmnh)) + (setq bh (X-WMSize-height wmnh)) + + (when (X-WMSize-presizeinc-p wmnh) + (setq wi-st (X-WMSize-width-inc wmnh)) ;width step + (setq he-st (X-WMSize-height-inc wmnh)) ;height step + ) + + ;; - Calculate size reminders + ;; - Adjust wi-rmd and he-rmd if needed + (when wi-st + (setq wi-rmd (% (abs (- wi bw)) wi-st)) + (when (> bw wi) + (setq wi-rmd (- wi-st wi-rmd)))) + + (when he-st + (setq he-rmd (% (abs (- he bh)) he-st)) + (when (> bh he) + (setq he-rmd (- he-st he-rmd))))) + + (unless (X-Geom-p clgmt) + (setf (xwem-cl-xgeom cl) (make-X-Geom)) + (setq clgmt (xwem-cl-xgeom cl))) + + (setf (X-Geom-x clgmt) (+ (xwem-win-x xwem-win) hthi (/ wi-rmd 2))) + (setf (X-Geom-y clgmt) (+ (xwem-win-y xwem-win) hthi (/ he-rmd 2))) + (setf (X-Geom-width clgmt) (- wi wi-rmd)) + (setf (X-Geom-height clgmt) (- he he-rmd)) + + (if need-reparent + (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) + (xwem-frame-xwin frame) + (X-Geom-x clgmt) (X-Geom-y clgmt)) + + (XMoveWindow (xwem-dpy) (xwem-cl-xwin cl) (X-Geom-x clgmt) (X-Geom-y clgmt))) + + (X-Dpy-log (xwem-dpy) "Get size: wi=%d,%d he=%d,%d\n" 'wi '(X-Geom-width clgmt) 'he '(X-Geom-height clgmt)) + (XResizeWindow (xwem-dpy) (xwem-cl-xwin cl) + (X-Geom-width clgmt) (X-Geom-height clgmt)) + + (xwem-cl-send-config cl) + )) + +;; I think special CLs should be handled in very different way then +;; normals. It is the one of things TODO. +;; +(defun xwem-cl-iconify (cl &optional clear) + "Iconify CL. Used to handle Iconify ClientMessage from special CL." + ;; XXX + (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl clear) + (xwem-client-change-state cl 'iconified) + ) + +(define-xwem-command xwem-client-iconify (cl) + "Iconifies selected client." + (xwem-interactive (list (xwem-cl-selected))) + + (if (xwem-cl-p cl) + (let ((win (xwem-cl-win cl))) + (xwem-cl-iconify cl nil) + (setf (xwem-cl-win cl) nil) + (xwem-tabber-regeom-window win (xwem-win-selected-p win (xwem-win-frame win)))) + + (xwem-message 'warn "No client in selected window."))) + +;;; Manda functions ends here + +(defun xwem-cl-query-cl (prompt &optional predic) + "Query for CL, using XWEM's minibuffer. +PREDIC is function, wich passed with cl as argument and must return +non-nil to make cl be in listing." + (xwem-under-minib-focus + (let* ((rcl nil) + (clsnl (xwem-cl-normal-list xwem-clients predic)) + (clns (mapcar + (lambda (cl) + (cons (xwem-client-name cl clsnl) cl)) + clsnl)) + (name (flet ((iswitchb-make-buflist + (default) + (setq iswitchb-buflist (mapcar (lambda (cl) (car cl)) clns)))) + (iswitchb-read-buffer prompt)))) + + (while clns + (when (string= (caar clns) name) + (setq rcl (cdar clns)) + (setq clns nil)) + (setq clns (cdr clns))) + rcl))) + +(define-xwem-command xwem-cl-switch (arg) + "Interactively switch to some client window, using 'iswitchb. +When used with prefix ARG, then filter clients to selected widow only." + (xwem-interactive "P") + + (let* ((pred (when arg + (lambda (cl) + (eq (xwem-cl-win cl) (xwem-win-selected))))) + (cl (xwem-read-client (if arg "XWEM-CL win: " + "XWEM-CL: ") + pred))) + (when cl + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl)) + )) + +(define-xwem-command xwem-cl-switch-other-win (cl &optional arg) + "Switch to CL in other window. +When used with prefix ARG, then focuse to that other window." + (xwem-interactive "cXWEM-CL Other: \nP") + + (let ((wn (xwem-win-next (xwem-win-selected))) + (xwem-cl-manage-hook nil)) ; skip setup hooks + + (when cl + (when (xwem-win-only-one-p (xwem-win-selected)) + (xwem-frame-split-vert nil) + (setq wn (xwem-win-next (xwem-win-selected)))) + + (when wn + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl wn) + + (when arg + (xwem-window-select wn))) + ))) + +(define-xwem-command xwem-cl-switch-other-frame (cl &optional arg) + "Switch to CL in other XWEM frame. +When used with prefix ARG, then create embedded frame, if creation is +needed at all." + (xwem-interactive "cXWEM-CL Other frame: \nP") + + (let ((ofr (or (xwem-frame-other (xwem-frame-selected)) + (xwem-make-frame-1 arg nil nil t)))) + + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl (xwem-frame-selwin ofr)) + (xwem-frame-select ofr)) + ) + +(define-xwem-command xwem-cl-switch-to-other (n &optional window) + "Switch to other client." + (xwem-interactive "p") + + (let* ((win (or window (xwem-win-selected))) + (ocl (xwem-win-cl win))) + (while (> n 0) + (setq ocl (xwem-cl-other ocl)) + (setq n (- n 1))) + (if (xwem-cl-p ocl) + (xwem-manda-fun-run (xwem-cl-manda ocl) 'manage ocl win) + (xwem-message 'note "No other client available.")))) + +(define-xwem-command xwem-cl-switch-to-other-in-other-win (n) + "Like `xwem-cl-switch-to-other', but in other window." + (xwem-interactive "p") + + (xwem-cl-switch-to-other n (xwem-window-other 1))) + +(define-xwem-command xwem-kill-cl-and-window (arg) + "Kill selected client and window. +If used with prefix ARG then kill client in other window and other +window (not implemented)." + (xwem-interactive "P") + + (let* ((win (if arg (xwem-window-other 1) (xwem-win-selected))) + (cl (xwem-win-cl win))) + + (when (xwem-cl-p cl) + ;; Deassociate CL from WIN so no client will be managed when we + ;; kill CL. + (setf (xwem-cl-win cl) nil) + (setf (xwem-win-cl win) nil) + (xwem-client-kill t cl) + + ;; Make sure CL is removed from clients list + (xwem-remove-client cl)) + + (xwem-window-delete win) + (xwem-frame-redraw (xwem-win-frame win)) + )) + +(define-xwem-command xwem-cl-transpose (arg &optional win) + "Transpose client with client at right in WIN. +If ARG is non-nil transpose with left client. +If WIN is ommited than selected window will be used." + (xwem-interactive "P") + + (let* ((sw (or win (xwem-win-selected))) + (cl (xwem-win-cl sw)) + (tai (cadr (member cl (funcall (if arg 'reverse 'identity) + (xwem-win-make-cl-list sw)))))) + + (when (not (xwem-cl-p tai)) + (setq tai (cadr (member cl (funcall (if arg 'identity 'reverse) + (xwem-win-make-cl-list sw)))))) + + (when (and (xwem-cl-p cl) (xwem-cl-p tai)) + (xwem-list-exchange-els xwem-clients cl tai)) + + (xwem-tabber-regeom-window sw (xwem-win-selected-p sw (xwem-win-frame sw))))) + +(defun xwem-client-rearrange-top (cl) + "Move CL on top of `xwem-clients'." + (when (xwem-win-selected-p (xwem-cl-win cl)) + (setq xwem-clients (cons cl (delete cl xwem-clients)))) + + nil) ;continue hooks processing + +;;;###autoload +(defun xwem-init-clients () + "Clients part initializer" + (xwem-message 'msg "Initializing clients ... wait") + + (setq xwem-clients nil) + + (add-hook 'xwem-cl-manage-hook + (lambda (cl) + (when (and (xwem-win-p (xwem-cl-win cl)) + (xwem-win-selected-p (xwem-cl-win cl))) + (xwem-tab-item-draw-format (xwem-cl-tabitem cl))))) + (add-hook 'xwem-cl-demanage-hook + (lambda (cl) + (when (and (xwem-win-p (xwem-cl-win cl)) + (xwem-win-selected-p (xwem-cl-win cl))) + (xwem-tab-item-draw-format (xwem-cl-tabitem cl))))) + + (when xwem-cl-use-set-focus + (add-hook 'xwem-cl-manage-hook 'xwem-client-focus)) + + (when xwem-cl-use-recent-cl-on-top + (add-hook 'xwem-cl-manage-hook 'xwem-client-rearrange-top)) +; (add-hook 'xwem-cl-demanage-hook 'xwem-cl-bury)) + + ;; Gentle handling of window splitting + (add-hook 'xwem-win-after-split-hook 'xwem-cl-other-on-split) + ) + +;;;###autoload +(defun xwem-client-sendmsg-atom (cl atom &optional time) + "Send Client message to client CL." + (XSendEvent (xwem-dpy) (xwem-cl-xwin cl) nil 0 + (X-Create-message + (list [1 X-ClientMessage] ;type + [1 32] ;format + [2 1000] ;XXX seq + [4 (X-Win-id (xwem-cl-xwin cl))] ; window + [4 (X-Atom-id (X-Atom-find-by-name (xwem-dpy) "WM_PROTOCOLS"))] + [4 (X-Atom-id atom)] + [4 (or time X-CurrentTime)] + [4 nil])))) + +(defun xwem-client-close (cl) + "Close xwem client CL in safe manner. +Return non-nil, if CL supports WM_DELETE_WINDOW." + (when (XWMProtocol-set-p (xwem-dpy) (xwem-hints-wm-protocols (xwem-cl-hints cl)) "WM_DELETE_WINDOW") + (xwem-client-sendmsg-atom cl (X-Atom-find-by-name (xwem-dpy) "WM_DELETE_WINDOW")) + t)) + +;;;###autoload +(defun xwem-client-focus (cl &optional revto force) + "Focus xwem client's CL window. +By default this function does useful things only if CL is selected CL +or FORCE is non-nil. +Return non-nil, if CL supports WM_TAKE_FOCUS." + (when (or force + (and (xwem-cl-p cl) (eq cl (xwem-cl-selected)))) + (xwem-focus-set (xwem-cl-xwin cl)) + + ;; TODO: - we can't use WM_TAKE_FOCUS here because X-CurrentTime + ;; disalowed as timestamp, we need some real event + ;; (xwem-last-xevent?) to get timestamp from. +; (when (XWMProtocol-set-p (xwem-dpy) (xwem-hints-wm-protocols (xwem-cl-hints cl)) "WM_TAKE_FOCUS") +; (xwem-client-sendmsg-atom cl (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS"))))) + + )) + +;;;###autoload +(defun xwem-client-change-state (cl state) + "Change WM_STATE for CL, STATE is one of 'managed, 'iconified, 'withdrawn, etc." + (let ((old-state (xwem-cl-state cl))) + (setf (xwem-cl-state cl) state) + + (XSetWMState (xwem-dpy) (xwem-cl-xwin cl) + (cond ((eq state 'managed) X-NormalState) + ((eq state 'normal) X-NormalState) + + ((eq state 'iconified) X-IconicState) + + (t X-WithdrawnState))) + + (run-hook-with-args 'xwem-cl-state-change-hook cl old-state state) + )) + +;;;###autoload +(defsubst xwem-cl-managed-p (cl) + "Return non-nil if client CL is managed, i.e. has 'managed or 'normal state." + (or (eq (xwem-cl-state cl) 'managed) + (eq (xwem-cl-state cl) 'normal))) + +;;; Creating new client +(defun xwem-cl-presetup (cl) + "Reparent client CL. CL should be already setuped. +NOTE: specials clients presetuped as any other." + (let ((xwin (xwem-cl-xwin cl))) + + (if (not (xwem-frame-p (xwem-frame-find 'xwin xwin))) + ;; Not an embedded frame + (XSelectInput (xwem-dpy) xwin (xwem-cl-ev-mask cl)) + + ;; Embedded frame + (XSelectInput (xwem-dpy) xwin (Xmask-or xwem-frame-ev-mask + (xwem-cl-ev-mask cl)))) + + ;; Add event handlers + (X-Win-EventHandler-add-new xwin 'xwem-cl-events-handler 100) + (X-Win-EventHandler-add-new xwin 'xwem-ev-property 0 (list X-PropertyNotify)) + + (XSetWindowBorderWidth (xwem-dpy) xwin 0) + + ;; Fetch some window properties + (setf (xwem-cl-hints cl) + (make-xwem-hints :wm-normal-hints (XGetWMNormalHints (xwem-dpy) xwin) + :wm-hints (XGetWMHints (xwem-dpy) xwin) + :wm-class (XGetWMClass (xwem-dpy) xwin) + :wm-command (XGetWMCommand (xwem-dpy) xwin) + :wm-name (XGetWMName (xwem-dpy) xwin) + :wm-transient-for (XGetWMTransientFor (xwem-dpy) xwin) + :wm-protocols (XGetWMProtocols (xwem-dpy) xwin))) + + (when (zerop (length (xwem-hints-wm-name (xwem-cl-hints cl)))) + ;; WMNAME is empty + (setf (xwem-hints-wm-name (xwem-cl-hints cl)) "<noname>")) + + (setf (xwem-cl-transient-for cl) + (xwem-hints-wm-transient-for (xwem-cl-hints cl))) + + )) + +;;;###autoload +(defun xwem-make-client (win attrs &optional xwem-win) + "Make new client window." + + (when (XGetWindowAttributes (xwem-dpy) win) ; just to check that window not destroyed + (let ((new-cl (make-xwem-cl))) + + (setf (xwem-cl-xwin new-cl) win) + (X-Dpy-log (xwem-dpy) "New Client making name=%s\n" '(XGetWMName (xwem-dpy) win)) + + (xwem-cl-presetup new-cl) + + (when (null attrs) + (setq attrs (XGetWindowAttributes (xwem-dpy) win))) + + (setf (xwem-cl-xattrs new-cl) attrs) + (setf (xwem-cl-xgeom new-cl) (XGetGeometry (xwem-dpy) win)) + (setf (xwem-cl-start-time new-cl) (current-time)) + + ;; Add to clients list, because manage function from manda may use + ;; it. + (setq xwem-clients (cons new-cl xwem-clients)) + + ;; Make tab item for client + (setf (xwem-cl-tabitem new-cl) + (make-xwem-tab-item :type 'client + :state 'unmapped :rect (make-X-Rect :y 0 :x 0 :width 0 :height 0) + :cl new-cl :format xwem-tab-default-format)) + + ;; Walk manage database to find how to deal with this client + (let ((mdis (xwem-manda-find-inst new-cl))) + (if (not mdis) + (progn + (xwem-message 'err "Client not in manage database") + (error "Client not described in manage database")) + + (setf (xwem-cl-manda new-cl) mdis) + + ;; Check for Win's expectations + (let ((wmcmd (xwem-hints-wm-command (xwem-cl-hints new-cl))) + (dwin nil)) ;destination win + + ;; Find a window who expects NEW-CL + (setq dwin + (catch 'dwin + (mapc (lambda (fr) + (xwem-win-map + (lambda (win) + (when (> (xwem-win-get-expt win wmcmd) 0) + (xwem-win-expt-dec win wmcmd) + (throw 'dwin win))) + (xwem-frame-selwin fr))) + xwem-frames-list))) + + ;; Setup focus mode + (xwem-focus-mode-set new-cl xwem-default-focus-mode) + + ;; Run new client hook + (run-hook-with-args 'xwem-cl-new-client-hook new-cl) + + (if (xwem-win-p dwin) + (xwem-manda-fun-run mdis 'manage new-cl dwin) + (xwem-manda-fun-run mdis 'manage new-cl))) + ))) + )) + + +;; Operations on other clients +(defun xwem-cl-manage-other-cl (cl &optional win) + "Manage other client to CL in WIN." + (let ((ocl (xwem-cl-other cl))) + (when (xwem-cl-p ocl) + (xwem-manda-fun-run (xwem-cl-manda ocl) 'manage ocl win)))) + +(defun xwem-cl-other-on-split (win how new-size) + "Manage current WIN's cl in othen window. +To be used in `xwem-win-after-split-hook'. +HOW is split type. +NEW-SIZE is size of newly created window." + (when xwem-cl-other-on-split + (xwem-cl-manage-other-cl (xwem-win-cl win) (xwem-win-next win)))) + + +;; Commands +(define-xwem-command xwem-client-turn-on-other-on-split () + "Turn on `xwem-cl-other-on-split' minor mode." + (xwem-interactive) + + (setq xwem-cl-other-on-split t) + (xwem-message 'info "Other on split minor mode is ON.")) + +(define-xwem-command xwem-client-turn-off-other-on-split () + "Turn off `xwem-cl-other-on-split' minor mode." + (xwem-interactive) + + (setq xwem-cl-other-on-split nil) + (xwem-message 'info "Other on split minor mode is OFF.")) + +(define-xwem-command xwem-client-toggle-other-on-split (arg) + "Toggle `xwem-cl-other-on-split' minor mode. +Negative ARG turns it off, positive turns it on." + (xwem-interactive "P") + + (if (numberp arg) + (if (> arg 0) + (setq xwem-cl-other-on-split nil) + (setq xwem-cl-other-on-split t))) + + (if xwem-cl-other-on-split + (xwem-client-turn-off-other-on-split) + (xwem-client-turn-on-other-on-split))) + +(define-xwem-command xwem-client-kill (arg &optional cl) + "Kill xwem client CL. Also destroys CL's X window. +If used with prefix ARG is given, force CL to die, by default WM_DELETE_WINDOW will be probed. +If CL is `nil' than client in `xwem-win-selected' assumed." + ;; TODO: - take icccm stuff(like WM_DELETE_WINDOW) into account + ;; - switch to other client + (xwem-interactive (list xwem-prefix-arg (xwem-cl-selected))) + + (let ((client (or cl (xwem-cl-selected)))) + (if (xwem-cl-p client) + (if arg + (progn +; (xwem-remove-client client) + (XDestroyWindow (xwem-dpy) (xwem-cl-xwin client))) + (or (xwem-client-close client) (xwem-client-kill t client))) + (xwem-message 'warn "No Active client found.")))) + +(define-xwem-command xwem-client-query-kill (arg client) + "Kill CLIENT. +Prefix ARG directly passed to `xwem-client-kill'." + (xwem-interactive (list + xwem-prefix-arg + ;; Sort clients, so selected client will be first + (let* ((csel (xwem-cl-selected)) + (xwem-clients (sort (copy-list xwem-clients) + (lambda (cl1 cl2) + (eq cl1 csel))))) + (xwem-read-client "Kill client: ")))) + + (when (xwem-cl-p client) + (xwem-client-kill arg client)) + ) + +(define-xwem-command xwem-client-demanage-others (arg) + "Demanage others then selected client in selected window. +If ARG given, remain ARG most recent clients." + (xwem-interactive "p") + + (let ((rcls (nthcdr arg (xwem-win-make-cl-list-sort-by-recency (xwem-win-selected))))) + ;; cls in RCLS already demanaged + (mapc (lambda (cl) + (setf (xwem-cl-win cl) nil)) + rcls) + + ;; Redraw frame's tabber + (xwem-tabber-safe-regeom (xwem-frame-tabber (xwem-frame-selected)) t) + )) + +(define-xwem-command xwem-client-run-copy (arg) + "Run the same command as selected CL. +With prefix arg run it in other window. +With double prefix arg run in other window and select. +With numeric prefix arg run ARG copies." + (xwem-interactive "P") + + (let* ((nw (xwem-win-selected)) + (cl (xwem-win-cl nw))) + + (if (not (xwem-cl-p cl)) + (xwem-message 'warn "No client selected to copy.") + (let ((cmd (xwem-hints-wm-command (xwem-cl-hints cl))) + (cnt (if (numberp arg) arg 1)) ;how many clients to start + (i 0)) + (if (or (not (stringp cmd)) (string= cmd "")) + (xwem-message 'warn "Invalid cmd: \"%s\"" cmd) + + (when (and (listp arg) (not (null arg))) + (setq nw (xwem-win-next nw)) + (when (not (xwem-win-p nw)) + ;; Create window + (xwem-frame-split-vert nil) + (setq nw (xwem-win-next (xwem-win-selected)))) + + (when (xwem-win-p nw) + (when (= (prefix-numeric-value arg) 4) + (xwem-win-expt-inc nw cmd cnt)) + + (when (= (prefix-numeric-value arg) 16) + (xwem-window-select nw)))) + + (when (xwem-win-p nw) + (while (< i cnt) + (xwem-execute-program cmd) + (setq i (1+ i)))) + ))))) + +(define-xwem-command xwem-client-run-copy-other-win (arg) + "Run copy of selected client in other window. +With prefix ARG, make horizontal split instead of vertical if split +really needed." + (xwem-interactive "P") + + (let ((cmd (xwem-hints-wm-command (xwem-cl-hints (xwem-cl-selected)))) + (own (xwem-window-other 1)) + (xwem-win-after-split-hook nil)) ; prevent hooks processing + + (when cmd + ;; Check is there split needed + (when (eq own (xwem-win-selected)) + (if arg + (xwem-frame-split-horiz 0) + (xwem-frame-split-vert 0)) + (setq own (xwem-win-next (xwem-win-selected)))) + + ;; Install expectance + (xwem-win-expt-inc own cmd) + + ;; Finnaly run command + (xwem-execute-program cmd)))) + +(define-xwem-command xwem-client-run-copy-other-frame (arg) + "Run copy of selected client in other frame. +If prefix ARG is specified, create embedded frame, if creation is +needed at all." + (xwem-interactive "P") + + (let ((cmd (xwem-hints-wm-command (xwem-cl-hints (xwem-cl-selected)))) + (ofr (xwem-frame-other (xwem-frame-selected)))) + (unless (xwem-frame-p ofr) + (setq ofr (xwem-make-frame-1 arg nil nil t))) + + ;; Setup expectance + (xwem-win-expt-inc (xwem-frame-selwin ofr) cmd) + + (xwem-frame-select ofr) + + ;; Finnaly run command + (xwem-execute-program cmd))) + +(defun xwem-cl-prog-geom (cl) + "Get program specified geometry for CL." + (let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))) + (if (and wmnh (X-WMSize-psize-p wmnh)) + (cons (X-WMSize-width wmnh) ;program specified width + (X-WMSize-height wmnh)) ;program specified height + nil))) + +(defun xwem-cl-base-geom (cl) + "Return base width and height for CL." + (let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))) + (if (and wmnh (X-WMSize-pbasesize-p wmnh)) + (cons (X-WMSize-base-width wmnh) ;base width + (X-WMSize-base-height wmnh)) ;base height + nil))) + +(defun xwem-cl-min-geom (cl) + "Returns minimal geometry for CL." + (let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))) + (if (and wmnh (X-WMSize-pminsize-p wmnh)) + (cons (X-WMSize-min-width wmnh) + (X-WMSize-min-height wmnh)) + nil))) + +(defun xwem-cl-step-geom (cl) + "Returns vertical and horisontal step's width for CL." + (let ((wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl)))) + (if (and wmnh (X-WMSize-presizeinc-p wmnh)) + (cons (X-WMSize-width-inc wmnh) + (X-WMSize-height-inc wmnh)) + nil))) + +;;;###autoload +(defun xwem-cl-get-usize (cl) + "Returns cons cell (uwi . uhe) - CL's size in steps." + (let* ((clgmt (xwem-cl-xgeom cl)) + (wmnh (xwem-hints-wm-normal-hints (xwem-cl-hints cl))) + (steps (xwem-cl-step-geom cl)) + (base (xwem-cl-base-geom cl)) + (minsize (xwem-cl-min-geom cl)) + (uwi (X-Geom-width clgmt)) + (uhe (X-Geom-height clgmt))) + + (if (and steps + (not (= (car steps) 0)) + (not (= (cdr steps) 0))) + (when (or base minsize) + (progn + (setq uwi (- uwi (if (X-WMSize-pbasesize-p wmnh) + (car base) + (car minsize)))) + (setq uhe (- uhe (if (X-WMSize-pbasesize-p wmnh) + (cdr base) + (cdr minsize)))))) + (setq steps '(1 . 1))) + + (cons (/ uwi (car steps)) + (/ uhe (cdr steps))))) + +;;;###autoload +(defun xwem-cl-get-psize (cl) + "Return pixel size of CL (pwi . phe)." + (let ((gmt (xwem-cl-xgeom cl))) + (cons (X-Geom-width gmt) (X-Geom-height gmt)))) + +(unless (fboundp 'subtract-time) + (defun subtract-time (t1 t2) + "Subtract two internal times." + (let ((borrow (< (cadr t1) (cadr t2)))) + (list (- (car t1) (car t2) (if borrow 1 0)) + (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))) + +;;;###autoload +(defun xwem-cl-get-uptime (cl &optional format) + "Return CL's uptime. +FORMAT can contain %-sequences to substitute parts of the uptime. +%d is replaced by the days +%h is replaced by the hours +%m is replaced by the minutes +%s is replaced by the seconds +%A is replaced by autogenerated format." + (let ((upt (nth 1 (subtract-time (current-time) (xwem-cl-start-time cl)))) + (fmt (or format "%A")) + (days 0) + (hours 0) + (minutes 0) + (seconds 0) + (rup "")) + + (when (> upt (* 60 60 24)) + (setq days (/ upt (* 60 60 24)))) + + (when (> upt (* 60 60)) + (setq hours (% (/ upt (* 60 60)) 24))) + + (when (> upt 60) + (setq minutes (% (/ upt 60) 60))) + + (setq seconds (% upt 60)) + + (let ((flst (string-to-list fmt)) + chr) + (while flst + (setq chr (car flst)) + (cond ((= chr ?%) + (setq flst (cdr flst)) + (setq chr (car flst)) + (cond ((= chr ?d) + (setq rup (concat rup (format "%d" days)))) + ((= chr ?h) + (setq rup (concat rup (format "%d" hours)))) + ((= chr ?m) + (setq rup (concat rup (format "%d" minutes)))) + ((= chr ?s) + (setq rup (concat rup (format "%d" seconds)))) + ((= chr ?A) + (setq rup (concat + (cond ((> days 0) (format "%d days %d hours" days hours)) + ((> hours 0) (format "%d hours %d minutes" hours minutes)) + ((> minutes 0) (format "%d minutes %d seconds" minutes seconds)) + ((> seconds 0) (format "%d seconds" seconds)) + (t ""))))) + (t (error "Invalid format")))) + + (t (setq rup (concat rup (char-to-string chr))))) + (setq flst (cdr flst)))) + rup)) + +(define-xwem-command xwem-client-info (&optional cl) + "Display info about xwem client CL." + (xwem-interactive) + + (let ((client (or cl (xwem-cl-selected)))) + (if (xwem-cl-p client) + (let ((usz (xwem-cl-get-usize client)) + (psz (xwem-cl-get-psize client))) + (xwem-message 'info "id: 0x%d, usize: %dx%d, psize: %dx%d, uptime: %s, name: `%s'" + (X-Win-id (xwem-cl-xwin client)) + (car usz) (cdr usz) + (car psz) (car psz) + (xwem-cl-get-uptime client "%d days") + (xwem-client-name client))) + (xwem-message 'warn "No active clients found."))) + ) + +(define-xwem-command xwem-cl-pop-to-client (cl &optional warp) + "Pop to client CL, i.e. switch to its frame and manage it. +If CL have no frame, popup it in current frame." + (xwem-interactive "cXWEM-CL Pop: ") + + (when (xwem-cl-p cl) + (let ((fr (or (xwem-cl-frame cl) (xwem-frame-selected))) + (clw (or (xwem-cl-win cl) (xwem-win-selected)))) + (when (not (xwem-frame-selected-p fr)) + (xwem-frame-select fr)) + (when (not (xwem-win-selected-p clw)) + (xwem-window-select-maybe-redraw clw)) + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl clw) + + (when warp + (XWarpPointer (xwem-dpy) X-None (xwem-cl-xwin cl) 0 0 0 0 10 10)) + ))) + +(define-xwem-command xwem-cl-set-title (title &optional cl) + "Set new TITLE for client CL." + (xwem-interactive "sNet title: ") + + (let ((ccl (xwem-win-cl (or cl (xwem-win-selected))))) + (if (not (xwem-cl-p ccl)) + (error "No currently selected client.") + (XSetWMName (xwem-dpy) (xwem-cl-xwin ccl) title)))) + +(define-xwem-command xwem-client-unset-mark (&optional cl) + "Uset mark on CL." + (xwem-interactive (list (xwem-cl-selected))) + + (when (member cl xwem-cl-mark-ring) + (setq xwem-cl-mark-ring (delete cl xwem-cl-mark-ring)) + ;; Tab maybe affected, so redraw it + (xwem-tab-item-draw-format (xwem-cl-tabitem cl)))) + +(define-xwem-command xwem-client-set-mark (arg &optional cl) + "Mark selected client CL. +If CL is ommited or `xwem-client-set-mark' called interactively then +selected client assumed. +With no prefix ARG push selected client to `xwem-cl-mark-ring'. +With ARG, jump to last marked client, pop value from `xwem-cl-mark-ring'." + (xwem-interactive (list xwem-prefix-arg + (if xwem-prefix-arg + (pop xwem-cl-mark-ring) + (xwem-cl-selected)))) + + (unless (xwem-cl-p cl) + (if arg + (error "Empty `xwem-cl-mark-ring'.") + (error "No selected client."))) + + (if arg + (progn + ;; Put client at the end of `xwem-cl-mark-ring' + (if xwem-cl-mark-ring + (setcdr (last xwem-cl-mark-ring) (cons cl nil)) + (setq xwem-cl-mark-ring (cons cl nil))) + (xwem-cl-pop-to-client cl)) + + ;; Push cl and adjust `xwem-cl-mark-ring' according to + ;; `xwem-cl-mark-ring-max' value if needed. + (when (= (length xwem-cl-mark-ring) xwem-cl-mark-ring-max) + ;; Remove last item + (let ((rcl (car (last xwem-cl-mark-ring)))) + (setq xwem-cl-mark-ring (butlast xwem-cl-mark-ring)) + ;; Tab maybe affected, so redraw it + (xwem-tab-item-draw-format (xwem-cl-tabitem rcl)))) + + (push cl xwem-cl-mark-ring) + ;; Tab maybe affected, so redraw it + (xwem-tab-item-draw-format (xwem-cl-tabitem cl)) + + (xwem-message 'info "Marking selected client, total ring size %d" + (length xwem-cl-mark-ring)) + )) + +;;;###autoload +(defun xwem-fini-clients () + "Fini all clients." + (while xwem-clients + ;; TODO: finalize client in (car xwem-clients) + (setq xwem-clients (cdr xwem-clients)))) + +;;; New stuff +(defun xwem-client-hide (cl &optional new-state) + "Hide CL's window. Optionally you may specify NEW-STATE." + ;; Just move off the screen + (XMoveWindow (xwem-dpy) (xwem-cl-xwin cl) + (X-Geom-width (xwem-rootgeom)) + (X-Geom-height (xwem-rootgeom))) + + (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)) + (xwem-client-change-state cl (or new-state 'iconified)) + ) + +(defun xwem-client-show (cl) + "Show xwem client CL." + (if (xwem-cl-transient-for cl) + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) + + ;; Must be lowered + (XLowerWindow (xwem-dpy) (xwem-cl-xwin cl))) + + (XMoveWindow (xwem-dpy) (xwem-cl-xwin cl) + (X-Geom-x (xwem-cl-xgeom cl)) + (X-Geom-y (xwem-cl-xgeom cl))) + + (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)) + + (xwem-client-change-state cl 'normal) + ) + + +;;; Events handling for client windows +(defun xwem-cl-hkeybutton (cl xev) + "KeyPress, ButtonPress or ButtonRelease event XEV." + (xwem-kbd-handle-keybutton xev) + ) + +(defun xwem-cl-hproperty (cl xev) + "PropertyNotify." + ) + +(defun xwem-cl-hconfigure-request (cl xev) + "ConfigureRequest event XEV." + ) + +(defun xwem-cl-hdestroy-notify (cl xev) + "DestroyNotify event XEV." + (let ((ocl (xwem-cl-other cl)) + (owin (xwem-cl-win cl))) + +; (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl) + (xwem-remove-client cl) + + (if (xwem-cl-transient-for cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl) + + ;; Try to switch to other client + (when (xwem-cl-inwin-p cl) + (when (xwem-win-p owin) + (setf (xwem-win-cl owin) nil) + + (when (xwem-cl-p ocl) + (xwem-manda-fun-run (xwem-cl-manda ocl) 'manage ocl owin)))) + + (when (xwem-win-p owin) + (xwem-tabber-regeom-window owin (xwem-win-selected-p owin))) + ) + )) + +(defun xwem-cl-hunmap-notify (cl xev) + "UnmapNotify event XEV." + ) + +(defun xwem-cl-hmap-notify (cl xev) + "MapNotify event XEV." + ) + +(defun xwem-cl-hmap-request (cl xev) + "MapRequest event XEV." + (X-Dpy-log (X-Event-dpy xev) "XWEM-ROOT-HMAP-REQUEST: win=%S\n" (X-Event-win xev)) + + (let ((cl (xwem-find-client (X-Event-win xev)))) + (if (xwem-cl-p cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl) + + (xwem-make-client (X-Event-win xev) nil))) + ) + +(defun xwem-cl-hclient-message (cl xev) + "ClientMessage event XEV." + ) + +(defun xwem-cl-events-handler (xdpy xwin xev) + "Events handler for root window." + (X-Dpy-log xdpy "CLIENT HANDLER: xev type=%S, win=%S\n" '(X-Event-name xev) '(X-Win-id (X-Event-win xev))) + + (let ((cl (xwem-find-client xwin))) + + (X-Event-CASE xev + ((:X-KeyPress :X-ButtonPress :X-ButtonRelease) + (xwem-cl-hkeybutton cl xev)) + + ;; Focusing mode + (:X-FocusIn + (xwem-focus-mode-invoke cl 'focus-in xev)) + (:X-FocusOut + (xwem-focus-mode-invoke cl 'focus-out xev)) + (:X-EnterNotify + (xwem-focus-mode-invoke cl 'enter xev)) + (:X-LeaveNotify + (xwem-focus-mode-invoke cl 'leave xev)) + + (:X-PropertyNotify + (xwem-cl-hproperty cl xev)) + + (:X-ConfigureRequest + (xwem-cl-hconfigure-request cl xev)) + + (:X-DestroyNotify + (setq cl (xwem-find-client (X-Event-xdestroywindow-window xev))) + (when (xwem-cl-p cl) + (xwem-cl-hdestroy-notify cl xev))) + + (:X-UnmapNotify + ;; Someone issued XUnmapWindow + (xwem-cl-hunmap-notify cl xev)) + + (:X-MapNotify + ;; Someone issued XMapWindow + (xwem-cl-hmap-notify cl xev)) + + (:X-MapRequest + (xwem-cl-hmap-request cl xev)) + + (:X-ClientMessage + (xwem-cl-hclient-message cl xev)) + + ))) + + +(provide 'xwem-clients) + +;;; xwem-clients.el ends here diff --git a/lisp/xwem-compat.el b/lisp/xwem-compat.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWNvbXBhdC5lbA== --- /dev/null +++ b/lisp/xwem-compat.el @@ -0,0 +1,57 @@ +;;; xwem-compat.el --- GNU Emacs compatibility layer. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 15:51:10 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(defvar xwem-gnuemacs-p nil "Non-nil when running under GNU Emacs.") + +(eval-and-compile + (setq xwem-gnuemacs-p (string-match "GNU Emacs" emacs-version))) + +;;;###autoload +(defun xwem-define-prefix-command (name &optional mapvar) + "Compat version for `define-prefix-command'." + (if xwem-gnuemacs-p + (define-prefix-command name) + (define-prefix-command name t))) + +(unless (fboundp 'set-keymap-default-binding) + (fset 'set-keymap-default-binding + (lambda (keym cmd) (define-key keym [t] cmd)))) + +(unless (fboundp 'events-to-keys) + (defalias 'events-to-keys 'identity)) + + +(provide 'xwem-compat) + +;;; xwem-compat.el ends here diff --git a/lisp/xwem-custom-load.el b/lisp/xwem-custom-load.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWN1c3RvbS1sb2FkLmVs --- /dev/null +++ b/lisp/xwem-custom-load.el @@ -0,0 +1,25 @@ +;;; custom-load.el --- automatically extracted custom dependencies + +;;; Code: + +(messsage "Loading xwem custom load") + +(custom-add-loads 'xwem '("xwem-main" "xwem-clients" "xwem-faces" "xwem-frame" "xwem-keyboard" "xwem-launcher" "xwem-minibuffer" "xwem-misc" "xwem-special" "xwem-strokes" "xwem-tabbing" "xwem-tray" "xwem-win")) +(custom-add-loads 'xwem-cursor '("xwem-misc")) +(custom-add-loads 'xwem-special '("xwem-special")) +(custom-add-loads 'applications '("xwem-main")) +(custom-add-loads 'xwem-minibuffer '("xwem-minibuffer")) +(custom-add-loads 'xwem-faces '("xwem-faces" "xwem-frame" "xwem-strokes" "xwem-tabbing")) +(custom-add-loads 'xwem-launcher '("xwem-launcher")) +(custom-add-loads 'xwem-keys '("xwem-keyboard")) +(custom-add-loads 'xwem-cl '("xwem-clients" "xwem-manage")) +(custom-add-loads 'xwem-frame '("xwem-frame")) +(custom-add-loads 'xwem-keyboard '("xwem-keyboard" "xwem-keymacro")) +(custom-add-loads 'xwem-win '("xwem-win")) +(custom-add-loads 'xwem-tray '("xwem-tray")) +(custom-add-loads 'xwem-strokes '("xwem-strokes")) +(custom-add-loads 'xwem-tab '("xwem-tabbing")) +(custom-add-loads 'xwem-storkes '("xwem-strokes")) +(custom-add-loads 'xwem-misc '("xwem-misc")) + +;;; custom-load.el ends here diff --git a/lisp/xwem-events.el b/lisp/xwem-events.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWV2ZW50cy5lbA== --- /dev/null +++ b/lisp/xwem-events.el @@ -0,0 +1,271 @@ +;;; xwem-events.el --- Events handlers. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; This file used to work with X events, also includes some events +;; handlers. +;; +;;; Code + + +;; Property change hooks +;;;###autoload +(defvar xwem-wmnh-change-hooks nil "Hooks to be called when WM_NORMAL_HINTS changes.") +;;;###autoload +(defvar xwem-wmname-change-hooks nil "Hooks to be called when WM_NAME changes.") +;;;###autoload +(defvar xwem-wmcommand-chage-hooks nil "Hooks to be called when WM_COMMAND changes.") +;;;###autoload +(defvar xwem-wmclass-change-hooks nil "Hooks to be called when WM_CLASS changes.") +;;;###autoload +(defvar xwem-wmh-change-hooks nil "Hooks to be called when WM_HINTS changes.") + +(defun xwem-ev-defhnd (xdpy win xev) + "Default X-Events handler." + + (X-Event-CASE + xev + (:X-ClientMessage + (xwem-ev-clnmsg xdpy win xev)) + (:X-ConfigureRequest + (xwem-ev-reconfig xdpy win xev)) + (:X-MapRequest + (xwem-ev-remap xdpy win xev)) + (:X-DestroyNotify + (xwem-ev-destroy xdpy win xev)) + (:X-PropertyNotify + (xwem-ev-property xdpy win xev)) + (:X-ResizeRequest + (xwem-ev-reresize xdpy win xev))) + ) + +(defun xwem-ev-clnmsg (xdpy win xev) + "Handle ClientMessage event." + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: ClientMessage event: win=%s msg=%s\n" + '(X-Win-id win) '(X-Event-xclient-msg xev)) + + (let ((cl (xwem-find-client win)) + (type (length (X-Event-xclient-msg xev)))) ; 5 -> 32, 10 -> 16, 20 -> 8 + + (when (xwem-cl-p cl) + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: in ClientMessage: type=%S (car (nth 0 (X-Event-xclient-msg xev)))=%S\n" + 'type '(car (nth 0 (X-Event-xclient-msg xev)))) + (if (and (= type 5) + (= (car (nth 0 (X-Event-xclient-msg xev))) + X-IconicState)) + (xwem-manda-fun-run (xwem-cl-manda cl) 'iconify cl)) + ) + nil)) + +(defun xwem-ev-reconfig (xdpy win xev) + "Common ConfigureRequest handler." + (let* ((win (X-Event-xconfigurerequest-window xev)) + (cl (xwem-find-client win)) +; (clgeom (if (xwem-cl-p cl) (xwem-cl-xgeom cl) nil)) + (vmask (X-Event-xconfigurerequest-value-mask xev))) + + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: ConfigureRequest event for win=%s vmask=%s, x=%S, y=%S, width=%S, height=%S\n" + '(X-Win-id win) 'vmask '(X-Event-xconfigurerequest-x xev) '(X-Event-xconfigurerequest-y xev) + '(X-Event-xconfigurerequest-width xev) '(X-Event-xconfigurerequest-height xev)) + + (if (not (xwem-cl-p cl)) + (XConfigureWindow (xwem-dpy) win + (make-X-Conf :dpy (X-Win-dpy win) + :x (X-Event-xconfigurerequest-x xev) + :y (X-Event-xconfigurerequest-y xev) + :width (X-Event-xconfigurerequest-width xev) + :height (X-Event-xconfigurerequest-height xev) + :border-width (X-Event-xconfigurerequest-border-width xev))) + + ;; [else] Client window already in air + (progn + (if (not (= 0 (Xmask-and vmask (Xmask-or X-CWWidth X-CWHeight X-CWBorderWidth)))) + (xwem-manda-fun-run (xwem-cl-manda cl) 'refit cl) + + (xwem-cl-send-config cl)))) + nil)) + +(defun xwem-ev-remap (xdpy win xev) + "MapRequest handler." + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: MapRequest event handled for win=%s\n" + '(X-Win-id win)) + + (let ((cl (xwem-find-client win))) + (if (xwem-cl-p cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl) + (xwem-make-client win nil))) + nil) + +(defun xwem-ev-destroy (xdpy win xev) + "DestroyNotify handler." + ;; TODO: - May this stuff should be moved to `xwem-xdestrnot-hooks'? + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: DestroyNotify event handled for win=%s, evwin=%S\n" + '(X-Win-id win) '(X-Win-id (X-Event-xdestroywindow-event xev))) + + (let* ((cl (xwem-find-client win)) + (owin (and (xwem-cl-p cl) (xwem-cl-win cl)))) + (when (xwem-cl-p cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl) + (xwem-remove-client cl) + + (when (xwem-cl-inwin-p cl) + (when (xwem-win-p owin) + (setf (xwem-win-cl owin) nil))) + + (when (xwem-win-p owin) + (xwem-tabber-regeom-window owin (xwem-win-selected-p owin (xwem-win-frame owin)))) + )) + nil) + +(defun xwem-ev-property (xdpy win xev) + "PropertyNotify handler." + ;; TODO: write me + (X-Dpy-log (xwem-dpy) "XWEM-EVENTS: PropertyNotify event win=%S, atom=%S, state=%S\n" + '(X-Win-id (X-Event-win xev)) '(X-Atom-id (X-Event-xproperty-atom xev)) + '(X-Event-xproperty-state xev)) + + (let ((cl (xwem-find-client win)) + (atom-id (X-Atom-id (X-Event-xproperty-atom xev))) + (state (X-Event-xproperty-state xev)) + (rhook nil)) ;hook to be runned after processing + + (if (null cl) + ;; hmm -- no such client + nil + + (cond + ((= atom-id (X-Atom-id XA-wm-normal-hints)) + (setf (xwem-hints-wm-normal-hints (xwem-cl-hints cl)) + (if (= state X-PropertyNewValue) + (XGetWMNormalHints (xwem-dpy) win) + nil)) + (setq rhook 'xwem-wmnh-change-hooks)) + + ((= atom-id (X-Atom-id XA-wm-hints)) + (setf (xwem-hints-wm-hints (xwem-cl-hints cl)) + (if (= state X-PropertyNewValue) + (XGetWMHints (xwem-dpy) win) + nil)) + (setq rhook 'xwem-wmh-change-hooks)) + + ((= atom-id (X-Atom-id XA-wm-class)) + (setf (xwem-hints-wm-class (xwem-cl-hints cl)) + (if (= state X-PropertyNewValue) + (XGetWMClass (xwem-dpy) win) + nil)) + (setq rhook 'xwem-wmclass-change-hooks)) + + ((= atom-id (X-Atom-id XA-wm-command)) + (setf (xwem-hints-wm-command (xwem-cl-hints cl)) + (if (= state X-PropertyNewValue) + (XGetWMCommand (xwem-dpy) win) + nil)) + (setq rhook 'xwem-wmcommand-chage-hooks)) + + ((= atom-id (X-Atom-id XA-wm-name)) + (setf (xwem-hints-wm-name (xwem-cl-hints cl)) + (if (= state X-PropertyNewValue) + (XGetWMName (xwem-dpy) win) + nil)) + (setq rhook 'xwem-wmname-change-hooks)) + + (t (X-Dpy-log (xwem-dpy) "PropertyNotify: Atom-id = %d\n" 'atom-id))) + + (when rhook + (run-hook-with-args rhook cl))) + + nil)) + +(defun xwem-ev-reresize (xdpy win xev) + "On display XDPY handler ResizeRequest for WIN." + (X-Dpy-log xdpy "XWEM-EVENTS: ResizeRequest: win=%S, width=%S, height=%S\n" + '(X-Win-id (X-Event-xresizerequest-window xev)) '(X-Event-xresizerequest-width xev) + '(X-Event-xresizerequest-height xev)) + ) + +;;; Unusesd events +(defun xwem-ev-focusin (xdpy win xev) + "Handle FocusIn event." + (X-Dpy-log (xwem-dpy) "FocusIn event: win=%s mode=%s\n" '(X-Win-id win) '(X-Event-xfocus-mode xev)) + ) + +(defun xwem-ev-focusout (xdpy win xev) + "Handle FocusOut event." + (X-Dpy-log (xwem-dpy) "FocusOut event: win=%s mode=%s\n" '(X-Win-id win) '(X-Event-xfocus-mode xev)) + ) + +(defun xwem-ev-config (xdpy win xev) + "ConfigureNotify handler." + (X-Dpy-log (xwem-dpy) "ConfigureNotify event handled for win=%s\n" '(X-Win-id win)) + nil) + +(defun xwem-ev-map (xdpy win xev) + "MapNotify handler." + (X-Dpy-log (xwem-dpy) "MapNotify event handled for win=%s\n" '(X-Win-id win)) + nil) + +(defun xwem-ev-unmap (xdpy win xev) + "UnmapNotify handler." + (X-Dpy-log (xwem-dpy) "UnmapNotify event handled for win=%s\n" '(X-Win-id win)) + nil) + +(defun xwem-ev-create (xdpy win xev) + "CreateNotify handler." + (X-Dpy-log (xwem-dpy) "CreateNotify event handled for win=%s\n" '(X-Win-id win)) + nil) + +(defun xwem-ev-enter (xdpy win xev) + "EnterNotify handler." + (X-Dpy-log (xwem-dpy) "EnterNotify event handled for win=%s\n" '(X-Win-id win)) + (let ((cl (xwem-find-client win))) + + (X-Dpy-log (xwem-dpy) "ev-enter: win-id=%f\n" '(X-Win-id win)) + (when cl + (X-Dpy-log (xwem-dpy) "CL founded\n")) + )) + +(defun xwem-ev-expose (xdpy win xev) + "ExposureNotify handler." + (X-Dpy-log (xwem-dpy) "ExposureNotify event handled for win=%s\n" '(X-Win-id win)) + nil) + + +;;;###autoload +(defun xwem-init-events () + "Init part rot events. Installs events dispatcher on `xwem-dpy'." +; (X-Dpy-EventHandler-add (xwem-dpy) 'xwem-ev-defhnd 100) + ) + +;;;###autoload +(defun xwem-fini-events () + ) + +(provide 'xwem-events) + +;;; xwem-events.el ends here diff --git a/lisp/xwem-faces.el b/lisp/xwem-faces.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWZhY2VzLmVs --- /dev/null +++ b/lisp/xwem-faces.el @@ -0,0 +1,202 @@ +;;; xwem-faces.el --- XWEM can handle Emacs faces. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Mon Dec 29 12:04:19 MSK 2003 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Faces support. + +;;; Code: +(require 'cus-face) ; for `custom-face-get-spec' + + +(defgroup xwem-faces nil + "*Group to customize faces used by XWEM." + :prefix "xwem-face-" + :group 'xwem) + +(defface xwem-face-white + `((t (:foreground "white" :background "black"))) + "White color face." + :group 'xwem-faces) + +(defface xwem-face-black + `((t (:foreground "black" :background "black"))) + "Black color face." + :group 'xwem-faces) + +(defface xwem-face-red + `((t (:foreground "red" :background "black"))) + "Red color face." + :group 'xwem-faces) + +(defface xwem-face-green + `((t (:foreground "green" :background "black"))) + "Green color face." + :group 'xwem-faces) + +(defface xwem-face-blue + `((t (:foreground "blue" :background "black"))) + "Blue color face." + :group 'xwem-faces) + +(defface xwem-face-yellow + `((t (:foreground "yellow" :background "black"))) + "Yellow color face." + :group 'xwem-faces) + +(defface xwem-face-cyan + `((t (:foreground "cyan" :background "black"))) + "Cyan color face." + :group 'xwem-faces) + +(defface xwem-face-magenta + `((t (:foreground "magenta" :background "black"))) + "Magenta color face." + :group 'xwem-faces) + +(defface xwem-face-darkgray + `((t (:foreground "gray20" :background "black"))) + "DarkGray color face." + :group 'xwem-faces) + +(defface xwem-face-lightgray + `((t (:foreground "gray80" :background "black"))) + "LightGray color face." + :group 'xwem-faces) + +(defface xwem-face-gray + `((t (:foreground "gray50" :background "black"))) + "Gray color face." + :group 'xwem-faces) + +(defface xwem-face-outline1 + `((t (:foreground "red" :background "black"))) + "Face used to outline something." + :group 'xwem-faces) + +(defface xwem-face-outline2 + `((t (:foreground "blue" :background "black"))) + "Face used to outline something." + :group 'xwem-faces) + +(defface xwem-face-outline3 + `((t (:foreground "cyan" :background "black"))) + "Face used to outline something." + :group 'xwem-faces) + + +;;; Functions +(defun xwem-eface-to-gc (xdpy face &optional d) + "On display XDPY convert Emacs FACE to X graphical context. +Drawable D. +TOOD: - maybe add support for domains?." + (let* ((cmap (XDefaultColormap xdpy)) + (fgcol (xwem-misc-colorspec->rgb-vector-safe (face-foreground-name face) [0 0 0])) + (bgcol (xwem-misc-colorspec->rgb-vector-safe (face-background-name face) [0 0 0])) + (gc (XCreateGC + xdpy (or (and (X-Drawable-p d) d) + (XDefaultRootWindow xdpy)) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :line-style (xwem-face-tag face :line-style) + :line-width (xwem-face-tag face :line-width) + :cap-style (xwem-face-tag face :cap-style) + :join-style (xwem-face-tag face :join-style) + :function (xwem-face-tag face :function) + :subwindow-mode (xwem-face-tag face :subwindow-mode) + :graphics-exposures (xwem-face-tag face :graphics-exposures) + :foreground (XAllocColor xdpy cmap + (make-X-Color :id (X-Dpy-get-id xdpy) + :cmap cmap + :red (aref fgcol 0) + :green (aref fgcol 1) + :blue (aref fgcol 2))) + :background (XAllocColor xdpy cmap + (make-X-Color :id (X-Dpy-get-id xdpy) + :cmap cmap + :red (aref bgcol 0) + :green (aref bgcol 1) + :blue (aref bgcol 2))) + :font (X-Font-get xdpy (face-font-name face)))))) + + (put face 'xwem-face-gc gc) + gc)) + +;;;###autoload +(defun xwem-init-faces () + "Initialize faces." + + (xwem-message 'info "Initializing faces ...") + + ;; NOTE: + ;; - Faces initialization now dynamic. + ) + +;;;###autoload +(defun xwem-face-tag (face tag) + "Get FACE's TAG value. +For example \\(xwem-face-tag 'xwem-face-win-selected :line-width\\)." + (let ((spec (custom-face-get-spec face))) + (while (and spec + (not (eq (car (car spec)) t))) + (setq spec (cdr spec))) + + (when (car spec) + (plist-get (cadr (car spec)) tag)))) + +;;;###autoload +(defun xwem-face-get-gc (name &optional xdpy d) + "Return X-Gc with NAME. +Name can be symbol or string." + (let ((gc (get name 'xwem-face-gc))) + (unless (X-Gc-p gc) + (xwem-eface-to-gc (or xdpy (xwem-dpy)) name d) + (setq gc (get name 'xwem-face-gc))) + + gc)) + +;;;###autoload +(defun xwem-face-set-foreground (face fg) + "Set FACE's foreground color to FG." + + (set-face-foreground face fg) + + (let ((xdpy (xwem-dpy)) + (gc (xwem-face-get-gc face)) + (fgcol (xwem-misc-colorspec->rgb-vector-safe (face-foreground-name face) [0 0 0]))) + (setf (X-Gc-foreground (XAllocColor xdpy (XDefaultColormap xdpy) + (make-X-Color :id (X-Dpy-get-id xdpy) + :cmap (XDefaultColormap xdpy) + :red (aref fgcol 0) + :green (aref fgcol 1) + :blue (aref fgcol 2))))) + (XChangeGC xdpy gc))) + + +(provide 'xwem-faces) + +;;; xwem-faces.el ends here diff --git a/lisp/xwem-focus.el b/lisp/xwem-focus.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWZvY3VzLmVs --- /dev/null +++ b/lisp/xwem-focus.el @@ -0,0 +1,200 @@ +;;; xwem-focus.el --- Controling focus under XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 19 13:25:30 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Various focus operations. + +;;; Code: + + +;;;###autoload +(defvar xwem-focus-stack nil + "Last thing that has focus. +Internal variable, do not modify.") + + +;;;###autoload +(defun xwem-focus-xcurrent () + "Return current focus." + (let ((cf (XGetInputFocus (xwem-dpy)))) + cf)) + +;;;###autoload +(defun xwem-focus-push (&optional xwin) + "Push current focus or XWIN to `xwem-focus-stack'." + (push (or xwin (xwem-focus-xcurrent)) xwem-focus-stack)) + +;;;###autoload +(defun xwem-focus-pop () + "Pop value from `xwem-focus-stack'." + (pop xwem-focus-stack)) + +;;;###autoload +(defun xwem-focus-push-set (xwin) + "Push current focus to `xwem-focus-stack' and set focus to XWIN." + (xwem-focus-push) + (XSetInputFocus (X-Win-dpy xwin) xwin X-RevertToParent)) + +;;;###autoload +(defun xwem-focus-pop-set () + "Pop from `xwem-focus-stack' and set focus." + (let ((xwin (xwem-focus-pop))) + (when (X-Win-p xwin) + (XSetInputFocus (X-Win-dpy xwin) xwin X-RevertToParent)))) + +;;;###autoload +(defun xwem-focus-set (thing) + "Set input focus to THING. +THING is one of X-Win, xwem-frame, or xwem-client." + (cond ((or (X-Win-p thing) (numberp thing)) ; X11 window + (xwem-focus-push-set thing)) + + ;; xwem client + ((xwem-cl-p thing) + (xwem-focus-set (xwem-cl-xwin thing)) + (when (XWMProtocol-set-p (xwem-dpy) + (xwem-hints-wm-protocols (xwem-cl-hints thing)) + "WM_TAKE_FOCUS") + (xwem-client-sendmsg-atom thing + (X-Atom-find-by-name (xwem-dpy) "WM_TAKE_FOCUS")))) + + ;; xwem window + ((xwem-win-p thing) + (xwem-focus-set (xwem-win-frame thing))) + + ;; xwem-frame + ((xwem-frame-p thing) + (let* ((cl (xwem-win-cl (xwem-frame-selwin thing))) + (embf (and (xwem-cl-p cl) + (xwem-frame-find 'xwin (xwem-cl-xwin cl))))) ; maybe cl is embedded frame + + (if (xwem-frame-p embf) + ;; embedded frame + (xwem-focus-set embf) + + (if (xwem-cl-p cl) + ;; Current client active + (xwem-focus-set cl) + + (xwem-focus-set (xwem-frame-xwin thing)))))) + + ;; Normally should not happen + (t (xwem-message 'warn "Strange thing to focus: %S" thing)))) + +;;;###autoload +(defmacro xwem-focus-excursion (xwin &rest forms) + "Do FORMS, saving current input focus and under XWIN focus." + `(prog2 + (xwem-focus-push-set xwin) + ,@forms + (xwem-focus-pop-set))) + + +;;; Focus modes support +;;;###autoload +(defcustom xwem-default-focus-mode 'generic + "*Default CL's focus mode." + :type '(choice (const :tag "Generic mode" generic) + (const :tag "Click to focus" click-focus) + (const :tag "Follow mouse" follow-mouse)) + :group 'xwem) + +(defvar xwem-focus-modes nil + "Alist of focus modes, car is mode name, cdr is function.") + +(defun xwem-focus-mode-define (name fun) + "Define new focus mode named by NAME. +FUN specifies function to call when focus changes." + (add-to-list 'xwem-focus-modes (cons name fun)) + (put name 'xwem-focus-mode fun)) + +;;;###autoload +(defun xwem-focus-mode-invoke (cl &rest args) + "Invoke CL's focus mode function with ARGS." + (when (xwem-cl-p cl) + (let* ((mode (xwem-cl-get-prop cl 'xwem-focus-mode)) + (fun (get mode 'xwem-focus-mode))) + (when fun + (apply fun cl args))))) + +;;;###autoload +(defun xwem-focus-mode-set (cl mode) + "For CL window set focus mode to MODE." + (unless (eq (xwem-cl-get-prop cl 'xwem-focus-mode) mode) + (xwem-focus-mode-invoke cl 'before-mode-change) + (xwem-cl-put-prop cl 'xwem-focus-mode mode) + (xwem-focus-mode-invoke cl 'after-mode-change))) + +;; Some built-in focus modes +(xwem-focus-mode-define 'generic + (lambda (cl action &optional xev) + nil)) + +(xwem-focus-mode-define 'follow-mouse + (lambda (cl action &optional xev) + (cond ((and (eq action 'enter) + (eq (X-Event-xcrossing-mode xev) X-NotifyNormal)) + (xwem-cl-pop-to-client cl)) + ))) + +(define-xwem-command xwem-focus-click-on () + "Command used by `click-focus' focus mode." + (xwem-interactive) + + (let* ((xev xwem-last-xevent) + (cl (xwem-find-client (X-Event-win xev)))) + (when (xwem-cl-p cl) + (xwem-cl-pop-to-client cl)))) + +(xwem-focus-mode-define 'click-focus + (lambda (cl action &optional xev) + (cond ((and (eq action 'focus-in) + (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) + (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) + ;; Remove button1 from local keymap and ungrab it + (xwem-message 'info "focus in")) + + ((and (eq action 'focus-out) + (or (eq (X-Event-xfocus-mode xev) X-NotifyNormal) + (eq (X-Event-xfocus-mode xev) X-NotifyWhileGrabbed))) + ;; Add button1 to local keymap and grab for it + (xwem-local-set-key [button1] 'xwem-focus-click-on cl) + (xwem-message 'info "focus out")) + + ((eq action 'before-mode-change) + ;; Remove button1 from local keymap and ungrab it + ) + ))) + +(put 'xwem-focus-mode-define 'lisp-indent-function 1) + + +(provide 'xwem-focus) + +;;; xwem-focus.el ends here diff --git a/lisp/xwem-frame.el b/lisp/xwem-frame.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWZyYW1lLmVs --- /dev/null +++ b/lisp/xwem-frame.el @@ -0,0 +1,1383 @@ +;;; xwem-frame.el -- Frames ops for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary + +;; This file contain operations on XWEM frames. +;; + +;;; Code + + +(autoload 'X-XIneramaQueryScreens "xlib-xinerama") + +;;; Variables +(defgroup xwem-frame nil + "Group to customize xwem frames." + :prefix "xwem-frame-" + :prefix "xwem-face-" + :group 'xwem) + +(defcustom xwem-frame-background "gray60" + "*Frame background color." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-frame) + +(defcustom xwem-frame-cursor-shape 'X-XC-left_ptr + "*Cursors shape which will be used when pointer is over xwem frame." + :type (xwem-cursor-shape-choice) + :group 'xwem-frame) + +(defcustom xwem-frame-cursor-foreground-color "#002800" + "*Cursor's foreground color used when pointer is on xwem's frame." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-frame) + +(defcustom xwem-frame-cursor-background-color "#000000" + "*Cursor's background color used when pointer is on xwem's frame." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-frame) + +(defcustom xwem-frame-defprops + (list 'inner-border-width 0 ;internal border of xwem's frame + 'otter-border-width 0 ; + 'title-height 17 ; TODO: maybe create 'auto to fit font height? + 'title-thickness 2 ; + ) + "*Default PLIST for frame" + :type '(restricted-sexp :match-alternatives (valid-plist-p)) + :group 'xwem-frame) + +(defface xwem-face-frame-selected-win-selected + `((t (:foreground "green" :background "green4" :line-width 3))) + "Face to outline selected window in selected frame." + :group 'xwem-frame + :group 'xwem-faces) + +(defface xwem-face-frame-selected-win-nonselected + `((t (:foreground "blue4" :background "blue4" :line-style X-LineDoubleDash))) + "Face to outline nonselected window in selected frame." + :group 'xwem-frame + :group 'xwem-faces) + +(defface xwem-face-frame-nonselected-win-selected + `((t (:foreground "green4" :background "green4" :line-width 2))) + "Face to outline selected window in nonselected frame." + :group 'xwem-frame + :group 'xwem-faces) + +(defface xwem-face-frame-nonselected-win-nonselected + `((t (:foreground "blue4" :background "blue" :line-style X-LineDoubleDash))) + "Face to outline nonselected window in nonselected frame." + :group 'xwem-frame + :group 'xwem-faces) + +(defface xwem-face-win-delimeter + `((t (:foreground "gray80" :background "black"))) + "Face to draw window delimeter." + :group 'xwem-frame + :group 'xwem-faces) + +(defface xwem-face-win-delimeter-shadow + `((t (:foreground "gray50" :background "black"))) + "Face to draw shadow of window delimeter." + :group 'xwem-frame + :group 'xwem-faces) + +(defcustom xwem-frame-rolling-switch t + "*Non-nil mean that \\<xwem-global-map>\\[xwem-frame-next] and +\\<xwem-global-map>\\[xwem-frame-previous] will always switch, even if +there no next or previous frame." + :type 'boolean + :group 'xwem-frame) + +(defcustom xwem-frame-switch-hook nil + "Hooks to be called when frame switching occurs (i.e. `xwem-current-frame' changes). + Function will receive two arguments OLD-FRAME and NEW-FRAME." + :type 'hook + :group 'xwem-hooks) + +;; Variables +;;;###autoload +(defconst xwem-frame-ev-mask (Xmask-or XM-Exposure + XM-StructureNotify + XM-SubstructureRedirect + XM-SubstructureNotify + XM-EnterWindow XM-LeaveWindow + XM-KeyPress XM-ButtonPress XM-ButtonRelease + XM-FocusChange + XM-ResizeRedirect) + "Events mask for xwem's frame.") + +(defvar xwem-frame-keymap + (let ((map (make-sparse-keymap))) + (define-key map [button1] 'xwem-frame-on-delim-resize) + (define-key map [button3] 'xwem-frame-on-delim-menu) + + (set-keymap-parent map xwem-global-map) + map) + "Keymap used in frames.") + +(defvar xwem-frame-cursor nil "Cursor used for xwem frame.") + +;;;###autoload +(defvar xwem-frames-list nil "All frames xwem owns.") + +(defvar xwem-current-frame nil "Current frame.") + +;;;###autoload +(defstruct (xwem-frame (:predicate xwem-isframe-p)) + (name "default") ; frame name + xgeom ; frame geometry + xwin ; X window + rootwin ; XWEM's root window for frame + selwin ; XWEM's selected window + link-next ; Link to next xwem's frame in linkage + link-prev ; Link to prev xwem's frame in linkage + embedded-p ; Non-nil when frame is embedded + state ; 'mapped, 'unmapped, 'destroyed + + tabber ; xwem-tabber + props) ; Properties list + + +;;; Functions +;;;###autoload +(defun xwem-frame-p (frame &optional sig) + "Return t if FRAME is XWEM frame." + (let ((isfr (xwem-isframe-p frame))) + (if (and sig (not isfr) ) + (signal 'wrong-type-argument (list sig 'xwem-frame-p frame)) + isfr))) + +;;;###autoload +(defmacro xwem-frame-x (frame) + `(X-Geom-x (xwem-frame-xgeom ,frame))) +;;;###autoload +(defmacro xwem-frame-y (frame) + `(X-Geom-y (xwem-frame-xgeom ,frame))) +;;;###autoload +(defmacro xwem-frame-width (frame) + `(X-Geom-width (xwem-frame-xgeom ,frame))) +;;;###autoload +(defmacro xwem-frame-height (frame) + `(X-Geom-height (xwem-frame-xgeom ,frame))) + +(defsetf xwem-frame-x (frame) (x) + `(setf (X-Geom-x (xwem-frame-xgeom ,frame)) ,x)) +(defsetf xwem-frame-y (frame) (y) + `(setf (X-Geom-y (xwem-frame-xgeom ,frame)) ,y)) +(defsetf xwem-frame-width (frame) (width) + `(let ((tabber (xwem-frame-tabber ,frame))) + (when (xwem-tabber-p tabber) + (setf (X-Geom-width (xwem-tabber-xgeom tabber)) ,width)) + + (setf (X-Geom-width (xwem-frame-xgeom ,frame)) ,width))) +(defsetf xwem-frame-height (frame) (height) + `(setf (X-Geom-height (xwem-frame-xgeom ,frame)) ,height)) + +(defsubst xwem-frame-alive-p (frame) + "Return non-nil if FRAME is alive XWEM frame, i.e. which is in `xwem-frames-list'." + (member frame xwem-frames-list)) + +(defsubst xwem-frame-mapped-p (frame) + "Return non-nil if xwem FRAME is mapped." + (and (xwem-frame-p frame) + (eq (xwem-frame-state frame) 'mapped))) + +(defun xwem-frame-unmap (frame) + "Unmap frame FRAME." + (when (xwem-frame-mapped-p frame) + (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) 0) + (XUnmapWindow (xwem-dpy) (xwem-frame-xwin frame)) + (setf (xwem-frame-state frame) 'unmapped))) + +(defun xwem-frame-map (frame) + "Map frame FRAME." + (unless (xwem-frame-mapped-p frame) + (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) xwem-frame-ev-mask) + + (XMapWindow (xwem-dpy) (xwem-frame-xwin frame)) + (setf (xwem-frame-state frame) 'mapped))) + +;;;###autoload +(defun xwem-frame-selected () + "Return selected frame." + xwem-current-frame) + +;;;###autoload +(defun xwem-frame-selected-p (frame) + "Return non-nil if FRAME is selected." + (eq frame (xwem-frame-selected))) + +(defun xwem-frame-embedded-for-frame (frame) + "Return XWEM frame for which FRAME is embedded." + (let* ((cl (and (xwem-frame-p frame) + (xwem-find-client (xwem-frame-xwin frame)))) + (rv (and (xwem-cl-p cl) + (xwem-cl-frame cl)))) + rv)) + +(defun xwem-frame-embedded-pop (frame) + "Pop embedded FRAME, see also `xwem-cl-pop-to-client'." + (let* ((cl (xwem-find-client (xwem-frame-xwin frame))) + (clfr (and (xwem-cl-p cl) (xwem-cl-frame cl))) + (clw (and (xwem-cl-p cl) (xwem-cl-win cl)))) + + (when (null clfr) + (setq clfr (xwem-frame-selected))) + (when (null clw) + (setq clw (xwem-win-selected))) + + ;; Raise frame in which we are embedded. + (when (not (xwem-frame-selected-p clfr)) + (if (xwem-frame-embedded-p clfr) + (xwem-frame-embedded-pop clfr) + (xwem-frame-raise clfr))) + + (when (not (xwem-win-selected-p clw)) + (xwem-window-select clw)) + + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl clw))) + +;;;###autoload +(defun xwem-frame-select (frame &optional dnr-hooks) + "Set FRAME as selected frame. +If DNR-HOOKS is non-nil, than do not run hooks." + + ;; If FRAME is embedded frame we should raise frame in whose + ;; window FRAME is embedded. + (when (xwem-frame-embedded-p frame) + (xwem-frame-embedded-pop frame)) + + (let ((ofr (xwem-frame-selected)) + (nfr frame)) + + (setq xwem-current-frame frame) + + ;; Now raise and set input focus to FRAME + (xwem-frame-raise nfr) + (xwem-focus-set frame) + + (when (not dnr-hooks) + (run-hook-with-args 'xwem-frame-switch-hook ofr nfr)))) + +(defun xwem-frame-select-defhook (ofr nfr) + "Default hook for `xwem-frame-switch-hook'. +NOT USED." + ;; Here is OFR may be invisible, but we redraw it in case it is + ;; visible. + (X-Dpy-send-excursion (xwem-dpy) + (when (and (xwem-frame-p ofr) + (xwem-frame-alive-p ofr)) + (xwem-tabber-draw (xwem-frame-tabber ofr)) + (xwem-frame-redraw ofr)) + + (when (and (xwem-frame-p nfr) + (xwem-frame-alive-p nfr)) + (xwem-tabber-draw (xwem-frame-tabber nfr)) + (xwem-frame-redraw nfr)) + nil)) ; continue hooks processing + +;;;###autoload +(defun xwem-make-frame-1 (&optional embedded-p params props non-select) + "Create new frame with optional frame properties PROPS. +If EMBEDDED-p is non-nil than create embedded frame. +If NON-SELECT is non-nil then do not select newly created frame to be +current." + (let* ((fplist (copy-sequence xwem-frame-defprops)) + (frame (apply 'make-xwem-frame params))) + + (setf (xwem-frame-embedded-p frame) embedded-p) + + ;; setup properties + (while props + (setq fplist (plist-put fplist (car props) (cadr props))) + (setq props (cddr props))) + (setf (xwem-frame-props frame) fplist) + + (unless (xwem-frame-xgeom frame) + (setf (xwem-frame-xgeom frame) (make-X-Geom))) + + (unless (xwem-frame-x frame) + (setf (xwem-frame-x frame) 0)) + (unless (xwem-frame-y frame) + (setf (xwem-frame-y frame) 0)) + (unless (xwem-frame-width frame) + (setf (xwem-frame-width frame) (X-Geom-width (xwem-rootgeom)))) + (unless (xwem-frame-height frame) + (setf (xwem-frame-height frame) + (- (X-Geom-height (xwem-rootgeom)) + (if (X-Geom-p (xwem-minib-xgeom xwem-minibuffer)) + (X-Geom-height (xwem-minib-xgeom xwem-minibuffer)) + 0)))) + + ;; We should not process events before frame's window events + ;; handler installed + (setf (xwem-frame-xwin frame) + (XCreateWindow + (xwem-dpy) nil + (xwem-frame-x frame) + (xwem-frame-y frame) + (xwem-frame-width frame) + (xwem-frame-height frame) + (xwem-frame-get-prop frame 'inner-border-width) + nil ;DefaultDepth + nil ;CopyFromParent + nil ;CopyFromParent + (make-X-Attr :override-redirect 0 + :background-pixel (XAllocNamedColor + (xwem-dpy) (XDefaultColormap (xwem-dpy)) + xwem-frame-background + (make-X-Color :dpy (xwem-dpy))) + :border-pixel (XBlackPixel (xwem-dpy)) + :cursor xwem-frame-cursor + :event-mask xwem-frame-ev-mask))) + + ;; Create tabber + (setf (xwem-frame-tabber frame) + (xwem-tabber-create frame (make-X-Geom :x 0 :y 0 :width (xwem-frame-width frame) + :height (xwem-frame-get-prop frame 'title-height)) + 'unknown)) + + (let ((fwin (xwem-frame-xwin frame)) + parwin) + (X-Win-EventHandler-add-new fwin 'xwem-frame-events-handler 200) + (X-Win-EventHandler-add-new fwin 'xwem-ev-reconfig 90 (list X-ConfigureRequest)) + + ;; XXX XXX XXX Setup various hints + (XSetWMClass (xwem-dpy) fwin + '("xwem-frame" "xwem-frame")) + (XSetWMName (xwem-dpy) fwin + (format "xwem-frame[%d]" (length xwem-frames-list))) + + ;; Initialize root window + (setq parwin (xwem-win-new (list :frame frame) nil)) + + (setf (xwem-win-x parwin) + (xwem-frame-get-prop frame 'otter-border-width)) + (setf (xwem-win-y parwin) + (+ (xwem-frame-get-prop frame 'title-height) + (xwem-frame-get-prop frame 'otter-border-width))) + (setf (xwem-win-width parwin) + (- (xwem-frame-width frame) + (* 2 (xwem-frame-get-prop frame 'otter-border-width)))) + (setf (xwem-win-height parwin) + (- (xwem-frame-height frame) + (xwem-frame-get-prop frame 'title-height) + (* 2 (xwem-frame-get-prop frame 'otter-border-width)))) + + (setf (xwem-frame-selwin frame) parwin) + (setf (xwem-frame-rootwin frame) parwin) + + ;; Add to the end of frames list + (if xwem-frames-list + (setcdr (last xwem-frames-list) (list frame)) + (setq xwem-frames-list (list frame))) + + ;; Handle as client, i.e. make frame to be embedded + (when embedded-p + (xwem-make-client (xwem-frame-xwin frame) nil)) + + ;; Finally map and maybe select newly created frame + (xwem-frame-map frame) + + ;; TODO: + ;; Actually here we should wait for an Expose event, according to + ;; some standard. +; (unless embedded-p +; ;; Not for embedded frames +; (XIfEvent (xwem-dpy) +; (lambda (xev) +; (and (= (X-Event-type xev) X-Expose) +; (= (X-Win-id (X-Event-win xev)) (X-Win-id fwin)))))) + + ;; Install grabbing + (unless embedded-p + (xwem-kbd-install-grab xwem-global-map fwin)) + + (unless non-select + (xwem-frame-select frame)) + + ;; Now draw frames contents. +; (unless embedded-p +; (xwem-frame-draw frame nil)) + ) + + frame)) + +(defun xwem-frame-track-wmname-change (cl) + "Called when WM_NAME of CL changes. +Used in `xwem-wmname-change-hooks'." + (let ((new-name (xwem-hints-wm-name (xwem-cl-hints cl))) + frame win) + + (unless (string= (xwem-cl-saved-name cl) new-name) + (setf (xwem-cl-saved-name cl) new-name) + (setq frame (xwem-frame-find 'cl cl)) + (when (xwem-frame-p frame) + (setq win (xwem-cl-win cl)) + (when (and (xwem-win-p win) + (xwem-win-selected-p win (xwem-win-frame win))) + (xwem-tab-item-draw-format (xwem-cl-tabitem cl))))))) + +(defun xwem-init-frame-at-rect (xrect) + "Create frame to fit in XRECT rectangle." + (let ((xmrect (make-X-Rect :x 0 :y 0 :width (X-Geom-width (xwem-rootgeom)) + :height + (if (xwem-minib-frame xwem-minibuffer) + (frame-pixel-height (xwem-minib-frame xwem-minibuffer)) + 0)))) + + (when (X-Rect-intersect-p xmrect xrect) + ;; Take into account this intersection + (setf (X-Rect-height xrect) + (- (X-Rect-height xrect) + (X-Rect-height xmrect)))) + + (xwem-make-frame-1 nil (list :xgeom (X-Rect-to-X-Geom xrect)) nil t))) + +(defun xwem-frame-adjust-geom (frame new-rect) + "Adjust FRAME geom according to NEW-RECT and xwem-minibuffer geom." + (let ((mrect (X-Geom-to-X-Rect (xwem-minib-xgeom xwem-minibuffer))) + ngeom) + + (when (X-Rect-intersect-p new-rect mrect) + (setf (X-Rect-height new-rect) + (- (X-Rect-height new-rect) + (X-Rect-height mrect)))) + + (setq ngeom (X-Rect-to-X-Geom new-rect)) + (setf (X-Geom-border-width ngeom) + (X-Geom-border-width (xwem-frame-xgeom frame))) + + (setf (xwem-frame-xgeom frame) ngeom))) + +;;;###autoload +(defun xwem-init-frames () + "xwem frames initializer." + (xwem-message 'msg "Initializing frames ... wait") + (setq xwem-frames-list nil) + (setq xwem-current-frame nil) + + ;; Create cursor used while pointer is over xwem frame + (setq xwem-frame-cursor (xwem-make-cursor (eval xwem-frame-cursor-shape) + xwem-frame-cursor-foreground-color + xwem-frame-cursor-background-color)) + + ;; Initialize tabbing stuff + (xwem-init-tabber) + + ;; Add WM_XXX trackers + (add-hook 'xwem-wmname-change-hooks 'xwem-frame-track-wmname-change) + + ;; Xinerama stuff + (let ((xin (X-XIneramaQueryScreens (xwem-dpy)))) + (if (car xin) + ;; XInerama enabled + (while (setq xin (cdr xin)) + (xwem-init-frame-at-rect (car xin))) + +; (xwem-init-frame-at-rect (make-X-Rect :x 300 :y 300 :width 200 :height 200)))) + (xwem-init-frame-at-rect (X-Geom-to-X-Rect (xwem-rootgeom))))) + + ;; Select very first frame + (xwem-frame-select (car xwem-frames-list)) + ) + +;;;###autoload +(defun xwem-fini-frames () + "Finialize frames." + (mapc (lambda (frame) + (xwem-frame-destroy frame)) + xwem-frames-list)) + +(define-xwem-command xwem-make-frame (arg) + "Create new XWEM frame. +If ARG is non-nil then create embedded frame." + (xwem-interactive "P") + + (xwem-make-frame-1 arg)) + +(defun xwem-frame-cl (frame) + "Return currently active xwem client in FRAME." + (xwem-win-cl (xwem-frame-selwin frame))) + +;;;###autoload +(defun xwem-find-frame (win) + ;;XXX rewrite me + (let ((flist xwem-frames-list) + (rf nil)) + (while flist + (if (= (X-Win-id win) + (X-Win-id (xwem-frame-xwin (car flist)))) + (progn + (setq rf (car flist)) + (setq flist nil)) + (setq flist (cdr flist)))) + rf)) + +;;;###autoload +(defun xwem-frame-find (how arg) + "Find frame by ARG. HOW is search type, one of 'xwin 'win 'cl." + (let ((flist xwem-frames-list) + (rf nil)) + + (while flist + (if (cond ((and (eq how 'xwin) + (X-Win-p arg) + (= (X-Win-id arg) (X-Win-id (xwem-frame-xwin (car flist))))) + t) + + ((and (eq how 'win) + (eq (xwem-win-frame arg) (car flist))) + t) + + ((and (eq how 'cl) + (eq (xwem-cl-frame arg) (car flist))) + t) + + (t nil)) + (progn + (setq rf (car flist)) + (setq flist nil)) + + (setq flist (cdr flist)))) + rf)) + +(defun xwem-frame-other-frame (frame) + "Return other frame for FRAME. +NOTE: not yet implemented" + + ;; Try linkage, and then try closest frame + (let ((oframe (xwem-frame-link-next frame))) + (unless (xwem-frame-p oframe) + (setq oframe (xwem-frame-link-prev frame))) + (unless (xwem-frame-p oframe) + (setq oframe (nth 0 xwem-frames-list))) + oframe)) + +;;;###autoload +(defun xwem-frame-other (frame &optional type) + "Same as `xwem-frame-other-frame', but return nil, if no good other frame found. +TYPE is ane of 'any, 'linkage" + (unless type + (setq type 'any)) + + ;; First try linkaged frames + (let ((allframes xwem-frames-list) + (oframe (xwem-frame-link-next frame))) + (unless (xwem-frame-mapped-p oframe) + (setq oframe (xwem-frame-link-prev frame))) + + ;; Now try parent in case when FRAME is embedded frame. + (unless (xwem-frame-mapped-p oframe) + (when (xwem-frame-embedded-p frame) + (let ((cl (xwem-find-client (xwem-frame-xwin frame)))) + (when (xwem-cl-p cl) + (setq oframe (xwem-cl-frame cl)))))) + + (when (and (not (xwem-frame-mapped-p oframe)) + (eq type 'any)) + ;; Scan frames list only for 'any TYPE + (while (and allframes (not (xwem-frame-mapped-p oframe))) + (when (and (xwem-frame-mapped-p (car allframes)) + (not (eq frame (car allframes)))) + (setq oframe (car allframes)) + (setq allframes nil)) + (setq allframes (cdr allframes)))) + oframe)) + +;;;###autoload +(defun xwem-frame-num (frame) + "Return FRAME index in `xwem-frames-list'." + (xwem-frame-p frame 'xwem-frame-num) + (let ((fl xwem-frames-list) + (num 0)) + (while fl + (if (eq frame (car fl)) + (setq fl nil) + (setq num (+ 1 num)) + (setq fl (cdr fl)))) + num)) + +(defun xwem-frame-xy-in-p (x y frame) + "Return non-nil if point at X Y is in FRAME." + (and (>= x (xwem-frame-x frame)) + (<= x (+ (xwem-frame-x frame) (xwem-frame-width frame))) + (>= y (xwem-frame-y frame)) + (<= y (+ (xwem-frame-y frame) (xwem-frame-width frame))))) + +(defun xwem-frame-at (x y) + "Return frame which contain point at X Y." + (let ((fl xwem-frames-list)) + (while (and fl (not (xwem-frame-xy-in-p x y (car fl)))) + (setq fl (cdr fl))) + (car fl))) + +;;;###autoload +(defun xwem-frame-set-pos (frame new-x new-y) + "Set FRAME position at NEW-X and NEW-Y." + + (setf (xwem-frame-x frame) new-x) + (setf (xwem-frame-y frame) new-y) + + (XMoveWindow (xwem-dpy) (xwem-frame-xwin frame) new-x new-y)) + +;;;###autoload +(defun xwem-frame-set-size (frame new-width new-height) + "Resize FRAME to NEW-WIDTH and NEW-HEIGHT." + + (setf (xwem-frame-width frame) new-width) + (setf (xwem-frame-height frame) new-height) + + (xwem-window-set-pixsize (xwem-frame-rootwin frame) + (xwem-frame-width frame) t nil) + (xwem-window-set-pixsize (xwem-frame-rootwin frame) + (- (xwem-frame-height frame) + (xwem-frame-get-prop frame 'title-height)) t t) + (XResizeWindow (xwem-dpy) (xwem-frame-xwin frame) new-width new-height) + + ;; Also resize tabber + (XResizeWindow (xwem-dpy) (xwem-tabber-xwin (xwem-frame-tabber frame)) + (xwem-frame-width frame) + (xwem-frame-get-prop frame 'title-height)) + + (xwem-tabber-safe-regeom (xwem-frame-tabber frame) t) + ) + +;;; Frame Events handling +(defvar xwem-frame-exposes-counter 0 "xwem-frame exposes counter.") + +(defun xwem-frame-hexpose (frame xev) + "Expose event handler." + (X-Dpy-log (xwem-dpy) "xwem-frame-expose: Exposure event count: %S\n" + '(X-Event-xexpose-count xev)) + + (let ((cnt (X-Event-xexpose-count xev))) ; exposures counter + + (if (> xwem-frame-exposes-counter 0) + ;; frame already exposed, and we flush other expose events + ;; according to counter. + (setq xwem-frame-exposes-counter (1- xwem-frame-exposes-counter)) + + (setq xwem-frame-exposes-counter cnt) + ;; It may be case(when frame is not founded) when frame already + ;; removed from `xwem-frames-list' but window is not destroed yet. + (when (xwem-frame-p frame) + (xwem-frame-draw frame nil))) + )) + +(defun xwem-frame-hfocus-in (frame xev) + "FRAME received FocusIn x event XEV." + ;; TODO: + ;; * More acurate FocusIn handiling + ;; * Take in account embedded frames + (X-Dpy-log (xwem-dpy) "!!!!!!!!!!!!!+++++++++!!!!!!!!!!!!!!!!!! [%d] FRAME FOCUS IN: mode=%S, detail=%S\n" + '(xwem-frame-num frame) + '(X-Event-xfocus-mode xev) '(X-Event-detail xev)) + + (when (and (member (X-Event-xfocus-mode xev) (list X-NotifyNormal X-NotifyWhileGrabbed)) + (member (X-Event-detail xev) (list X-NotifyNonlinearVirtual X-NotifyNonlinear))) + + ;; * Focus moves from client in other frame to client in FRAME. + ;; * Or Focus moves from normal frame to embedded frame + (xwem-tabber-draw (xwem-frame-tabber frame)) + (xwem-frame-draw frame nil) + )) + +(defun xwem-frame-hfocus-out (frame xev) + "FocusOut event XEV." + ;; * More acurate FocusOut handiling + ;; * Take in account embedded frames + (X-Dpy-log (xwem-dpy) "!!!!!!!!!!!!!----------------------!!!!!!!!!!!!!!!!!! [%d] FRAME FOCUS OUT: mode=%S, detail=%S\n" + '(xwem-frame-num frame) + '(X-Event-xfocus-mode xev) '(X-Event-detail xev)) + + (when (and (member (X-Event-xfocus-mode xev) (list X-NotifyNormal X-NotifyWhileGrabbed)) + (member (X-Event-detail xev) (list X-NotifyNonlinearVirtual X-NotifyNonlinear))) + + ;; * Focus moves from client in FRAME to client in other frame. + ;; * Or Focus moves from embedded frame to normal frame. +; (when (eq frame (xwem-frame-selected)) +; (setq xwem-current-frame nil)) + + (xwem-tabber-draw (xwem-frame-tabber frame)) + (xwem-frame-draw frame nil))) + +(defun xwem-frame-hdestroy (frame xev) + "FRAME have got DestroyNotify event XEV." + (let ((oframe (xwem-frame-other frame 'any))) ; other frame + + ;; Remove FRAME from linkage if any + (xwem-frame-link-remove frame) + + ;; Now Remove FRAME from frame list + (setq xwem-frames-list (delete frame xwem-frames-list)) + + ;; If frame is not selected it mean that it was embedded + (when (xwem-frame-p oframe) + (xwem-frame-select oframe)) + )) + +(defun xwem-frame-hconfigure (frame xev) + "FRAME just received ConfigureNotify event XEV." + (let ((owid (xwem-frame-width frame)) + (ohei (xwem-frame-height frame)) + (nwid (X-Event-xconfigure-width xev)) ;new width + (nhei (X-Event-xconfigure-height xev)) ;new height + rwwid rwhei) + + (when (not (= owid nwid)) + (setf (xwem-frame-width frame) nwid) + (setq rwwid nwid) + (xwem-window-set-pixsize (xwem-frame-rootwin frame) rwwid t nil)) + + (when (not (= ohei nhei)) + (setf (xwem-frame-height frame) nhei) + (setq rwhei (- nhei (xwem-frame-get-prop frame 'title-height))) + (xwem-window-set-pixsize (xwem-frame-rootwin frame) rwhei t t)) + )) + +(defun xwem-frame-hcirculate (frame xev) + "Handle CirculateRequest." + ) + +(defun xwem-frame-hkeybutton (frame xev) + "On FRAME handle KeyPress, ButtonPress or ButtonRelease event XEV." + (when (eq (xwem-kbd-current-map) xwem-global-map) + (xwem-kbd-set-current-prefix-keymap xwem-frame-keymap)) + + (xwem-kbd-handle-keybutton xev)) + +(defun xwem-frame-events-handler (xdpy win xev) + "Event handler for frame." + (X-Dpy-log (xwem-dpy) "XWEM-FRAME-EVENTS-HANDLER: ev=%S, win=%S\n" + '(X-Event-name xev) '(X-Win-id win)) + + (let ((frame (xwem-frame-find 'xwin win))) + + (when (xwem-frame-mapped-p frame) + (X-Event-CASE xev + (:X-Expose + (xwem-frame-hexpose frame xev)) + + (:X-FocusIn + (xwem-frame-hfocus-in frame xev)) + + (:X-FocusOut + (xwem-frame-hfocus-out frame xev)) + + (:X-DestroyNotify + ;; Somebody kill us, or one of clients die + (setq frame (xwem-frame-find 'xwin (X-Event-xdestroywindow-window xev))) + (when (xwem-frame-p frame) + (xwem-frame-hdestroy frame xev)) + ) + + (:X-ConfigureNotify + ;; Seems that we are embedded frame + (setq frame (xwem-frame-find 'xwin (X-Event-xconfigure-window xev))) + (when (xwem-frame-p frame) + (xwem-frame-hconfigure frame xev))) + + ((:X-KeyPress :X-ButtonPress :X-ButtonRelease) + (xwem-frame-hkeybutton frame xev)) + + (:X-CirculateRequest + (xwem-frame-hcirculate frame xev)) + + )))) + +;;;; Frame Events handling ends here + +;;;###autoload +(defun xwem-frame-redraw (frame) + "Redraw FRAMEs windows outlines." + (let* ((sw-gc (xwem-face-get-gc + (if (xwem-frame-selected-p frame) + 'xwem-face-frame-selected-win-nonselected + 'xwem-face-frame-nonselected-win-nonselected))) + (cw-gc (xwem-face-get-gc + (if (xwem-frame-selected-p frame) + 'xwem-face-frame-selected-win-selected + 'xwem-face-frame-nonselected-win-selected)))) + + (xwem-win-map + (lambda (win) + (let* ((cgc (if (xwem-win-selected-p win frame) cw-gc sw-gc)) + (hthi (X-Gc-line-width cgc))) + + (unless (numberp hthi) + (setq hthi 1)) + +; (X-Dpy-log (xwem-dpy) "Get cgc=%s hthi=%d\n" 'cgc 'hthi) + ;; XXX is Clearing window area is really needed? + (XClearArea (xwem-dpy) (xwem-frame-xwin (xwem-win-frame win)) + (+ (xwem-win-x win) hthi) + (+ (xwem-win-y win) hthi) + (- (xwem-win-width win) hthi) + (- (xwem-win-height win) hthi) + nil) + + (XDrawRectangle (xwem-dpy) + (xwem-frame-xwin frame) + cgc + (+ (xwem-win-x win) (/ hthi 2)) + (+ (xwem-win-y win) (/ hthi 2)) + (- (xwem-win-width win) hthi) + (- (xwem-win-height win) hthi)))) + + (xwem-frame-selwin frame)) + + ;; Draw delimetrs (ARGUSED!) +; (xwem-win-draw-delims (xwem-frame-rootwin frame)) + )) + +(defun xwem-frame-draw (frame full) + "Draw FRAME. If FULL is t then fully redraw it, i.e. ClearWindow first." + (let ((win (xwem-frame-xwin frame))) + (X-Dpy-send-excursion (xwem-dpy) + (when full + (XClearArea (xwem-dpy) win 0 0 + (xwem-frame-width frame) + (xwem-frame-height frame) nil)) + + ;; Outile windows + (xwem-frame-redraw frame) + + ;; Delims + (xwem-win-draw-delims (xwem-frame-rootwin frame)) + ))) + +(define-xwem-command xwem-frame-lower (frame) + "Lower FRAME's window." + (xwem-interactive (list (xwem-frame-selected))) + + (XLowerWindow (xwem-dpy) (xwem-frame-xwin frame))) + +(define-xwem-command xwem-frame-raise (frame) + "Raise FRAME's window." + (xwem-interactive (list (xwem-frame-selected))) + + (xwem-frame-map frame) + (XRaiseWindow (xwem-dpy) (xwem-frame-xwin frame)) + ) + +(define-xwem-command xwem-frame-next (arg) + "Switch to ARG next frame." + (xwem-interactive "p") + + (let ((frame (nth arg (member (xwem-frame-selected) + xwem-frames-list)))) + + (when (and xwem-frame-rolling-switch + (not (xwem-frame-p frame))) + ;; Assume first frame if there no next + (setq frame (car xwem-frames-list))) + + (if (xwem-frame-p frame) + (xwem-frame-select frame) + + (xwem-message 'warn "Can't switch to `%S' frame" frame)))) + +(define-xwem-command xwem-frame-previous (arg) + "Switch to ARG previous frame." + (xwem-interactive "p") + + (let ((frame (nth arg (member (xwem-frame-selected) + (reverse xwem-frames-list))))) + + (when (and xwem-frame-rolling-switch + (not (xwem-frame-p frame))) + ;; Assume last frame if there no previous + (setq frame (car (last xwem-frames-list)))) + + (if (xwem-frame-p frame) + (xwem-frame-select frame) + + (xwem-message 'warn "Can't switch to `%S' frame" frame)))) + +(define-xwem-command xwem-frame-switch-nth (arg) + "Switch xwem frame. +If ARG is numeric prefix, then switch to ARG frame. +If ARG ommited, 0 as ARG value will be used. +If ARG is list and selected frame is embedded, than unembedd it." + (xwem-interactive "P") + + (when (null arg) + (setq arg 0)) + (if (numberp arg) + (let ((frame (nth (abs arg) xwem-frames-list))) + (if (xwem-frame-p frame) + (xwem-frame-select frame) + (xwem-message 'warn "No such %S frame." (abs arg)))) + + ;; TODO: unembed selected frame + (let ((frame (xwem-frame-selected))) + (when (xwem-frame-embedded-p frame) + (let* ((cl (xwem-find-client (xwem-frame-xwin frame))) + (rtgeom (xwem-rootgeom)) + (nwi (X-Geom-width rtgeom)) + (nhe (X-Geom-height rtgeom))) + + (setf (xwem-frame-embedded-p frame) nil) + + (setq nhe (- nhe + (if (xwem-minib-frame xwem-minibuffer) + (frame-pixel-height (xwem-minib-frame xwem-minibuffer)) + 0))) ;XXX frame's height calculation + (xwem-manda-fun-run (xwem-cl-manda cl) 'demanage cl t) + (setf (xwem-cl-win cl) nil) + (setf (xwem-frame-width frame) nwi) + (setf (xwem-frame-height frame) nhe) +; (xwem-window-set-pixsize (xwem-frame-rootwin frame) nwi t nil) +; (xwem-window-set-pixsize (xwem-frame-rootwin frame) nhe t t) + (XResizeWindow (xwem-dpy) (xwem-frame-xwin frame) nwi nhe) + (XReparentWindow (xwem-dpy) (xwem-frame-xwin frame) (xwem-rootwin) 0 0) + (xwem-frame-select frame t) + ))) + )) + +(define-xwem-command xwem-frame-switch-nth-linkage (arg) + "Raise all frames that in linkage of frame with number NUM." + (xwem-interactive "P") + + (when (null arg) (setq arg 0)) + (if (numberp arg) + (let ((frame (nth (abs arg) xwem-frames-list))) + (if (not (xwem-frame-p frame)) + (xwem-message 'warn "No such %S frame." (abs arg)) + + ;; Select linkage + (xwem-frame-linkage-map + frame + (lambda (fr) + (xwem-frame-raise fr))) + (xwem-frame-select frame))) + (xwem-message 'warn "Strange arg value: %S" arg)) + ) + +(define-xwem-command xwem-frame-destroy (frame) + "Destroy FRAME. If FRAME is not given selected frame assumed." + (xwem-interactive (list (xwem-frame-selected))) + + ;; Desetup all clients + (let ((xwem-cl-manage-hook nil) + (xwem-cl-demanage-hook nil)) + + (XSelectInput (xwem-dpy) (xwem-frame-xwin frame) 0) + (setf (xwem-frame-state frame) 'destroed) + + ;; Em + (xwem-frame-hdestroy frame nil) + + (xwem-win-map + (lambda (win) + (let ((cl (xwem-win-cl win))) + (when (xwem-cl-p cl) + (XReparentWindow (xwem-dpy) (xwem-cl-xwin cl) (xwem-rootwin) + (X-Geom-width (xwem-rootgeom)) (X-Geom-height (xwem-rootgeom))) + (setf (xwem-cl-win cl) nil) + (xwem-client-change-state cl 'iconified) +; (xwem-manda-fun-run (xwem-cl-manda cl) 'iconify (xwem-win-cl win)) + ))) + (xwem-frame-rootwin frame))) + + (XDestroySubwindows (xwem-dpy) (xwem-frame-xwin frame)) + (XDestroyWindow (xwem-dpy) (xwem-frame-xwin frame)) + ) + +(define-xwem-command xwem-frame-del-win (&optional window) + "Removes WINDOW from FRAME. +If FRAME ommited then selected frame assumed. +If WINDOW ommitted selected window will be used." + (xwem-interactive) + + (let* ((del-frame (or (and window (xwem-win-frame window)) (xwem-frame-selected))) + (del-win (or window (xwem-frame-selwin del-frame)))) + + (if (xwem-win-only-one-p del-win) + (xwem-message 'warn "Can't delete window, because it is only one.") + + (xwem-window-delete del-win) + (xwem-frame-redraw del-frame)) + )) + +(define-xwem-command xwem-frame-del-others (&optional window) + "Remove all xwem windows other then WINDOW." + (xwem-interactive) + + (let* ((del-frame (or (and window (xwem-win-frame window)) (xwem-frame-selected))) + (del-win (or window (xwem-frame-selwin del-frame))) + (cl (xwem-win-cl del-win))) + + (xwem-window-delete-others del-win) + + (xwem-frame-redraw del-frame) + + ;; If there was client I think it need refitting + (when (xwem-cl-p cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'refit cl)) + )) + +(define-xwem-command xwem-frame-split-horiz (arg &optional frame) + "Split FRAME horizontally. +Prefix argument specifies how many pixels splitted window will be after split." + (xwem-interactive "p") + + (let* ((sp-frame (or frame (xwem-frame-selected)))) + (xwem-win-split (xwem-frame-selwin sp-frame) 'horizontal arg) + (xwem-frame-redraw sp-frame) + )) + +(define-xwem-command xwem-frame-split-vert (arg &optional frame) + "Split FRAME vertically. +Prefix argument specifies how many pixels splitted window will be after split." + (xwem-interactive "p") + + (let* ((sp-frame (or frame (xwem-frame-selected)))) + (xwem-win-split (xwem-frame-selwin sp-frame) 'vertical arg) + (xwem-frame-redraw sp-frame) + )) + +;; XXX experimental things +(define-xwem-command xwem-frame-win-enlarge-hor (n &optional win) + "Enlarge WIN or selected window N pixels horizontaly." + (xwem-interactive "p") + + (xwem-window-enlarge n nil (or win (xwem-win-selected))) + (xwem-frame-draw (xwem-win-frame (or win (xwem-win-selected))) nil)) + +(define-xwem-command xwem-frame-win-enlarge-ver (n &optional win) + "Enlarge WIN or selected window N pixels horizontaly." + (xwem-interactive "p") + + (xwem-window-enlarge n t (or win (xwem-win-selected))) + (xwem-frame-draw (xwem-win-frame (or win (xwem-win-selected))) nil)) + +(defun xwem-frame-goto (n direction &optional frame) + "Goto window at DIRECTION on FRAME N times. +DIRECTION is one of 'next, 'prev, 'next-vert, ..." + (let* ((gframe (if frame frame (xwem-frame-selected))) + (cwin (xwem-frame-selwin gframe)) + (bwin nil)) + (while (> n 0) + (cond ((eq direction 'next) + (setq bwin (xwem-window-next cwin))) + ((eq direction 'prev) + (setq bwin (xwem-window-prev cwin))) + ((eq direction 'next-vert) + (setq bwin (xwem-window-next-vertical cwin))) + (t (error "Bad DIRECTION in xwem-frame-goto, should be one of 'next or 'prev"))) + (setq n (1- n))) + + (xwem-window-select bwin) + (xwem-frame-redraw gframe)) + ) + +(define-xwem-command xwem-frame-goto-next (arg) + "Goto ARG next window in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'next)) + +(define-xwem-command xwem-frame-goto-prev (arg) + "Goto ARG previous window in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'prev)) + +(define-xwem-command xwem-frame-goto-next-vert (arg) + "Goto ARG next window in vertical direction in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'next-vert)) + +(define-xwem-command xwem-frame-goto-next-hor (arg) + "Goto ARG next window in horizontal direction in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'next-hor)) + +(define-xwem-command xwem-frame-goto-prev-vert (arg) + "Goto ARG previous window in vertical direction in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'priv-vert)) + +(define-xwem-command xwem-frame-goto-prev-hor (arg) + "Goto ARG previous window in horizontal direction in selected frame." + (xwem-interactive "p") + (xwem-frame-goto arg 'prev-hor)) + + +(define-xwem-command xwem-frame-split-sbs (n &optional frame side) + "Makes N frames side by size of FRAME. +SIDE is one of 'vertical or 'horizontal, if ommited or not one of +above - 'horizontal will be used. + +Example: +SIDE is 'horiz ++--------+ +----+----+--...--+----+ ++--------+ +----+----+--...--+----+ +| 1 | `xwem-frame-split-sbs' |--> | 1 | 2 | | N | +| | | | | | | ++--------+ +----+----+--...--+----+ + +Widths sum of all N frames after sbs split is equal to width of frame +before." + (xwem-interactive "p") + + (let* ((vertp (eq side 'vertical)) + (frm (or frame (xwem-frame-selected))) + (wi (xwem-frame-width frm)) + (he (xwem-frame-height frm)) + (nwi wi) + (nhe he) + (wost 0) + (host 0) + xoff yoff) + + (if vertp + (progn + (setq nhe (/ he (1+ n))) + (setq host (% he (1+ n)))) + (setq nwi (/ wi (1+ n))) + (setq wost (% wi (1+ n)))) + + (setq xoff (+ nwi wost)) + (setq yoff (+ nhe host)) + ;; setup frame's properties + (setf (xwem-frame-width frm) xoff) + (setf (xwem-frame-height frm) yoff) + ;; setup sizes for root window + (xwem-window-set-pixsize (xwem-frame-rootwin frm) xoff t nil) + (xwem-window-set-pixsize (xwem-frame-rootwin frm) + (+ nhe host (- (xwem-frame-get-prop frm 'title-height))) t t) + + (XResizeWindow (xwem-dpy) (xwem-frame-xwin frm) + (xwem-frame-width frm) + (xwem-frame-height frm)) + + ;; Also resize tabber + (XResizeWindow (xwem-dpy) (xwem-tabber-xwin (xwem-frame-tabber frm)) + (xwem-frame-width frm) + (xwem-frame-get-prop frm 'title-height)) + (xwem-tabber-safe-regeom (xwem-frame-tabber frm) t) + + ;; TODO: - inherit same parent in case FRM is embedded + ;; - install frames linkage + (let ((oframe frm) + (nframe nil) + (samex (xwem-frame-x frm)) + (samey (xwem-frame-y frm))) + (while (> n 0) + (setq nframe + (xwem-make-frame-1 nil + (list :xgeom + (make-X-Geom :x (if vertp samex (+ samex xoff)) + :y (if vertp (+ samey yoff) samey) + :width nwi + :height nhe)) + nil + t)) + ;; Now setup linkage + (xwem-frame-link-insert-after oframe nframe) + (setq oframe nframe) + + (if vertp + (setq yoff (+ yoff nhe)) + (setq xoff (+ xoff nwi))) + (setq n (1- n)))) + )) + +(define-xwem-command xwem-frame-sbs-hor-split (n) + "Make horizontal sbs split N times for selected frame." + (xwem-interactive "p") + (xwem-frame-split-sbs n)) + +(define-xwem-command xwem-frame-sbs-vert-split (n) + "Make vertical sbs split N times for selected frame." + (xwem-interactive "p") + (xwem-frame-split-sbs n nil 'vertical)) + +(define-xwem-command xwem-frame-fit-screen (frame) + "Fit FRAME to screen sizes." + (xwem-interactive (list (xwem-frame-selected))) + + ;; Take into acount XInerama layout + (let ((frect (X-Geom-to-X-Rect (xwem-frame-xgeom frame))) + (xin (X-XIneramaQueryScreens (xwem-dpy)))) + (if (car xin) + (progn + ;; XInerama enabled + (while (and (setq xin (cdr xin)) + (not (X-Rect-intersect-p (car xin) frect)))) + (setq xin (car xin))) + + ;; No XInerama, so use root geometry + (setq xin (X-Geom-to-X-Rect (xwem-rootgeom)))) + + (xwem-frame-adjust-geom frame xin) + + (xwem-window-set-pixsize (xwem-frame-rootwin frame) + (xwem-frame-width frame) t nil) + (xwem-window-set-pixsize (xwem-frame-rootwin frame) + (- (xwem-frame-height frame) + (xwem-frame-get-prop frame 'title-height)) t t) + (XMoveResizeWindow (xwem-dpy) (xwem-frame-xwin frame) + (xwem-frame-x frame) + (xwem-frame-y frame) + (xwem-frame-width frame) + (xwem-frame-height frame)) + (XRaiseWindow (xwem-dpy) (xwem-frame-xwin frame)) + + ;; Also resize tabber + (XResizeWindow (xwem-dpy) (xwem-tabber-xwin (xwem-frame-tabber frame)) + (xwem-frame-width frame) + (xwem-frame-get-prop frame 'title-height)) + + ;; XXX uninstall linkage if any + (xwem-frame-link-remove frame) + + ;; Redraw frame + (xwem-tabber-safe-regeom (xwem-frame-tabber frame) t) + (xwem-frame-redraw frame) + )) + +(define-xwem-command xwem-frame-transpose (arg) + "Transpose frames ARG times." + (xwem-interactive "p") + (error "`xwem-frame-transpose' not implemented yet.")) + +(define-xwem-command xwem-frame-showroot () + "Show root window, i.e. unmap all xwem frames." + (xwem-interactive) + + (mapc 'xwem-frame-unmap xwem-frames-list)) + +(define-xwem-command xwem-frame-hide (frame &optional no-select) + "Hide FRAME. +When called interactively, FRAME is selected frame. +With prefix ARG, do not select new frame." + (xwem-interactive (list (xwem-frame-selected) + xwem-prefix-arg)) + + (let ((oframe (xwem-frame-other frame))) + (when (xwem-frame-mapped-p frame) + ;; We are about to hide FRAME, so select other frame + (when (and (not no-select) + (xwem-frame-p oframe)) + (xwem-frame-select oframe)) + + (xwem-frame-unmap frame) + ))) + +(define-xwem-command xwem-transpose-frames (arg) + "Transpose selected frame with ARG other frame." + (xwem-interactive "p") + + (let* ((sfr (xwem-frame-selected)) + (ofr (xwem-frame-other sfr)) + sg og) + + (when (xwem-frame-p ofr) + (setq sg (copy-sequence (xwem-frame-xgeom sfr)) + og (copy-sequence (xwem-frame-xgeom ofr))) + + (xwem-frame-set-pos sfr (X-Geom-x og) (X-Geom-y og)) + (xwem-frame-set-pos ofr (X-Geom-x sg) (X-Geom-y sg)) + + (xwem-frame-set-size sfr (X-Geom-width og) (X-Geom-height og)) + (xwem-frame-set-size ofr (X-Geom-width sg) (X-Geom-height sg)) + + ;; Finally exchange positions (aka frame number) in + ;; `xwem-frames' list + (xwem-list-exchange-els xwem-frames-list sfr ofr) + ))) + +;; XXX: what this? +(defun xwem-frame-in-delim-p (win x y) + "Return non-nil if X Y is inside some delimeter." + (catch 'found + (let ((hc (xwem-win-hchild win)) + (vc (xwem-win-vchild win))) + + (while (xwem-win-p hc) + ;; For horizontal split + (when (xwem-win-p (xwem-win-next hc)) + (when (and (> x (+ (xwem-win-x hc) (xwem-win-width hc))) + (< x (+ (xwem-win-x hc) (xwem-win-width hc) xwem-win-delim-width)) + (> y (xwem-win-y hc)) + (< y (+ (xwem-win-y hc) (xwem-win-height hc)))) + (throw 'found t)) + (when (xwem-frame-in-delim-p hc x y) + (throw 'found t))) + (setq hc (xwem-win-next hc))) + + (while (xwem-win-p vc) + ;; For vertical split + (when (xwem-win-p (xwem-win-next vc)) + (when (and (> x (xwem-win-x vc)) + (< x (+ (xwem-win-x vc) (xwem-win-width vc))) + (> y (+ (xwem-win-y vc) (xwem-win-height vc))) + (< y (+ (xwem-win-y vc) (xwem-win-height vc) xwem-win-delim-width))) + (throw 'found t)) + (when (xwem-frame-in-delim-p vc x y) + (throw 'found t))) + (setq vc (xwem-win-next vc))) + + nil))) + +(define-xwem-command xwem-frame-on-delim-resize () + "Resize window dragging delimiter." + (xwem-interactive) + + ) + +(define-xwem-command xwem-frame-on-delim-menu () + "Popup menu when delimiter clicked." + (xwem-interactive) + + (let ((in-xy (xwem-frame-in-delim-p + (xwem-frame-rootwin (xwem-frame-selected)) + (X-Event-xbutton-event-x xwem-last-xevent) + (X-Event-xbutton-event-y xwem-last-xevent)))) + (when in-xy + (xwem-popup-function-menu nil)) + )) + +;;;###autoload +(defun xwem-frame-make-cl-list (frame) + "Make list of all clients FRAME holds." + (let ((rcls nil)) + (xwem-win-map (lambda (win) + (setq rcls (nconc rcls (xwem-win-make-cl-list win)))) + (xwem-window-next (xwem-frame-selwin frame))) + rcls)) + + +(provide 'xwem-frame) + +;;; xwem-frame.el ends here diff --git a/lisp/xwem-help.el b/lisp/xwem-help.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWhlbHAuZWw= --- /dev/null +++ b/lisp/xwem-help.el @@ -0,0 +1,226 @@ +;;; xwem-help.el --- Getting help in XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 1 Sep 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Helping. + +;;; Code: + +;;; Some help stuff +;;;###autoload +(defun xwem-logo-string () + "Return textified XWEM's logo string." + (concat (xwem-str-with-faces "X" (list 'bold-italic)) + (xwem-str-with-faces "W" (list 'bold-italic 'red)) + (xwem-str-with-faces "E" (list 'bold-italic 'green)) + (xwem-str-with-faces "M" (list 'bold-italic 'blue)))) + +(define-xwem-command xwem-help () + "Display some help info." + (xwem-interactive) + + (xwem-help-display + (progn + (insert "Hello, this is help for ") + (insert (xwem-logo-string)) + (insert "\n\n")) + (progn + (insert "TODO: here is some description for ") + (insert (xwem-logo-string)) + (insert " stuff.\n")) + (insert "\n") + ;; Frames config + (progn + (insert "---=== Frames Info ===---\n\n") + (insert (format "You have %d frames now and [%d] frame is selected.\n" + (length xwem-frames-list) (xwem-frame-num (xwem-frame-selected)))) + (insert "\n")) + + ;; Clients + ;; Maybe use tree-widget package to display this info? + (let ((curr-classn "") + (curr-classi "")) + (insert "---=== Clients Info ===---\n") + (mapc + (lambda (el) + (let ((clclass (xwem-hints-wm-class (xwem-cl-hints el))) + (clgeom (xwem-cl-xgeom el))) + (when (not (string= curr-classn (cadr clclass))) + (setq curr-classn (cadr clclass)) + (insert (format "\n= Begin for class name: <%s> =\n" curr-classn))) + (when (not (string= curr-classi (car clclass))) + (setq curr-classi (car clclass)) + (insert (format "\n- Class instance: <%s> -\n" curr-classi))) + (insert (format "WM-NAME: <%s>, Geom: %dx%d+%d+%d\n" + (xwem-hints-wm-name (xwem-cl-hints el)) + (X-Geom-width clgeom) + (X-Geom-height clgeom) + (X-Geom-x clgeom) + (X-Geom-y clgeom))))) + (sort (copy-list xwem-clients) + (lambda (el1 el2) (let ((cl1-clas (xwem-hints-wm-class (xwem-cl-hints el1))) + (cl1-name (xwem-hints-wm-name (xwem-cl-hints el1))) + (cl2-clas (xwem-hints-wm-class (xwem-cl-hints el2))) + (cl2-name (xwem-hints-wm-name (xwem-cl-hints el2)))) + ;; Sort by class name, than by class + ;; instance, than by wm-name. + (or (string-lessp (cadr cl1-clas) (cadr cl2-clas)) + (and (string= (cadr cl1-clas) (cadr cl2-clas)) + (string-lessp (car cl1-clas) (car cl2-clas))) + (and (string= (car cl1-clas) (car cl2-clas)) + (string-lessp cl1-name cl2-name)))))) + ) + (insert "\n")) + + (progn + (insert "---=== Bindings for `") + (insert (xwem-str-with-faces "xwem-global-map" 'font-lock-keyword-face)) + (insert "' ===---\n")) + (describe-bindings-internal xwem-global-map))) + +(define-xwem-command xwem-help-for-help () + "Help for XWEM's help system." + (xwem-interactive) + + (xwem-help-display + (insert "Here should be Help-for-Help!\n\n") + (insert (format "Help prefix is %s, Keys are:\n" + (substitute-command-keys "\\<xwem-global-map>\\[xwem-help-prefix]"))) + (describe-bindings-internal 'xwem-help-prefix) + )) + +(define-xwem-command xwem-describe-prefix-bindings (keys) + "Describe the bindings of the prefix used to reach this command." + (xwem-interactive (list xwem-this-command-keys)) + + (xwem-help-display + (let ((prefix (make-vector (1- (length keys)) nil)) + (i 0)) + + (while (< i (length prefix)) + (aset prefix i (aref keys i)) + (setq i (1+ i))) + + (insert (format "Key bindings for %s" (key-description prefix))) + (insert ":\n") + (describe-bindings-internal xwem-global-map nil nil prefix nil) + ))) + +(define-xwem-command xwem-help-describe-bindings () + "Describe XWEM's bindings." + (xwem-interactive) + + (xwem-help-display + (insert "XWEM global Keybindings:\n") + (describe-bindings-internal xwem-global-map) + )) + +(define-xwem-command xwem-help-describe-key1 (key) + "Describe KEY" + (xwem-interactive (list xwem-this-command-keys)) + + (let ((dfn (xwem-kbd-key-binding key xwem-global-map)) + (keystr (key-description key))) + + (if (or (null dfn) (integerp dfn)) + (xwem-message 'info "%s is undefined." keystr) + (xwem-help-display + (insert keystr) + (insert " runs ") + (if (symbolp dfn) + (insert (format "`%s'" dfn)) + (insert dfn)) + (insert "\n\n") + (cond ((or (stringp dfn) (vectorp dfn)) + (let ((cmd (key-binding dfn))) + (if (not cmd) + (insert "a keyboard macro") + (insert "a keyboard macro which runs the command ") + (insert cmd) + (insert ":\n\n") + (when (documentation cmd) + (insert (documentation cmd)))))) + ((and (consp dfn) (not (eq 'lambda (car-safe dfn)))) + (let ((describe-function-show-arglist nil)) + (describe-function-1 (car dfn)))) + ((symbolp dfn) + (describe-function-1 dfn)) + ((documentation dfn) + (insert (documentation dfn))) + (t (insert "not documented")))) + ))) + +(define-xwem-command xwem-help-describe-key (keys) + "Describe keysequence." + (xwem-interactive "KDescribe key: ") + + (xwem-help-describe-key1 keys)) + +(define-xwem-command xwem-help-frames () + "Help for XWEM's frames." + (xwem-interactive) + ;; TODO: write me + (xwem-message 'info "`xwem-help-frames' is not written yet.") + ) + +(define-xwem-command xwem-help-wins () + "Help for XWEM's windows." + (xwem-interactive) + ;; TODO: write me + (xwem-message 'info "`xwem-help-wins' is not written yet.") + ) + +;; TODO: we should write something similar to ibuffer or +;; electric-buffer-list to operate on cliets, switching, getting stat, +;; etc. +(define-xwem-command xwem-help-clients () + "Help for XWEM's clients." + (xwem-interactive) + ;; TODO: write me + (xwem-message 'info "`xwem-help-clients' is not written yet.") + ) + +(define-xwem-command xwem-help-where-is (dfn &optional paste) + "Where-is for XWEM." + (xwem-interactive "CWhere is command: \nP") + + (let ((keys (where-is-internal dfn (list xwem-global-map)))) + (if keys + (if paste + nil ;paste to selected client + (xwem-message 'info "%s is on %s" dfn (sorted-key-descriptions keys))) + (if paste + nil ;paste to selected client + (xwem-message 'info "%s is not on any keys" dfn)))) + nil) + + +(provide 'xwem-help) + +;;; xwem-help.el ends here diff --git a/lisp/xwem-icons.el b/lisp/xwem-icons.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWljb25zLmVs --- /dev/null +++ b/lisp/xwem-icons.el @@ -0,0 +1,122 @@ +;;; xwem-icons.el --- Icons handling routines. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Sat Dec 27 15:38:24 MSK 2003 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Icons support. + +;;; Code: + +(require 'xlib-xpm) + +(defvar xwem-icons-dir (locate-data-directory "xwem") + "Directory where icons for use by XWEM lies.") + +(defvar xwem-icons-list nil + "List of already loaded icons.") + +;;;###autoload +(defvar xwem-icons-alist + ;; [ wm-name wm-class-name wm-class-instance ] . icon-name + '(([".*" ".term" ".Term"] . "mini-term.xpm") + ([".*" "xclock" "XClock"] . "mini-clock.xpm") + ([".*" "xload" "XLoad"] . "mini-measure.xpm") + ([".*" "xcalc" "XCalc"] . "mini-calc.xpm") + + ([".*" "xkeycaps" "XKeyCaps"] . "mini-xkeycaps.xpm") + ([".*" "xdvi" "XDvi"] . "mini-xdvi.xpm") + ([".*" "xv" "XV.*"] . "mini-xv.xpm") + ([".*" ".*" "AcroRead"] . "mini-acroread.xpm") + ([".*" ".*" "Xpdf"] . "mini-acroread.xpm") + ([".*" ".*" "Xman"] . "mini-info.xpm") + + ([".*" "Mozilla" ".*"] . "mini-mozilla.xpm") + ([".*" "gv" "GV"] . "mini-gv.xpm") + ([".*" "ghostview" "Ghostview"] . "mini-gv.xpm") + ([".*" "xfig" "Fig"] . "mini-xfig.xpm") + ([".*" "ethereal" "Ethereal"] . "mini-ethereal.xpm") + ([".*" "xfd" "Xfd"] . "mini-font.xpm") + ([".*" "xfontsel" "XFontSel"] . "mini-font.xpm") + ([".*" "xconsole" "XConsole"] . "mini-sh1.xpm") + ([".*" "xcolors" "Xcolors"] . "mini-colors.xpm") + ([".*" ".*" "X-Chat"] . "mini-xchat.xpm") + + ;; Match by WM_NAME since WM_CLASS is not setuped + (["Lupe" ".*" ".*"] . "mini-zoom.xpm") + (["xcmap" "" ".*"] . "mini-colors.xpm") + + ;; EMACS + ([".*\\.tex.*" "emacs" "Emacs"] . "mini-xemacstex.xpm") + ([".*\\.c.*" "emacs" "Emacs"] . "mini-xemacsC.xpm") + ([".*\\.py.*" "emacs" "Emacs"] . "mini-xemacspy.xpm") + ([".*\\(Group\\|Summary\\|Article\\).*" "emacs" "Emacs"] . "mini-xemacsgnus.xpm") + ([".*\\*info\\*.*" "emacs" "Emacs"] . "mini-xemacsinfo.xpm") + ([".*" "emacs" "Emacs"] . "mini-xemacs.xpm") + + ([".*" ".*" ".*"] . "mini-x2.xpm"))) + +(defun xwem-icons-cl-icon-name (cl) + "Return icon name for CL." + (let* ((hints (xwem-cl-hints cl)) + (wm-name (xwem-hints-wm-name hints)) + (wm-class (xwem-hints-wm-class hints)) + (class-name (or (car wm-class) "")) + (class-inst (or (cadr wm-class) "")) + (ialist xwem-icons-alist)) + + (while (and ialist + (not (and (string-match (aref (car (car ialist)) 0) wm-name) + (string-match (aref (car (car ialist)) 1) class-name) + (string-match (aref (car (car ialist)) 2) class-inst)))) + (setq ialist (cdr ialist))) + + (cdr (car ialist)))) + +;;;###autoload +(defun xwem-icons-cl-icon (cl) + "Get X-Image of CL's icon. +Return cons cell where car is X-Pixmap of icon and cdr is X-Pixmap +where mask for icon is stored." + (let ((iname (xwem-icons-cl-icon-name cl)) + fname ximg ximg-mask-pixmap) + (when iname + (setq ximg (plist-get xwem-icons-list iname)) + (unless ximg + (setq fname (concat xwem-icons-dir "/" iname)) + (setq ximg (X:xpm-pixmap-from-file (xwem-dpy) (XDefaultRootWindow (xwem-dpy)) fname)) + (setq ximg-mask-pixmap (X:xpm-pixmap-from-file (xwem-dpy) (XDefaultRootWindow (xwem-dpy)) fname t)) + + (setq xwem-icons-list (plist-put xwem-icons-list iname (cons ximg ximg-mask-pixmap))) + (setq ximg (plist-get xwem-icons-list iname))) + + ximg))) + + +(provide 'xwem-icons) + +;;; xwem-icons.el ends here diff --git a/lisp/xwem-interactive.el b/lisp/xwem-interactive.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWludGVyYWN0aXZlLmVs --- /dev/null +++ b/lisp/xwem-interactive.el @@ -0,0 +1,190 @@ +;;; xwem-interactive.el --- XWEM interactive interface. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Dec 18 05:49:52 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +;;;###autoload +(defvar xwem-interactively nil + "Non-nil when xwem in interactive mode. +Internal variabel, do not modify.") + +;;;###autoload +(fset 'read-from-minibuffer-for-xwem (symbol-function 'read-from-minibuffer)) + + +;;;###autoload +(defun xwem-interactive-p () + "Return non-nil when xwem in interactive mode." + xwem-interactively) + +(defun xwem-interactive-itimer () + "Itimer used by `xwem-read-from-minibuffer'." + (when xwem-executing-kbd-macro + (xwem-key-send-ekeys + (vector (aref xwem-executing-kbd-macro (incf xwem-executing-kbd-macro-index)))) + )) + +;;; Keymacros safe variant of `read-from-minibuffer', i.e. does not +;; block if we are executing keyboard macro. +;;;###autoload +(defun xwem-read-from-minibuffer (prompt &optional initial-contents keymap readp history abbrev-table) + "Read data from xwem minibuffer. +Arguments PROMPT, INITIAL-CONTENTS, KEYMAP, READP, HISTORY and +ABBREV-TABLE are same as for `read-from-minibuffer'." + (let (ret) + + (xwem-under-minib-focus + (xwem-kbd-stop-grabbing) + + (when xwem-executing-kbd-macro + (start-itimer "xwem-macro-itimer" 'xwem-interactive-itimer 0.01 0.01 t)) + + (unwind-protect + (setq ret (read-from-minibuffer-for-xwem prompt initial-contents keymap readp history abbrev-table)) + + (when xwem-executing-kbd-macro + (delete-itimer "xwem-macro-itimer"))) + + ret))) + +;;;###autoload +(defun xwem-completing-read (prompt table &optional predicate require-match initial-contents history) + "XWEM awared varian of `completing-read'." + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + (completing-read prompt table predicate require-match initial-contents history))) + +;;;###autoload +(defun xwem-read-command (prompt) + "Just like `read-command', but for XWEM. +Argument PROMPT is same as for `read-command'." + + ;; Temporary redefine `read-from-minibuffer' + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + (read-command prompt))) + +;;;###autoload +(defun xwem-read-filename (prompt &optional dir default must-match initial-contents history) + "Just like `read-file-name', but for XWEM. +PROMPT, DIR, DEFAULT, MUST-MATCH, INITIAL-CONTENTS and HISTORY are +same as for `read-file-name'." + + ;; Temporary redefine `read-from-minibuffer' + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + (read-file-name prompt dir default must-match initial-contents history))) + +;;;###autoload +(defun xwem-read-shell-command (prompt &optional initial-input history) + "Just like `read-shell-command', but for XWEM. +PROMPT, INITIAL-INPUT and HISTORY are same as for `read-shell-command'." + + ;; Temporary redefine `read-from-minibuffer' + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + (read-shell-command prompt initial-input history))) + +;;;###autoload +(defun xwem-read-external-command (prompt) + "Read for external command using PROMPT." + (xwem-launcher-query prompt)) + +;;;###autoload +(defun xwem-read-client (prompt &optional predic) + "Read for client name prompting PROMPT and return xwem client. +Additional argument PREDIC is passed right to `xwem-client-name'." + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + + (let* ((rcl nil) + (clsnl (xwem-cl-normal-list xwem-clients predic)) + (clns (mapcar + (lambda (cl) + (cons (xwem-client-name cl clsnl) cl)) + clsnl)) + (name (flet ((iswitchb-make-buflist + (default) + (setq iswitchb-buflist (mapcar (lambda (cl) (car cl)) clns)))) + (iswitchb-read-buffer prompt)))) + + (while clns + (when (string= (caar clns) name) + (setq rcl (cdar clns)) + (setq clns nil)) + (setq clns (cdr clns))) + rcl))) + +;;;###autoload +(defun xwem-read-frame (prompt) + "Read for frame number prompting PROMPT and return xwem frame." + ) + +;; For `xwem-interactive' take a look at xwem-macros.el +;;;###autoload +(defun xwem-interactive-ilist (spec) + "Return list valid for `interactive'. +SPEC is specification of list items." + (let ((xwem-interactively t)) + (declare (special xwem-interactively)) + + ;; XXX if ?_ is first than command need to run with ungrabbed + ;; keyboard. + (when (and spec (eq (aref (car spec) 0) ?_)) + (xwem-kbd-stop-grabbing) + + ;; Remove ?_ from first element in SPEC + (if (= (length (car spec)) 1) + (setq spec (cdr spec)) + (setq spec (cons (substring (car spec) 1) (cdr spec))))) + + (mapcar (lambda (el) + (let ((code (aref el 0)) + (prompt (substring el 1))) + (cond ((eq code ?P) xwem-prefix-arg) + ((eq code ?p) (prefix-numeric-value xwem-prefix-arg)) + + ((eq code ?k) (xwem-read-key prompt)) + ((eq code ?K) (xwem-read-key-sequence prompt)) + ((eq code ?c) (xwem-read-client prompt)) + ((eq code ?f) (xwem-read-filename prompt nil nil t)) + ((eq code ?F) (xwem-read-filename prompt)) + ((eq code ?s) (xwem-read-from-minibuffer prompt)) + ((eq code ?C) (xwem-read-command prompt)) + ((eq code ?c) (xwem-read-client prompt)) + ((eq code ?e) (xwem-read-external-command prompt)) + ))) + spec))) + +(provide 'xwem-interactive) + +;;; xwem-interactive.el ends here diff --git a/lisp/xwem-keyboard.el b/lisp/xwem-keyboard.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWtleWJvYXJkLmVs --- /dev/null +++ b/lisp/xwem-keyboard.el @@ -0,0 +1,1324 @@ +;;; xwem-keyboard.el --- Keyboard support for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Authors: Zajcev Evgeny <zevlg@yandex.ru> +;; Alex Ott <ottalex@narod.ru> +;; Created: 21 Mar 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; `xwem-global-map' is normal keymap used by xwem. +;; +;; Set `xwem-keyboard-echo-keystrokes' to t if you want echoing of +;; incomplete commands in echo area. + +;;; Code: + + +(eval-and-compile + (require 'xlib-xtest) + (require 'xwem-macros)) + +;;;###autoload +(defun xwem-kbd (spec) + "Just like `kbd' but take into account values of `xwem-hyper-modifier' and `xwem-meta-modifier'." + (let ((keys (key-sequence-list-description (kbd spec)))) + (mapvector (lambda (key) + (let ((rkey (last key)) + (rmods (butlast key))) + (when (member 'meta key) + (setq rmods (delete 'meta rmods)) + (setq rkey (cons xwem-meta-modifier rkey))) + (when (member 'hyper key) + (setq rmods (delete 'hyper rmods)) + (setq rkey (cons xwem-hyper-modifier rkey))) + + (when rmods + (setq rkey (nconc rmods rkey))) + rkey)) + keys))) + +;;{{{ [-] Custamizable xwem-keyboard group + +;;; Customize variables +(defgroup xwem-keyboard nil + "Group to customize keyboard in XWEM." + :prefix "xwem-" + :group 'xwem) + +(defcustom xwem-post-command-hook nil + "*Hooks to run after command execution." + :type 'hook + :group 'xwem-keyboard + :group 'xwem-hooks) + +(defcustom xwem-keyboard-echo-keystrokes t + "*If non-nil than echo unfinished commands in echo area." + :type 'boolean + :group 'xwem-keyboard) + +(defcustom xwem-hyper-modifier 'hyper + "*This is a little trick of how ``H'' interpretted in `xwem-kbd' specification." + :type '(choice (const :tag "Meta" meta) + (const :tag "Control" control) + (const :tag "Super" super) + (const :tag "Hyper" hyper)) + :group 'xwem-keyboard) + +(defcustom xwem-meta-modifier 'meta + "*This is a little trick of how ``M'' interpretted in `xwem-kbd' specification." + :type '(choice (const :tag "Meta" meta) + (const :tag "Control" control) + (const :tag "Super" super) + (const :tag "Hyper" hyper)) + :group 'xwem-keyboard) + +;;;###autoload +(defcustom xwem-quit-key (xwem-kbd "H-g") + "Quit command key." + :type 'sexp + :group 'xwem-keyboard) + +;;;###autoload +(defcustom xwem-quit-command 'xwem-keyboard-quit + "Default command to be called when `xwem-quit-key' pressed." + :type 'function + :group 'xwem-keyboard) + +(defcustom xwem-help-key (xwem-kbd "H-h") + "Help command key." + :type 'sexp + :group 'xwem-keyboard) + +;;;###autoload +(defcustom xwem-prefix-help-command 'xwem-describe-prefix-bindings + "Default command to be called when `xwem-help-key' pressed." + :type 'function + :group 'xwem-keys) + +(defcustom xwem-universal-key (xwem-kbd "H-u") + "Key for universal argument commands." + :type 'sexp + :group 'xwem-keyboard) + +(defcustom xwem-kbd-quit-hook nil + "*Hooks to be runned when KBD exits. +Runned only on \\<xwem-global-map>\\[xwem-kbd-quit], but not on +\\<xwem-global-map>\\[xwem-keyboard-quit]." + :type 'hook + :group 'xwem-keyboard + :group 'xwem-hooks) + +;;}}} + +;;{{{ [-] Internal variables + +;;;###autoload +(defvar xwem-override-map nil + "Keymap that overrides all other keymaps. +If this variable is non-nil, it is used as a keymap instead of +`xwem-global-map' or keymap returned by `xwem-kbd-current-map'. +You should *bind* this, not set it.") + +;;;###autoload +(defvar xwem-kbd-now-grabbing nil + "Non-nil indicates that we now grabbing keyboard. +Internal variable, do not modify.") + +(defvar xwem-xkeys-mapping nil + "X KeyMapping fetched from X server. +Internal variable, do not modify.") + +(defvar xwem-kbd-private-modifiers (make-vector 6 nil) + "Private modifers [shift lock control meta hyper super]. +Internal variable, do not modify.") + +(defvar xwem-xmods-mapping nil + "X ModifierMapping fetched from X server. +Internal variable, do not modify.") + +;;;###autoload +(defvar xwem-event-window nil "Window that receive last keypress event.") +;;;###autoload +(defvar xwem-last-event nil "Last keypress event.") +;;;###autoload +(defvar xwem-last-xevent nil "Last keypress/buttonpress X Event.") +;;;###autoload +(defvar xwem-this-command-keys [] "List of pressed keys to execute command.") + +;; Private variables +(defvar xwem-kbd-private-prefix-map nil + "Private variable holds prefix keymap or symbol that holds keymap. +Internal variable, do not modify.") + +(defvar xwem-kbd-last-prefix-map nil "Last value of `xwem-kbd-private-prefix-map'.") + +;; Special modes for reading key or keysequence +(defvar xwem-kbd-reading-key nil + "Non-nil mean we are reading for key. +Actually references symbol to which save readed key. +Internal variable, do not modify.") + +(defvar xwem-kbd-reading-keyseq nil + "Non-nil mean we are reading key sequence. +Actually references symbol to which save readed key sequence. +Internal variable, do not modify.") + +;;}}} + + +;;{{{ [-] Reading key and keysequence + +(defvar xwem-saved-this-command-keys nil + "Saved value of `xwem-this-command-keys'.") + +(defun xwem-read-keys-start (keyseq-p keyvar) + "Start reading key or key sequence. +KEYSEQ-P is non-nil when staring reading key sequence. +KEYVAR is place where to store readed key or key sequence." + (xwem-kbd-start-grabbing) + + (setq xwem-saved-this-command-keys xwem-this-command-keys) + (setq xwem-this-command-keys []) + (if keyseq-p + (setq xwem-kbd-reading-keyseq keyvar) + (setq xwem-kbd-reading-key keyvar)) + + (xwem-recursive-edit)) + +(defun xwem-read-keys-stop (keyseq-p) + "Stop reading key or key sequence. +If KEYSEQ-P is non-nil than stop reading key sequence." + (set (if keyseq-p xwem-kbd-reading-keyseq xwem-kbd-reading-key) + xwem-this-command-keys) + (if keyseq-p + (setq xwem-kbd-reading-keyseq nil) + (setq xwem-kbd-reading-key nil)) + + (xwem-kbd-set-current-prefix-keymap nil) + (setq xwem-this-command-keys xwem-saved-this-command-keys) + + (xwem-exit-recursive-edit)) + +;; Read key, install active grab +;;;###autoload +(defun xwem-read-key (&optional prompt no-minib-focus-p) + "Read single key press, prompting PROMPT in `xwem-minibuffer'. +If NO-MINIB-FOCUS-P is non-nil, focus `xwem-minibuffer' while reading." + (let ((xwem-keyboard-echo-keystrokes t) + key) + + (when prompt + (xwem-message 'msg prompt)) + + (if no-minib-focus-p + (xwem-read-keys-start nil 'key) + + (xwem-under-minib-focus + (xwem-read-keys-start nil 'key))) + + (aref key 0))) + +;; Read keysequence which binds to command +;;;###autoload +(defun xwem-read-key-sequence (&optional prompt) + "Read key sequence that call command prompting PROMPT." + (let ((xwem-keyboard-echo-keystrokes t) + keys) + (xwem-under-minib-focus + (when prompt + (xwem-message 'msg prompt)) + + (xwem-read-keys-start t 'keys)) + keys)) + +;;}}} + +;;{{{ [-] Defining new key + +;;;###autoload +(defun xwem-define-key (win keymap key command) + "Add KEY to KEYMAP to execute COMMAND and grab KEY on WIN. +When command is `nil', then undefine KEY in KEYMAP and ungrab KEY." + (define-key keymap key command) + (xwem-kbd-graugra-key key win (if command 'grab 'ungrab))) + +;;;###autoload +(defun xwem-global-set-key (key command) + "Define KEY to call COMMAND, when xwem is already run. +If command is `nil' then undefine KEY in `xwem-global-map' and ungrab KEY." + (define-key xwem-global-map key command) + (mapc (lambda (frm) + (xwem-kbd-graugra-key key (xwem-frame-xwin frm) + (if command 'grab 'ungrab))) + xwem-frames-list)) + +;;}}} + +;;{{{ [-] local keymap + +;;;###autoload +(defun xwem-local-map (cl) + "Return local map for CL." + (and (xwem-cl-p cl) (xwem-cl-get-prop cl 'xwem-local-keymap))) + +;;;###autoload +(defun xwem-local-set-key (key command &optional cl) + "Set KEY to call COMMAND in CL's local keymap. +If COMMAND is `nil' then undefine KEY in CL's local map and ungrab KEY. +If CL is ommited `xwem-cl-selected' assumed." + (let* ((ccl (or cl (xwem-cl-selected))) + (kmap (xwem-local-map ccl))) + (when (keymapp kmap) + (define-key kmap key command) + (xwem-kbd-graugra-key key (xwem-cl-xwin ccl) + (if command 'grab 'ungrab))))) + +;;}}} + +;;{{{ [-] Undefined command processing + +(define-xwem-command xwem-undefined-command () + "Called when key is not binded." + (xwem-interactive) + (xwem-message 'warn "Command undefined for key %S." xwem-last-event)) + +(define-xwem-command xwem-self-insert-or-undefined (arg) + "Self insert or undefined command. +Prefix ARG specifies how many characters to insert." + (xwem-interactive "p") + + (let ((lev xwem-last-event)) + ;; TODO: + ;; * Check is LEV is actually self insertable event + + (if arg + (xwem-key-send-ekeys (make-vector arg lev)) + + (xwem-message 'warn "%s is not defined, prefix arg is %S." + (key-description xwem-this-command-keys) arg) + ))) + +(put 'xwem-self-insert-or-undefined 'xwem-need-keyrelease t) +(put 'xwem-self-insert-or-undefined 'xwem-need-ungrabed-kbd t) + +;;}}} + +;;{{{ [-] Quiting keyboarding + +(define-xwem-command xwem-keyboard-quit () + "Send quit signal." + (xwem-interactive) + + (signal 'quit '(xwem)) + (xwem-message 'info "quit.")) + +(define-xwem-command xwem-kbd-quit () + "Quit from keyboard haldling." + (xwem-interactive) + + (xwem-kbd-stop-grabbing) + (setq xwem-kbd-private-prefix-map nil) + (XSetInputFocus (xwem-dpy) X-PointerRoot X-RevertToPointerRoot X-CurrentTime) + (xwem-message 'note "[kbd-quit] InputFocus is PonterRoot, prfxmap is nil.") + + (run-hooks 'xwem-kbd-quit-hook) + ) + +;;}}} + +;;{{{ [-] Initializators + +(defun xwem-kbd-initialize-private-modifiers () + "Create internal modifier representation to speedup futher work." + (setq xwem-kbd-private-modifiers (make-vector 6 nil)) + (let* ((modifs (car (last xwem-xmods-mapping))) + (sh (nth 0 modifs)) +; (locks (nth 1 modifs)) + (ctrl (nth 2 modifs)) + (m1 (nth 3 modifs)) + (m2 (nth 4 modifs)) + (m3 (nth 5 modifs)) + (m4 (nth 6 modifs)) + (m5 (nth 7 modifs)) + (ctrls (list (car (xwem-kbd-xksym->xkcode XK-Control-L)) + (car (xwem-kbd-xksym->xkcode XK-Control-R)))) + (shifts (list (car (xwem-kbd-xksym->xkcode XK-Shift-L)) + (car (xwem-kbd-xksym->xkcode XK-Shift-R)))) + (metas (list (car (xwem-kbd-xksym->xkcode XK-Meta-L)) + (car (xwem-kbd-xksym->xkcode XK-Meta-R)))) + (hypers (list (car (xwem-kbd-xksym->xkcode XK-Hyper-L)) + (car (xwem-kbd-xksym->xkcode XK-Hyper-R)))) + (supers (list (car (xwem-kbd-xksym->xkcode XK-Super-L)) + (car (xwem-kbd-xksym->xkcode XK-Super-R)))) + (mlist (mapcar (lambda (m) + (truncate m)) + (list X-Shift X-Control X-Mod1 X-Mod2 + X-Mod3 X-Mod4 X-Mod5))) + (slist (list sh ctrl m1 m2 m3 m4 m5))) + + (while slist + ;; TODO: locks + (when (intersection (car slist) shifts) + (aset xwem-kbd-private-modifiers 0 (cons (car mlist) (aref xwem-kbd-private-modifiers 0)))) + (when (intersection (car slist) ctrls) + (aset xwem-kbd-private-modifiers 2 (cons (car mlist) (aref xwem-kbd-private-modifiers 2)))) + (when (intersection (car slist) metas) + (aset xwem-kbd-private-modifiers 3 (cons (car mlist) (aref xwem-kbd-private-modifiers 3)))) + (when (intersection (car slist) hypers) + (aset xwem-kbd-private-modifiers 4 (cons (car mlist) (aref xwem-kbd-private-modifiers 4)))) + (when (intersection (car slist) supers) + (aset xwem-kbd-private-modifiers 5 (cons (car mlist) (aref xwem-kbd-private-modifiers 5)))) + + (setq slist (cdr slist)) + (setq mlist (cdr mlist))))) + +;;;###autoload +(defun xwem-kbd-init () + "Init part for keys. +Fetches KeyboardMapping from the X server and stores it in +`xwem-xkeys-mapping'" + (xwem-message 'msg "Initializing keyboard ... wait") + (xwem-kbd-set-current-prefix-keymap nil) + + ;; Hmm FSFmacs issued "invalid instraction" in `XGetKeyboardMapping' + (setq xwem-xkeys-mapping + (XGetKeyboardMapping (xwem-dpy) + (X-Dpy-min-keycode (xwem-dpy)) + (- (X-Dpy-max-keycode (xwem-dpy)) + (X-Dpy-min-keycode (xwem-dpy))))) + + (setq xwem-xmods-mapping + (XGetModifierMapping (xwem-dpy))) + + ;; Initialize `xwem-kbd-private-modifiers' + (xwem-kbd-initialize-private-modifiers) + + ;; Initialize keyboard macrosing + (xwem-keymacro-init) + + ;; Initialize root window grabbing +; (xwem-kbd-install-grab xwem-root-map (xwem-rootwin)) + ) + +;;}}} + +;;{{{ [-] Converters + +;; Convertors +(defun xwem-kbd-xksym->emacs (ksym) + "Convert KSYM to Emacs key symbol." + (cond + ;; ksym is list for buttons + ((listp ksym) + (let ((kval (car ksym))) + (cond ((= kval 1) 'button1) + ((= kval 2) 'button2) + ((= kval 3) 'button3) + ((= kval 4) 'button4) + ((= kval 5) 'button5) + (t nil)))) ;can't be!!! + + ((= ksym XK-BackSpace) 'backspace) + ((= ksym XK-Tab) 'tab) + ((= ksym XK-Linefeed) 'linefeed) + ((= ksym XK-Return) 'return) + ((= ksym XK-Escape) 'escape) + ((= ksym XK-Delete) 'delete) + + ((= ksym XK-Home) 'home) + ((= ksym XK-End) 'end) + ((= ksym XK-Left) 'left) + ((= ksym XK-Right) 'right) + ((= ksym XK-Up) 'up) + ((= ksym XK-Down) 'down) + + ((= ksym XK-Insert) 'insert) + ((= ksym XK-Pause) 'pause) + ((= ksym XK-Space) 'space) + ;; TODO: add more + + ((= ksym XK-F1) 'f1) + ((= ksym XK-F2) 'f2) + ((= ksym XK-F3) 'f3) + ((= ksym XK-F4) 'f4) + ((= ksym XK-F5) 'f5) + ((= ksym XK-F6) 'f6) + ((= ksym XK-F7) 'f7) + ((= ksym XK-F8) 'f8) + ((= ksym XK-F9) 'f9) + ((= ksym XK-F10) 'f10) + ((= ksym XK-F11) 'f11) + ((= ksym XK-F12) 'f12) + + ((= ksym 0) nil) + + (t (XCharacter ksym)))) ;nil or proper character + +(defun xwem-kbd-emacs->xksym (ksym) + "Convert back from Emacs key symbol KSYM to proper X key symbol." + (cond ((null ksym) 0) ;hmm + + ((symbolp ksym) + (let ((osymname (symbol-name ksym)) + (symname (downcase (symbol-name ksym)))) + (cond ((string= symname "backspace") XK-BackSpace) + ((string= symname "tab") XK-Tab) + ((string= symname "linefeed") XK-Return) ;XXX + ((string= symname "linefeed") XK-Linefeed) + ((string= symname "return") XK-Return) + ((string= symname "escape") XK-Escape) + ((string= symname "delete") XK-Delete) + ((string= symname "space") XK-Space) + + ((string= symname "home") XK-Home) + ((string= symname "end") XK-End) + ((string= symname "left") XK-Left) + ((string= symname "right") XK-Right) + ((string= symname "up") XK-Up) + ((string= symname "down") XK-Down) + + ((string= symname "insert") XK-Insert) + ((string= symname "pause") XK-Pause) + + ;; Mouse buttons + ((string= symname "button1") (list X-XButton1)) + ((string= symname "button2") (list X-XButton2)) + ((string= symname "button3") (list X-XButton3)) + ((string= symname "button4") (list X-XButton4)) + ((string= symname "button5") (list X-XButton5)) + + ;; Functional keys + ((string-match "[fF]\\([0-9]+\\)" symname) + (symbol-value + (intern + (concat "XK-F" + (substring symname (match-beginning 1) + (match-end 1)))))) + + (t (Xforcenum (string-to-char osymname)))))) + + ((characterp ksym) (Xforcenum ksym)) ;Should not be there + + (t 0))) ;HMM! + +(defun xwem-kbd-emods->xmodmask (emods) + "Convert Emacs modifiers list EMODS to X modifer Mask." + (Xmask-or + (if (member 'control emods) (xwem-kbd-controlmask) 0) + (if (member 'shift emods) (xwem-kbd-shiftmask) 0) + (if (member 'meta emods) (xwem-kbd-metamask) 0) + (if (member 'hyper emods) (xwem-kbd-hypermask) 0) + (if (member 'super emods) (xwem-kbd-supermask) 0))) + +(defun xwem-kbd-xmodmask->emods (mmask) + "Convert X modifier mask MMASK to Emacs modifiers list." + (let (rmods) + (when (Xtest mmask (xwem-kbd-controlmask)) + (push 'control rmods)) + (when (Xtest mmask (xwem-kbd-shiftmask)) + (push 'shift rmods)) + (when (Xtest mmask (xwem-kbd-hypermask)) + (push 'hyper rmods)) + (when (Xtest mmask (xwem-kbd-metamask)) + (push 'meta rmods)) + (when (Xtest mmask (xwem-kbd-supermask)) + (push 'super rmods)) + rmods)) + +;; keysyms and keycodes converters +(defun xwem-kbd-xksym->xkcode (ksym) + "Convert keysym KSYM to keycode. +Convert keysym to cons cell where car is keycode and cdr is modifiers +list, using `xwem-xkeys-mapping' list. +NOTE: only 'shift modifier supported." + (setq ksym (float ksym)) ; for sure + (let ((kslist (car (last xwem-xkeys-mapping))) + (kcode (X-Dpy-min-keycode (xwem-dpy))) + (kmods nil) + kel) + + (while kslist + (setq kel (car kslist)) + (if (member ksym kel) + (progn + (cond ((= ksym (nth 0 kel)) nil) + ((= ksym (nth 1 kel)) + (setq kmods (cons 'shift kmods))) + (t nil)) + (setq kslist nil)) + + (setq kslist (cdr kslist)) + (setq kcode (1+ kcode)) + )) + (cons kcode kmods))) + +(defun xwem-kbd-xkcode->xksym (kcode) + "Convert key code KCODE to keysym. +KeyCode -> KeySyms list in form (base shift caps ShiftCaps)." + (nth (- kcode (X-Dpy-min-keycode (xwem-dpy))) (car (last xwem-xkeys-mapping))) + ) + +;;; Various subroutines +;;;###autoload +(defun xwem-kbd-emod->kcode (emod &optional any) + "Convert Emacs modifier EMOD to X keycode. +Behaviour is undefined If ANY argument is supplied. +DO NOT RELY ON THIS FUNCTION." + (let* ((mods (car (last xwem-xmods-mapping))) + (rmod (cond ((eq emod 'shift) (nth 0 mods)) + ;; locks skiped + ((eq emod 'control) (nth 2 mods)) + ((eq emod 'meta) (nth 3 mods)) + ;; numlock skiped + ((eq emod 'hyper) (nth 5 mods)) + ((eq emod 'super) (nth 6 mods)) + (t (error (format "Bad modifier `%S'" emod)))))) + (if any + rmod + (car rmod)))) + +(defun xwem-kbd-kcode->emod (kcode) + "Convert key code KCODE to Emacs modifier, if KCODE is actually a modifier. +See also `xwem-kbd-kcode-modifier-p'." + (let* ((mods (car (last xwem-xmods-mapping))) + (rmod (cond ((member kcode (nth 0 mods)) 'shift) + ;; locks skiped + ((member kcode (nth 2 mods)) 'control) + ((member kcode (nth 3 mods)) 'meta) + ;; numlock skiped + ((member kcode (nth 5 mods)) 'hyper) + ((member kcode (nth 6 mods)) 'super) + (t nil)))) + rmod)) + +(defun xwem-kbd-kcode-modifier-p (kcode) + "Return non-nil if key code KCODE is modifier." + (let ((mods (car (last xwem-xmods-mapping)))) + (while (and mods + (not (member kcode (car mods)))) + (setq mods (cdr mods))) + (car mods))) + +(defun xwem-kbd-adjust-keycode (keycode modifiers) + "Convert KEYCODE to keysym according to MODIFIERS." + ;; XXX only 'shift modifier supported + (if (and (member 'shift modifiers) + (> (cadr (xwem-kbd-xkcode->xksym keycode)) 0)) + (cadr (xwem-kbd-xkcode->xksym keycode)) + + (car (xwem-kbd-xkcode->xksym keycode)))) + +(defun xwem-kbd-adjust-modifiers (keycode modifiers) + "According to KEYCODE adjust MODIFIERS, i.e. remove 'shift." + (if (and (member 'shift modifiers) + (> (cadr (xwem-kbd-xkcode->xksym keycode)) 0)) + ;; 'shift in modifiers and keysym is valid, so we remove 'shift + (remove 'shift modifiers) + + modifiers)) + +;;;###autoload +(defun xwem-kbd-xevents->emacs-events (xevs &optional trust-modbits) + "Convert X-Events XEVS to Emacs events. + +If TRUST-MODBITS is non-nil than we can trust modifier bits in +X-Event, otherwise we are trying to keep track of modifiers presses +and releases. This is needed because core X events obtained from +RECORD extension does not have valid inforamtion about modifiers +bits." + + ;; NOTE: events garbbed using RECORD extension does not have correct + ;; state field. + (let ((rxevs (cond ((listp xevs) (vconcat xevs)) + ((vectorp xevs) xevs) + (t xevs))) + eevs xevtype kcode mbutton current-modifiers) + + ;; TODO: + ;; - Change `mapcar' to `mapvector' + (setq eevs + (mapcar (lambda (xev) + (setq xevtype (X-Event-type xev)) + + (unless (member xevtype (list X-KeyPress X-KeyRelease X-ButtonPress X-ButtonRelease X-MotionNotify)) + (error "Invalid event type: %s" (X-Event-name xev))) + + (setq kcode nil + mbutton nil) + (cond ((member xevtype (list X-KeyPress X-KeyRelease)) + (setq kcode (X-Event-xkey-keycode xev))) + ((member xevtype (list X-ButtonPress X-ButtonRelease)) + (setq mbutton (X-Event-xbutton-button xev)))) + + (if (xwem-kbd-kcode-modifier-p kcode) + ;; KCODE is actually modifier + (if (= (X-Event-type xev) X-KeyPress) + (setq current-modifiers (cons (xwem-kbd-kcode->emod kcode) current-modifiers)) + (setq current-modifiers (delete (xwem-kbd-kcode->emod kcode) current-modifiers))) + + ;; Skip normal key realese events + (unless (eq xevtype X-KeyRelease) + + ;; If we can trust modifier bits, get information about + ;; modifiers currently pressed from state field. + (when trust-modbits + (setq current-modifiers + (xwem-kbd-xmodmask->emods + (cond ((eq xevtype X-KeyPress) (X-Event-xkey-state xev)) + ((member xevtype (list X-ButtonPress X-ButtonRelease)) + (X-Event-xbutton-state xev)) + ((eq xevtype X-MotionNotify) (X-Event-xmotion-state xev)))))) + + (make-event (cond ((eq xevtype X-KeyPress) 'key-press) + ((eq xevtype X-ButtonPress) 'button-press) + ((eq xevtype X-ButtonRelease) 'button-release) + ((eq xevtype X-MotionNotify) 'motion) + (t (error "Unknown event: %s" (X-Event-name xev)))) + (nconc (when (member xevtype (list X-ButtonPress X-ButtonRelease X-MotionNotify)) + (list 'x (cond ((member xevtype (list X-ButtonPress X-ButtonRelease)) + (X-Event-xbutton-root-x xev)) + (t (X-Event-xmotion-root-x xev))) + 'y (cond ((member xevtype (list X-ButtonPress X-ButtonRelease)) + (X-Event-xbutton-root-y xev)) + (t (X-Event-xmotion-root-y xev))))) + (list 'modifiers (xwem-kbd-adjust-modifiers kcode current-modifiers)) + (when (eq xevtype X-KeyPress) + (list 'key (xwem-kbd-xksym->emacs + (xwem-kbd-adjust-keycode kcode current-modifiers)))) + (when (member xevtype (list X-ButtonPress X-ButtonRelease)) + (list 'button mbutton))))) + )) + rxevs)) + + ;; Remove non-events from list + (delete* nil eevs :test (lambda (el1 el2) (not (eventp el2)))) + )) + +(defun xwem-kbd-emacs-events->xevents (events) + "Convert Emacs EVENTS list to X events list." + ) + +;;;###autoload +(defun xwem-kbd-ekeys->eevents (ekeys) + "Convert Emacs keys sequence EKEYS to Emacs events vector." + (mapvector (lambda (key) + (let (mods keychar) + + (if (listp key) + (progn + (setq keychar (car (last key))) + (setq mods (butlast key))) + (setq keychar key)) + + (make-event 'key-press (list 'modifiers mods + 'key keychar)))) + ekeys)) + +;;}}} + +;;{{{ [-] Sending + +;; Sending(using XTEST) +(defun xwem-key-sendseq (keycode-seq) + "Emulate KEYCODE-SEQ. +KEYCODE-SEQ is list of cons cells where car is event type and cdr is keycode. +Supported event types are `X-Xtest-KeyPress' and `X-Xtest-KeyRelease'." + (mapc (lambda (ksel) + (let ((ktype (car ksel)) + (kcode nil) + (ktime nil)) + (cond ((vectorp (cdr ksel)) + (setq kcode (aref (cdr ksel) 0)) + (setq ktime (aref (cdr ksel) 1))) + (t + (setq kcode (cdr ksel)) + (setq ktime X-CurrentTime))) + (X-XTest-FakeInput (xwem-dpy) ktype kcode X-None 0 0 ktime))) + keycode-seq)) + +;;;###autoload +(defun xwem-key-send-ekeys (keys) + "Send Emacs key sequence KEYS using XTEST extension." + (let (lseq) + (mapc (lambda (key) + (let (mods code) + (setq mods (mapcar (lambda (mm) + (xwem-kbd-emod->kcode mm)) + (butlast key))) + + ;; Now calculade key CODE maybe add shift modifier + (setq code (xwem-kbd-xksym->xkcode + (xwem-kbd-emacs->xksym (car (last key))))) + (setq mods (nconc mods (mapcar (lambda (mm) + (xwem-kbd-emod->kcode mm)) + (cdr code)))) + (setq code (car code)) + + (mapc (lambda (mod) + (setq lseq (cons (cons X-Xtest-KeyPress mod) lseq))) + mods) + (setq lseq (cons (cons X-Xtest-KeyPress code) lseq)) + (setq lseq (cons (cons X-Xtest-KeyRelease code) lseq)) + (mapc (lambda (mod) + (setq lseq (cons (cons X-Xtest-KeyRelease mod) lseq))) + mods) + )) + (key-sequence-list-description keys)) + + (setq lseq (nreverse lseq)) + (xwem-key-sendseq lseq))) + +(defun xwem-kbd-wait-key-release (keycode) + "Wait for key with KEYCODE for release." + (unless xwem-executing-kbd-macro + + ;; Increase events queue protecs so no events will be + ;; processed inside `XIfEvent'. + (incf (X-Dpy-evq-protects (xwem-dpy))) + + ;; Wait for a keyrelease + (unwind-protect + (XIfEvent (xwem-dpy) + (lambda (xev) + (and (= (X-Event-type xev) X-KeyRelease) + (= (X-Event-xkey-keycode xev) keycode)))) + + ;; Allow later events processing + (decf (X-Dpy-evq-protects (xwem-dpy)))))) + +;;;###autoload +(defun xwem-kbd-force-mods-release () + "Force release of some modifiers." + (let* ((xmods (car (last xwem-xmods-mapping))) + (mods (list (car (nth 0 xmods)) ; shift + (car (nth 2 xmods)) ; control + (car (nth 3 xmods)) ; meta + (car (nth 5 xmods)) ; hyper + (car (nth 6 xmods))))) ; super + (mapc (lambda (mod) + (X-XTest-FakeInput (xwem-dpy) X-Xtest-KeyRelease mod (xwem-rootwin) 0 0)) + (delete 0 mods)) + )) + +(defun xwem-kbd-wait-button-release (button) + "Wait for BUTTON for release." + ) + +;;}}} + +;;{{{ [-] keypress/KeyRelease processing + +(defun xwem-kbd-echolastkey () + "Echo key sequence already pressed in xwem minibuffer." + (when xwem-keyboard-echo-keystrokes + ;; XXX if there message from XWEM in minibuffer than add, otherwise + (if (xwem-interactive-p) + (append-message 'command (concat (single-key-description xwem-last-event) " ")) + + (xwem-clear-message) + (display-message 'command (key-description xwem-this-command-keys))))) + +;;;###autoload +(defun xwem-kbd-current-map () + "Return current prefix map." + (let ((cm (or xwem-override-map xwem-kbd-private-prefix-map xwem-global-map))) + (when (symbolp cm) + (setq cm (symbol-function cm))) + cm)) + +(defun xwem-kbd-set-current-prefix-keymap (newkeymap) + "Set current keymap to NEWKEYMAP. + +Use (xwem-kbd-set-current-prefix-keymap nil) to set current keymap +to `xwem-global-keymap' instead of +(xwem-kbd-set-current-prefix-keymap xwem-global-map)." + (setq xwem-kbd-private-prefix-map newkeymap)) + +(defun xwem-kbd-handle-keyrelease (xdpy win xev) + "On XDPY and window WIN handle KeyRelease event XEV." + ;; TODO: + ;; - modifiers tracker + nil) + +;;;###autoload +(defun xwem-kbd-key-binding (keys &optional keymap accept-default) + "Return key binding corresponding to KEYS in KEYMAP. +If KEYMAP is ommited, `xwem-global-map' will be used. +`xwem-kbd-key-binding' omits default KEYMAP binding unless +ACCEPT-DEFAULT is non-nil." + (lookup-key (or keymap (xwem-kbd-current-map)) keys accept-default)) + +;;;###autoload +(defun xwem-kbd-key-binding-evs (evs &optional keymap accept-default) + "Return key binding corresponding to Emacs events EVS in KEYMAP. +If KEYMAP is ommited, `xwem-global-map' will be used. +ACCEPT-DEFAULT is the same as for `xwem-kbd-key-binding'." + (xwem-kbd-key-binding (events-to-keys evs) keymap accept-default)) + +;;;###autoload +(defun xwem-kbd-handle-keybutton (xev) + "On display XDPY and window WIN handle KeyPress or ButtonPress event XEV." + (if (and (= (X-Event-type xev) X-KeyPress) + (xwem-kbd-kcode-modifier-p (X-Event-xkey-keycode xev))) + ;; Seems that we are grabbing keyboard now and modifier + ;; pressed or it is case when some smart modifier pressed. + nil + + (xwem-kbd-handle-keybutton-from-emacs + (car (xwem-kbd-xevents->emacs-events (list xev) t)) xev))) + +;;;###autoload +(defun xwem-kbd-handle-keybutton-from-emacs (eev &optional xev) + "Handle Emacs event EEV originated from XWEM. +Optional X-Event XEV, if passed to obtain X specific information." + (let (lkm) + + ;; Remember some information about XEV event. + (when (X-Event-p xev) + (setq xwem-event-window (X-Event-win xev)) + (setq xwem-last-xevent xev)) + + (setq xwem-last-event eev) + + (setq xwem-this-command-keys + (vconcat xwem-this-command-keys (vector xwem-last-event))) + + (setq lkm (xwem-kbd-key-binding-evs (vector xwem-last-event))) + + ;; XXX -- maybe echoing should be done in `xwem-kbd-process-after-lookup'? + (xwem-kbd-echolastkey) + + (xwem-kbd-process-after-lookup lkm))) + +(defun xwem-kbd-process-after-lookup (lkm) + "Process keymap or command entry LKM after `lookup-key'." + (X-Dpy-log (xwem-dpy) "lkm = %S\n" 'lkm) + + (let ((slkm lkm) ;save lkm + (prfx-plist (when (and xwem-kbd-private-prefix-map + (symbolp xwem-kbd-private-prefix-map)) + (symbol-plist xwem-kbd-private-prefix-map))) + (splist (when (symbolp lkm) (symbol-plist lkm)))) + + (when (and (symbolp lkm) + (functionp lkm) + (keymapp (symbol-function lkm))) + (setq lkm (symbol-function lkm))) + + (X-Dpy-log (xwem-dpy) "PRFX-PLIST = %S, SPLIST = %S\n" 'prfx-plist 'splist) + + ;; Check for special mode, when we just reading single keystroke + (when xwem-kbd-reading-key + (xwem-read-keys-stop nil)) + + ;; Last chance to try default command + (when (null lkm) + (setq lkm (keymap-default-binding (xwem-kbd-current-map))) + (setq splist (and (symbolp lkm) (symbol-plist lkm)))) + + ;; Check is there need for prefix help or quit command + (when (and (null lkm) + xwem-kbd-now-grabbing) + (setq lkm + (let ((etk (events-to-keys (vector xwem-last-event)))) + (cond ((equal etk xwem-help-key) xwem-prefix-help-command) + ((equal etk xwem-quit-key) xwem-quit-command) + (t nil))))) + + ;; Now take a look at lkm + (cond ((null lkm) + ;; Check are we reading keysequence now + (when xwem-kbd-reading-keyseq + (xwem-read-keys-stop t)) + + (xwem-play-sound 'undefined-key) + (xwem-message 'info "%s not binded." (key-description xwem-this-command-keys)) + (xwem-kbd-stop-grabbing) + (xwem-kbd-set-current-prefix-keymap nil) + (setq xwem-this-command-keys []) + (setq xwem-kbd-reading-key nil) + (setq xwem-kbd-reading-keyseq nil) + + (let ((ex-fun (plist-get prfx-plist 'exit-fun))) + (when ex-fun (funcall ex-fun))) + ) + + ;; Prefix map + ((keymapp lkm) + + (xwem-kbd-set-current-prefix-keymap slkm) + (let ((enter-fun (plist-get splist 'enter-fun))) + (when enter-fun (funcall enter-fun))) + + (xwem-kbd-start-grabbing)) + + ;; Binded command or something else + (t + + ;; Check are we reading keysequence now + (when xwem-kbd-reading-keyseq + (xwem-read-keys-stop t)) + + ;; Sometimes command requires keyrelease before execution + (when (and (not xwem-executing-kbd-macro) + (or (vectorp lkm) ; Keybord macro, always need release + (and (symbolp lkm) ; LKM command need keyrelease + (plist-get (symbol-plist lkm) 'xwem-need-keyrelease)))) + + ;; LKM command need to wait keyrelease to run properly + (let ((kpev xwem-last-xevent)) + (when (= (X-Event-type kpev) X-KeyPress) + ;; Increase events queue protecs so no events will be + ;; processed inside `XIfEvent'. + (incf (X-Dpy-evq-protects (xwem-dpy))) + + ;; Wait for a keyrelease + + (XIfEvent (X-Event-dpy kpev) + (lambda (cev) (and (= (X-Event-type cev) X-KeyRelease) + (= (X-Event-xkey-keycode cev) + (X-Event-xkey-keycode kpev))))) + + ;; Allow later events processing + (decf (X-Dpy-evq-protects (xwem-dpy)))))) + + ;; Some commands need to bee runned in ungrabed keyboard + ;; mode + (when (and (not xwem-executing-kbd-macro) + (or (vectorp lkm) ; Keyboard macro, always need to run in ungrabbed keyboard + (and (symbolp lkm) ; LKM command need to run in ungrabbed keyboard + (plist-get (symbol-plist lkm) 'xwem-need-ungrabed-kbd)))) + (xwem-kbd-stop-grabbing)) + + ;; Function in lkm should use `xwem-kbd-last-prefix-map' + ;; instead of `xwem-kbd-private-prefix-map' + (setq xwem-kbd-last-prefix-map xwem-kbd-private-prefix-map) + (unless (or (plist-get prfx-plist 'congrab) + (plist-get splist 'congrab)) + (xwem-kbd-set-current-prefix-keymap nil) + + ;; TODO: may be do this after call-interactively? + (let ((ex-fun (plist-get prfx-plist 'exit-fun))) + (when ex-fun (funcall ex-fun)))) + + ;; Now run command or keyboard macro + (unwind-protect + (condition-case err + (cond ((vectorp lkm) (xwem-keymacro-internal-play + lkm + (prefix-numeric-value xwem-prefix-arg))) + + ((commandp lkm) (call-interactively lkm)) + (t (error "Unknown lkm %S" lkm))) + + (error + (xwem-play-sound 'command-fail) + (xwem-message 'err-nobeep "In cmd(%S): %s" lkm (error-message-string err))) + + (quit + (if (and (boundp 'xwem-bypass-quit) + (symbol-value 'xwem-bypass-quit)) + (signal 'quit (list 'xwem-bypass-quit (symbol-value 'xwem-bypass-quit))) + + (xwem-play-sound 'quit) + (xwem-message 'info "Quit: %s" err)))) + + ;; Release keyboard unless LKM command need to continue + ;; grabbing. + (unless (or (plist-get prfx-plist 'congrab) + (plist-get splist 'congrab)) + (xwem-kbd-stop-grabbing) + (setq xwem-this-command-keys []) + (setq xwem-prefix-arg nil))) + + ;; Run post command hook + (run-hooks 'xwem-post-command-hook) + ) + + (t (error + (format "Hm .. strange lkm=%S" lkm)))))) + +;;}}} + +;;{{{ [-] Grabbing + +(defun xwem-kbd-graugra-key (key win mode &optional button-mask) + "Grab or Ungrab KEY on WIN. +MODE is either 'grab or 'ungrab. +BUTTON-MASK is mask passed to `XGrabButton' if MODE is 'grab and key +is actually a mouse key." + (let* ((key (aref (key-sequence-list-description key) 0)) + (kmods (butlast key)) + (ksyko (xwem-kbd-emacs->xksym (car (last key)))) + mouse) + + (if (listp ksyko) + (setq mouse (car ksyko)) + + (setq ksyko (xwem-kbd-xksym->xkcode ksyko)) + (when (eq (cadr ksyko) 'shift) + (setq kmods (cons 'shift kmods))) + (setq ksyko (car ksyko))) + + (setq kmods (xwem-kbd-emods->xmodmask kmods)) + + (if mouse + (if (eq mode 'grab) + (XGrabButton (xwem-dpy) mouse kmods win + (or button-mask (Xmask-or XM-ButtonPress))) + (XUngrabButton (xwem-dpy) mouse kmods win)) + + (if (eq mode 'grab) + (XGrabKey (xwem-dpy) ksyko kmods win t) + (XUngrabKey (xwem-dpy) ksyko kmods win))))) + +(defun xwem-kbd-grab-key (key win) + "Grab KEY on WIN." + (xwem-kbd-graugra-key key win 'grab)) + +(defun xwem-kbd-ungrab-key (key win) + "Stop grabbing KEY on WIN." + (xwem-kbd-graugra-key key win 'ungrab)) + +;;;###autoload +(defun xwem-kbd-install-grab (keymap win) + "Install KEYMAP grabs on X window WIN." + (map-keymap (lambda (key unused) + (xwem-kbd-grab-key key win)) + keymap)) + +;;;###autoload +(defun xwem-kbd-uninstall-grab (keymap win) + "Uninstall KEYMAP grabs on X window WIN." + (map-keymap (lambda (key unused) + (xwem-kbd-ungrab-key key win)) + keymap)) + +;;;###autoload +(defun xwem-kbd-start-grabbing (&optional cursor) + "Begin grabbing keyboard (some key-prefix is entered). +Optionally you can specify CURSOR to be used, while grabbing." + (unless xwem-kbd-now-grabbing + (unless xwem-executing-kbd-macro + (XGrabKeyboard (xwem-dpy) (or (xwem-focus-xcurrent) (xwem-rootwin)) nil) + (xwem-mouse-grab (or cursor xwem-cursor-wait))) + + (setq xwem-kbd-now-grabbing t))) + +;;;###autoload +(defun xwem-kbd-start-grabbing-sync (&optional cursor) + "Same as `xwem-kbd-start-grabbing', but initiate grabs in Sync mode. +CURSOR argument is same is for `xwem-kbd-start-grabbing'." + (unless xwem-kbd-now-grabbing + (unless xwem-executing-kbd-macro + (XGrabKeyboard (xwem-dpy) (or (xwem-focus-xcurrent) (xwem-rootwin)) + nil X-GrabModeSync X-GrabModeSync) + (xwem-mouse-grab (or cursor xwem-cursor-wait)) + ) + + (setq xwem-kbd-now-grabbing t))) + +;;;###autoload +(defun xwem-kbd-stop-grabbing () + "Stop grabbing keyboard." + (when xwem-kbd-now-grabbing + (unless xwem-executing-kbd-macro + (XUngrabKeyboard (xwem-dpy)) + (xwem-mouse-ungrab)) + + (setq xwem-kbd-now-grabbing nil))) + +(define-xwem-command xwem-kbd-quote-command () + "Pass event EV to currently active window." + (xwem-interactive "_") + + (let ((xwin (xwem-focus-xcurrent))) + (when (X-Win-p xwin) + (XGrabKeyboard (xwem-dpy) xwin nil X-GrabModeAsync X-GrabModeSync) + (XGrabPointer (xwem-dpy) xwin (Xmask-or XM-ButtonPress XM-ButtonRelease) + xwem-cursor-quote nil X-GrabModeSync) + (XAllowEvents (xwem-dpy) X-SyncBoth) + + (xwem-message 'info "[Quote key]") + (unwind-protect + (let ((done nil) + xev) + (while (not done) + (setq xev (XNextEvent (xwem-dpy))) + (if (and (member (X-Event-type xev) + (list X-KeyPress X-ButtonPress X-ButtonRelease)) + (xwem-kbd-xevents->emacs-events (list xev) t)) + (progn + (XAllowEvents (xwem-dpy) X-ReplayKeyboard) + (XAllowEvents (xwem-dpy) X-ReplayPointer) + (xwem-clear-message) + (setq done t)) + + (XAllowEvents (X-Event-dpy xev) X-SyncBoth)))) + + (XUngrabKeyboard (xwem-dpy)) + (XUngrabPointer (xwem-dpy)) + )))) + +;;}}} + +;;{{{ [-] Universal argument + +;;;###autoload +(defvar xwem-prefix-arg nil +"The value of the prefix argument for this editing command. + +It may be a number, or the symbol `-' for just a minus sign as arg, or +a list whose car is a number for just one or more +\\<xwem-global-map>\\[xwem-universal-argument] or `nil' if no argument +has been specified. This is what `\\(xwem-interactive \"P\"\\)' +returns.") + +(defconst xwem-universal-map + (let ((map (make-sparse-keymap))) + (set-keymap-default-binding map 'xwem-universal-command) + (define-key map xwem-universal-key 'xwem-universal-more) + (define-key map [?-] 'xwem-universal-minus) + (define-key map [?0] 'xwem-universal-digit) + (define-key map [?1] 'xwem-universal-digit) + (define-key map [?2] 'xwem-universal-digit) + (define-key map [?3] 'xwem-universal-digit) + (define-key map [?4] 'xwem-universal-digit) + (define-key map [?5] 'xwem-universal-digit) + (define-key map [?6] 'xwem-universal-digit) + (define-key map [?7] 'xwem-universal-digit) + (define-key map [?8] 'xwem-universal-digit) + (define-key map [?9] 'xwem-universal-digit) + map) + "Keymap used while processing \\<xwem-global-map>\\[xwem-universal-argument].") + +(define-xwem-command xwem-universal-argument () + "Begin a numeric argument for the following command. +Digits or minus sign following +\\<xwem-global-map>\\[xwem-universal-argument] make up the numeric +argument. \\<xwem-global-map>\\[xwem-universal-argument] following the +digits or minus sign ends the argument. +\\<xwem-global-map>\\[xwem-universal-argument] without digits or minus +sign provides 4 as argument. +Repeating \\<xwem-global-map>\\[xwem-universal-argument] without digits or +minus sign multiplies the argument by 4 each time." + (xwem-interactive) + + (setq xwem-prefix-arg (list 4)) + (when (not xwem-kbd-now-grabbing) + (xwem-kbd-set-current-prefix-keymap xwem-universal-map) + (xwem-kbd-start-grabbing))) + +(put 'xwem-universal-argument 'congrab t) + +;; A subsequent H-u means to multiply the factor by 4 if we've typed +;; nothing but H-u's; otherwise it means to terminate the prefix arg. +(define-xwem-command xwem-universal-more (arg) + "A subsequent \\<xwem-universal-map>\\[xwem-universal-more] means to + multiply the factor by 4 if we've typed nothing but + \\<xwem-universal-map>\\[xwem-universal-more]'s; otherwise it means + to terminate the prefix arg." + (xwem-interactive "P") + + (if (consp xwem-prefix-arg) + (setq xwem-prefix-arg (list (* 4 (car arg)))) + + (setq xwem-prefix-arg arg) + (xwem-kbd-set-current-prefix-keymap nil))) + +(put 'xwem-universal-more 'congrab t) + +(define-xwem-command xwem-universal-minus (arg) + "Begin a negative numeric argument for the next command. +\\<xwem-global-map>\\[xwem-universal-argument] following digits or +minus sign ends the argument." + (xwem-interactive "P") + + (setq xwem-prefix-arg (cond ((integerp arg) (- arg)) + ((eq arg '-) nil) + (t '-))) + (when (not xwem-kbd-now-grabbing) + (xwem-kbd-set-current-prefix-keymap xwem-universal-map) + (xwem-kbd-start-grabbing))) + +(put 'xwem-universal-minus 'congrab t) + +(define-xwem-command xwem-universal-digit (arg) + "Part of the numeric argument for the next command. +\\<xwem-global-map>\\[xwem-universal-argument] following digits or +minus sign ends the argument." + (xwem-interactive "P") + + (let* ((num (event-key xwem-last-event)) + (digit (- num ?0))) + (cond ((integerp arg) + (setq xwem-prefix-arg (+ (* arg 10) (if (< arg 0) (- digit) digit)))) + ((eq arg '-) + ;; Treat -0 as just -, so that -01 will work. + (setq xwem-prefix-arg (if (zerop digit) '- (- digit)))) + + (t (setq xwem-prefix-arg digit))) + + (when (not xwem-kbd-now-grabbing) + (xwem-kbd-set-current-prefix-keymap xwem-universal-map) + (xwem-kbd-start-grabbing)))) + +(put 'xwem-universal-digit 'congrab t) + +(defun xwem-reset-this-command-lengths () + "For some documentation look at `reset-this-command-lengths'." + ;; This brokes some things, like H-1 H-2 H-3 will not be properly + ;; displayed in minibuffer, so i disabled it. + + ;; Also there is notice in event-stream.c to + ;; `reset-this-command-lengths': + ;; + ;; /* #### I don't understand this at all, so currently it does nothing. + ;; If there is ever a problem, maybe someone should investigate. */ + + ; (setq xwem-this-command-keys (vector xwem-last-event)) + ) + +(define-xwem-command xwem-universal-command (arg) + "Handle universal argument functionality." + (xwem-interactive "P") + + (setq xwem-prefix-arg arg) + (xwem-reset-this-command-lengths) + (xwem-kbd-set-current-prefix-keymap nil) + + (xwem-kbd-process-after-lookup + (xwem-kbd-key-binding-evs (vector xwem-last-event))) + ) + +(put 'xwem-universal-command 'congrab t) + +;;}}} + + +(provide 'xwem-keyboard) + +;;; xwem-keyboard.el ends here diff --git a/lisp/xwem-keydefs.el b/lisp/xwem-keydefs.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWtleWRlZnMuZWw= --- /dev/null +++ b/lisp/xwem-keydefs.el @@ -0,0 +1,325 @@ +;;; xwem-keydefs.el --- Define standard XWEM keybindings. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 15:47:42 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(defmacro xwem-keymap-put-prop (keymap prop value) + "In on of xwem KEYMAP put property PROP with VALUE." + `(setplist ,keymap (plist-put (symbol-plist ,keymap) ,prop ,value))) + +(put 'xwem-keymap-put-prop 'lisp-indent-function 2) + +;;;###autoload +(defvar xwem-global-map (make-sparse-keymap 'XWEM-global-map) + "XWEM's global keymap. + +Bindings: +\\{xwem-global-map}.") + +;;; Prefixes + +;; XWEM keymap prefixes may have properties: +;; +;; * 'congrab - If non-nil then continue grabbing after command from +;; that keymap issued. Prefix is unchanged. +;; * 'enter-fun - this function will be called when prefix installed +;; * 'exit-fun - this function will be called when prefix deinstalled +;; + +;; Extended commands +(xwem-define-prefix-command 'xwem-Hyper-X-prefix t) +(defvar xwem-hyp-x-map (symbol-function 'xwem-Hyper-X-prefix) + "Keymap for extended (\\<xwem-global-map>\\[xwem-Hyper-X-prefix]) commands. + +Bindings: +\\{xwem-hyp-x-map}") +(define-key xwem-global-map (xwem-kbd "H-x") 'xwem-Hyper-X-prefix) + +;; Help +;;;###autoload +(defvar xwem-help-map (symbol-function (xwem-define-prefix-command 'xwem-help-prefix t)) + "Keymap for help (\\<xwem-global-map>\\[xwem-help-prefix]) commands. + +Bindings: +\\{xwem-help-map}") +(xwem-keymap-put-prop 'xwem-help-prefix 'enter-fun + (lambda () + (xwem-kbd-start-grabbing xwem-cursor-help) + (xwem-message 'info (format (substitute-command-keys + "Entering XWEM help, type \\<xwem-help-map>\\[xwem-help-for-help] for help."))))) +(define-key xwem-global-map (xwem-kbd "H-h") 'xwem-help-prefix) + +;; Window commands +(xwem-define-prefix-command 'xwem-Hyper-X-4-prefix t) +(defvar xwem-hyp-x-4-map (symbol-function 'xwem-Hyper-X-4-prefix) + "Keymap for subcommands of \\<xwem-global-map>\\[xwem-Hyper-X-4-prefix]. + +Bindings: +\\{xwem-hyp-x-4-map}") +(define-key xwem-global-map (xwem-kbd "H-x 4") 'xwem-Hyper-X-4-prefix) + +;; Frame commads +(xwem-define-prefix-command 'xwem-Hyper-X-5-prefix t) +(defvar xwem-hyp-x-5-map (symbol-function 'xwem-Hyper-X-5-prefix) + "Keymap for subcommands of \\<xwem-global-map>\\[xwem-Hyper-X-5-prefix]. + +Bindings: +\\{xwem-hyp-x-5-map}") +(define-key xwem-global-map (xwem-kbd "H-x 5") 'xwem-Hyper-X-5-prefix) + +;; Client commands +(xwem-define-prefix-command 'xwem-Hyper-X-7-prefix t) +(defvar xwem-hyp-x-7-map (symbol-function 'xwem-Hyper-X-7-prefix) + "Keymap for subcommands of \\<xwem-global-map>\\[xwem-Hyper-X-7-prefix]. + +Bindings: +\\{xwem-hyp-x-7-map}") +(define-key xwem-global-map (xwem-kbd "H-x 7") 'xwem-Hyper-X-7-prefix) + +;; Launcher keymap +(xwem-define-prefix-command 'xwem-launcher-prefix t) +(defvar xwem-launcher-map (symbol-function 'xwem-launcher-prefix) + "Keymap for xwem launcher (\\<xwem-global-map>\\[xwem-launcher-prefix]) commands. + +Bindings: +\\{xwem-launcher-map}") +(define-key xwem-global-map (xwem-kbd "H-a") 'xwem-launcher-prefix) + +(xwem-define-prefix-command 'xwem-launcher-other-win-prefix) +(defvar xwem-launcher-other-win-map (symbol-function 'xwem-launcher-other-win-prefix) + "Keymap for launcher in other window (\\<xwem-global-map>\\[xwem-launcher-other-win-prefix]) commands. + +Bindings: +\\{xwem-launcher-other-win-map}") +(define-key xwem-hyp-x-4-map (xwem-kbd "H-a") 'xwem-launcher-other-win-prefix) + +(xwem-define-prefix-command 'xwem-launcher-other-frame-prefix) +(defvar xwem-launcher-other-frame-map (symbol-function 'xwem-launcher-other-frame-prefix) + "Keymap for launcher in other frame (\\<xwem-global-map>\\[xwem-launcher-other-frame-prefix]) commands. + +Bindings: +\\{xwem-launcher-other-frame-map}") +(define-key xwem-hyp-x-5-map (xwem-kbd "H-a") 'xwem-launcher-other-frame-prefix) + +;; Keyboard macros keymap +;;;###autoload +(defvar xwem-user-macros-map (symbol-function (xwem-define-prefix-command 'xwem-user-macros-prefix t)) + "Keymap of user defined keyboard macros (\\<xwem-global-map>\\[xwem-user-macros-prefix]) commands. + +Bindings: +\\{xwem-user-macros-map}") +(set-keymap-default-binding xwem-user-macros-map 'xwem-keymacro-undefined) +(define-key xwem-user-macros-map (xwem-kbd "H-h") xwem-prefix-help-command) +(define-key xwem-global-map (xwem-kbd "H-m") 'xwem-user-macros-prefix) + +;; Window Resizing keymap +(xwem-define-prefix-command 'xwem-resize-prefix t) +(defvar xwem-hyp-resize-map (symbol-function 'xwem-resize-prefix) + "Keymap for window resize (\\<xwem-global-map>\\[xwem-resize-prefix]) commands. + +Bindings: +\\{xwem-hyp-resize-map}") +(define-key xwem-global-map (xwem-kbd "H-R") 'xwem-resize-prefix) + +;; Mode specific commands +(xwem-define-prefix-command 'xwem-mode-specific-prefix t) +(defvar xwem-mode-specific-map (symbol-function 'xwem-mode-specific-prefix) + "Keymap for mode specific (\\<xwem-global-map>\\[xwem-mode-specific-prefix]) commands. + +Bindings: +\\{xwem-mode-specific-map}") +(define-key xwem-global-map (xwem-kbd "H-c") 'xwem-mode-specific-prefix) + + +;;; Default bindings for `xwem-global-map' +(set-keymap-default-binding xwem-global-map 'xwem-self-insert-or-undefined) + +(define-key xwem-global-map (xwem-kbd "H-g") xwem-quit-command) +(define-key xwem-global-map (xwem-kbd "H-G") 'xwem-kbd-quit) + +;; Quoting keyboard +(define-key xwem-global-map (xwem-kbd "H-q") 'xwem-kbd-quote-command) + +;; help keys +(define-key xwem-global-map (xwem-kbd "H-h H-h") 'xwem-help-for-help) +(define-key xwem-global-map (xwem-kbd "H-h b") 'xwem-help-describe-bindings) +(define-key xwem-global-map (xwem-kbd "H-h c") 'xwem-help-clients) +(define-key xwem-global-map (xwem-kbd "H-h f") 'xwem-help-frames) +(define-key xwem-global-map (xwem-kbd "H-h w") 'xwem-help-wins) +(define-key xwem-global-map (xwem-kbd "H-h k") 'xwem-help-describe-key) +(define-key xwem-global-map (xwem-kbd "H-h h") 'xwem-help) +(define-key xwem-global-map (xwem-kbd "H-h H-w") 'xwem-help-where-is) +(define-key xwem-global-map (xwem-kbd "H-h H-f") 'xwem-help-function) +(define-key xwem-global-map (xwem-kbd "H-h l") 'xwem-show-message-log) +(define-key xwem-global-map (xwem-kbd "H-h s") 'xwem-strokes-list) + +;; Universal argument +(define-key xwem-global-map (xwem-kbd "H-u") 'xwem-universal-argument) + +(define-key xwem-global-map (xwem-kbd "H--") 'xwem-universal-minus) +(define-key xwem-global-map (xwem-kbd "H-0") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-1") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-2") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-3") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-4") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-5") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-6") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-7") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-8") 'xwem-universal-digit) +(define-key xwem-global-map (xwem-kbd "H-9") 'xwem-universal-digit) + +;; Keyboard macros +(define-key xwem-global-map (xwem-kbd "H-x (") 'xwem-keymacro-begin) +(define-key xwem-global-map (xwem-kbd "H-x )") 'xwem-keymacro-end) +(define-key xwem-global-map (xwem-kbd "H-x e") 'xwem-keymacro-play-last) +(define-key xwem-global-map (xwem-kbd "H-x q") 'xwem-keymacro-recursive-edit) +(define-key xwem-global-map (xwem-kbd "H-M-c") 'xwem-keymacro-exit-recursive-edit) +(define-key xwem-global-map (xwem-kbd "H-x H-k") 'xwem-edmacro-edit-kbd-macro) + +;; Moving across windows +(define-key xwem-global-map (xwem-kbd "H-n") 'xwem-frame-goto-next) +(define-key xwem-global-map (xwem-kbd "H-p") 'xwem-frame-goto-prev) + +(define-key xwem-global-map (xwem-kbd "H-left") 'xwem-winmove-left) +(define-key xwem-global-map (xwem-kbd "H-right") 'xwem-winmove-right) +(define-key xwem-global-map (xwem-kbd "H-up") 'xwem-winmove-up) +(define-key xwem-global-map (xwem-kbd "H-down") 'xwem-winmove-down) + +(define-key xwem-global-map (xwem-kbd "H-x +") 'xwem-balance-windows) + +;; Frames operations +(define-key xwem-global-map (xwem-kbd "H-x 5 0") 'xwem-frame-destroy) +(define-key xwem-global-map (xwem-kbd "H-x 5 1") 'xwem-frame-fit-screen) +(define-key xwem-global-map (xwem-kbd "H-x 5 2") 'xwem-frame-sbs-vert-split) +(define-key xwem-global-map (xwem-kbd "H-x 5 3") 'xwem-frame-sbs-hor-split) +(define-key xwem-global-map (xwem-kbd "H-x 5 5") 'xwem-make-frame) +(define-key xwem-global-map (xwem-kbd "H-x 5 b") 'xwem-cl-switch-other-frame) +(define-key xwem-global-map (xwem-kbd "H-x 5 r") 'xwem-launch-program-other-frame) +(define-key xwem-global-map (xwem-kbd "H-x 5 C-l") 'xwem-frame-lower) +(define-key xwem-global-map (xwem-kbd "H-x 5 C-r") 'xwem-frame-raise) +(define-key xwem-global-map (xwem-kbd "H-x 5 z") 'xwem-frame-hide) +(define-key xwem-global-map (xwem-kbd "H-x 5 Z") 'xwem-frame-showroot) +(define-key xwem-global-map (xwem-kbd "H-x 5 H-a x") 'xwem-launch-xterm-other-frame) +(define-key xwem-global-map (xwem-kbd "H-x 5 H-a m") 'xwem-launch-lupe-other-frame) + +(define-key xwem-global-map (xwem-kbd "H-x H-n") 'xwem-frame-next) +(define-key xwem-global-map (xwem-kbd "H-x H-p") 'xwem-frame-previous) + +(define-key xwem-global-map (xwem-kbd "H-x 5 H-t") 'xwem-transpose-frames) + +;; Window commands +(define-key xwem-global-map (xwem-kbd "H-x 4 0") 'xwem-kill-cl-and-window) +(define-key xwem-global-map (xwem-kbd "H-x 4 b") 'xwem-cl-switch-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 C-o") 'xwem-cl-switch-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 r") 'xwem-launch-program-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 H-M-l") 'xwem-cl-switch-to-other-in-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 H-a x") 'xwem-launch-xterm-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 H-a m") 'xwem-launch-lupe-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 4 H-t") 'xwem-transpose-windows) + +(define-key xwem-global-map (xwem-kbd "H-o") 'xwem-Hyper-X-4-prefix) + +;; Clients commands +(define-key xwem-global-map (xwem-kbd "H-x 7 z") 'xwem-client-iconify) +(define-key xwem-global-map (xwem-kbd "H-x 7 0") 'xwem-client-kill) +(define-key xwem-global-map (xwem-kbd "H-x 7 1") 'xwem-client-demanage-others) +(define-key xwem-global-map (xwem-kbd "H-x 7 2") 'xwem-client-run-copy) +(define-key xwem-global-map (xwem-kbd "H-x 7 4") 'xwem-client-run-copy-other-win) +(define-key xwem-global-map (xwem-kbd "H-x 7 5") 'xwem-client-run-copy-other-frame) +(define-key xwem-global-map (xwem-kbd "H-x 7 i") 'xwem-client-info) +(define-key xwem-global-map (xwem-kbd "H-x 7 C-o") 'xwem-cl-switch-to-other) +(define-key xwem-global-map (xwem-kbd "H-x 7 p") 'xwem-cl-pop-to-client) +(define-key xwem-global-map (xwem-kbd "H-x 7 t") 'xwem-cl-set-title) +(define-key xwem-global-map (xwem-kbd "H-x 7 H-t") 'xwem-cl-transpose) + +(define-key xwem-global-map (xwem-kbd "H-=") 'xwem-client-info) + +(define-key xwem-global-map (xwem-kbd "H-@") 'xwem-client-set-mark) +(define-key xwem-global-map (xwem-kbd "H-SPC") 'xwem-client-set-mark) +(define-key xwem-global-map (xwem-kbd "H-x k") 'xwem-client-query-kill) + +;; Launcher commands +(define-key xwem-global-map (xwem-kbd "H-a H-s") 'xwem-launcher-toggle-split-type) +(define-key xwem-global-map (xwem-kbd "H-a H-f") 'xwem-launcher-toggle-frame-type) +(define-key xwem-global-map (xwem-kbd "H-a l") 'xwem-launch-xlock) +(define-key xwem-global-map (xwem-kbd "H-a x") 'xwem-launch-xterm) +(define-key xwem-global-map (xwem-kbd "H-a m") 'xwem-launch-lupe) ; Syn for 'm' is magnifier +(define-key xwem-global-map (xwem-kbd "H-a e") 'make-frame) + +;; Resizing +(define-key xwem-global-map (xwem-kbd "H-r h") 'xwem-frame-win-enlarge-hor) +(define-key xwem-global-map (xwem-kbd "H-r v") 'xwem-frame-win-enlarge-ver) + +;; Various commands +(define-key xwem-global-map (xwem-kbd "H-s") 'xwem-frame-switch-nth) +(define-key xwem-global-map (xwem-kbd "H-S") 'xwem-frame-switch-nth-linkage) +(define-key xwem-global-map (xwem-kbd "H-x 0") 'xwem-frame-del-win) +(define-key xwem-global-map (xwem-kbd "H-x 3") 'xwem-frame-split-horiz) +(define-key xwem-global-map (xwem-kbd "H-x 2") 'xwem-frame-split-vert) +(define-key xwem-global-map (xwem-kbd "H-x 1") 'xwem-frame-del-others) + +(define-key xwem-global-map (xwem-kbd "H-M-l") 'xwem-cl-switch-to-other) +(define-key xwem-global-map (xwem-kbd "H-x H-o") 'xwem-client-toggle-other-on-split) + +(define-key xwem-global-map (xwem-kbd "H-x b") 'xwem-cl-switch) +(define-key xwem-global-map (xwem-kbd "H-x H-b") 'xwem-ixwem) + +(define-key xwem-global-map (xwem-kbd "H-t") 'xwem-cl-transpose) +(define-key xwem-global-map (xwem-kbd "H-o H-t") 'xwem-transpose-windows) +(define-key xwem-global-map (xwem-kbd "H-x H-t") 'xwem-transpose-frames) + +(define-key xwem-global-map (xwem-kbd "H-x r") 'xwem-launch-program) +(define-key xwem-global-map (xwem-kbd "H-:") 'xwem-eval-expression) +(define-key xwem-global-map (xwem-kbd "H-!") 'xwem-shell-command) +(define-key xwem-global-map (xwem-kbd "H-M-x") 'xwem-execute-extended-command) +(define-key xwem-global-map (xwem-kbd "H-#") 'xwem-mini-calc) + +(define-key xwem-global-map (xwem-kbd "H-<") 'xwem-beginning-of-cl) +(define-key xwem-global-map (xwem-kbd "H->") 'xwem-end-of-cl) + +(define-key xwem-global-map (xwem-kbd "H-f12") 'xwem-misc-make-screenshot) +(define-key xwem-global-map (xwem-kbd "H-z") 'xwem-misc-pause) +(define-key xwem-global-map (xwem-kbd "H-pause") 'xwem-misc-pause) + +;; Compat layer, must move to xwem-compat.el +(if xwem-gnuemacs-p + (progn + (define-key xwem-global-map [s-mouse-1] 'xwem-strokes-begin) + (define-key xwem-global-map [h-mouse-1] 'xwem-strokes-cmplx-begin)) + (progn + (define-key xwem-global-map (xwem-kbd "M-button1") 'xwem-strokes-begin) + (define-key xwem-global-map (xwem-kbd "H-button1") 'xwem-strokes-cmplx-begin))) + + +(provide 'xwem-keydefs) + +;;; xwem-keydefs.el ends here diff --git a/lisp/xwem-keymacro.el b/lisp/xwem-keymacro.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWtleW1hY3JvLmVs --- /dev/null +++ b/lisp/xwem-keymacro.el @@ -0,0 +1,382 @@ +;;; xwem-keymacro.el --- Recording/playing keyboard macros. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Fri Dec 12 17:18:00 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; XWEM uses Record X extension to collect keypresses when saving +;; keyboard macros, this method is tranparent to user and allow +;; catching events without need of keyboard grabbing. + +;; XWEM keyboard macro is the same as Emacs keyboard macro. It is a +;; vector of Emacs events. XWEM uses special keymap - +;; `xwem-user-macros-map' to hold user defined macros. This keymap +;; used to save/restore keyboard macros across XWEM sessions. + +;; XWEM's support for keyboard macros is full-featured. It includes +;; H-x q command to start recursive edition, command which allow to +;; change keyboard macro execution on fly. It has workaround Emacs +;; blocking, when Emacs enters minibuffer and block waiting for user +;; input, keyboard macro execution stops (deadlock! Emacs can't send +;; further input, because it waiting for this input), but when Emacs +;; is about to block, i.e. enter `read-from-minibuffer' XWEM installs +;; special itimer which track Emacs state and send next event if need. +;; This feature allow you to create keyboard macros which requires +;; interaction with user, for example 'H-x r xterm RET H-u H-z H-x b +;; emac RET'. When defining keyboard macro remember that XWEM can't +;; track window operations such as map, configure, destroy and others, +;; so please use `xwem-misc-pause' command(default binded to H-z to +;; sleep for a while). For example you need to define macro - 1) +;; start new xterm 2) in newly managed xterm enter "test it" text. It +;; will be something like: H-x ( H-a x H-u H-z test it H-x ), because +;; when you start new xterm application it does not appear on screen +;; immediately, but when executing keyboard macro all keystrokes are +;; sent to X server as fast as possible. + +;; To save keyboard macros on on exit add something like: +;; +;; (add-hook 'xwem-exit-hook 'xwem-keymacro-save-macros) +;; +;; And to restore saved keyboard macros on start do next: +;; +;; (add-hook 'xwem-after-init-hook 'xwem-keymacro-load-macros) +;; + +;;; Code: + +(eval-and-compile + (require 'xlib-xtest) + (require 'xlib-xrecord)) + + +;; Macros customization +(defcustom xwem-keymacro-minib-bg "gray60" + "*Background color for xwem's minibuffer while recording KBD macro. +If nil - background will not change." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-keyboard) + +(defcustom xwem-keymacro-debug nil + "*Non-nil mean run keyboard macrosing stuff in debug mode." + :type 'boolean + :group 'xwem-keyboard) + +(defcustom xwem-keymacro-show-macro t + "*Non-nil mean show keyboard macro in minibuffer, while executing." + :type 'boolean + :group 'xwem-keyboard) + +(defcustom xwem-keymacro-macrofile "xwem-macros.el" + "*Default filename where keyboard macros stores." + :type 'file + :group 'xwem-keyboard) + + +;;; Macros recording/playing internal variables +;;;###autoload +(defvar xwem-executing-kbd-macro nil + "Non-nil when executing keyboard macro. +Actually Emacs keysequence(vector of keys) to be executed. +Internal variable, do not modify.") + +;;;###autoload +(defvar xwem-executing-kbd-macro-index nil + "Indexes current key in `xwem-excuting-kbd-macro' vector. +Internal variable, do not modify.") + +;;;###autoload +(defvar xwem-keymacro-last-kbd-macro nil "Last KBD macro.") + +(defvar xwem-keymacro-default-command 'xwem-keymacro-default + "Default command while recording/playing macro. +NOTE: may be changed to play macro.") + +(defvar xwem-keymacro-prefix-arg nil + "Value of `xwem-prefix-arg' when entering macro recording. +Internal variable, do not modify directly.") + +(defvar xwem-keymacro-minib-old-bg nil + "Variable used to hold old backgroup of xwem's minibuffer. +Internal variable, do not modify directly.") + +(defvar xwem-keymacro-saving nil + "Non-nil mean that we saving macro now. +Internal variable, do not modify it directly.") +(defvar xwem-keymacro-dpy nil + "Display used as data connection. +Internal variable, do not modify it directly.") +(defvar xwem-keymacro-rcontext nil + "Record context used when keymacrosing. +Internal variable, do not modify it directly.") +(defvar xwem-keymacro-rclient nil + "Client used when keymacrosing. +Internal variable, do not modify it directly.") +(defvar xwem-keymacro-rranges nil + "Record ranges used when keymacrosing. +Internal variable, do not modify it directly.") + +(defvar xwem-keymacro-initialized nil + "Non-nil when keyboard macrosing initialized. +Internal variable, do not modify it directly.") + +;;;###autoload +(defun xwem-keymacro-init () + "Initialize keyboard macrosing stuff." + ;; User xlib-xrecord extension to intercept KeyPress/KeyRelease + ;; events. + (let ((xrec-ext (X-XRecordQueryVersion (xwem-dpy))) + (xtest-ext (XQueryExtension (xwem-dpy) "XTEST"))) + (if (or (null (car xrec-ext)) + (null (car xtest-ext))) + ;; Not XRECORD or XTEST extension support + (xwem-message 'warn "No XRECORD or XTEST extension on dpy, you can't use keyboard macros saving.") + + ;; Dpy supports XRECORD extension + (setq xwem-keymacro-rcontext (make-X-RecordContext :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)))) + (setq xwem-keymacro-rranges + ;; We are only interested in KeyPrees/KeyRelease events + (list (make-X-RecordRange :device-events (cons X-KeyPress X-KeyRelease)))) + + (setq xwem-keymacro-rclient (float X-XRecordAllClients)) + (setq xwem-keymacro-rcontext (X-XRecordCreateContext + (xwem-dpy) xwem-keymacro-rcontext 0 + (list xwem-keymacro-rclient) + xwem-keymacro-rranges)) + (X-XRecordRegisterClients (xwem-dpy) xwem-keymacro-rcontext 0 + (list xwem-keymacro-rclient) + xwem-keymacro-rranges) + + (setq xwem-keymacro-dpy (XOpenDisplay + (format "%s:%d" (X-Dpy-name (xwem-dpy)) + (X-Dpy-default-screen (xwem-dpy))))) + (when xwem-keymacro-debug + (setf (X-Dpy-log-buffer xwem-keymacro-dpy) "XREC.log")) + + (setq xwem-keymacro-initialized t) + ))) + +(defun xwem-keymacro-extract (xevs &optional cutlen) + "Extract keyboard macro from X-Events list XEVS. +Return list of Emacs events. +CUTLEN is how many events cut from the end (default is 1)." + (let ((evs (butlast (xwem-kbd-xevents->emacs-events xevs nil) + (or cutlen 1)))) + (key-sequence-list-description (vconcat evs)))) + +;;;###autoload +(defun xwem-keymacro-execute-keys (keys) + "Execute keyboard macro KEYS." + (let ((xwem-executing-kbd-macro keys) + (xwem-executing-kbd-macro-index 0) + eev cmd) + + (while (< xwem-executing-kbd-macro-index + (length xwem-executing-kbd-macro)) + ;; Construct Emacs event + (setq eev (aref xwem-executing-kbd-macro xwem-executing-kbd-macro-index)) + (setq eev (make-event 'key-press (list 'modifiers (butlast eev) 'key (car (last eev))))) + + (setq cmd (xwem-kbd-key-binding-evs (vector eev))) + + ;; If current map is `xwem-global-map' and command not found, it + ;; is most possible that this is normal input, i.e. not an XWEM + ;; command. + (if (or cmd (not (eq xwem-global-map (xwem-kbd-current-map)))) + (xwem-kbd-handle-keybutton-from-emacs eev) + + ;; Otherwise send fake event. Should we have default command + ;; in `xwem-global-map' to self-insert last command keys? + (xwem-key-send-ekeys eev)) + + (incf xwem-executing-kbd-macro-index)))) + +(define-xwem-command xwem-keymacro-begin (arg) + "Start to record keyboard macro. +If used with prefix ARG, then query for bind after macro define." + (xwem-interactive "P") + + (when (not xwem-keymacro-initialized) + (error "Keyboard macros not initialized, use `xwem-keymacro-init'")) + + (if xwem-keymacro-saving + (xwem-message 'warn "Already defining macro...") + + (xwem-message 'msg "Defining KBD macro ...") + + ;; Clear events queue and enable context + (setf (X-Dpy-evq xwem-keymacro-dpy) nil) + (X-XRecordEnableContext xwem-keymacro-dpy xwem-keymacro-rcontext) + + ;; Change xwem's minibuffer background + (when xwem-keymacro-minib-bg + (setq xwem-keymacro-minib-old-bg + (face-background 'default (xwem-minib-frame xwem-minibuffer))) + (set-face-property 'default 'background xwem-keymacro-minib-bg + (xwem-minib-frame xwem-minibuffer))) + + (setq xwem-keymacro-prefix-arg arg) + (setq xwem-keymacro-saving t) + )) + +(define-xwem-command xwem-keymacro-end (arg &optional key) + "Stop recording keyboard macro. +If recording done with prefix argument, then query for bind." + (xwem-interactive (list xwem-keymacro-prefix-arg + (when xwem-keymacro-prefix-arg + (xwem-read-key "Enter character to bind: ")))) + + (if (not xwem-keymacro-saving) + (xwem-message 'warn "Not recording KBD macro.") + + (X-XRecordDisableContext (xwem-dpy) xwem-keymacro-rcontext) + (setq xwem-keymacro-saving nil) + + ;; Change xwem's minibuffer background back + (when xwem-keymacro-minib-old-bg + (set-face-property 'default 'background xwem-keymacro-minib-old-bg + (xwem-minib-frame xwem-minibuffer))) + + (let ((kmacro (xwem-keymacro-extract (X-Dpy-evq xwem-keymacro-dpy) + (length xwem-this-command-keys)))) + (if (not xwem-keymacro-prefix-arg) + ;; Save last keyboard macro + (setq xwem-keymacro-last-kbd-macro kmacro) + + (define-key xwem-user-macros-map (events-to-keys (vector key)) kmacro))) + + (xwem-message 'msg "KBD macro defined.") + )) + +(put 'xwem-keymacro-end 'xwem-need-keyrelease t) + +;;;###autoload +(defun xwem-keymacro-internal-play (keys &optional times) + "Play Emacs KEYS TIMES times." + (unless times + (setq times 1)) + + ;; Unset some variables + (setq xwem-this-command-keys []) + (setq xwem-kbd-now-grabbing nil) + (setq xwem-prefix-arg nil) + + (when xwem-keymacro-show-macro + (xwem-message 'info "Executing macro: '%s'" + (key-description keys))) + + ;; Force release of modifiers + (xwem-kbd-force-mods-release) + + (mapc (lambda (keyseq) + (xwem-keymacro-execute-keys keyseq)) + (make-list times keys))) + +;; Commands to be used in `xwem-keymacro-user-macros' +(define-xwem-command xwem-keymacro-undefined () + "Undefined macro command." + (xwem-interactive) + + (xwem-message 'warn "Macro key `%s' is not defined" (key-description xwem-this-command-keys))) + +(define-xwem-command xwem-keymacro-play-last (arg) + "Play last KBD macro ARG times." + (xwem-interactive "_p") + + (if xwem-keymacro-saving + (xwem-message 'warn "Can't play macro while recording.") + + (if (not xwem-keymacro-last-kbd-macro) + (xwem-message 'warn "No KBD macros have been saved.") + + (xwem-keymacro-internal-play xwem-keymacro-last-kbd-macro arg)) + )) + +(put 'xwem-keymacro-play-last 'xwem-need-keyrelease t) + +(define-xwem-command xwem-keymacro-recursive-edit (arg) + "Enter recursive edit. +Using \\<xwem-global-map>\\[xwem-keymacro-recursive-edit] you can +change keyboard macro execution in different way, i.e. you can +temporary suspend macro execution. Use +\\<xwem-global-map>\\[xwem-exit-recursive-edit] to exit recursive +edit." + (xwem-interactive "_P") + + (or xwem-executing-kbd-macro + xwem-keymacro-saving + (error "Not defining or executing keyboard macro")) + + (let ((xwem-this-command-keys []) + (xwem-prefix-arg nil)) + + (unless xwem-executing-kbd-macro + (X-XRecordDisableContext (xwem-dpy) xwem-keymacro-rcontext)) + + (xwem-recursive-edit) + + (unless xwem-executing-kbd-macro + (X-XRecordEnableContext xwem-keymacro-dpy xwem-keymacro-rcontext)) + )) + +(define-xwem-command xwem-keymacro-exit-recursive-edit () + "Exit recursive edition." + (xwem-interactive) + + ;; XXX + (when xwem-executing-kbd-macro + (xwem-kbd-force-mods-release)) + + (xwem-exit-recursive-edit)) + +(put 'xwem-keymacro-exit-recursive-edit 'xwem-need-keyrelease t) + +;;;###autoload +(defun xwem-keymacro-save-macros (&optional file) + "Save all defined macros to FILE. +Default value for FILE is ~/.xwem/xwem-macros.el." + (let ((buf (get-buffer-create " * temp keymacro buffer *"))) + (with-current-buffer buf + (erase-buffer) + + (map-keymap (lambda (kseq fbind) + (when (vectorp fbind) + (insert (format "(define-key xwem-user-macros-map '%S %S)\n" kseq fbind)))) + xwem-user-macros-map) + + (write-file (or file (concat xwem-dir "/" xwem-keymacro-macrofile))) + (kill-buffer buf)))) + +;;;###autoload +(defun xwem-keymacro-load-macros (&optional file) + "Load macros saved with `xwem-key-save-macros' from FILE. +Default value for FILE is ~/.xwem/xwem-macros.el" + (load (or file (concat xwem-dir "/" xwem-keymacro-macrofile)))) + + +(provide 'xwem-keymacro) + +;;; xwem-keymacro.el ends here diff --git a/lisp/xwem-launcher.el b/lisp/xwem-launcher.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWxhdW5jaGVyLmVs --- /dev/null +++ b/lisp/xwem-launcher.el @@ -0,0 +1,478 @@ +;;; xwem-launcher.el --- Program launcher for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Dec 4 16:32:11 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; External programs launcher for XWEM. + +;;; TODO: +;; * Assume argument in quotas as single argument, i.e. do not make +;; splitting inside quotas. + +;;; Code: + +(eval-and-compile + (require 'comint)) + +(autoload 'executable-find "executable") + +(defgroup xwem-launcher nil + "Group to customize XWEM's programs launcher." + :prefix "xwem-" + :group 'xwem) + +(defcustom xwem-launcher-beep-done nil + "*Non-nil mean beep when execution of program done. +Beep performed using \(xwem-play-sound 'ready\)." + :type 'boolean + :group 'xwem-launcher) + +;;;###autoload +(defcustom xwem-launcher-function 'xwem-execute-program + "Function to be used to execute external program." + :type 'function + :group 'xwem-launcher) + +(defcustom xwem-launcher-abbrev-table nil + "Abbrev table used by `xwem-launcher-query'." + :type 'list + :group 'xwem-launcher) + +(defcustom xwem-launcher-history nil + "History of `xwem-launcher-query'ies." + :type 'list + :group 'xwem-launcher) + +(defcustom xwem-launcher-split-type 'xwem-execute-program-other-win-vertical + "Window split type, when launching program in other window." + :type '(choice (const :tag "Horizontal" xwem-execute-program-other-win-horizontal) + (const :tag "Vertical" xwem-execute-program-other-win-vertical)) + :group 'xwem-launcher) + +(defcustom xwem-launcher-frame-type 'xwem-execute-program-other-frame + "Type of frame, when launching program in other frame." + :type '(choice (const :tag "Normal frame" xwem-execute-program-other-frame) + (const :tag "Embedded frame" xwem-execute-program-embedded-frame)) + :group 'xwem-launcher) + +(defcustom xwem-xterm-program "xterm" + "Name of terminal emulator program." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xterm-font-argument "-fn" + "Program key to specify in order to change font." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xterm-font1 "" + "Default xterm font." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xterm-font2 "10x20" + "Second xterm font." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xterm-font3 "9x15" + "Third xterm font." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xterm-font4 "fixed" + "Forth xterm font." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-lupe-program "lupe" + "Xmag like mignifier program." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-lupe-arguments "-noshape -nohud" + "Argument to pass to `xwem-lupe-program'." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xlock-program "xlock" + "Program to run in order to lock X display." + :type 'string + :group 'xwem-launcher) + +(defcustom xwem-xlock-arguments "-mode image" + "Arguments to supply `xwem-xlock-program'." + :type 'string + :group 'xwem-launcher) + +;;;###autoload +(defun xwem-launcher-read-command (prompt &optional initial-input) + "Read command name prompting PROMPT. +Just linke `read-shell-command', but installs +`xwem-launcher-abbrev-table' as abbrev table, `xwem-launcher-history' +as history of commands and `xwem-launcher-shell-completion-table' as table +to performe completions. +INITIAL-INPUT is self-described." + (let ((minibuffer-completion-table nil)) + (xwem-read-from-minibuffer prompt initial-input read-shell-command-map + nil 'xwem-launcher-history xwem-launcher-abbrev-table) + (setq read-shell-command-map keymap) + )) + +(defun xwem-launcher-split-cmd (cmd-with-args) + "Split string CMD-WITH-ARGS into command and aguments strings. +Also aplly `executable-find' to find out full path to command. +Also remove explicit spaces in arguments string." + (let* ((scmd (split-string cmd-with-args " ")) + (cmd-str (car scmd)) + (arg-str (mapconcat 'identity (cdr scmd) " "))) + (cons (executable-find cmd-str) (replace-in-string arg-str " +" " ")))) + +(defun xwem-launcher-join-cmd (cmd-cell) + "Construct final command from cons cell CMD-CELL. +`car' of CMD-CELL is cmd and `cdr' is arguments string." + (when (car cmd-cell) + (concat (car cmd-cell) + (if (and (stringp (cdr cmd-cell)) + (> (length (cdr cmd-cell)) 0)) + (concat " " (cdr cmd-cell)) + "")))) + +(defun xwem-launcher-normalize-cmd (cmd) + "Normalize command CMD, i.e. performe `xwem-launcher-split-cmd' and `xwem-launcher-join-cmd'. +If some errors encoureged, send signal" + (let ((ncmd (xwem-launcher-split-cmd cmd))) + (if (null (car ncmd)) + (error "Can't normalize command: %S" cmd) + (xwem-launcher-join-cmd ncmd)))) + +;;;###autoload +(defun xwem-launcher-query (&optional prompt) + "Query for command to launch using PROMPT." + (let ((cmd (xwem-launcher-read-command + (if prompt (concat prompt "XWEM-Run: ") "XWEM-Run: ")))) + + (xwem-launcher-normalize-cmd cmd))) + +(define-xwem-command xwem-run-program (command) + "Run COMMAND." + (xwem-interactive "eRun command: ") + + (xwem-execute-program command)) + +;;;###autoload +(defun xwem-execute-program (command &optional buffer-name) + "Execute COMMAND in buffer with BUFFER-NAME. +Unlike `background' do not use shell." + (let* ((cmdargs (condition-case nil (split-string command " ") (t (list command)))) ; due to split-string args-out-of-range bug + (prg (car cmdargs)) + (args (cdr cmdargs)) + (job-number 1) + job-name) + (while (get-process (setq job-name (format "xwem-run-%d" job-number))) + (setq job-number (1+ job-number))) + + (or buffer-name + (setq buffer-name (format " *%s*" job-name))) + + (with-current-buffer (get-buffer-create buffer-name) + (erase-buffer) + + (insert "--- working directory: " default-directory + "\n% " command ?\n) + + (let ((proc (get-buffer-process + (comint-exec buffer-name job-name prg nil args)))) + (comint-mode) + ;; COND because the proc may have died before the G-B-P is called. + (cond (proc (set-process-sentinel proc 'xwem-program-sentinel) + (message "[%d] %d" job-number (process-id proc)))) + (setq mode-name "XWEM-Run") + proc)))) + +(defun xwem-program-sentinel (process msg) + "Called when PROCESS changed state to MSG." + (let ((ms (match-data))) ; barf + (unwind-protect + (let ((msg (cond ((string= msg "finished\n") "Done") + ((string-match "^exited" msg) + (concat "Exit " (substring msg 28 -1))) + ((zerop (length msg)) "Continuing") + (t (concat (upcase (substring msg 0 1)) + (substring msg 1 -1)))))) + (when xwem-launcher-beep-done + (xwem-play-sound 'ready)) + (xwem-message 'info "[%s] %s '%s'" (process-name process) + msg + (mapconcat 'identity (process-command process) " ")) + (if (null (buffer-name (process-buffer process))) + (set-process-buffer process nil) ; WHY? Olin. + + (if (memq (process-status process) '(signal exit)) + (with-current-buffer (process-buffer process) + (let ((at-end (eobp))) + (save-excursion + (goto-char (point-max)) + (insert ?\n msg ?\x20 + (substring (current-time-string) 11 19) ?\n)) + (if at-end (goto-char (point-max)))) + (set-buffer-modified-p nil))))) + (store-match-data ms)))) + +(defun xwem-execute-program-other-win (cmd type) + "Execute CMD in other XWEM window, making TYPE split if needed. +TYPE is one of 'horizontal of 'vertical" + (setq cmd (xwem-launcher-normalize-cmd cmd)) + + (let ((own (xwem-window-other 1)) + (xwem-win-after-split-hook nil)) ; prevent hooks processing + + ;; Check is there split needed + (when (eq own (xwem-win-selected)) + (if (eq type 'horizontal) + (xwem-frame-split-horiz 0) + (xwem-frame-split-vert 0)) + (setq own (xwem-win-next (xwem-win-selected)))) + + (when (xwem-win-p own) + (xwem-win-expt-inc own cmd)) ;install expectation + (xwem-execute-program cmd) + )) + +(defun xwem-execute-program-other-win-horizontal (cmd) + "Execute CMD in other XWEM window, making horizontal split if needed." + (xwem-execute-program-other-win cmd 'horizontal)) + +(defun xwem-execute-program-other-win-vertical (cmd) + "Execute CMD in other XWEM window, making vertical split if needed." + (xwem-execute-program-other-win cmd 'vertical)) + +(defun xwem-execute-program-other-frame (cmd) + "Execute CMD in other XWEM frame." + (setq cmd (xwem-launcher-normalize-cmd cmd)) + + (let ((oframe (or (xwem-frame-other (xwem-frame-selected)) + (xwem-make-frame-1 nil nil nil t)))) + + (xwem-win-expt-inc (xwem-frame-selwin oframe) cmd) + (xwem-execute-program cmd) + (xwem-frame-select oframe) + )) + +(defun xwem-execute-program-embedded-frame (cmd) + "Execute CMD in linkaged frame or in embedded XWEM frame." + (setq cmd (xwem-launcher-normalize-cmd cmd)) + + (let ((oframe (or (xwem-frame-other (xwem-frame-selected) 'linkage) + (xwem-make-frame-1 t nil nil t)))) + + (xwem-win-expt-inc (xwem-frame-selwin oframe) cmd) + (xwem-execute-program cmd) + (xwem-frame-select oframe) + )) + +;;;; XWEM commands. + +(define-xwem-command xwem-launcher-turn-on-horizontal-split-type () + "Set `xwem-launcher-split-type' to `xwem-execute-program-other-win-horizontal'." + (xwem-interactive) + + (setq xwem-launcher-split-type 'xwem-execute-program-other-win-horizontal) + (xwem-message 'info "Launcher split type HORIZONTAL on.")) + +(define-xwem-command xwem-launcher-turn-on-vertical-split-type () + "Set `xwem-launcher-split-type' to `xwem-execute-program-other-win-vertical'." + (xwem-interactive) + + (setq xwem-launcher-split-type 'xwem-execute-program-other-win-vertical) + (xwem-message 'info "Launcher split type VERTICAL on.")) + +(define-xwem-command xwem-launcher-toggle-split-type (arg) + "Toggle `xwem-launcher-split-type'. +Without prefix ARG set it to vertical, with prefix ARG set it to horizontal." + (xwem-interactive "P") + + (if arg + (xwem-launcher-turn-on-horizontal-split-type) + (xwem-launcher-turn-on-vertical-split-type))) + +(define-xwem-command xwem-launcher-turn-on-normal-frame-type () + "Set `xwem-launcher-frame-type' to `xwem-execute-program-other-frame', aka normal frame type." + (xwem-interactive) + + (setq xwem-launcher-frame-type 'xwem-execute-program-other-frame) + (xwem-message 'info "Other frame NORMAL type on.")) + +(define-xwem-command xwem-launcher-turn-on-embedded-frame-type () + "Set `xwem-launcher-frame-type' to `xwem-execute-program-embedded-frame' aka embedded frame type." + (xwem-interactive) + + (setq xwem-launcher-frame-type 'xwem-execute-program-embedded-frame) + (xwem-message 'info "Other frame EMBEDDED type on.")) + +(define-xwem-command xwem-launcher-toggle-frame-type (arg) + "Toggle `xwem-launcher-frame-type'. +Without prefix ARG set it to normal, with prefix ARG set it to embedded." + (xwem-interactive "P") + + (if arg + (xwem-launcher-turn-on-normal-frame-type) + (xwem-launcher-turn-on-embedded-frame-type))) + +(define-xwem-command xwem-launch-program (cmd &optional arg) + "Run CMD program in background. +If used with prefix ARG (\\<xwem-global-map>\\[xwem-universal-argument]), then instlall +expectance on selected window (i.e. when client window performe +MapWindow, it will be managed to window where expectance setuped +regardless selected window at map moment. It is usefull to do so when +you start application with large start time, such as Mozilla or +AcrobatReader, and you want continue doing things not wainting untill +application window maps. +If used with numeric prefix ARG, then that number specifies how many +programs to run." + (xwem-interactive "eLaunch program: \nP") + + (cond ((listp arg) + (xwem-win-expt-inc (xwem-win-selected) cmd) + (xwem-execute-program cmd)) + + ((numberp arg) + (while (> arg 0) + (xwem-execute-program cmd) + (setq arg (1- arg)))) + (t (error "Invalid arg: %s" arg))) + ) + +(define-xwem-command xwem-launch-program-other-win (cmd &optional arg) + "Run program in other window. +If used with prefix ARG, then do horisontal split if needed." + (xwem-interactive "eLaunch Other Win: \nP") + + (let ((own (xwem-window-other 1)) + (xwem-win-after-split-hook nil)) ; prevent hooks processing + + ;; Check is there split needed + (when (eq own (xwem-win-selected)) + (if arg + (xwem-frame-split-horiz 0) + (xwem-frame-split-vert 0)) + (setq own (xwem-win-next (xwem-win-selected)))) + + (when (xwem-win-p own) + (xwem-win-expt-inc own cmd)) ;install expectation + (xwem-execute-program cmd) + )) + +(define-xwem-command xwem-launch-program-other-frame (cmd &optional arg) + "Run programm in other frame. +ARG passed as first argument to `xwem-make-frame-1'." + (xwem-interactive "eLaunch Other Frame: \nP") + + (let ((oframe (or (xwem-frame-other (xwem-frame-selected)) + (xwem-make-frame-1 arg nil nil t)))) + + (xwem-win-expt-inc (xwem-frame-selwin oframe) cmd) + (xwem-execute-program cmd) + (xwem-frame-select oframe)) + ) + +;;;###autoload +(defsubst xwem-launch (cmd) + "Execute CMD using `xwem-launcher'." + (funcall xwem-launcher-function cmd)) + +;;;###autoload +(defun xwem-launch-generic-program (cmd sarg) + "Run generic program CMD with arguments SARG." + (xwem-launch (xwem-launcher-join-cmd (cons cmd sarg)))) + +;; Executing xterm +(defun xwem-xterm-construct-cmd (arg) + "Construct xterm command according to ARG." + (let ((fn (symbol-value (intern (concat "xwem-xterm-font" (int-to-string arg))))) + (cmd xwem-xterm-program)) + + (when (and (stringp fn) (> (length fn) 0)) + (setq cmd (concat cmd " " xwem-xterm-font-argument " " fn))) + cmd)) + +(define-xwem-command xwem-launch-xterm (arg) + "Run xterm program `xwem-xterm-program' with ARG as font argument." + (xwem-interactive "p") + + (let ((cmd (xwem-xterm-construct-cmd arg))) + (xwem-launch cmd))) + +(define-xwem-command xwem-launch-xterm-other-win (arg) + "Execute xterm in other window, ARG have same meaning as in `xwem-launch-xterm'." + (xwem-interactive "p") + + (let ((xwem-launcher-function xwem-launcher-split-type)) + (xwem-launch-xterm arg))) + +(define-xwem-command xwem-launch-xterm-other-frame (arg) + "Execute xterm in other frame, ARG have same meaning as in `xwem-launch-xterm'." + (xwem-interactive "p") + + (let ((xwem-launcher-function xwem-launcher-frame-type)) + (xwem-launch-xterm arg))) + +;; Executing lupe +(define-xwem-command xwem-launch-lupe (arg) + "Run lupe `xwem-lupe-program' with `xwem-lupe-arguments'. +Prefix ARG is actually unused." + (xwem-interactive "P") + + (xwem-launch-generic-program xwem-lupe-program xwem-lupe-arguments)) + +(define-xwem-command xwem-launch-lupe-other-win (arg) + "Run lupe in other window. +Prefix ARG is actually unused." + (xwem-interactive "P") + + (let ((xwem-launcher-function xwem-launcher-split-type)) + (xwem-launch-lupe arg))) + +(define-xwem-command xwem-launch-lupe-other-frame (arg) + "Run lupe in other frame. +Prefix ARG is actually unused." + (xwem-interactive "P") + + (let ((xwem-launcher-function xwem-launcher-frame-type)) + (xwem-launch-lupe arg))) + +(define-xwem-command xwem-launch-xlock () + "Launch `xwem-xlock-program' with `xwem-xlock-arguments'." + (xwem-interactive) + + (xwem-launch-generic-program xwem-xlock-program xwem-xlock-arguments)) + + +(provide 'xwem-launcher) + +;;; xwem-launcher.el ends here diff --git a/lisp/xwem-load.el b/lisp/xwem-load.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLWxvYWQuZWw= --- /dev/null +++ b/lisp/xwem-load.el @@ -0,0 +1,143 @@ +;;; xwem-load.el --- Load everything we will need. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Authors: Zajcev Evgeny <zevlg@yandex.ru> +;; Alex Ott <ottalex@narod.ru> +;; Created: 1 Sep 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(eval-when-compile + (require 'cl)) + +;; Compatibility layer +(require 'xwem-compat) + +;; Macros +(require 'xwem-macros) + +;; Autoload some xwem commands +;; +;; TODO: +;; * write tiny funcition which will recognize `define-xwem-command' +;; as autoloadable defun. +;; +(mapc (lambda (fun) + (autoload fun "xwem-help" nil t)) + (list 'xwem-describe-prefix-bindings 'xwem-help-describe-bindings + 'xwem-help-describe-key 'xwem-help-frames 'xwem-help-wins + 'xwem-help-clients 'xwem-help-where-is)) + +(mapc (lambda (fun) + (autoload fun "xwem-win" nil t)) + (list 'xwem-balance-windows 'xwem-transpose-windows)) + +(mapc (lambda (fun) + (autoload fun "xwem-clients" nil t)) + (list 'xwem-cl-switch 'xwem-cl-switch-other-win 'xwem-cl-switch-other-frame + 'xwem-cl-switch-to-other 'xwem-cl-switch-to-other-in-other-win + 'xwem-kill-cl-and-window 'xwem-cl-transpose 'xwem-client-toggle-other-on-split + 'xwem-client-kill 'xwem-client-demanage-others 'xwem-client-run-copy + 'xwem-client-run-copy-other-win 'xwem-client-run-copy-other-frame + 'xwem-cl-pop-to-client 'xwem-cl-set-title 'xwem-client-iconify + 'xwem-client-turn-on-other-on-split 'xwem-client-turn-off-other-on-split + 'xwem-client-info 'xwem-client-set-mark)) + +(mapc (lambda (fun) + (autoload fun "xwem-frame" nil t)) + (list 'xwem-make-frame 'xwem-frame-lower 'xwem-frame-raise 'xwem-frame-switch-nth + 'xwem-frame-switch-nth-linkage 'xwem-frame-destroy 'xwem-frame-del-win + 'xwem-frame-del-others 'xwem-frame-split-horiz 'xwem-frame-split-vert + 'xwem-frame-win-enlarge-hor 'xwem-frame-win-enlarge-ver + 'xwem-frame-goto-next 'xwem-frame-goto-prev 'xwem-frame-goto-next-vert + 'xwem-frame-goto-next-hor 'xwem-frame-goto-prev-vert 'xwem-frame-goto-prev-hor + 'xwem-frame-split-sbs 'xwem-frame-sbs-hor-split 'xwem-frame-sbs-vert-split + 'xwem-frame-fit-screen 'xwem-frame-transpose 'xwem-frame-showroot + 'xwem-frame-hide 'xwem-frame-next 'xwem-frame-previous 'xwem-transpose-frames)) + +(mapc (lambda (fun) + (autoload fun "xwem-help" nil t)) + (list 'xwem-help 'xwem-help-for-help 'xwem-describe-prefix-bindings + 'xwem-help-describe-bindings 'xwem-help-describe-key1 'xwem-help-describe-key + 'xwem-help-frames 'xwem-help-wins 'xwem-help-clients 'xwem-help-where-is)) + +(mapc (lambda (fun) + (autoload fun "xwem-keyboard" nil t)) + (list 'xwem-undefined-command 'xwem-keyboard-quit 'xwem-kbd-quit + 'xwem-kbd-quote-command 'xwem-universal-argument 'xwem-universal-digit + 'xwem-universal-minus 'xwem-universal-command)) + +(mapc (lambda (fun) + (autoload fun "xwem-keymacro" nil t)) + (list 'xwem-keymacro-end 'xwem-keymacro-begin 'xwem-keymacro-undefined + 'xwem-keymacro-play-last 'xwem-keymacro-play 'xwem-keymacro-save-macros + 'xwem-keymacro-recursive-edit 'xwem-keymacro-exit-recursive-edit)) + +(mapc (lambda (fun) + (autoload fun "xwem-launcher" nil t)) + (list 'xwem-run-program 'xwem-launcher-turn-on-horizontal-split-type + 'xwem-launcher-turn-on-vertical-split-type 'xwem-launcher-toggle-split-type + 'xwem-launcher-turn-on-normal-frame-type 'xwem-launcher-turn-on-embedded-frame-type + 'xwem-launcher-toggle-frame-type 'xwem-launch-program 'xwem-launch-program-other-win + 'xwem-launch-program-other-frame + 'xwem-launch-xterm 'xwem-launch-xterm-other-win 'xwem-launch-xterm-other-frame + 'xwem-launch-lupe 'xwem-launch-lupe-other-win 'xwem-launch-lupe-other-frame + 'xwem-launch-xlock)) + +(mapc (lambda (fun) + (autoload fun "xwem-misc" nil t)) + (list 'xwem-eval-expression 'xwem-execute-extended-command 'xwem-mini-calc + 'xwem-misc-make-screenshot 'xwem-beginning-of-cl 'xwem-end-of-cl + 'xwem-show-message-log + )) + +(mapc (lambda (fun) + (autoload fun "xwem-mouse" nil t)) + (list 'xwem-popup-function-menu 'xwem-popup-auto-menu)) + +(mapc (lambda (fun) + (autoload fun "xwem-strokes" nil t)) + (list 'xwem-strokes-define 'xwem-strokes-descrcurr 'xwem-strokes-begin + 'xwem-strokes-cmplx-begin)) + + +(mapc (lambda (fun) + (autoload fun "xwem-edmacro" nil t)) + (list 'xwem-edmacro-edit-kbd-macro)) + +;; install default bindings +(eval-when 'load + (load "xwem-keydefs") ; default keybindings + + (run-hooks 'xwem-load-hook)) + + +(provide 'xwem-load) + +;;; xwem-load.el ends here diff --git a/lisp/xwem-macros.el b/lisp/xwem-macros.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1hY3Jvcy5lbA== --- /dev/null +++ b/lisp/xwem-macros.el @@ -0,0 +1,362 @@ +;;; xwem-macros.el --- Generic XWEM's macros. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 1 Sep 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(defmacro xwem-misc-aref0 (vec) + `(aref ,vec 0)) + +(defmacro xwem-misc-aref1 (vec) + `(aref ,vec 1)) + +(defmacro xwem-misc-aref2 (vec) + `(aref ,vec 2)) + +(defmacro xwem-misc-aref3 (vec) + `(aref ,vec 3)) + +(defmacro xwem-misc-aref4 (vec) + `(aref ,vec 4)) + +(defmacro xwem-misc-aref5 (vec) + `(aref ,vec 5)) + +(defmacro xwem-misc-aref6 (vec) + `(aref ,vec 6)) + +(defmacro xwem-misc-aref7 (vec) + `(aref ,vec 7)) + +(defmacro xwem-misc-aset0 (vec val) + `(aset ,vec 0 ,val)) + +(defmacro xwem-misc-aset1 (vec val) + `(aset ,vec 1 ,val)) + +(defmacro xwem-misc-aset2 (vec val) + `(aset ,vec 2 ,val)) + +(defmacro xwem-misc-aset3 (vec val) + `(aset ,vec 3 ,val)) + +(defmacro xwem-misc-aset4 (vec val) + `(aset ,vec 4 ,val)) + +(defmacro xwem-misc-aset5 (vec val) + `(aset ,vec 5 ,val)) + +(defmacro xwem-misc-aset6 (vec val) + `(aset ,vec 6 ,val)) + +(defmacro xwem-misc-aset7 (vec val) + `(aset ,vec 7 ,val)) + +(defmacro defmacro-alias (new old &optional doc-str) + "Define NEW macro as alias to OLD macro. +It will look like (defmacro-alias new-macro 'old-macro)." + `(defmacro ,new (&rest args) + ,doc-str + `(,,old ,@args))) + +;;; CL macros +(defmacro xwem-dpy-dummy () + `(make-vector 3 nil)) + +(defmacro xwem-dpy () + `(aref xwem-root-screen 0)) + +(defmacro xwem-minkeycode () + `(aref (xwem-dpy) 12)) + +(defmacro xwem-maxkeycode () + `(aref (xwem-dpy) 13)) + +(defmacro xwem-rootwin () + `(aref xwem-root-screen 1)) + +(defmacro xwem-rootgeom () + `(aref xwem-root-screen 2)) + +;;; Macros +(defmacro xwem-cl-selected () + "Return selected client." + `(xwem-win-cl (xwem-win-selected))) + +(defmacro xwem-cl-frame (cl) + "Return frame where CL." + `(let ((win (xwem-cl-win ,cl))) + (if (xwem-win-p win) + (xwem-win-frame win) + nil))) + +(defmacro xwem-cl-tabber (cl) + "Return CL's tabber." + `(and (xwem-frame-p (xwem-cl-frame ,cl)) + (xwem-frame-tabber (xwem-cl-frame ,cl)))) + +(defmacro xwem-tab-item-tabber (tabi) + `(xwem-cl-tabber (xwem-tab-item-cl ,tabi))) + +(defmacro xwem-cl-win-geom (cl) + "Get geometry for client CL. Actually return xwem window geometry." + `(xwem-win-geom (xwem-cl-win ,cl))) + + +;;; Window macros +(defmacro xwem-win-put-prop (window prop val) + "Set property PROP of WINDOW to VAL." + `(when (xwem-win-p ,window) + (aset ,window 2 (plist-put (xwem-win-props ,window) ,prop ,val)))) + +(defmacro xwem-win-get-prop (window prop) + "Get property PROP for WINDOW." + `(when (xwem-win-p ,window) + (plist-get (xwem-win-props ,window) ,prop))) + +(defmacro xwem-win-child (window) + "Return child of WINDOW, hchild checked first then if not set vchild + tested." + `(or (xwem-win-hchild ,window) (xwem-win-vchild ,window))) + +(defmacro xwem-win-mark-deleted (win) + "Mark WIN as deleted window." + `(setf (xwem-win-deleted ,win) t)) + +;; -- Expectations macros +;; +(defmacro xwem-win-get-expt (win expt) + "Get value of EXPT from expectances plist of WIN. +Returns 0 if EXPT is not in plist." + `(let ((exv (lax-plist-get (xwem-win-expectances ,win) ,expt))) + (if (null exv) 0 exv))) + +(defmacro xwem-win-set-expt (win expt expt-value) + "Set EXPT with value EXPT-VALUE in expectations plist for WIN." + `(setf (xwem-win-expectances ,win) + (lax-plist-put (xwem-win-expectances ,win) ,expt ,expt-value))) + +(defmacro xwem-win-expt-inc (win expt &optional howmuch) + "Include by one EXPT in expectations plist for WIN. +If there no such EXPT, new one will be created with count equal to one." + `(xwem-win-set-expt + ,win ,expt + (+ (xwem-win-get-expt ,win ,expt) (if ,howmuch ,howmuch 1)))) + +(defmacro xwem-win-expt-dec (win expt &optional howmuch) + "Decrement by one value of EXPT in expectations plist for WIN." + `(let ((exv (xwem-win-get-expt ,win ,expt)) + (hm (if ,howmuch ,howmuch 1))) + (xwem-win-set-expt ,win ,expt + (if (> (- exv hm) 0) (- exv hm) 0)))) + + +;;; Frames macros +(defmacro xwem-frame-get-prop (frame prop) + `(plist-get (xwem-frame-props ,frame) ,prop)) + +(defmacro xwem-frame-set-prop (frame prop val) + "Puts PROP with VAL to FRAME's properties list." + `(let ((props (xwem-frame-props ,frame))) + (setq props (plist-put props ,prop ,val)) + (setf (xwem-frame-props ,frame) props))) + +(defmacro xwem-frame-link-insert-after (frame1 frame2) + "Make FRAME2 to be after FRAME1." + `(let ((nf (xwem-frame-link-next ,frame1))) + (when (xwem-frame-p nf) + (setf (xwem-frame-link-prev nf) ,frame2)) + (setf (xwem-frame-link-next ,frame1) ,frame2) + (setf (xwem-frame-link-prev ,frame2) ,frame1) + (setf (xwem-frame-link-next ,frame2) nf))) + +(defmacro xwem-frame-link-insert-before (frame1 frame2) + "Make FRAME2 to be before FRAME1." + `(let ((pf (xwem-frame-link-prev ,frame1))) + (when (xwem-frame-p pf) + (setf (xwem-frame-link-next pf) ,frame2)) + (setf (xwem-frame-link-prev ,frame1) ,frame2) + (setf (xwem-frame-link-next ,frame2) ,frame1) + (setf (xwem-frame-link-prev ,frame2) pf))) + +(defmacro xwem-frame-link-remove (frame) + "Remove FRAME from linkage." + `(let ((nfr (xwem-frame-link-next ,frame)) + (pfr (xwem-frame-link-prev ,frame))) + (when (xwem-frame-p pfr) + (setf (xwem-frame-link-next pfr) nfr)) + (when (xwem-frame-p nfr) + (setf (xwem-frame-link-prev nfr) pfr)))) + +(defmacro xwem-frame-link-head (frame) + "Returns head frame of FRAME's linkage." + `(let ((fr ,frame)) + (while (xwem-frame-p (xwem-frame-link-prev fr)) + (setq fr (xwem-frame-link-prev fr))) + fr)) + +(defmacro xwem-frame-linkage-map (frame fn) + "Call FN for each frame in FRAME's linkage. +FN called with one argument - frame." + ;; TODO: avoid infinit recursion + `(let ((fr (xwem-frame-link-head ,frame))) + + (while (xwem-frame-p fr) + (funcall ,fn fr) + (setq fr (xwem-frame-link-next fr))))) + + +;;; Key macros +(defmacro xwem-kbd-private-makemask (mlist) + `(apply 'Xmask-or (cons 0 ,mlist))) + +(defmacro xwem-kbd-shiftmask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 0))) + +(defmacro xwem-kbd-lockmask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 1))) + +(defmacro xwem-kbd-controlmask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 2))) + +(defmacro xwem-kbd-metamask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 3))) + +(defmacro xwem-kbd-hypermask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 4))) + +(defmacro xwem-kbd-supermask () + `(xwem-kbd-private-makemask (aref xwem-kbd-private-modifiers 5))) + + +(defmacro xwem-help-display (&rest forms) + "Evaluate FORMS in special emacs frame and xwem help buffer." + `(let ((temp-buffer-show-function 'xwem-special-popup-frame)) + (with-displaying-help-buffer + (lambda () + (set-buffer standard-output) + (progn ,@forms)) + ))) + +(defmacro xwem-interactive (&rest ispec) + "Just like `interactive', but accepts xwem specific arguments. +Code letters available are: +s -- String. +k -- Single key. +K -- Key sequence that executes command. +c -- Client. +f -- Existing file. +F -- Possible non-existing file. +p -- Prefix argument as number. +P -- Prefix argument in raw form. +C -- Command. +e -- External command." + (let ((is (cond ((and (= (length ispec) 1) + (stringp (car ispec))) + (setq ispec (car ispec)) + (split-string ispec "\n")) + + (t ispec)))) + + (if (not (stringp ispec)) + `(interactive (let ((xwem-interactively t)) + ,@ispec)) + + `(interactive (xwem-interactive-ilist (quote ,is)))))) + +(defmacro define-xwem-command (funsym args docstring inter &rest body) + "Same as `xwem-defun', but make FUNSYM to be interactive command. +INTER is actually a for of `xwem-interactive'." + `(defun ,funsym ,args + ,docstring + ,(macroexpand inter) + ;; Maybe run command without GCing at all + (let ((gc-cons-threshold (if xwem-commands-inhibit-gc + most-positive-fixnum + gc-cons-threshold))) + ,@body))) + +(put 'xwem-command 'lisp-indent-function 'defun) + +(defmacro xwem-under-minib-focus (&rest forms) + "Evaluate FORM under XWEM's minibuffer focus." + `(progn + (xwem-focus-set (xwem-minib-cl xwem-minibuffer)) + + (unwind-protect + (progn ,@forms) + + (xwem-focus-pop-set) + ))) + +(defmacro xwem-cursor-shape-choice () + "Return choice dialog to select cursor shape." + `(`(choice (const :tag "Left" X-XC-left_ptr) + (const :tag "Right" X-XC-right_ptr ) + (const :tag "Cross" X-XC-cross) + (const :tag "Reverse Cross" X-XC-cross_reverse) + (const :tag "Crosshair" X-XC-crosshair) + (const :tag "Daimond cross" X-XC-diamond_cross) + ;; TODO: add more, take a look at Cursors section in + ;; xlib-const.el + (const :tag "Dot" X-XC-dot) + (const :tag "Square Icon" X-XC-icon) + (const :tag "Down Arrow" X-XC-sb_down_arrow) + (const :tag "Question Arrow" X-XC-question_arrow) + (const :tag "Fluer" X-XC-fleur) + (const :tag "Bottom Left corner" X-XC-bottom_left_corner) + (const :tag "Bottom Right corner" X-XC-bottom_right_corner) + (const :tag "Top Left corner" X-XC-top_left_arrow) + (const :tag "Top Right corner" X-XC-top_right_arrow) + ))) + +(defmacro xwem-gc-function-choice () + "Return choice dialog to select GC function." + `(`(choice (const :tag "None" nil) + (const :tag "Clear" X-GXClear) + (const :tag "And" X-GXAnd) + (const :tag "Reverse And" X-GXAndReverse) + (const :tag "Inverted And" X-GXAndInverted) + (const :tag "Xor" X-GXXor) + (const :tag "Or" X-GXOr) + (const :tag "Reverse Or" X-GXOrReverse) + (const :tag "Inverted Or" X-GXOrInverted) + (const :tag "Nor" X-GXNor) + (const :tag "Equive" X-GXEquiv) + (const :tag "Invert" X-GXInvert) + (const :tag "Copy" X-GXCopy) + (const :tag "Inverted Copy" X-GXCopyInverted) + (const :tag "Set" X-GXSet)))) + + +(provide 'xwem-macros) + +;;; xwem-macros.el ends here diff --git a/lisp/xwem-main.el b/lisp/xwem-main.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1haW4uZWw= --- /dev/null +++ b/lisp/xwem-main.el @@ -0,0 +1,240 @@ +;;; xwem-main.el --- Main part of xwem. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;; Commentary: +;; +;; This main part of XWEM. +;; +;; I strongly recommend you to raise max-lisp-eval-depth value to say +;; 5000. +;; (setq max-lisp-eval-depth 5000) +;; +;; Try to avoid to use such evil thing as `mouse-avoidance-mode', but +;; if you really want it, than set it to either 'banish or 'jump. +;; +;; If you want develop some xwem addons or take in touch with xwem, it +;; will be usefull to change `find-function-regexp', because xwem uses +;; its own syntax to define interactive commands. + +;; (setq find-function-regexp +;; (concat "^\\s-*(\\(def[^cgvW]\\w+\\*?" +;; "\\|define-function" +;; "\\|define-obsolete-function-alias" +;; "\\|define-compatible-function-alias" +;; "\\|define-derived-mode" +;; "\\|define-xwem-command" +;; "\\)\\s-+%s\\(\\s-\\|$\\)")) + +;;; Code + + + +(eval-when-compile + (require 'cl)) ;last, intersection etc + +(defgroup xwem nil + "XWEM window manager." + :prefix "xwem-" + :group 'applications) + +(defgroup xwem-hooks nil + "Group to customize xwem hooks." + :prefix "xwem-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-dir "~/.xwem" + "Directory to store XWEM's files." + :type 'string + :group 'xwem) + +;;;###autoload +(defcustom xwem-debug nil + "*Non-nil mean run xlib and xwem in debugging mode." + :type 'boolean + :group 'xwem) + +;;;###autoload +(defcustom xwem-commands-inhibit-gc t + "*Non-nil mean that xwem interactive commands runs without GCing." + :type 'boolean + :group 'xwem) + +(defcustom xwem-custom-display nil ;"127.0.0.1:2" + "*Custom display, mostly for debugging purposes." + :type 'string + :group 'xwem) + +;;;###autoload +(defcustom xwem-load-hook nil + "*Hooks to call after xwem was load." + :type 'hook + :group 'xwem-hooks) + +(defcustom xwem-after-init-hook nil + "Hooks to be runned after xwem initialisation." + :type 'hook + :group 'xwem-hooks) + +(defcustom xwem-exit-hook nil + "Hooks called after xwem exit." + :type 'hook + :group 'xwem-hooks) + + +;;; Variables +;;;###autoload +(defvar xwem-started nil + "Non-nil when xwem started. +Do not modify!") + + +;;; Functions +(defun xwem-init-wins () + "Manage all mapped X windows." + (xwem-message 'msg "Initializing X windows ... wait") + + (let ((wins (XQueryTree (xwem-dpy) (xwem-rootwin))) + (attrs nil) + (shcfgl nil)) + (setq wins (cdr (cdr (cdr (cdr wins))))) + + (X-Dpy-log (xwem-dpy) "IN xwem-init-wins: wins length = %d\n" '(length wins)) + (while wins + (X-Dpy-log (xwem-dpy) "XGetWindowAttr BEGIN in xwem-init-wins\n") + (setq attrs (XGetWindowAttributes (xwem-dpy) (car wins))) + (X-Dpy-log (xwem-dpy) "XGetWindowAttr END in xwem-init-wins, as=%s\n" 'attrs) + + (when (and (not (X-Attr-override-redirect attrs)) + (= (X-Attr-mapstate attrs) X-Viewable) + (not (xwem-find-frame (car wins)))) + ;; X window visible and not XWEM frame + (setq shcfgl (cons (cons (car wins) attrs) shcfgl)) + ) + + (setq wins (cdr wins))) + + ;; Manage all visible clients + (mapc (lambda (cl) + (xwem-make-client (car cl) (cdr cl))) + shcfgl) + )) + +(defun xwem-after-window-setup () + "Function which will be added to `window-setup-hook' and called + after ~/.emacs file loaded and emacs X window subsystems + initialized." + + ;; revert back `menubar-visible-p' specifier + (set-specifier menubar-visible-p xwem-saved-menubar-visible-p) + + (let ((dfen (or xwem-custom-display (getenv "DISPLAY")))) + (xwem-init-root + (if (eq (aref dfen 0) ?\:) + (concat "127.0.0.1" dfen) + dfen))) + + ;; Select input on root window + (XSelectInput (xwem-dpy) (xwem-rootwin) xwem-root-ev-mask) + (X-Win-EventHandler-add-new (xwem-rootwin) 'xwem-root-events-handler 100) + + ;; Create XWEM minibuffer + (xwem-minib-create) + + (xwem-init-cursors) + (xwem-init-faces) + (xwem-init-events) + (xwem-kbd-init) + (xwem-init-frames) + (xwem-init-win) + (xwem-init-misc) + + ;; Handle all X clients + (xwem-init-wins) + + (when xwem-strokes-enabled + (xwem-strokes-init)) + + ;; Initialize xwem system tray + (when xwem-tray-enabled + (xwem-tray-startit (xwem-dpy))) + + ;; Refit frames, so they will adjust sizes according to + ;; xwem-minibuffer size, after it was managed. + (mapc 'xwem-frame-fit-screen xwem-frames-list) + + ;; Make sure all events are processes + (XSync (xwem-dpy)) + (XSync (xwem-dpy) t) + + (setq xwem-started t) + + ;; Now xwem is fully intialized and it is time to run hooks + (run-hooks 'xwem-after-init-hook) + + (xwem-message 'asis (concat (xwem-logo-string) + " succesfully started. Start with `M-x xwem-help RET'.")) + ) + +;;;###autoload +(defun xwem-init () + "Initialization of xwem subsystems." + + (setq inhibit-startup-message t) + + ;; read configuration + (let ((cfg (expand-file-name (concat xwem-dir "/xwemrc.el")))) + (if (file-exists-p cfg) + (load cfg) + (xwem-message 'warn "Configuration file `%s' does not exists" cfg))) + + ;; Initialize various stuff that does not need display + (xwem-manda-init) + + (add-hook 'window-setup-hook 'xwem-after-window-setup) + (add-hook 'kill-emacs-hook 'xwem-fini t) + ) + +;;;###autoload +(defun xwem-fini () + "Fini all subsystems." + (xwem-kbd-quit) + (xwem-fini-events) + (xwem-fini-frames) + (xwem-fini-clients) + (when xwem-tray-enabled + (xwem-tray-fini)) + (xwem-fini-root) + + ;; Finally run exit hooks + (run-hooks 'xwem-exit-hook)) + + +(provide 'xwem-main) + +;;; xwem-main.el ends here diff --git a/lisp/xwem-manage.el b/lisp/xwem-manage.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1hbmFnZS5lbA== --- /dev/null +++ b/lisp/xwem-manage.el @@ -0,0 +1,196 @@ +;;; xwem-manage.el --- Manage stuff for xwem. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code + + +;; Variables +(defvar xwem-manda-list nil + "Manage database list, all manage instances should be there.") + +;;;###autoload +(defstruct xwem-manda + name ; manda name + matcher-function + priority + + exclude-p ; non-nil if such clients + ; should be excluded from + ; clients list + + init-fun + manage-fun + demanage-fun + iconify-fun + refit-fun + ) + + +;;; Functions +;;;###autoload +(defun xwem-manda-fun-run (manel fun &rest args) + "Run function FUN for MANEL. +FUN is one of 'init, 'manage, 'demanage or 'refit +NOTE: A little bit hackish, do not do so at home." + (let* ((ifun (intern (format "xwem-manda-%s-fun" fun))) + (val (funcall ifun manel))) + + (when val + (apply val args)))) + +;;;###autoload +(defun xwem-manda-find-inst (cl) + "Find instance for CL in manage database. +NOTE: Find first match." + (let ((manls xwem-manda-list)) + (while (and manls (not (funcall (xwem-manda-matcher-function (car manls)) cl))) + (setq manls (cdr manls))) + + (car manls))) + +(defun define-xwem-manda (name matcher-function &optional priority exclude-p + init-fun manage-fun demanage-fun iconify-fun refit-fun) + "Define new entry in manage database." + + (let ((man (make-xwem-manda :name name + :priority priority + :exclude-p exclude-p + :matcher-function matcher-function + :init-fun init-fun + :manage-fun manage-fun + :demanage-fun demanage-fun + :iconify-fun iconify-fun + :refit-fun refit-fun))) + (setq xwem-manda-list (cons man xwem-manda-list)) + + ;; Resort by priority + (setq xwem-manda-list (sort xwem-manda-list + (lambda (el1 el2) + (> (xwem-manda-priority el1) + (xwem-manda-priority el2))))) + man)) + +;;;###autoload +(defun xwem-manda-init () + "Initialize manage database." + (setq xwem-manda-list nil) + + ;; Generic manda entry + (define-xwem-manda 'generic (lambda (cl) t) + -100 nil + 'xwem-init-clients 'xwem-cl-manage 'xwem-cl-demanage + 'xwem-cl-iconify 'xwem-cl-refit) + + ;; Manda entry to handle xwem minibuffer + (define-xwem-manda 'xwem-minibuffer + (lambda (cl) + (let ((class (xwem-hints-wm-class (xwem-cl-hints cl)))) + (and (nth 0 class) (string= (nth 0 class) xwem-minibuffer-name)))) + 0 t + 'xwem-minibuffer-init 'xwem-minib-manage nil nil 'xwem-minib-refit) + + ;; Manda entry to manage special Emacs frames + (define-xwem-manda 'xwem-special + (lambda (cl) + (let ((class (xwem-hints-wm-class (xwem-cl-hints cl)))) + (and (nth 0 class) (string= (nth 0 class) xwem-special-frame-name)))) + 0 t + 'xwem-special-frame-init 'xwem-special-frame-manage + 'xwem-special-frame-demanage 'xwem-special-frame-iconify) + + ;; Manda entry to manage transient-for(dialogs) windows + (define-xwem-manda 'transient-for + (lambda (cl) + (xwem-hints-wm-transient-for (xwem-cl-hints cl))) + 0 t + nil 'xwem-trans-for-manage 'xwem-trans-for-demanage + 'xwem-trans-for-demanage) + + ;; run init functions + (mapc (lambda (manel) + (xwem-manda-fun-run manel 'init)) + xwem-manda-list)) + + +;; Transient for clients handling +(defcustom xwem-cl-transient-border-color "blue4" + "Border color for transient for windows." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-cl) + +(defcustom xwem-cl-transient-border-width 2 + "Border width in pixels of transient for windows." + :type 'number + :group 'xwem-cl) + +(defun xwem-trans-for-manage (cl &rest others) + "Manage CL that have transient-for flag." + ;; Map window for witch CL is transient and just map and raise CL + ;; over it + (let* ((xwin (xwem-cl-xwin cl)) + (tfwin (xwem-cl-transient-for cl)) + (trc (xwem-find-client tfwin))) + + (XChangeWindowAttributes (xwem-dpy) xwin + (make-X-Attr :border-pixel (XAllocNamedColor + (xwem-dpy) (XDefaultColormap (xwem-dpy)) + xwem-cl-transient-border-color + (make-X-Color :dpy (xwem-dpy))) + )) + (XSetWindowBorderWidth (xwem-dpy) xwin xwem-cl-transient-border-width) + + (XMapWindow (xwem-dpy) (xwem-cl-xwin cl)) + (XRaiseWindow (xwem-dpy) (xwem-cl-xwin cl)) + (XSelectInput (xwem-dpy) (xwem-cl-xwin cl) (Xmask-or XM-StructureNotify)) + + (when (xwem-cl-p trc) + (setf (xwem-cl-translist trc) (cons cl (xwem-cl-translist trc)))) + + (xwem-focus-set cl) + )) + +(defun xwem-trans-for-demanage (cl &rest others) + "Demanage CL that have transient-for flag." + (let* ((tfwin (xwem-cl-transient-for cl)) + (trc (xwem-find-client tfwin))) + + (when (xwem-cl-p trc) + (xwem-message 'info "here i trc=%d" (X-Win-id (xwem-cl-xwin trc))) + + (setf (xwem-cl-translist trc) (delete cl (xwem-cl-translist trc)))) + + (xwem-focus-pop-set))) + + +(provide 'xwem-manage) + +;;; xwem-manage.el ends here diff --git a/lisp/xwem-minibuffer.el b/lisp/xwem-minibuffer.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1pbmlidWZmZXIuZWw= --- /dev/null +++ b/lisp/xwem-minibuffer.el @@ -0,0 +1,273 @@ +;;; xwem-minibuffer.el --- XWEM minibuffer support. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Dec 4 15:13:12 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +;;;###autoload +(defstruct xwem-minib + frame ; Emacs frame + (evmask 0.0) ; events to select + cl + + plist ; User defined plist + ) + +;;;###autoload +(defmacro xwem-minib-xgeom (minb) + "Get MINB xgeom." + `(xwem-cl-xgeom (xwem-minib-cl ,minb))) + +(defmacro xwem-minib-xwin (minb) + "Get MINB xwin." + `(xwem-cl-xwin (xwem-minib-cl ,minb))) + +(defsetf xwem-minib-xgeom (minb) (xgeom) + `(setf (xwem-cl-xgeom (xwem-minib-cl ,minb)) ,xgeom)) + +(defsetf xwem-minib-xwin (minb) (xwin) + `(setf (xwem-cl-xwin (xwem-minib-cl ,minb)) ,xwin)) + +;; Customization +(defgroup xwem-minibuffer nil + "Group to customize XWEM minibuffer." + :prefix "xwem-minibuffer-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-minibuffer-name "xwem-minibuffer" + "*Minibuffer name to be used by XWEM." + :type 'string + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-bgcol "gray80" + "*Background color to be used in `xwem-minib-frame'." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-font nil + "*Font to be used in `xwem-minib-frame'. May be nil or string." + :type '(restricted-sexp :match-alternatives ('nil try-font-name)) + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-height 1 + "Height of `xwem-minibuffer'." + :type 'number + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-width 80 + "*Usable width of `xwem-minibuffer' frame." + :type 'number + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-border-width 3 + "Border width for `xwem-minibuffer'." + :type 'number + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-passive-border-color "blue3" + "Border color for `xwem-minibuffer'." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-active-border-color "blue" + "Border color for `xwem-minibuffer' when it focused." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-minibuffer) + +(defcustom xwem-minibuffer-hide-cursor-mode t + "*Non-nil value mean that cursor will be hided, when xwem-minibuffer +loses focus, and unhides when it focused." + :type 'boolean + :group 'xwem-minibuffer) + +;; Variables +;;;###autoload +(defvar xwem-minibuffer nil + "Internal variable, holds `xwem-minibuffer' structure.") + + +(defvar xwem-minib-after-creat-hooks nil + "Hooks to be called after xwem minibuffer created.") + +;;;###autoload +(defun xwem-minib-create () + "Create minibuffer that will be used by xwem, or use existen." + (let ((mframe (xwem-misc-find-frame xwem-minibuffer-name))) + + (when (null mframe) + ;; not yet created + (xwem-message 'info "here creating minibuffer. frames=%S" (frame-list)) + (setq mframe (make-frame minibuffer-frame-plist))) + + (setq default-minibuffer-frame mframe) + (setf (xwem-minib-frame xwem-minibuffer) mframe) + + ;; XXX - maybe move it to `xwem-minib-after-creat-hooks'? + (when xwem-minibuffer-font + (set-face-property 'default 'font xwem-minibuffer-font (xwem-minib-frame xwem-minibuffer))) + (when xwem-minibuffer-bgcol + (set-face-property 'default 'background xwem-minibuffer-bgcol + (xwem-minib-frame xwem-minibuffer))) + + ;; TODO: run after create hooks + )) + +;; Manda functions +;;;###autoload +(defun xwem-minib-refit (cl &rest args) + "Refit xwem minibuffer. +CL is non-nil when `xwem-minib-refit' is called internally by xwem-minb-manage. +ARGS is additional arguments." + ;; Adjust geometry a little + (xwem-cl-correct-size-for-size cl (xwem-cl-xgeom cl) 'left 'bottom) + + (let ((mgeom (xwem-minib-xgeom xwem-minibuffer))) + (XMoveResizeWindow (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) + (X-Geom-x mgeom) (X-Geom-y mgeom) (X-Geom-width mgeom) (X-Geom-height mgeom))) + ) + +;;;###autoload +(defun xwem-minib-manage (cl) + "Manage XWEM's minibuffer client CL." + (setf (xwem-minib-cl xwem-minibuffer) cl) + (setf (xwem-cl-xgeom cl) + (make-X-Geom :x 0 :y (- (X-Geom-height (xwem-rootgeom)) + (X-Geom-height (xwem-cl-xgeom cl))) + :width (X-Geom-width (xwem-rootgeom)) + :height (X-Geom-height (xwem-cl-xgeom cl)) + :border-width 0)) + + ;; Install event handler for xwem minibuffer window. + (setf (xwem-minib-evmask xwem-minibuffer) + (Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-FocusChange)) + (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) (xwem-minib-evmask xwem-minibuffer)) + (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer) 'xwem-minib-events-handler) + + ;; Install grabs + (xwem-kbd-install-grab xwem-global-map (xwem-minib-xwin xwem-minibuffer)) + + (xwem-minib-refit cl)) + +;;;###autoload +(defun xwem-minib-demanage (cl &rest args) + "Demage xwem minibuffer client CL. +ARGS is additional arguments." + ;; Is this really needed? + nil) + +;;;###autoload +(defun xwem-minib-iconify (cl &rest args) + "Iconify xwem minibuffer client CL. +ARGS is additional arguments." + ;; Is this really needed? + nil) + +;; Events handler +(defun xwem-minib-events-handler (xdpy xwin xev) + "Events handler for minibuffer window. +XDPY - X-Dpy . +XWIN - X-Win for which event is generated. +XEV - X-Event to handle." + (X-Dpy-log (X-Event-dpy xev) "MINIBUFFER: %S event win = %S\n" + '(X-Event-name xev) '(X-Win-id (X-Event-win xev))) + + (X-Event-CASE xev + (:X-FocusIn + (when (and (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinear)) + (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinearVirtual))) + ;; XWEM Minibuffer activates + (set-frame-property (xwem-minib-frame xwem-minibuffer) + 'border-color xwem-minibuffer-active-border-color) + (when xwem-minibuffer-hide-cursor-mode + (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p t)) + )) + + (:X-FocusOut + (when (and (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinear)) + (not (eq (X-Event-xfocus-mode xev) X-NotifyNonlinearVirtual))) + ;; XWEM Minibuffer deactivates + (set-frame-property (xwem-minib-frame xwem-minibuffer) + 'border-color xwem-minibuffer-passive-border-color) + (when xwem-minibuffer-hide-cursor-mode + (set-frame-property (xwem-minib-frame xwem-minibuffer) 'text-cursor-visible-p nil)) + )) + + ;; TODO: add more? + (t nil))) + +;;;###autoload +(defvar xwem-saved-menubar-visible-p nil + "Saved value of `menubar-visible-p' specifier.") + +;;;###autoload +(defun xwem-minibuffer-init () + "Initialize xwem minibuffer." + (xwem-message 'msg "Initializing minibuffer ... wait") + + ;; Xt will wait ConfigureNotify event unless we specify to not do + ;; so. We can't send it because process already blocked. +; (modify-frame-parameters nil '((wait-for-wm . nil))) + + (setq minibuffer-frame-plist + (list 'menubar-visible-p nil + 'default-toolbar-visible-p nil + 'name xwem-minibuffer-name + 'height xwem-minibuffer-height + 'border-width xwem-minibuffer-border-width + 'border-color xwem-minibuffer-passive-border-color + 'width xwem-minibuffer-width + 'wait-for-wm nil + )) + + (setq default-frame-plist + (plist-put default-frame-plist 'minibuffer nil)) + (setq default-frame-plist + (plist-put default-frame-plist 'wait-for-wm nil)) + (setq initial-frame-plist + (plist-put initial-frame-plist 'minibuffer nil)) + (setq initial-frame-plist + (plist-put initial-frame-plist 'wait-for-wm nil)) + + ;; Some strange things happens with XEmacs, it skips + ;; `menubar-visible-p' property, so there is hack to set + ;; `menubar-visible-p' specifier temporary to nil and after XWEM + ;; minibuffer creating revert it back. + (setq xwem-saved-menubar-visible-p (specifier-instance menubar-visible-p)) + (set-specifier menubar-visible-p nil) + + (setq xwem-minibuffer (make-xwem-minib)) + ) + + +(provide 'xwem-minibuffer) + +;;; xwem-minibuffer.el ends here diff --git a/lisp/xwem-misc.el b/lisp/xwem-misc.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1pc2MuZWw= --- /dev/null +++ b/lisp/xwem-misc.el @@ -0,0 +1,668 @@ +;;; xwem-misc.el --- Misc stuff for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; This file used for misc purposes. +;; +;; If you have troubles with C-g key in Emacs, try to set eval: +;; +;; (set-input-mode nil nil nil ?\xff) +;; +;; I dont know where is bug, but sometimes my XEmacs behaves very +;; strange. Especially after M-x C-h k. + +;;; Code: +;; + + +(eval-and-compile + (defvar elp-function-list nil) ; shut up compiler + (autoload 'elp-instrument-list "elp" nil t) + (autoload 'elp-results "elp" nil t) + + (autoload 'calc-eval "calc")) + +(define-error 'xwem-internal-error + "Internal XWEM error.") + +(defgroup xwem-misc nil + "Group to customize miscellaneous options." + :prefix "xwem-misc-" + :group 'xwem) + +(defcustom xwem-messages-buffer-name " *xwem-messages*" + "*Buffer name for xwem messages." + :type 'string + :group 'xwem) + +(defcustom xwem-messages-buffer-lines 1000 + "*Maximum lines in xwem messages buffer." + :type 'number + :group 'xwem) + +(defcustom xwem-misc-functions-to-profile + '(X-Create-message + X-Dpy-parse-message + string->int + string4->int + X-Dpy-grab-bytes + X-Dpy-filter + X-Dpy-parse-message-guess + accept-process-output + X-Text-width + X-Text-height + XImagePut) + "List of functions to profile using xwem profiler." + :type '(repeat function) + :group 'xwem-misc) + +;;; Cursors +(defgroup xwem-cursor nil + "Group to customize cursors in XWEM." + :prefix "xwem-cursor-" + :group 'xwem) + +;; Default cursor +(defcustom xwem-cursor-default-shape 'X-XC-left_ptr + "*Shape of default xwem cursor." + :type (xwem-cursor-shape-choice) + :group 'xwem-cursor) + +(defcustom xwem-cursor-default-foreground-color "#002800" + "*Default cursor's foreground color." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +(defcustom xwem-cursor-default-background-color "#000000" + "*Default cursor's background color." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +;; wait cursor +(defcustom xwem-cursor-wait-shape 'X-XC-icon + "*Shape of cursor, when XWEM wait for something." + :type (xwem-cursor-shape-choice) + :group 'xwem-cursor) + +(defcustom xwem-cursor-wait-foreground-color "#ea0000" + "*Cursor's foreground color when XWEM wait for something." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +(defcustom xwem-cursor-wait-background-color nil;"#280000" + "*Cursor's background color when XWEM waiit for something." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +;; quote cursor +(defcustom xwem-cursor-quote-shape 'X-XC-sb_down_arrow + "*Shape of cursor, when XWEM quoting keyboard or mouse." + :type (xwem-cursor-shape-choice) + :group 'xwem-cursor) + +(defcustom xwem-cursor-quote-foreground-color "#0000BB" + "*Cursor's foreground color when XWEM quoting keyboard/mouse." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +(defcustom xwem-cursor-quote-background-color "#000099" + "*Cursor's background color when XWEM quoting keyboard/mouse." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +;; help cursor +(defcustom xwem-cursor-help-shape 'X-XC-question_arrow + "*Shape of cursor, when getting help with XWEM." + :type (xwem-cursor-shape-choice) + :group 'xwem-cursor) + +(defcustom xwem-cursor-help-foreground-color "#00BB00" + "*Cursor's foreground color when quering XWEM for help." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +(defcustom xwem-cursor-help-background-color "#009900" + "*Cursor's background color when quering XWEM for help." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-cursor) + +;; cursor storages +;;;###autoload +(defvar xwem-cursor-fnt nil "Font for \"cursor\" series.") + +;;;###autoload +(defvar xwem-cursor-default nil "Default cursor.") +;;;###autoload +(defvar xwem-cursor-left nil "Left cursor.") +;;;###autoload +(defvar xwem-cursor-right nil "Right cursor.") +;;;###autoload +(defvar xwem-cursor-wait nil "Cursor when we are wait.") +;;;###autoload +(defvar xwem-cursor-drag nil "Cursor when we drag. Drug is a bad idea.") +;;;###autoload +(defvar xwem-cursor-move nil "Cursor when we move.") +;;;###autoload +(defvar xwem-cursor-resize nil "Cursor when we resize.") +;;;###autoload +(defvar xwem-cursor-quote nil "Cursor when quoting key.") +;;;###autoload +(defvar xwem-cursor-help nil "Cursor when in help mode.") + +;;; Functions +;;;###autoload +(defsubst xwem-misc-colorspec->rgb-vector (colspec) + "Conver color specification COLSPEC to internal representation. +COLSPEC maybe in form: #RRGGBB or name like 'green4'." + (vconcat (color-instance-rgb-components (make-color-instance colspec)))) + +;;;###autoload +(defsubst xwem-misc-colorspec->rgb-vector-safe (colspec &optional defret) + "Validate COLSPEC to be color specification in safe manner. +Return DEFRET or [0 0 0] if there was error." + (condition-case nil + (xwem-misc-colorspec->rgb-vector colspec) + (t (or defret [0 0 0])))) + +;;;###autoload +(defsubst xwem-misc-colorspec-valid-p (colspec) + "Return non-nil if COLSPEC is valid color specification. +Valid colorspecification is spec in form: #RRGGBB or name like 'green4'." + (condition-case nil + (xwem-misc-colorspec->rgb-vector colspec) + (t nil))) + +;;;###autoload +(defun xwem-make-cursor (type &optional fgcol bgcol) + "Make new cursor of TYPE and store it in WHERE-STORE. +BGCOL maybe nil, that mean masking will not be done." + (let ((fgc (xwem-misc-colorspec->rgb-vector-safe fgcol [0 0 0])) + (bgc (xwem-misc-colorspec->rgb-vector-safe bgcol 'invalid-bgcol)) + cursor) + (setq cursor (make-X-Cursor :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) + :source xwem-cursor-fnt + :mask xwem-cursor-fnt + :src-char type + :msk-char (+ (if (eq bgc 'invalid-bgcol) 0 1) type) + :fgred (aref fgc 0) + :fggreen (aref fgc 1) + :fgblue (aref fgc 2))) + (unless (eq bgc 'invalid-bgcol) + (setf (X-Cursor-bgred cursor) (aref bgc 0)) + (setf (X-Cursor-bggreen cursor) (aref bgc 1)) + (setf (X-Cursor-bgblue cursor) (aref bgc 2))) + + (XCreateGlyphCursor (xwem-dpy) cursor) + cursor)) + +;;;###autoload +(defun xwem-init-cursors () + "Initialize cursors." + ;; Make cursors + (xwem-message 'msg "Initializing cursors ... wait") + + (setq xwem-cursor-fnt (make-X-Font :dpy (xwem-dpy) :id (X-Dpy-get-id (xwem-dpy)) + :name "cursor")) + (XOpenFont (xwem-dpy) xwem-cursor-fnt) + + (setq xwem-cursor-default (xwem-make-cursor (eval xwem-cursor-default-shape) + xwem-cursor-default-foreground-color + xwem-cursor-default-background-color) + + xwem-cursor-left (xwem-make-cursor X-XC-left_ptr + xwem-cursor-default-foreground-color + xwem-cursor-default-background-color) + + xwem-cursor-right (xwem-make-cursor X-XC-right_ptr + xwem-cursor-default-foreground-color + xwem-cursor-default-background-color) + + xwem-cursor-wait (xwem-make-cursor (eval xwem-cursor-wait-shape) + xwem-cursor-wait-foreground-color + xwem-cursor-wait-background-color) + + xwem-cursor-quote (xwem-make-cursor (eval xwem-cursor-quote-shape) + xwem-cursor-quote-foreground-color + xwem-cursor-quote-background-color) + + xwem-cursor-help (xwem-make-cursor (eval xwem-cursor-help-shape) + xwem-cursor-help-foreground-color + xwem-cursor-help-background-color)) + ;; TODO: add other cursors + ) + +;;; Misc drawing +;;;###autoload +(defun xwem-misc-draw-shadow (dpy win gc1 gc2 x y w h thick) + "Draw shadow." + (let ((offset 0)) + (if (or (> (* thick 2) h) (> (* thick 2) w)) + nil ; undrawable + (while (not (= thick offset)) + (XDrawLine dpy win gc1 + (+ x offset) (+ y offset) + (+ x offset) (- (+ y h) offset)) + (XDrawLine dpy win gc1 + (+ x offset) (+ y offset) + (- (+ x w) offset) (+ y offset)) + + (XDrawLine dpy win gc2 + (+ x offset 1) (- (+ y h) offset 1) ; XXX + (- (+ x w) offset) (- (+ y h) offset 1)) + + (XDrawLine dpy win gc2 + (- (+ x w) offset 1) (+ y offset 1) + (- (+ x w) offset 1) (- (+ y h) offset)) + + (setq offset (+ offset 1)) + )))) + +;;;###autoload +(defun xwem-misc-draw-bar (dpy win gc1 gc2 gc3 x y w h th) + "Draw shadowed bar. +Bar filled with GC1. +Shadow thickness is TH and it is drawed with GC2 and GC3." + (X-Dpy-log dpy "xwem-misc-draw .. x=%d y=%d w=%d h=%d\n" 'x 'y 'w 'h) + + (xwem-misc-draw-shadow dpy win gc2 gc3 x y w h th) + (XFillRectangle dpy win gc1 (+ x th) (+ y th) (- w (* th 2)) (- h (* th 2))) + ) + +;;;###autoload +(defun xwem-misc-find-frame (name) + "Find Emacs frame by its NAME." + (let ((fl (if xwem-gnuemacs-p (frame-list) (device-frame-list))) + (rf nil)) + + (while fl + (when (string= (frame-name (car fl)) xwem-minibuffer-name) + ;; Found + (setq rf (car fl)) + (setq fl nil)) + (setq fl (cdr fl))) + rf)) + +;; Some hooks +;;;###autoload +(defun xwem-misc-xerr-hook (xdpy xev) + "Display X errors in `xwem-minibuffer'. +Error hook must not performe any interaction with X server! +XDPY - X-Dpy. +XEV - X-Event of error type." + (let* ((err (X-Event-xerror-code xev)) + (badth (X-Event-xerror-resourceid xev)) + (seq (X-Event-seq xev)) + (maj (X-Event-xerror-maj-op xev)) + (min (X-Event-xerror-min-op xev)) + (bstr (cond ((= err 1) "Request") + ((= err 2) "Value") + ((= err 3) "Window") + ((= err 4) "Pixmap") + ((= err 5) "Atom") + ((= err 6) "Cursor") + ((= err 7) "Font") + ((= err 8) "Match") + ((= err 9) "Drawable") + ((= err 10) "Access") + ((= err 11) "Alloc") + ((= err 12) "Color") + ((= err 13) "GC") + ((= err 14) "IDChoice") + ((= err 15) "Name") + ((= err 16) "Length") + ((= err 17) "Implementation") + ((= err 128) "FirstExtension") + ((= err 255) "LastExtension") + (t "Unknown")))) + (xwem-message 'err "X error - Bad %s %f seq=%f:%d ops=%d:%d" + bstr badth seq (X-Dpy-rseq-id (xwem-dpy)) maj min) + )) + +;;;###autoload +(defun xwem-init-misc () + "Some misc initializetions." + (pushnew 'xwem-misc-xerr-hook (X-Dpy-error-hooks (xwem-dpy))) + ) + +;;; Stuff for debugging +(defun xwem-misc-str2hexstr (str) + "Convert STR to hexidecimal string representation." + (substring (mapconcat (lambda (el) (format "%x " el)) str "") 0 -1)) + +;;; Messaging + +;;;###autoload +(defun xwem-str-with-faces (str face-list) + "Return STR with applied FACE-LIST." + (let ((ext (make-extent 0 (length str) str))) + + (set-extent-property ext 'duplicable t) + (set-extent-property ext 'unique t) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'end-open t) + (set-extent-property ext 'face face-list)) + str) + +(defun xwem-format-faces (fmt def-face &rest args) + "Accepts format FMT and ARGS in form `((arg . face) ...)'. +DEF-FACE is default face. Returns string with faces." + (let ((flst (string-to-list fmt)) + (chr nil) + (rstr "")) + (while flst + (setq chr (car flst)) + (cond ((= chr ?%) + (setq flst (cdr flst)) + (setq chr (car flst)) + (let ((arg (if (consp (car args)) (caar args) (car args))) + (fcs (if (consp (car args)) (cdr (car args)) nil))) + (cond ((= chr ?s) + (setq rstr (concat + rstr + (xwem-str-with-faces + arg + (if fcs (list fcs def-face) (list def-face))))) + (setq args (cdr args))) + + ((= chr ?d) + (setq rstr (concat + rstr + (xwem-str-with-faces + (int-to-string arg) + (if fcs (list fcs def-face) (list def-face))))) + (setq args (cdr args))) + (t nil)))) + (t + (setq rstr (concat + rstr + (xwem-str-with-faces (char-to-string chr) (list def-face)))))) + (setq flst (cdr flst))) + + rstr)) + +(defun xwem-message-insert (message) + "Insert MESSAGE in `xwem-messages-buffer-name' buffer." + (with-current-buffer (get-buffer-create xwem-messages-buffer-name) + (let ((inhibit-read-only t)) + ;; Remove all messages from buffer if it exided maximum value + (when (> (count-lines-buffer) xwem-messages-buffer-lines) + (delete-region (point-min) (point-max))) + + (goto-char (point-max)) + (insert (format-time-string "%D %T: ")) + (insert message) + (insert "\n")))) + +;;;###autoload +(defun xwem-message (type fmt &rest args) + "Display xwem message of TYPE using FMT format. +Type is: +'note -- For some xwem notes. +'warn -- For xwem warnings (beeps). +'warn-nobeep -- For xwem warnings (does not beeps). +'err -- For xwem warnings (beeps). +'err-nobeep -- For xwem warnings (does not beeps). +'todo -- Things that xwem should have. +'msg -- Informatical message. +'prompt -- XWEM's input prompt. +'asis -- Such type is not passed through `format', ARGS should be nil, + used to message colorized text. + +ARGS are passed to `format' with FMT to generate final message." + (if (eq type 'asis) + (display-message 'message fmt) + (let ((str + (cond ((eq type 'note) "-Note:") + ((eq type 'warn) + (concat "-" (xwem-str-with-faces "Warning:" (list 'red)))) + ((eq type 'warn-nobeep) + (concat "-" (xwem-str-with-faces "Warning:" (list 'red)))) + ((eq type 'err) + (concat "-" (xwem-str-with-faces "Error:" (list 'red 'bold)))) + ((eq type 'err-nobeep) + (concat "-" (xwem-str-with-faces "Error:" (list 'red 'bold)))) + ((eq type 'todo) (concat "-" (xwem-str-with-faces "TODO:" (list 'bold)))) + ((eq type 'msg) "") + ((eq type 'prompt) "") + ((eq type 'progress) "") + ((eq type 'nolog) "") + (t ""))) + (msg (apply 'format fmt args))) + + (unless (member type '(prompt progress nolog)) + (xwem-message-insert msg)) + + ;; Beep if needed + (cond ((eq type 'warn) (xwem-play-sound 'msg-warn)) + ((eq type 'err) (xwem-play-sound 'msg-err))) + + (display-message 'message (concat "XWEM" str " " msg))))) + +;;;###autoload +(defun xwem-clear-message () + "Just as `clear-message'." + (clear-message)) + +(define-xwem-command xwem-show-message-log (arg) + "Show `xwem-messages-buffer-name'. +If prefix ARG is given, than behaviour is undefined." + (xwem-interactive "P") + + (let ((mbuf (get-buffer-create xwem-messages-buffer-name))) + (xwem-special-popup-frame mbuf) + (with-current-buffer mbuf + (setq mode-name "XWEM-log") + (local-set-key (kbd "q") 'delete-frame) + (message "Press `q' to eliminate buffer.") + ))) + +;;;###autoload +(defun xwem-list-to-string (list len) + "Convert LIST of characterters to string with length LEN." + (let ((rstr "")) + (while (and list (> len 0)) + (setq rstr (concat rstr (string (car list)))) + (setq list (cdr list)) + (setq len (1- len))) + rstr)) + +;;;; Misc commands. +(defvar xwem-read-expression-history nil + "*History of expressions evaled using `xwem-eval-expression'.") + +(define-xwem-command xwem-eval-expression (expr &optional arg) + "Eval Lisp expression interactively. +When used with prefix ARG, then insert the result into selected client." + (xwem-interactive (list + (xwem-read-from-minibuffer (if xwem-prefix-arg + "XWEM (insert) Eval: " + "XWEM Eval: ") + nil read-expression-map + t 'xwem-read-expression-history) + xwem-prefix-arg)) + + (setq values (cons (eval expr) values)) + (if arg + (xwem-key-send-ekeys (prin1-to-string (car values))) + + (xwem-message 'info "%S => %S" expr (car values)))) + +(define-xwem-command xwem-execute-extended-command (arg) + "Execute Emacs command. +If prefix ARG is given insert result to current client." + (xwem-interactive "P") + + (flet ((read-from-minibuffer (&rest args) nil)) + (fset 'read-from-minibuffer (symbol-function 'xwem-read-from-minibuffer)) + (let ((retval (execute-extended-command arg))) + (when arg + (xwem-key-send-ekeys (pp retval)))))) + +(define-xwem-command xwem-shell-command (command arg) + "Execute shell command, just as `shell-command' do. +If prefix ARG is given insert result to current client. +If output of COMMAND fits to one string it is displayed in +`xwem-minibuffer', if not Emacs special frame will be poped up with +contents of COMMAND output. +If double prefix ARG \(i.e. \\<xwem-global-map>\\[xwem-universal-argument] \\<xwem-global-map>\\[xwem-universal-argument]\) supplied, then last +'\\n' character will be cuted in output to current client." + (xwem-interactive (list (xwem-read-shell-command "XWEM Shell command: ") + xwem-prefix-arg)) + + ;; Create temporary + (let ((tbuf (get-buffer-create (generate-new-buffer-name " *temp-buf*"))) + dontkill) + (unwind-protect + (with-current-buffer tbuf + (call-process shell-file-name nil tbuf nil + shell-command-switch command) + + (if arg + (xwem-key-send-ekeys (buffer-substring (point-min) + (- (point-max) (if (> (prefix-numeric-value arg) 4) 1 0)))) + + (if (= 1 (count-lines (point-min) (point-max))) + (xwem-message 'info (buffer-substring (point-min) (point-max))) + + (xwem-special-popup-frame tbuf) + (setq dontkill t)))) + (unless dontkill + (kill-buffer tbuf))))) + +(define-xwem-command xwem-mini-calc (expr &optional arg) + "Calculate expression EXPR. +If prefix ARG is given, insert the result to current client." + (xwem-interactive + (list (xwem-read-from-minibuffer (if xwem-prefix-arg + "XWEM (insert) Calc: " + "XWEM Calc: ")) + xwem-prefix-arg)) + + (let ((result (calc-eval expr))) + (if arg + (xwem-key-send-ekeys result) + (xwem-message 'info "%s = %s" expr result)))) + +(define-xwem-command xwem-beginning-of-cl () + "Send Home key to selected client." + (xwem-interactive "_") + + (xwem-kbd-force-mods-release) + (xwem-key-send-ekeys (vector 'home))) + +(put 'xwem-beginning-of-cl 'xwem-need-keyrelease t) + +(define-xwem-command xwem-end-of-cl () + "Send End key to current client." + (xwem-interactive "_") + + (xwem-kbd-force-mods-release) + (xwem-key-send-ekeys (vector 'end))) + +(put 'xwem-end-of-cl 'xwem-need-keyrelease t) + +(define-xwem-command xwem-misc-make-screenshot (file-name) + "Make screen screenshot and save it to file with NAME." + (xwem-interactive "FImport screen to file: ") + + (flet ((message (fmt &rest args) nil)) + ;; shut up messaging + (xwem-message 'msg + (format "Importing screenshot to %s." file-name)) + (xwem-execute-program (format "import -window root %s" file-name)))) + +(define-xwem-command xwem-misc-pause (arg) + "Pause for ARG decaseconds(0.1 sec). +This command is usefull, when recording keyboard macro, and there need +to wait for something, f.e. window mapping." + (xwem-interactive "p") + + (while (> arg 0) + (sleep-for 0.1) + ;; Try to accept some data, so incoming events would be processed + (accept-process-output (X-Dpy-proc (xwem-dpy)) 0.01) + (setq arg (1- arg)))) + +;;; Some useful operations on lists +(defun xwem-insert-after (list aft-el el) + "In LIST after AFT-EL insert EL." + (push el (cdr (member aft-el list))) + list) + +(defun xwem-insert-before (list bef-el el) + "In LIST before BEF-EL insert EL." + (nreverse (xwem-insert-after (nreverse list) bef-el el))) + +(defun xwem-list-set-element (list old-el new-el) + "In LIST set OLD-EL to NEW-EL." + (setcar (member old-el list) new-el) + list) + +;;;###autoload +(defun xwem-list-exchange-els (list el1 el2) + "In LIST exchange places of EL1 and EL2." + (when (or (null (member el1 list)) + (null (member el2 list))) + (error "El1 or el2 is not in list")) + + (xwem-list-set-element list el1 'this-fake-name1-should-not-be-in-list) + (xwem-list-set-element list el2 el1) + (xwem-list-set-element list 'this-fake-name1-should-not-be-in-list el2)) + +;;; Profiling support +;;;###autoload +(defun xwem-misc-start-profiling () + "Start profiling critical xlib/xwem functions." + (interactive) + + (setq elp-function-list xwem-misc-functions-to-profile) + (elp-instrument-list)) + +;;;###autoload +(defun xwem-misc-profiling-results () + "Show xlib/xwem profiling results." + (interactive) + (elp-results)) + +;;;###autoload +(defun xwem-recursive-edit () + "Enter recursive edit." + (recursive-edit)) + +;;;###autoload +(defun xwem-exit-recursive-edit () + "Exit from recursive edit." + (if (> (recursion-depth) 0) + (throw 'exit nil)) + (xwem-message 'warn "No recursive edit is in progress")) + + +(provide 'xwem-misc) + +;;; xwem-misc.el ends here diff --git a/lisp/xwem-mouse.el b/lisp/xwem-mouse.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLW1vdXNlLmVs --- /dev/null +++ b/lisp/xwem-mouse.el @@ -0,0 +1,135 @@ +;;; xwem-mouse.el --- Mouse support for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; + +;; TODO: +;; * Add item here. +;; + +;;; Code: +;; + +(defcustom xwem-popup-menu-function 'popup-menu + "*Function used to popup menus." + :type 'function + :group 'xwem) + + +(defun xwem-mouse-change-cursor (cursor ) + (XChangeActivePointerGrab (xwem-dpy) cursor + (Xmask-or XM-ButtonPress XM-ButtonRelease))) + +;;;###autoload +(defun xwem-mouse-grab (cursor &optional win mask) + "Begin to grab mouse from root window with cursor typ CURSOR.." + ;; TODO: install custom events handlers? + (XGrabPointer (xwem-dpy) + (or win (xwem-rootwin)) + (or mask (Xmask-or XM-ButtonPress XM-ButtonRelease)) + cursor) + ) + +;;;###autoload +(defun xwem-mouse-ungrab () + "Stop grabing mouse." + (XUngrabPointer (xwem-dpy)) + ) + +;;; Menus +(defvar xwem-applications-submenu + '("Applications" + ["XEmacs" (make-frame)] + ["xterm" (xwem-execute-program "xterm")] + ["gv" (xwem-execute-program "gv")] + ["xfontsel" (xwem-execute-program "xfontsel")] + ) + "Submenu with applications.") + +(defvar xwem-menu + (list "XWEM Menu" + xwem-applications-submenu + '("Windows" + ["Vertical Split" (xwem-frame-split-vert nil)] + ["Horizontal Split" (xwem-frame-split-horiz nil)] + ["Delete Window" (xwem-window-delete)] + ["Delete Others" (xwem-window-delete-others)] + ["Balance" (xwem-balance-windows (xwem-frame-selected))]) + ) + "Popup menu to be used by xwem." + ) + +(defun xwem-menu-generate () + "Generates xwem menu on fly." + (list "XWEM Menu" + '("xwem-frames" :filter + (lambda (not-used) + (mapcar (lambda (el) + (let ((fn (xwem-frame-num el))) + (vector + (concat "Frame " (int-to-string fn)) + `(xwem-frame-switch-nth ,fn)))) + xwem-frames-list))) + + '("xwem-clients" :filter + (lambda (not-used) + (mapcar (lambda (el) + (let ((nam (xwem-hints-wm-name (xwem-cl-hints el)))) + (vector nam `(xwem-cl-pop-to-client ,el t) + :active (if (xwem-cl-exclude-p el) nil t)))) + xwem-clients))) + "--" + xwem-applications-submenu + + ;; XXX - it is just demo of popup menus + )) + +(defun xwem-popup-menu (menu &optional event) + "Popup MENU. +MENU and EVENT is same as for `popup-menu'." + (funcall xwem-popup-menu-function menu event)) + +(define-xwem-command xwem-popup-function-menu (arg) + "Just popup `xwem-menu'." + (xwem-interactive "_P") + + ;; TODO: + ;; * use ARG + (xwem-popup-menu xwem-menu)) + +(define-xwem-command xwem-popup-auto-menu (arg) + "Popup menu generated by `xwem-menu-generate'." + (xwem-interactive "_P") + + (xwem-popup-menu (xwem-menu-generate))) + + +(provide 'xwem-mouse) + +;;; xwem-mouse.el ends here diff --git a/lisp/xwem-root.el b/lisp/xwem-root.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXJvb3QuZWw= --- /dev/null +++ b/lisp/xwem-root.el @@ -0,0 +1,174 @@ +;;; xwem-root.el --- Root window and geom operations. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; This file used to manipulate and agragate information about root +;; window. Also has macros to work with geometry. +;; +;;; Code + +;;; Variables + +;;;###autoload +(defconst xwem-root-ev-mask (Xmask-or XM-SubstructureNotify + XM-SubstructureRedirect + XM-KeyPress XM-ButtonPress XM-ButtonRelease + XM-PropertyChange + XM-FocusChange + XM-EnterWindow + XM-ResizeRedirect) + "Event mask for X root window.") + +;;;###autoload +(defvar xwem-root-screen nil + "Description of root screen") + +(defvar xwem-root-keymap + (let ((map (make-sparse-keymap 'XWEM-root-map))) + (set-keymap-parents map (list xwem-global-map)) + map) + "Root window keymap. + +Bindings: +\\{xwem-root-map}") + + +;;; Functions + +;;;###autoload +(defun xwem-init-root (host) + "Initialization part for root." + (setq xwem-root-screen (xwem-dpy-dummy)) + + (aset xwem-root-screen 0 (XOpenDisplay host)) + (when xwem-debug + (setf (X-Dpy-log-buffer (xwem-dpy)) "*XWEM.Xlog*")) + + (aset xwem-root-screen 1 (XDefaultRootWindow (xwem-dpy))) + (aset xwem-root-screen 2 (XGetGeometry (xwem-dpy) (xwem-rootwin)))) + +;;;###autoload +(defun xwem-fini-root () + (XCloseDisplay (xwem-dpy))) + +;;;###autoload +(defun xwem-root-refresh (x y width height) + "Refresh area WIDTHxHEIGHT+X+Y." + (let ((wn (XCreateWindow + (xwem-dpy) nil + x y width height 0 + nil ;DefaultDepth + nil ;CopyFromParent + nil ;CopyFromParent + (make-X-Attr :override-redirect 0) + ))) + (XMapWindow (xwem-dpy) wn) + (XDestroyWindow (xwem-dpy) wn))) + +;;; Events handling for root window +(defun xwem-root-hkeybutton (xev) + "KeyPress, ButtonPress or ButtonRelease event XEV." + (when (eq (xwem-kbd-current-map) xwem-global-map) + (xwem-kbd-set-current-prefix-keymap xwem-root-keymap)) + + (xwem-kbd-handle-keybutton xev)) + +(defun xwem-root-hconfigure-request (xev) + "ConfigureRequest event XEV." + (let* ((win (X-Event-xconfigurerequest-window xev)) + (cl (xwem-find-client win)) + (vmask (X-Event-xconfigurerequest-value-mask xev))) + + (X-Dpy-log (xwem-dpy) "ROOT: ConfigureRequest event for win=%s vmask=%s, x=%S, y=%S, width=%S, height=%S\n" + '(X-Win-id win) 'vmask '(X-Event-xconfigurerequest-x xev) '(X-Event-xconfigurerequest-y xev) + '(X-Event-xconfigurerequest-width xev) '(X-Event-xconfigurerequest-height xev)) + + (if (not (xwem-cl-p cl)) + (XConfigureWindow (xwem-dpy) win + (make-X-Conf :dpy (X-Win-dpy win) + :x (when (Xtest vmask X-CWX) (X-Event-xconfigurerequest-x xev)) + :y (when (Xtest vmask X-CWY) (X-Event-xconfigurerequest-y xev)) + :width (when (Xtest vmask X-CWWidth) (X-Event-xconfigurerequest-width xev)) + :height (when (Xtest vmask X-CWHeight) (X-Event-xconfigurerequest-height xev)) + :border-width (when (Xtest vmask X-CWBorderWidth) (X-Event-xconfigurerequest-border-width xev)))) + + ;; [else] Client window already in air + (if (Xtest vmask (Xmask-or X-CWX X-CWY X-CWWidth X-CWHeight X-CWBorderWidth)) + (progn + ;; TODO: Is this really needed? +; (when (Xtest vmask X-CWWidth) +; (setf (X-Geom-width (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-width xev))) +; (when (Xtest vmask X-CWHeight) +; (setf (X-Geom-height (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-height xev))) +; (when (Xtest vmask X-CWX) +; (setf (X-Geom-x (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-x xev))) +; (when (Xtest vmask X-CWY) +; (setf (X-Geom-y (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-y xev))) +; (when (Xtest vmask X-CWBorderWidth) +; (setf (X-Geom-border-width (xwem-cl-xgeom cl)) (X-Event-xconfigurerequest-border-width xev))) + + (xwem-manda-fun-run (xwem-cl-manda cl) 'refit cl)) + + (xwem-cl-send-config cl))) + nil)) + +(defun xwem-root-hmap-request (xev) + "MapRequest event XEV." + (X-Dpy-log (X-Event-dpy xev) "XWEM-ROOT-HMAP-REQUEST: parent win=%S, window=%S\n" + '(X-Win-id (X-Event-win xev)) '(X-Win-id (X-Event-xmaprequest-window xev))) + + (let ((cl (xwem-find-client (X-Event-xmaprequest-window xev)))) + (if (xwem-cl-p cl) + (xwem-manda-fun-run (xwem-cl-manda cl) 'manage cl) + + (xwem-make-client (X-Event-xmaprequest-window xev) nil))) + ) + +;;;###autoload +(defun xwem-root-events-handler (xdpy xwin xev) + "Events handler for root window." + (X-Dpy-log xdpy "ROOT WIN: ev=%s win = %S\n" '(X-Event-name xev) '(X-Win-id (X-Event-win xev))) + + (X-Event-CASE xev + ((:X-KeyPress :X-ButtonPress :X-ButtonRelease) + (xwem-root-hkeybutton xev)) + + (:X-ConfigureRequest + ;; Some of root win clients issued XConfigureWindow + (xwem-root-hconfigure-request xev) + ) + + (:X-MapRequest + (xwem-root-hmap-request xev)) + )) + + +(provide 'xwem-root) + +;;; xwem-root.el ends here diff --git a/lisp/xwem-sound.el b/lisp/xwem-sound.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXNvdW5kLmVs --- /dev/null +++ b/lisp/xwem-sound.el @@ -0,0 +1,242 @@ +;;; xwem-sound.el --- Sound support. + +;; Copyright (C) 2004 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Wed Jan 28 22:25:44 MSK 2004 +;; Keywords: xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Sounds support for XWEM. + +;;; Code: + + +(defgroup xwem-sound nil + "Group to customize XWEM sounds." + :prefix "xwem-sound-" + :prefix "xwem-" + :group 'xwem) + +(defcustom xwem-sound-default-alist + '((default :sound bass) + (undefined-key :sound drum) + (command-fail :sound bass) + (quit :sound quiet :volume 75) + (ready :sound cuckoo) + (alarm :sound cuckoo :volume 100) + (msg-warning :sound clink :volume 70) + (msg-error :sound bong :volume 100) + ) + "The alist of sounds and associated error symbols. +Used to set `xwem-sound-alist' in `xwem-sound-load-default'." + :group 'xwem-sound + :type '(repeat + (group (symbol :tag "Name") + (checklist :inline t + :greedy t + (group :inline t + (const :format "" :value :sound) + (symbol :tag "Sound")) + (group :inline t + (const :format "" :value :volume) + (integer :tag "Volume")) + (group :inline t + (const :format "" :value :pitch) + (integer :tag "Pitch")) + (group :inline t + (const :format "" :value :duration) + (integer :tag "Duration")))))) + +(defcustom xwem-sound-beeping-alist + '((default :sound t :pitch 70 :duration 15 :volume 100) + (undefined-key :sound t :pitch 100 :duration 10 :volume 100) + (command-fail :sound t :pitch 1000 :duration 40 :volume 100) + ;; H-g + (quit :sound t :pitch 70 :duration 5 :volume 100) + ;; Ready: time cunsuming task has beed done .. compile, cvs, + ;; etc. + (ready :sound t :pitch 800 :duration 50 :volume 100) + ;; alarm: used by reminders + (alarm :sound t :pitch 2000 :duration 150 :volume 100) + + ;; (xwem-message 'warn ..) + (msg-warning :sound t :pitch 50 :duration 10 :volume 100) + ;; (xwem-message 'err ..) + (msg-error :sound t :pitch 3000 :duration 50 :volume 100) + ) + "X Bell oriented candidate for `xwem-sound-alist'. +Format is identical as for `xwem-sound-default-alist'." + :group 'xwem-sound + :type '(repeat + (group (symbol :tag "Name") + (checklist :inline t + :greedy t + (group :inline t + (const :format "" :value :sound) + (symbol :tag "Sound")) + (group :inline t + (const :format "" :value :volume) + (integer :tag "Volume")) + (group :inline t + (const :format "" :value :pitch) + (integer :tag "Pitch")) + (group :inline t + (const :format "" :value :duration) + (integer :tag "Duration")))))) + +(defcustom xwem-sound-directory (locate-data-directory "sounds") + "Default directory to load sound files." + :type 'directory + :group 'sound) + +(defcustom xwem-sound-directory-list (locate-data-directory-list "sounds") + "List of directories, which to search for sound files." + :type '(repeat directory) + :group 'xwem-sound) + +(defcustom xwem-sound-extension-list ".au:" + "Filename extensions to complete sound file name with. If more than one + extension is used, they should be separated by \":\". " + :type 'string + :group 'xwem-sound) + +(defcustom xwem-sound-list + '((xwem-sound-file-load "bass-snap" 'bass 100) + (xwem-sound-file-load "drum-beep" 'drum 100) + (xwem-sound-file-load "quiet-beep" 'quiet 100) + (xwem-sound-file-load "cuckoo" 'cuckoo 100) + (xwem-sound-file-load "clink" 'clink 100) + (xwem-sound-file-load "bong" 'bong 100) + (xwem-sound-file-load "say-beep" 'say-beep 100) + ) + "A list of calls to `xwem-sound-file-load' to be processed by `xwem-sound-load-default'. +Reference `xwem-sound-file-load' for detailed information." + :type '(repeat (sexp :tag "Sound")) + :group 'xwem-sound) + +(defcustom xwem-visible-bell nil + "If non-nil mean try to flash selected frame to represent a bell." + :type 'boolean + :group 'xwem-sound) + +;;;###autoload +(defvar xwem-sound-alist nil + "Sound alist for use by XWEM. +Format is identical as for `sound-alist'. +Error symbols are: + default -- When nothing else matches. + quit -- After \\<xwem-global-map>\\[xwem-kbd-quit] + undefined-key -- Keybinding undefined. + command-fail -- When execution of command failed. + msg-warning -- Some one warnings you. + msg-error -- Some one reports you an error. + ready -- Time consumed task has been done. + alarm -- Used by reminders.") + +(defun xwem-sound-file-load (filename sound-name &optional volume) + "Read an audio FILE and return a valid node for use in `xwem-sound-alist'." + (unless (symbolp sound-name) + (error "SOUND-NAME not a symbol")) + (unless (or (null volume) (integerp volume)) + (error "VOLUME not an integer or nil")) + + (let ((file (locate-file filename xwem-sound-directory-list + xwem-sound-extension-list)) + buf data) + (unless file + (error "Couldn't locate sound file %s" filename)) + + (unwind-protect + (save-excursion + (set-buffer (setq buf (get-buffer-create " *sound-tmp*"))) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (let ((coding-system-for-read 'binary)) + (setq coding-system-for-read coding-system-for-read) ; shut up compiler + (insert-file-contents file)) + (setq data (buffer-string)) + (erase-buffer)) + (and buf (kill-buffer buf))) + + (nconc (list sound-name) (when volume (list :volume volume)) + (list :sound data)))) + +(defun xwem-sound-do-visible-bell () + "Visible bell." + (let* ((gc-cons-threshold most-positive-fixnum) ; inhibit gcing + (xdpy (xwem-dpy)) + (frame (xwem-frame-selected)) + (gc (XCreateGC xdpy (xwem-frame-xwin frame) + (make-X-Gc :dpy xdpy :id (X-Dpy-get-id xdpy) + :function X-GXInvert + :subwindow-mode X-IncludeInferiors)))) + (X-Dpy-events-excursion xdpy + (XGrabServer xdpy) + (unwind-protect + (progn + (XFillRectangle xdpy (xwem-frame-xwin frame) + gc 0 0 (xwem-frame-width frame) + (xwem-frame-height frame)) + + ;; XXX we need sleeping, so flashing will be visible + (sleep-for 0.1) + + (XFillRectangle xdpy (xwem-frame-xwin frame) + gc 0 0 (xwem-frame-width frame) + (xwem-frame-height frame))) + (XUngrabServer xdpy) + (XFreeGC xdpy gc)) + ))) + +;;;###autoload +(defun xwem-play-sound (sound &optional volume) + "Play a sound of provided SOUND type. +If VOLUME is specified, it overrides the value specified in +`xwem-sound-alist'." + (if xwem-visible-bell + (xwem-sound-do-visible-bell) + + (let ((sound-alist xwem-sound-alist)) + (play-sound sound volume)))) + +;;;###autoload +(defun xwem-sound-load-default (&optional x-beep) + "Loads and install `xwem-sound-default-alist'. +If X-BEEP is non-nil, `xwem-sound-beeping-alist' will be loaded." + (xwem-message 'info "Loading sounds ...") + (if x-beep + (setq xwem-sound-alist (append xwem-sound-beeping-alist + xwem-sound-alist)) + + ;; Load sound files + (setq xwem-sound-alist (append xwem-sound-default-alist + xwem-sound-alist + (mapcar 'eval xwem-sound-list)))) + (xwem-message 'info "Loading sounds ... done")) + + +(provide 'xwem-sound) + +;;; xwem-sound.el ends here diff --git a/lisp/xwem-special.el b/lisp/xwem-special.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXNwZWNpYWwuZWw= --- /dev/null +++ b/lisp/xwem-special.el @@ -0,0 +1,277 @@ +;;; xwem-special.el --- Special Emacs frames handling. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Dec 4 15:01:21 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Special emacs uses by XWEM to accomplish various tasks. Such as +;; help system, and others. Special frames are handled in different +;; way, but remain normal XWEM client. Usually special frame used by +;; XWEM has dedicated window, i.e. removing window will remove frame, +;; but optionally you can create normal frames. Take a look at +;; documentation for `xwem-special-popup-frame' function. + +;; XEmacs has a bug, when window is dedicated to buffer, after buffer +;; deletion window will be deleted as well and if it is only window in +;; frame frame will be also deleted. But if there is no visible +;; frames at the moment `replace-buffer-in-windows' will skip value of +;; `allow-deletion-of-last-visible-frame' and does not deletes frame. +;; So we can't use dedicated windows, because almost everywhere we +;; will get such sitiation, for example runnig H-h H-h when there is +;; no active emacs frame. `xwem-special-popup-frame' will use +;; dedicated frame to display buffer and here is advice for +;; `kill-buffer': + +;; (defadvice kill-buffer (before delete-dedicated-frame activate) +;; "Work around dedicated frame problem." +;; (let ((frame (buffer-dedicated-frame (ad-get-arg 0)))) +;; (when (framep frame) +;; (delete-frame frame)))) +;; + +;;; TODO: +;; - Models + +;;; Code: + +(defgroup xwem-special nil + "Group to customize special emacs frames handling." + :prefix "xwem-special-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-special-enabled t + "*Non-nil mean make xwem to understand emacs special frames." + :type 'boolean + :group 'xwem-special) + +;;;###autoload +(defcustom xwem-special-frame-name "xwem-special-frame" + "*Name for special emacs frames" + :type 'string + :group 'xwem-special) + +(defcustom xwem-special-model-function 'xwem-special-at-center + "*Special frame handiling model function." + :type '(choice (const :tag "At Center" xwem-special-at-center) + (const :tag "At Pointer" xwem-special-at-pointer) + (function :tag "User function")) + :group 'xwem-special) + +(defcustom xwem-special-border-width 2 + "Border width of special Emacs frames." + :type 'number + :group 'xwem-special) + +(defcustom xwem-special-border-color "red4" + "Border color of special Emacs frames." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-special) + +(defcustom xwem-special-menubar-visible-p nil + "Non-nil for menubar in special Emacs frames." + :type 'boolean + :group 'xwem-special) + +(defcustom xwem-special-toolbar-visible-p nil + "Non-nil for toolbar in special Emacs frames." + :type 'boolean + :group 'xwem-special) + +;; Internal variables +(defvar xwem-special-frames-list nil "List of special frames.") + + +;; Functions +;; NOTE: +;; - setting initially-unmapped to t causes double MapRequest +;; +(defun xwem-special-make-frame () + "Make special frame. +NOTE: frame is initially unmapped, use `make-frame-visible' to map it." + (let ((props special-display-frame-plist)) + (setq props (plist-put props 'name xwem-special-frame-name)) +; (setq props (plist-put props 'initially-unmapped t)) + + (make-frame props))) + +(defun xwem-special-frame-p (thing) + "Check THING is acctually special emacs frame. +THING may be X window or xwem clinet." + (cond ((X-Win-p thing) (string= (car (XGetWMClass (xwem-dpy) thing)) + xwem-special-frame-name)) + ((xwem-cl-p thing) (string= (car (xwem-hints-wm-class (xwem-cl-hints thing))) + xwem-special-frame-name)) + (t nil)) + ) + +;;;###autoload +(defun xwem-special-display-popup-frame (buffer &optional args) + "Popup special frame with BUFFER." + (frame-selected-window (xwem-special-popup-frame buffer))) + +;;;###autoload +(defun xwem-special-popup-frame (buf &optional nondedicated-p args) + "As `special-display-popup-frame', but popup frame for sure. +When NONDEDICATED-P is non-nil then frame will not be dedicated." + (let ((sfr (xwem-special-make-frame))) + (set-window-buffer (frame-selected-window sfr) buf) + (unless nondedicated-p + (set-window-dedicated-p (frame-selected-window sfr) t)) + + (set-buffer-dedicated-frame buf sfr) ; XXX + + ;; Put special frame property, to know that this frame forced to + ;; be special. + (set-frame-property sfr 'xwem-forced-special t) + +; (make-frame-visible sfr) + (raise-frame sfr) + (select-frame sfr) + sfr)) + +(defun xwem-special-at-center (cl) + "Display special frame at center of selected xwem frame." + ) + +;;;###autoload +(defun xwem-special-frame-manage (cl &rest not-used) + "Manage special xwem client CL." + (X-Dpy-log (xwem-dpy) "HERE in `xwem-special-frame-manage'.\n") + ;; Make it just above xwem-minibuffer + + ;; TODO: * What is if xwem minibuffer is not managed yet, e.g. when + ;; we processes after QueryTree and special frame is before + ;; xwem minibuffer frame. + ;; + ;; * Implement various special frame manage models + ;; - center of selected frame + ;; - just above xwem minibuffer + ;; - pointer at the center + ;; - other +; (funcall xwem-special-model-function cl) + (let* ((ming (xwem-minib-xgeom xwem-minibuffer)) + (win (xwem-cl-xwin cl)) + (clgeo (xwem-cl-xgeom cl)) + (clhe (X-Geom-height clgeo)) + (clwi (X-Geom-width clgeo)) + (cfr (xwem-frame-selected)) +; (cfrwi (if cfr (xwem-frame-width cfr) (X-Geom-width (xwem-rootgeom)))) + (yoff 0) + (xoff 0)) + + (X-Dpy-log (xwem-dpy) "HERE AGAIN: clgeo=%S\n" 'clgeo) + (setq yoff (- (X-Geom-y ming) clhe 4)) +; (setq xoff (/ (- (X-Geom-width (xwem-rootgeom)) clwi) 2)) + (setq xoff (+ (xwem-frame-x cfr) (/ (- (xwem-frame-width cfr) clwi) 2))) + (X-Dpy-log (xwem-dpy) "HERE again: xoff=%d yoff=%d\n" 'xoff 'yoff) +; (XReparentWindow (xwem-dpy) win (xwem-rootwin) xoff yoff) + (XMoveWindow (xwem-dpy) win xoff yoff) + (XMapWindow (xwem-dpy) win) + (XRaiseWindow (xwem-dpy) win) + + (XSelectInput (xwem-dpy) win + (Xmask-or XM-FocusChange + XM-VisibilityChange + XM-StructureNotify)) + + ;; Setup events handler for special frames + (X-Win-EventHandler-add-new win 'xwem-special-evhandler) + + ;; TODO: hooking? + (xwem-focus-set win) + nil)) + +(defun xwem-special-revert-focus () + "Try to predict who has focus, before special and revert to it." + (xwem-focus-pop-set)) + +;;;###autoload +(defun xwem-special-frame-demanage (cl &rest args) + "Demanage specal xwem client CL." + (XUnmapWindow (xwem-dpy) (xwem-cl-xwin cl)) + + (xwem-special-revert-focus) + ) + +;;;###autoload +(defun xwem-special-frame-iconify (cl &rest args) + "Iconify handler for special frame." + (xwem-special-frame-demanage cl)) + +;; Events handler +(defun xwem-special-evhandler (xdpy win xev) + "Event handler for speical emacs frames." + (X-Dpy-log (xwem-dpy) "XWEM-SPECIAL-EVHANDLER: ev = %S, winid = %S\n" + '(X-Event-name xev) '(aref win 2)) + + (X-Event-CASE xev + (:X-VisibilityNotify + (xwem-special-frame-demanage (xwem-find-client win))) + + (:X-UnmapNotify + (when (X-Win-p win) + (X-Win-EventHandler-rem win 'xwem-special-evhandler)) + (xwem-special-revert-focus)) + + (:X-DestroyNotify + (when (X-Win-p win) + (X-Win-EventHandler-rem win 'xwem-special-evhandler)) + (xwem-special-revert-focus)) + + (:X-FocusOut + (xwem-special-frame-demanage (xwem-find-client win))) + )) + +;;;###autoload +(defun xwem-special-frame-init () + "Initialize stuff to work with special emacs frames." + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'minibuffer nil)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'name xwem-special-frame-name)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'border-width xwem-special-border-width)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'border-color xwem-special-border-color)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'menubar-visible-p xwem-special-menubar-visible-p)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'default-toolbar-visible-p xwem-special-toolbar-visible-p)) + (setq special-display-frame-plist + (plist-put special-display-frame-plist 'wait-for-wm nil)) + + ;; XXX -- this should be in ~/.xwemrc.el +; (add-to-list 'special-display-regexps (cons "*Help" nil)) +; (add-to-list 'special-display-regexps (cons "*Completions" nil)) + ) + + + +(provide 'xwem-special) + +;;; xwem-special.el ends here diff --git a/lisp/xwem-strokes.el b/lisp/xwem-strokes.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXN0cm9rZXMuZWw= --- /dev/null +++ b/lisp/xwem-strokes.el @@ -0,0 +1,561 @@ +;;; xwem-strokes.el --- Strokes support by XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Thu Dec 4 17:42:12 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; + +;;; Code: + +(eval-and-compile + (require 'strokes)) + +(defgroup xwem-strokes nil + "Group to customize XWEM strokes." + :prefix "xwem-strokes-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-strokes-enabled t + "*Non-nil mean xwem-stroke is enabled." + :type 'boolean + :group 'xwem-strokes) + +(defcustom xwem-strokes-grid 25 + "*XWEM strokes Grid resolution. +Look at `strokes-grid-resolution' for details." + :type 'integer + :group 'xwem-strokes) + +(defcustom xwem-strokes-minimum-match-score 2000 + "*Take a look at `strokes-minimum-match-score'." + :type 'integer + :group 'xwem-strokes) + +(defcustom xwem-strokes-file "xwem-strokes.el" + "*File contained strokes for xwem stroke mode." + :type 'string + :group 'xwem-strokes) + +(defcustom xwem-strokes-click-command + (lambda () + (interactive) + (xwem-message 'info "Default `xwem-strokes-click-command'.")) + "*Command to execute when stroke is actually a `click'." + :type 'function + :group 'xwem-strokes) + +(defcustom xwem-strokes-cursor-type 'X-XC-dot + "*Type of cursor to use when XWEM enters strokes mode." + :type (xwem-cursor-shape-choice) + :group 'xwem-strokes) + +(defcustom xwem-strokes-cursor-foreground-color "#00ea00" + "*Cursor's foreground color when XWEM in strokes mode." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-strokes) + +(defcustom xwem-strokes-cursor-background-color "#002800" + "*Cursor's background color when XWEM in strokes mode." + :type '(restricted-sexp :match-alternatives ('nil xwem-misc-colorspec-valid-p)) + :group 'xwem-strokes) + +(defcustom xwem-strokes-gc-function X-GXCopy + "Function applied to draw strokes." + :type (xwem-gc-function-choice) + :group 'xwem-strokes) + +(defcustom xwem-strokes-sleep 0.2 + "*How many seconds sleep before executing stroke." + :type 'float + :group 'xwem-strokes) + +(defface xwem-face-strokes-begin + `((t (:foreground "red4" :background "black" :line-width 10 + :subwindow-mode X-IncludeInferiors + :function xwem-strokes-gc-function))) + "Face used to begin stroke." + :group 'xwem-strokes + :group 'xwem-faces) + +(defface xwem-face-strokes + `((t (:foreground "magenta4" :background "black" :line-width 7 + :subwindow-mode X-IncludeInferiors + :function xwem-strokes-gc-function + :cap-style X-CapRound))) + "Face used to draw stroke." + :group 'xwem-strokes + :group 'xwem-faces) + +;; Stroke variables +;;;###autoload +(defvar xwem-strokes-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-default-binding map 'xwem-strokes-nocmd) + + (define-key map xwem-quit-key 'xwem-keyboard-quit) + (define-key map [button2] 'xwem-strokes-idescribe) + (define-key map [button1] 'xwem-strokes-ibutton1) + (define-key map [button1up] 'xwem-strokes-ibutton1up) + (define-key map [(meta button1up)] 'xwem-strokes-ibutton1up) + (define-key map [(control button1up)] 'xwem-strokes-ibutton1up) + (define-key map [(meta control button1up)] 'xwem-strokes-ibutton1up) + (define-key map [button3] 'xwem-strokes-ibutton3) + map) + "Keymap being used while in strokes event loop.") + +(defvar xwem-strokes-map nil "Stroke map for XWEM.") + +(defvar xwem-strokes-curr nil "Current events list, it passed to `stroke-' routines.") +(defvar xwem-strokes-defining nil "Non-nil mean that we defining stroke now.") + +(defvar xwem-strokes-cursor nil "Cursor used while reading stroke.") + +;; Functions +(defun xwem-strokes-save-strokes () + "Save user defined strokes to file named by `xwem-strokes-file'. +Modification to `strokes-prompt-user-save-strokes' to work with xwem's stuff." + (let ((strokes-global-map xwem-strokes-map) + (strokes-file (concat xwem-dir "/" xwem-strokes-file))) + + (flet ((yes-or-no-p-maybe-dialog-box (prompt) + (lambda () (xwem-under-minib-focus (yes-or-no-p prompt))))) + (funcall 'strokes-prompt-user-save-strokes)) + + ;; Fix stroke-file .. + (when (file-exists-p strokes-file) + (let ((b (find-file-noselect strokes-file))) + (with-current-buffer b + (when (search-forward "strokes-global-map") + (replace-match "xwem-strokes-map")) + (save-buffer)) + (kill-buffer b))) + )) + +(defun xwem-strokes-load-strokes () + "Load user defined strokes from file named by `xwem-strokes-file'." + (if (file-exists-p (concat xwem-dir "/" xwem-strokes-file)) +; (xwem-under-minib-focus +; (and (y-or-n-p +; (format "XWEM: No strokes loaded. Load `%s'? " +; (concat xwem-dir "/" xwem-strokes-file))) + (let ((strokes-file (concat xwem-dir "/" xwem-strokes-file))) + (strokes-load-user-strokes)))) + +(defun xwem-strokes-cmd-valid-p (cmd) + "Return non-nil if CMD is valid to be run after stroke." + ;; NOTE: string/keyboard macro/interactive function/interactive + ;; lambda are valid commands. + (commandp cmd)) + +(defun xwem-strokes-cmd-type (cmd) + "Return type of strokes command CMD. +Type is one of \"string\", \"kbd macro\", \"symbol\" or \"function\"." + (cond ((stringp cmd) "string") + ((vectorp cmd) "kbd macro") + ((symbolp cmd) "symbol") + ((functionp cmd) "function") + (t "unknown"))) + +(defun xwem-strokes-cmd-description (cmd) + "Return description of strokes command CMD." + (let ((ctype (xwem-strokes-cmd-type cmd))) + (cond ((string= ctype "string") (concat "\"" cmd "\"")) + ((string= ctype "kbd macro") (key-description cmd)) + ((string= ctype "symbol") (format "%S" cmd)) + ((string= ctype "function") (format "%S" cmd))))) + +(defun xwem-strokes-read-command (&optional prompt) + "Read command, prompting PROMPT. Command may be interactive command or string." + ;; TODO: - write me + ;; * Emacs command + ;; * Emacs string + ;; * XWEM binded keyboard macro + (condition-case nil + (let* ((type (xwem-completing-read "XWEM Stroke type: " '(("key") ("command") ("string")) nil t "command")) + (cmd (cond ((string= type "command") (xwem-read-command "XWEM Stroke command: ")) + ((string= type "string") (xwem-read-from-minibuffer "XWEM Stroke string: ")) + ((string= type "key") + (let ((xwem-interactively t)) + (prog1 + (xwem-kbd-key-binding + (xwem-read-key-sequence "XWEM Stroke key: ")) + (xwem-kbd-stop-grabbing)))) + (t nil)))) + cmd) + (t nil))) + +(defun xwem-strokes-execute-command (cmd) + "Execute CMD. CMD is one of interactive command or keysequence." + (if (xwem-strokes-cmd-valid-p cmd) + (cond ((stringp cmd) + (xwem-kbd-force-mods-release) + (xwem-key-send-ekeys cmd)) + + ((vectorp cmd) + (xwem-kbd-force-mods-release) + (xwem-keymacro-execute-keys cmd)) + + (t (command-execute cmd))) + + (xwem-message 'err "Invalid CMD in `xwem-strokes-execute-command'."))) + +(defun xwem-strokes-execute-stroke (stroke) + "Given STROKE, execute the command corresponds to it." + (let* ((match (strokes-match-stroke stroke xwem-strokes-map)) + (command (car match)) + (score (cdr match))) + (cond ((strokes-click-p stroke) + (command-execute xwem-strokes-click-command)) + + ((and match (<= score xwem-strokes-minimum-match-score)) + (xwem-message 'info "Executing stroke: '%s'" (xwem-strokes-cmd-description command)) + (xwem-strokes-execute-command command)) + + ((null xwem-strokes-map) + ;; First try loading strokes file + (xwem-strokes-load-strokes) + + (if (null xwem-strokes-map) + (xwem-message 'err "No strokes defined; use `xwem-strokes-global-set-stroke'") + + ;; Re-execute stroke in hope it will be founded in loaded + ;; xwem-strokes-map. + (xwem-strokes-execute-stroke stroke))) + + (t (xwem-message 'err "No stroke matches; see variable `xwem-strokes-minimum-match-score'"))) + )) + +(defun xwem-strokes-define-or-execute (st) + "Bind stroke ST to command or execute." + (if (not xwem-strokes-defining) + ;; Execute stroke + (xwem-strokes-execute-stroke st) + + ;; Attach command to stroke + (setq xwem-strokes-defining nil) + (let ((cmdorstr (xwem-strokes-read-command))) + (when (xwem-strokes-cmd-valid-p cmdorstr) + (strokes-define-stroke xwem-strokes-map st cmdorstr) + (xwem-message 'info "New stroke defined."))))) + +(defun xwem-strokes-start-new (x y) + "Start new stroke or new stick at X Y point." + (push (cons x y) xwem-strokes-curr) + (XDrawArc (xwem-dpy) (xwem-rootwin) + (xwem-face-get-gc 'xwem-face-strokes-begin) + x y 1 1 0 (* 360 64)) + ) + +(defun xwem-strokes-continue (x y) + "Continue stroke at X Y." + (let* ((xsc xwem-strokes-curr) + (old-x (if (car xsc) (X-Point-x (car xsc)) x)) + (old-y (if (car xsc) (X-Point-y (car xsc)) y))) + + (push (cons x y) xwem-strokes-curr) + (XDrawLine (xwem-dpy) (xwem-rootwin) + (xwem-face-get-gc 'xwem-face-strokes) + old-x old-y x y))) + +(define-xwem-command xwem-strokes-define (arg) + "Define new stroke. +If used with prefix ARG, then define new complex stroke. +See also documentation for the `strokes-define-stroke' function." + (xwem-interactive "P") + + (if arg + (xwem-strokes-cmplx-begin '(4)) + (xwem-strokes-begin '(4)))) + +(defun xwem-strokes-motion (xev) + "Handles motion notify events." + (if (strokes-lift-p (car xwem-strokes-curr)) + ;; Before new stick in complex stroke, should not happen because + ;; we select for ButtonMotion, i.e. report motion events only + ;; when some button pressed. + nil + + (xwem-strokes-continue (X-Event-xmotion-root-x xev) (X-Event-xmotion-root-y xev)))) + +;;; Interactive commands +(define-xwem-command xwem-strokes-ibutton1 () + "On button1 command." + (xwem-interactive) + + (declare (special xwem-stroke-complexp)) + (declare (special xwem-stroke-done)) + + (xwem-strokes-start-new (X-Event-xbutton-root-x xwem-last-xevent) + (X-Event-xbutton-root-y xwem-last-xevent))) + + +(define-xwem-command xwem-strokes-idescribe () + "Describe current stroke." + (xwem-interactive) + + (declare (special xwem-stroke-complexp)) + (declare (special xwem-stroke-done)) + + (xwem-strokes-describe-current)) + +(define-xwem-command xwem-strokes-ibutton1up () + "On button1 up command." + (xwem-interactive) + + (declare (special xwem-stroke-complexp)) + (declare (special xwem-stroke-done)) + + (if (not xwem-stroke-complexp) + (progn (setq xwem-strokes-curr (nreverse xwem-strokes-curr)) + (setq xwem-stroke-done t)) + + (push strokes-lift xwem-strokes-curr))) + +(define-xwem-command xwem-strokes-ibutton3 () + "On button3 up command." + (xwem-interactive) + + (declare (special xwem-stroke-complexp)) + (declare (special xwem-stroke-done)) + + (setq xwem-strokes-curr (nreverse (cdr xwem-strokes-curr))) + (when (strokes-lift-p (car xwem-strokes-curr)) + (setq xwem-strokes-curr (cdr xwem-strokes-curr))) + (setq xwem-stroke-done t)) + +(define-xwem-command xwem-strokes-nocmd () + "`nil' command." + (xwem-interactive)) + +(defun xwem-strokes-go (complexp) + "Install stuff needed to handle stroke input. +If COMPLEXP is non-nil than setup all for complex stroke input." + ;; TODO: + ;; - Check whether there already button release event, so we wount + ;; start stroke in that case + + ;; Grab pointer + (xwem-mouse-grab xwem-strokes-cursor (xwem-rootwin) + (Xmask-or XM-ButtonPress XM-ButtonRelease XM-ButtonMotion)) + + (setq xwem-strokes-curr nil) + + (xwem-strokes-start-new (X-Event-xbutton-root-x xwem-last-xevent) + (X-Event-xbutton-root-y xwem-last-xevent)) + ;; Event loop + (unwind-protect + (let ((gc-cons-threshold most-positive-fixnum) ; inhibit GC'ing + (xwem-override-map xwem-strokes-keymap) + (xwem-keyboard-echo-keystrokes) ; Do not show + (xwem-bypass-quit t) ; Bypass quit signal in `xwem-kbd-handle-keybutton-from-emacs' + (xwem-stroke-complexp complexp) + (xwem-stroke-done nil) + xev eev) + (declare (special xwem-stroke-done)) + (declare (special xwem-stroke-complexp)) + + (setq xwem-bypass-quit xwem-bypass-quit) ;shutup compiler + + (while (not xwem-stroke-done) + (setq xev (XNextEvent (xwem-dpy))) + + (when (member (X-Event-type xev) + (list X-KeyPress X-ButtonPress X-ButtonRelease X-MotionNotify)) + (setq eev (car (xwem-kbd-xevents->emacs-events (list xev) t))) + + (if (eq (event-type eev) 'motion) + (xwem-strokes-motion xev) + + (xwem-kbd-handle-keybutton-from-emacs eev xev))) + )) + + (xwem-strokes-done)) + + ;; Execute or define stroke + (let* ((grid-locs (strokes-renormalize-to-grid xwem-strokes-curr xwem-strokes-grid)) + (st (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs)))) + + (xwem-strokes-define-or-execute st)) + ) + +(defun xwem-strokes-done (&optional xev) + "Uninstalls stuff installed by `xwem-strokes-go'. +XEV is last processed X-Event." + (XUngrabPointer (xwem-dpy)) + + (let ((xsc (or xwem-strokes-curr + (list (or (and xev (cons (X-Event-xbutton-root-x xev) + (X-Event-xbutton-root-y xev))) + (cons 0 0))))) + (x 10000000) (y 1000000) (xma 0) (yma 0) + (thi (* 2 (max (xwem-face-tag 'xwem-face-strokes-begin :line-width) + (xwem-face-tag 'xwem-face-strokes :line-width))))) + + (while xsc + (while (not (consp (car xsc))) + ;; cut off lifts + (setq xsc (cdr xsc))) + + (when (< (caar xsc) x) + (setq x (caar xsc))) + (when (> (caar xsc) xma) + (setq xma (caar xsc))) + + (when (< (cdar xsc) y) + (setq y (cdar xsc))) + (when (> (cdar xsc) yma) + (setq yma (cdar xsc))) + + (setq xsc (cdr xsc))) + + (xwem-root-refresh (- x thi) (- y thi) (+ (- xma x) (* 2 thi)) (+ (- yma y) (* thi 2))))) + +(defun xwem-strokes-describe-current () + "Describe current complex stroke." + (let ((pix-lock (copy-list xwem-strokes-curr)) ; because of nreverse + (match nil)) + + (setq pix-lock (nreverse (cdr pix-lock))) + (when (strokes-lift-p (car pix-lock)) + (setq pix-lock (cdr pix-lock))) + + (setq match (strokes-match-stroke + (strokes-fill-stroke + (strokes-eliminate-consecutive-redundancies + (strokes-renormalize-to-grid pix-lock xwem-strokes-grid))) + xwem-strokes-map)) + + (xwem-message 'info "Current stroke stands for: %S" (car match)))) + +(define-xwem-command xwem-strokes-begin (arg) + "Begin to input simple stroke. +If prefix ARG is given start to define simple stroke." + (xwem-interactive "P") + + (when arg + (setq xwem-strokes-defining t)) + + (xwem-strokes-go nil)) + +(define-xwem-command xwem-strokes-cmplx-begin (arg) + "Begin to input complex stroke(i.e. which has more than one strokes). +If prefix ARG is given start to define new complex stroke." + (xwem-interactive "P") + + (when arg + (setq xwem-strokes-defining t)) + + (xwem-strokes-go t)) + +(define-xwem-command xwem-strokes-unset-last-stroke (arg) + "Removes last stroke from `xwem-strokes-map'. +With prefix ARG do not require a confirmation" + (xwem-interactive + (list (or xwem-prefix-arg + (y-or-n-p (format "XWEM: Really delete last stroke (%s)" + (xwem-strokes-cmd-description (cdr (car xwem-strokes-map)))))))) + + (if arg + (progn + (setq xwem-strokes-map (cdr xwem-strokes-map)) + (xwem-message 'info "Last stroke has been deleted.")) + (xwem-message 'info "Nothing done."))) + +(define-xwem-command xwem-strokes-list (arg) + "List strokes defined for XWEM use. +With prefix ARG sort strokes by command (NOT IMPLEMENTED YET)." + (xwem-interactive "P") + + (unless xwem-strokes-map + (xwem-strokes-load-strokes)) + + (let ((stb (get-buffer-create "*XWEM Strokes*"))) + (xwem-special-popup-frame stb) + + (with-current-buffer stb + (setq buffer-read-only nil) + (erase-buffer) + (insert + "Command type Command Stroke\n" + "------------ ------- ------") + (mapc (lambda (stdef) + (let ((stroke (car stdef)) + (stroke-cmd (cdr stdef))) + (when (xwem-strokes-cmd-valid-p stroke-cmd) + (strokes-xpm-for-stroke stroke " *strokes-xpm*") + (newline 1) + (insert-char ?\x20 60) + (beginning-of-line) + (insert (xwem-strokes-cmd-type stroke-cmd)) + (beginning-of-line) + (forward-char 18) + (insert (xwem-strokes-cmd-description stroke-cmd)) + (beginning-of-line) + (forward-char 61) + (make-annotation (make-glyph + (list + (vector 'xpm + :data (buffer-substring + (point-min " *strokes-xpm*") + (point-max " *strokes-xpm*") + " *strokes-xpm*")) + [string :data "[Image]"])) + (point) 'text) + (add-text-properties (point-at-bol) (point-at-eol) (list 'face 'underline)) + ))) + xwem-strokes-map) + + (kill-region (1+ (point)) (point-max)) + (goto-char (point-min)) + + (view-mode) + + (define-key view-minor-mode-map (kbd "q") + (lambda () + (interactive) + (kill-buffer (current-buffer)) + (define-key view-minor-mode-map (kbd "q") 'view-quit))) + ))) + +;;;###autoload +(defun xwem-strokes-init () + "Initialize strokes support." + + (xwem-message 'info "Initializing strokes ...") + + (setq xwem-strokes-curr nil) + (setq xwem-strokes-cursor (xwem-make-cursor (eval xwem-strokes-cursor-type) + xwem-strokes-cursor-foreground-color + xwem-strokes-cursor-background-color)) + ) + + +(provide 'xwem-strokes) + +;;; xwem-strokes.el ends here diff --git a/lisp/xwem-tabbing.el b/lisp/xwem-tabbing.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXRhYmJpbmcuZWw= --- /dev/null +++ b/lisp/xwem-tabbing.el @@ -0,0 +1,592 @@ +;;; xwem-tabbing.el --- Tabs in XWEM frames. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: Sun Dec 7 18:35:15 MSK 2003 +;; Keywords: xwem, xlib +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; Tab format may contain one of escape seqs: +;; %n - Client's name (WM_NAME) +;; %c - Client's class instance (WM_CLASS) +;; %C - Client's class name (WM_CLASS) +;; %i - Client's icon +;; %u - Client's uptime +;; %U - Cilent's Uptime +;; %s - Client's size in pixels +;; %S - Client's size in units +;; %f - Client's Frame number +;; %* - "*" when client marked and "-" when not. +;; %# - "#" when client support WM_DELETE and "-" when not. + +;; %{ - starts emacs lisp +;; %} - ends emacs lisp + +;; Note that while running elisp within %{ and %} symbol `cl' refers +;; to client. + +;; Also `X-use-queryfont' is highly recommended to be `t' if you are +;; using this file. + +;;; Code: + + +(defconst xwem-tab-states + '(xwem-face-tab-selected-active + xwem-face-tab-selected-passive + xwem-face-tab-nonselected-active + xwem-face-tab-nonselected-passive) + "List of all tab items states. Actually face names.") + +(defgroup xwem-tab nil + "Group to customize tabs." + :prefix "xwem-tab-" + :prefix "xwem-face-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-tab-default-format " %i %*%# %n" + "*Default format for tab item." + :type 'string + :group 'xwem-tab) + +(defcustom xwem-tab-formats-alist + '(([".*" ".*" ".*"] . "%i %n")) + "Alist of formats for tab items." + :type 'alist + :group 'xwem-tab) + +(defcustom xwem-tab-delim-interval 2 + "*Number of client to group, will draw large delimeter." + :type 'number + :group 'xwem-tab) + +(defcustom xwem-tab-empty-name "<empty>" + "What to show when there no client." + :type 'string + :group 'xwem-tab) + +(defface xwem-face-tab-selected-active + `((t (:foreground "white" :background "green4" :bold t))) + "*Face used to draw active tab item in selected frame.." + :group 'xwem-tab + :group 'xwem-faces) + +(defface xwem-face-tab-selected-passive + `((t (:foreground "black" :background "gray60"))) + "*Face used to draw passive tab item in selected frame." + :group 'xwem-tab + :group 'xwem-faces) + +(defface xwem-face-tab-nonselected-active + `((t (:foreground "gray80" :background "DarkGreen" :bold t))) + "*Face used to draw active tab item in non-selected frame." + :group 'xwem-tab + :group 'xwem-faces) + +(defface xwem-face-tab-nonselected-passive + `((t (:foreground "black" :background "gray40"))) + "*Face used to draw passibe tab item in non-selected frame." + :group 'xwem-tab + :group 'xwem-faces) + + +;;; Structures +;;;###autoload +(defstruct xwem-tab-item + type ; type of tab one of 'header, 'tailer, 'normal etc +; tabber ; xwem-tabber + state + rect ; X-Rect + (delim-width 0) ; Width of delimiter + + cl ; xwem-cl + format) ; Tab item format + +;;;###autoload +(defstruct xwem-tabber + frame ; xwem-frame, our parent + xwin ; X-Win + xpreparer ; X-Pixmap to prepare tab items + xgeom + + state ; Global state of all tab items in tab-items field + header-tabis ; Header tab items + tailer-tabis ; Tailing tab items + + tab-items ; list of xwem-tab-item + ) + + +;;; Internal variables +(defvar xwem-tabi-sa-gc nil "Internal variable, do not modify.") +(defvar xwem-tabi-sp-gc nil "Internal variable, do not modify.") +(defvar xwem-tabi-na-gc nil "Internal variable, do not modify.") +(defvar xwem-tabi-np-gc nil "Internal variable, do not modify.") + +;; Additional GC's +(defvar xwem-tabber-gc1 nil "Additional GC.") +(defvar xwem-tabber-gc2 nil "Additional GC.") +(defvar xwem-tabber-gc3 nil "Additional GC.") +(defvar xwem-tabber-gc4 nil "Additional GC.") +(defvar xwem-tabber-gc5 nil "Additional GC.") +(defvar xwem-tabber-gc6 nil "Additional GC.") +(defvar xwem-tabber-gc7 nil "Additional GC.") +(defvar xwem-tabber-gc8 nil "Additional GC.") +(defvar xwem-tabber-gc9 nil "Additional GC.") + + +;;; Functions + +;;;###autoload +(defun xwem-init-tabber () + "Initialize tabbing." + (xwem-message 'info "Initializing tabbing ...") + ) + +(defun xwem-tabber-event-handler (xdpy xwin xev) + "On display XDPY and window XWIN handle event XEV." + (let ((tabber (X-Win-get-prop xwin 'xwem-tabber))) + (when (xwem-tabber-p tabber) + (X-Event-CASE xev + (:X-Expose + (when (eq (xwem-frame-state (xwem-tabber-frame tabber)) 'mapped) + (xwem-tabber-draw tabber)) + ) + + (:X-DestroyNotify + (X-invalidate-cl-struct tabber)))))) + +;;;###autoload +(defun xwem-tabber-create (frame geom initial-state) + "Create new tabber for FRAME with GEOM and INITIAL-STATE." + (let ((xft (make-xwem-tabber :frame frame + :xgeom geom + :state initial-state)) + (xdpy (xwem-dpy)) + w preparer) + (setq w (XCreateWindow xdpy + (xwem-frame-xwin frame) + (X-Geom-x geom) (X-Geom-y geom) + (X-Geom-width geom) (X-Geom-height geom) + (X-Geom-border-width geom) + nil X-InputOutput nil + (make-X-Attr :background-pixel (XWhitePixel (xwem-dpy))))) + (setf (xwem-tabber-xwin xft) w) + (X-Win-put-prop w 'xwem-tabber xft) + + (XSelectInput xdpy w (Xmask-or XM-Exposure XM-StructureNotify)) + (X-Win-EventHandler-add w 'xwem-tabber-event-handler 0 (list X-Expose X-DestroyNotify)) + + (setq preparer (XCreatePixmap xdpy (make-X-Pixmap :dpy xdpy :id (X-Dpy-get-id xdpy)) + w (XDefaultDepth xdpy) (X-Geom-width geom) (X-Geom-height geom))) + + (setf (xwem-tabber-xpreparer xft) preparer) + + (XMapWindow (X-Win-dpy w) w) + xft)) + +(defun xwem-tabber-add-tab-item (tabber tab-item) + "Into TABBER tab items list add TAB-ITEM." + (pushnew tab-item (xwem-tabber-tab-items tabber))) + +(defun xwem-tabber-headers-width (xft) + "Return width of XFT's headers." + (apply (lambda (els) + (if els (apply '+ els) 0)) + (mapcar (lambda (ti) + (X-Rect-width (xwem-tab-item-rect ti))) + (xwem-tabber-header-tabis xft)))) + +(defun xwem-tabber-tailers-width (xft) + "Return width of XFT's tailers." + (apply (lambda (els) + (if els (apply '+ els) 0)) + (mapcar (lambda (ti) + (X-Rect-width (xwem-tab-item-rect ti))) + (xwem-tabber-tailer-tabis xft)))) + +;;;###autoload +(defun xwem-tabber-regeom-window (win &optional draw-p) + (let ((tabber (xwem-frame-tabber (xwem-win-frame win)))) + (xwem-tabber-regeom tabber win draw-p))) + +;;;###autoload +(defun xwem-tabber-regeom (tabber window &optional draw-p) + "Adjust tabs geometries in TABBER." + ;; TODO: + ;; - Take into account large delimeters + (let* ((frame (xwem-tabber-frame tabber)) + (hw 0);(xwem-tabber-headers-width tabber)) + (tw 0);(xwem-tabber-tailers-width tabber)) + (twidth (- (xwem-frame-width frame) hw tw)) + (off hw) + (cls (xwem-win-make-cl-list (or window (xwem-frame-selwin (xwem-tabber-frame tabber))))) + (clsn (length cls)) ; number of clients + (dw 2) ; XXX delimeter width + (ldw 4) ; XXX large delimeter width + tiw tabi rect) + + (when cls + (setq tiw (/ (- twidth (* (- clsn 1) dw) + (* ldw (/ clsn xwem-tab-delim-interval))) + clsn)) ; tab item width + + (while cls + (setq tabi (xwem-cl-tabitem (car cls))) + (setq rect (xwem-tab-item-rect tabi)) + (setf (X-Rect-x rect) off) + (setf (X-Rect-width rect) tiw) + + ;; XXX + (setf (X-Rect-height rect) (X-Geom-height (xwem-tabber-xgeom tabber))) + + (if (zerop (% (length cls) xwem-tab-delim-interval)) + (progn + (setf (xwem-tab-item-delim-width tabi) ldw) + (setq off (+ off tiw ldw))) + + (setf (xwem-tab-item-delim-width tabi) dw) + (setq off (+ off tiw dw))) + + (setq cls (cdr cls)))) + + (when draw-p + (xwem-tabber-draw tabber)) + )) + +;;;###autoload +(defsubst xwem-tabber-safe-regeom (tabber &optional draw-p) + "Saf variant of `xwem-tabber-regeom'." + (and (xwem-tabber-p tabber) + (xwem-tabber-regeom tabber nil draw-p))) + +(defun xwem-tabber-draw-empty (tabber) + "Draw empty." + (let* ((frame (xwem-tabber-frame tabber)) + (selected-p (xwem-frame-selected-p frame)) + (xgeom (xwem-tabber-xgeom tabber)) + tabi) + + ;; Create fake CL and tabi + (setq tabi (make-xwem-tab-item :rect (make-X-Rect :x (X-Geom-x xgeom) + :y (X-Geom-y xgeom) + :width (X-Geom-width xgeom) + :height(X-Geom-height xgeom)) + :state (if selected-p + 'xwem-face-tab-selected-active + 'xwem-face-tab-nonselected-active) + :format xwem-tab-empty-name)) + (xwem-tab-item-draw-format-1 tabi tabber))) + +;;;###autoload +(defun xwem-tabber-draw (tabber) + "Draw tabber." + (let* ((cls (xwem-win-make-cl-list (xwem-frame-selwin (xwem-tabber-frame tabber)))) + (tabis (mapcar 'xwem-cl-tabitem cls));(xwem-tabber-tab-items tabber)) + tab-item) + + (if (not tabis) + (xwem-tabber-draw-empty tabber) + + (while tabis + (setq tab-item (car tabis)) + (xwem-tab-item-draw-format tab-item) + + (setq tabis (cdr tabis)) + )))) + +(defun xwem-tab-item-get-fill-gc (tabi &optional tabber) + "Return GC associated with TABI." + ;; TODO: write me + (xwem-face-get-gc (xwem-tab-item-state tabi))) + +(defun xwem-tab-item-get-draw-gc (tabi &optional tabber) + "Return GC to draw TABI's text." + (xwem-face-get-gc (xwem-tab-item-state tabi))) + + +;;; Drawers +;;;###autoload +(defun xwem-tab-item-draw-format (tabi) + (when (and (xwem-cl-p (xwem-tab-item-cl tabi)) + (xwem-frame-p (xwem-cl-frame (xwem-tab-item-cl tabi)))) + (xwem-tab-item-draw-format-1 tabi))) + +(defun xwem-tab-item-draw-format-1 (tabi &optional tabber) + "Draw TABI's format string." + (let* ((rect (xwem-tab-item-rect tabi)) + (tabxwin (xwem-tabber-xwin (or tabber (xwem-tab-item-tabber tabi)))) + (xprep (xwem-tabber-xpreparer (or tabber (xwem-tab-item-tabber tabi)))) + (cl (xwem-tab-item-cl tabi)) + (fmt (xwem-tab-item-format tabi)) + (xoff (X-Rect-x rect)) + (yoff (X-Rect-y rect)) + fill-gc currgc fi item fmt-index + sfg) + + ;; Update tabi's state + (when (xwem-cl-p cl) + (let ((frame (xwem-cl-frame cl))) + (when (xwem-frame-p frame) + (if (xwem-frame-selected-p frame) + (setf (xwem-tab-item-state tabi) + (if (xwem-cl-inwin-p cl) + 'xwem-face-tab-selected-active + 'xwem-face-tab-selected-passive)) + + ;; XXX + (setf (xwem-tab-item-state tabi) + (if (xwem-cl-inwin-p cl) + 'xwem-face-tab-nonselected-active + 'xwem-face-tab-nonselected-passive)))))) + + (setq fill-gc (xwem-tab-item-get-fill-gc tabi tabber)) + (setq currgc (xwem-tab-item-get-draw-gc tabi tabber)) + + (setq sfg (X-Gc-foreground fill-gc)) + (unwind-protect + (progn + (setf (X-Gc-foreground fill-gc) (X-Gc-background fill-gc)) + (XChangeGC (xwem-dpy) fill-gc) + + (XFillRectangles (xwem-dpy) xprep fill-gc (list rect))) + + (setf (X-Gc-foreground fill-gc) sfg) + (XChangeGC (xwem-dpy) fill-gc)) + + (XSetClipRectangles (xwem-dpy) fill-gc 0 0 (list rect)) + (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect)) + + ;; In case there no cl attached, skip format field + (unless (xwem-cl-p cl) + (setq fmt xwem-tab-empty-name)) + + (setq fmt-index 0) + (while (and (< xoff (+ (X-Rect-x rect) (X-Rect-width rect))) + (< fmt-index (length fmt))) + (setq fi (aref fmt fmt-index)) + + (incf fmt-index) + (if (eq fi ?%) + (progn + (setq fi (aref fmt fmt-index)) + (setq item (cond ((= fi ?n) (xwem-hints-wm-name (xwem-cl-hints cl))) + ((= fi ?c) (car (xwem-hints-wm-class (xwem-cl-hints cl)))) + ((= fi ?C) (cadr (xwem-hints-wm-class (xwem-cl-hints cl)))) + ((= fi ?i) (xwem-icons-cl-icon cl)) + ((= fi ?s) (xwem-cl-get-psize cl)) + ((= fi ?S) (xwem-cl-get-usize cl)) + ((= fi ?u) (xwem-cl-get-uptime cl)) + ((= fi ?U) (xwem-cl-get-uptime cl)) + ((= fi ?f) (int-to-string (xwem-frame-num (xwem-cl-frame cl)))) + ((= fi ?*) (if (xwem-cl-marked-p cl) "*" "-")) + ((= fi ?#) (if (XWMProtocol-set-p (xwem-dpy) + (xwem-hints-wm-protocols (xwem-cl-hints cl)) + "WM_DELETE_WINDOW") + "#" "-")) + ((= fi ?%) "%") + + ;; Emacs lisp + ((= fi ?{) + (let ((substr (substring fmt (1+ fmt-index))) + elstr) + (unless (string-match "\\(\\([^%]\\|%[^}]\\)*\\)%}" substr) + (signal 'search-failed fmt "%}")) + + ;; extract lisp code and update fmt indexer + (setq elstr (match-string 1 substr)) + (incf fmt-index (match-end 0)) + + ;; Now time to run emacs lisp. + + ;; NOTE: + ;; + ;; - Due to dynamic scoping, emacs + ;; lisp code that is in ELSTR can + ;; access any locally bounded + ;; variable for example `cl'. + ;; + ;; - It should return string, cons + ;; cell(image) or nil. + (eval (read elstr)))) + + ;; Ditig is number of aditional GC + ((and (> (Xforcenum fi) 47) (< (Xforcenum fi) 57)) + (let* ((n (string-to-int (char-to-string fi))) + (gc (if (= n 0) + (xwem-tab-item-get-draw-gc tabi) + (eval (intern-soft (concat "xwem-tabber-gc" (int-to-string n))))))) + (when (X-Gc-p gc) + (setq currgc gc) + (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect)))) + 'skip) + + (t (error "Unknown token in tabi format")))) + ;; size fix + (when (and (consp item) + (numberp (car item)) + (numberp (cdr item))) + (setq item (concat (int-to-string (car item)) + "x" + (int-to-string (cdr item))))) + (incf fmt-index)) + + ;; Not % + (setq item (char-to-string fi)) + (while (and (< fmt-index (length fmt)) + (not (= (aref fmt fmt-index) ?%))) + (setq item (concat item (char-to-string (aref fmt fmt-index)))) + (incf fmt-index))) + + (cond ((stringp item) + ;; Draw text + (let* ((font (X-Gc-font currgc)) + (ta (X-Text-ascent (xwem-dpy) font item)) + (td (X-Text-descent (xwem-dpy) font item)) + (hei (X-Rect-height rect)) + (ty (+ yoff (/ (- hei (+ ta td)) 2) ta))) + + (XDrawString (xwem-dpy) xprep currgc xoff ty item) + (setq xoff (+ xoff (X-Text-width (xwem-dpy) (X-Gc-font currgc) item))) + )) + + ((and (consp item) + (X-Pixmap-p (car item)) + (X-Pixmap-p (cdr item))) + ;; Draw icon + (let* ((ximg (X-Pixmap-get-prop (car item) 'ximg)) + (ty (/ (- (X-Rect-height rect) (X-Image-height ximg)) 2))) +; (ximg-mask (X-Pixmap-get-prop (cdr item) 'ximg))) + (unwind-protect + (progn + (setf (X-Gc-clip-mask currgc) (cdr item)) + (setf (X-Gc-clip-x-origin currgc) xoff) + (setf (X-Gc-clip-y-origin currgc) (+ yoff ty)) + (XChangeGC (xwem-dpy) currgc) + + (XCopyArea (xwem-dpy) (car item) xprep currgc 0 0 + (X-Image-width ximg) (X-Image-height ximg) + xoff (+ yoff ty))) + + (setf (X-Gc-clip-mask currgc) X-None) + (setf (X-Gc-clip-x-origin currgc) 0) + (setf (X-Gc-clip-y-origin currgc) 0) + (XChangeGC (xwem-dpy) currgc) + (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect))) + + (setq xoff (+ xoff (X-Image-width ximg))))) + + ((or (null item) + (eq item 'skip)) nil) + + (t (error "Unknown Item" item))) + ) + + (when (> xoff (+ (X-Rect-x rect) (X-Rect-width rect))) + (setq xoff (+ (X-Rect-x rect) (X-Rect-width rect)))) + + (X-Dpy-send-excursion (xwem-dpy) + (setq sfg (X-Gc-foreground fill-gc)) + (unwind-protect + (progn + (setf (X-Gc-foreground fill-gc) (X-Gc-background fill-gc)) + (XChangeGC (xwem-dpy) fill-gc) + + (XFillRectangles (xwem-dpy) tabxwin fill-gc (list rect))) + + (setf (X-Gc-foreground fill-gc) sfg) + (XChangeGC (xwem-dpy) fill-gc)) + + (XSetClipRectangles (xwem-dpy) fill-gc 0 0 (list rect)) + (XSetClipRectangles (xwem-dpy) currgc 0 0 (list rect)) + + (XCopyArea (xwem-dpy) xprep tabxwin currgc + (X-Rect-x rect) (X-Rect-y rect) (X-Rect-width rect) (X-Rect-height rect) + (+ (X-Rect-x rect) + (/ (- (+ (X-Rect-x rect) (X-Rect-width rect)) xoff) 2)) + (X-Rect-y rect)) + + ;; Draw a delimeter + (when (not (zerop (xwem-tab-item-delim-width tabi))) + (cond ((= (xwem-tab-item-delim-width tabi) 2) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-black) + (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-y rect) + (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-height rect)) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-white) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-y rect) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-height rect))) + ((= (xwem-tab-item-delim-width tabi) 4) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-black) + (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-y rect) + (+ (X-Rect-x rect) (X-Rect-width rect)) (X-Rect-height rect)) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-darkgray) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-y rect) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 1) (X-Rect-height rect)) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-white) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 2) (X-Rect-y rect) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 2) (X-Rect-height rect)) + (XDrawLine (xwem-dpy) tabxwin + (xwem-face-get-gc 'xwem-face-lightgray) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 3) (X-Rect-y rect) + (+ (+ (X-Rect-x rect) (X-Rect-width rect)) 3) (X-Rect-height rect))))) + ) + )) + +;;;###autoload +(defsubst xwem-client-get-tab-item (cl) + "Get tab item associated with CL." + (xwem-cl-get-prop cl 'tab-item)) + +;;;###autoload +(defsubst xwem-client-set-tab-item (tabi cl) + "Associate tab item TABI with client CL." + (xwem-cl-put-prop cl 'tab-item tabi)) + +;;; Test: +;(xwem-init-tabber) +;(setq tb (xwem-tabber-create (car xwem-frames-list) (make-X-Geom :x 0 :y 0 :width 600 :height 20) +; 'normal)) +;(setq ti (make-xwem-tab-item :type 'test :tabber tb +; :state 'tab-selected-active +; :rect (make-X-Rect :x 10 :y 0 :width 500 :height 20) +; :cl (xwem-cl-selected) +; :format "test %n test1")) +;(setf (xwem-tab-item-format ti) "Test %i test1") +;(setf (xwem-tab-item-state ti) 'nonselected-passive) +;(xwem-tab-item-draw-format ti) + +;(XClearArea (xwem-dpy) (xwem-tabber-xwin tb) 0 0 600 20 nil) +;(XDestroyWindow (xwem-dpy) (xwem-tabber-xwin tb)) + + +(provide 'xwem-tabbing) + +;;; xwem-tabbing.el ends here diff --git a/lisp/xwem-tray.el b/lisp/xwem-tray.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXRyYXkuZWw= --- /dev/null +++ b/lisp/xwem-tray.el @@ -0,0 +1,493 @@ +;;; xwem-tray.el --- Tray support for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 1 Sep 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: +;; +;; We should implement something like dockapp handler(or system tray), +;; that will be placed on free space of xwem-minibuffer or xwem-frame +;; and handle external X applications. It may receive some +;; ClientMessages and process them. Some of this ClientMessage should +;; be used to run elisp code. +;; +;; See how mbdock from matchbox made. +;; +;; xwem tray creates fake window which is only used to hold selection +;; needed for communicatio, xwem minibuffer window will be used for +;; holding apps. +;; +;;; TODO: +;; - Proper possition in `xwem-minibuffer' calculation. +;; - Run elisp support(almost already done). +;; +;;; Code: + +;;; xwem tray constants +(defconst xwem-tc-dock-req 0 "Dock place request.") +(defconst xwem-tc-message 1 "Message from dock app.") +(defconst xwem-tc-cancel-message 2 "Cancels message.") +(defconst xwem-tc-run-lisp 3 "Evaluate emacs lisp string") + +(defvar xwem-tray-message-hook 'xwem-tray-message-defhook + "*Hook to be called whin new message from dock app. +Function will be called with arg - dockapp.") + +(defcustom xwem-tray-id 0 "System tray identificator.") + +(defcustom xwem-tray-name "xwem-tray" + "X Name for xwem tray.") + +(defcustom xwem-tray-class '("xwem-tray" "xwem-tray") + "X Class for xwem tray") + +(defconst xwem-tray-evmask (Xmask-or XM-SubstructureNotify + XM-Exposure + XM-StructureNotify + XM-SubstructureRedirect + XM-PropertyChange + XM-ButtonPress + XM-ButtonRelease)) + +;;; Configuration for xwem system tray +(defgroup xwem-tray nil + "Group to customize XWEM system tray." + :prefix "xwem-tray-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-tray-enabled t + "*Non-nil mean that xwem's system tray will be used." + :type 'boolean + :group 'xwem-tray) + +(defcustom xwem-tray-max-docks 6 + "*Maximum number of docks." + :type 'number + :group 'xwem-tray) + +(defcustom xwem-tray-minib-position 'right + "*Position where dockapps will be placed in `xwem-minib-xwin'." + :type '(choice (const :tag "At Right" right) + (const :tag "At Left" left)) + :group 'xwem-tray) + +(defcustom xwem-tray-minib-posoffset 4 + "*Offset in pixels from `xwem-tray-minib-position'." + :type 'number + :group 'xwem-tray) + +(defcustom xwem-tray-minib-docoffset 5 + "*Offset in pixels between dockapps." + :type 'number + :group 'xwem-tray) + +(defcustom xwem-tray-cursor-shape 'X-XC-right_ptr + "*Cursor shape which will be used when pointer is over dock app." + :type (xwem-cursor-shape-choice) + :group 'xwem-tray) + +(defcustom xwem-tray-cursor-foreground-color "#000075" + "*Cursor's foreground color used when poniter is on dock app." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-tray) + +(defcustom xwem-tray-cursor-background-color "#000039" + "*Cursor's background color used when poniter is on dock app." + :type '(restricted-sexp :match-alternatives (xwem-misc-colorspec-valid-p)) + :group 'xwem-tray) + +;;; Internal variables +(defvar xwem-tray nil + "XWEM system tray holder.") + +(defvar xwem-tray-cursor nil "Cursor used when pointer is over dock app.") +(defvar xwem-tray-curroffset 0 "Current offset in pixels.") +(defvar xwem-tray-dockapps 0 "Dockapps counter.") + +;;; Dock applications +;; +;; Dock is array in form: +;; [x-window geom-after-reparent] +(defvar xwem-tray-dapp-list nil "List of dockapp X windows.") + +;; System tray +(defstruct xwem-tray + xwin + props + atoms + + curr-offset + dockapps) + +;; Dockapp structure +(defstruct xwem-dapp + xwin + geom + mess-type + mess-waitlen + mess-currlen + mess) + +;; Message is vector in form: +;; [message-type message-waitlen message-currlen message-string] + +;; message-type is one of `xwem-tc-message', `xwem-tc-cancel-message' +;; or `xwem-tc-run-lisp'. + +;;; Functions +(defun xwem-tray-find-dapp (xwin) + "Finds dock application by X window XWIN." + (let ((dal xwem-tray-dapp-list) + (rdapp nil)) + (while dal + (if (eq (xwem-dapp-xwin (car dal)) xwin) + (progn + (setq rdapp (car dal)) + (setq dal nil)) + (setq dal (cdr dal)))) + rdapp)) + +(defun xwem-tray-message-defhook (dapp) + "Default function for message from dock apps handling." + (if xwem-special-enabled + ;; XXX + (xwem-help-display + (insert (xwem-dapp-mess dapp))) + (xwem-message 'err "message arrived from dock app, but special frames not enabled.") + )) + +(defun xwem-tray-remove-dapp (dapp) + "Remove dock application DAPP from xwem tray dockapps list." + (setq xwem-tray-dapp-list (delete dapp xwem-tray-dapp-list))) + +(defun xwem-tray-new-dapp (xwin) + "New dock application XWIN wants to be managed." + (let* (;(minb-wid (X-Geom-width (xwem-minib-xgeom xwem-minibuffer))) + (minb-hei (X-Geom-height (xwem-minib-xgeom xwem-minibuffer))) + (wgeom (XGetGeometry (xwem-dpy) xwin)) + (w-wid (X-Geom-width wgeom)) + (w-hei (X-Geom-height wgeom)) + (dapp-geom (make-X-Geom :x 0 :y 0 :width w-wid :height w-hei))) + + (setf (X-Geom-x dapp-geom) + (- xwem-tray-curroffset w-wid xwem-tray-minib-docoffset)) + (setf (X-Geom-y dapp-geom) (/ (- minb-hei w-hei) 2)) + (add-to-list 'xwem-tray-dapp-list (make-xwem-dapp :xwin xwin :geom dapp-geom)) + + (setq xwem-tray-curroffset (X-Geom-x dapp-geom)) ;update curroffset + + (X-Win-EventHandler-add-new xwin 'xwem-dapp-evhandler 100) + + (XReparentWindow (xwem-dpy) xwin (xwem-minib-xwin xwem-minibuffer) + (X-Geom-x dapp-geom) + (X-Geom-y dapp-geom)) + (XMapWindow (xwem-dpy) xwin) + )) + +(defun xwem-tray-handle-client-message (win xev) + "Handles ClientMessage from dock application WIN." + (X-Dpy-log (xwem-dpy) "TRAY: ClientMessage, evinfo=%S\n" '(X-Event-evinfo xev)) + + (let* ((mes-type (X-Atom-id (X-Event-xclient-atom xev))) + (mes-data (X-Event-xclient-msg xev)) + (mes-win (X-Win-find-or-make (xwem-dpy) (car (nth 2 mes-data)))) + (data-type (truncate (car (nth 1 mes-data))))) + (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3))) + (cond ((= data-type xwem-tc-dock-req) + (xwem-tray-new-dapp mes-win)) + + (t (xwem-message 'warn "Unknown data-type %d in clientmessage." data-type)))) + + (t (xwem-message 'warn "Unknown mes-type %d" mes-type))) + nil)) + +(defun xwem-tray-handle-unmap-or-destroy-notify (xdpy win xev) + "Handles UnmapNotify event." + (X-Dpy-log (xwem-dpy) "TRAY: UnmapNotify, evwin=%S, win=%S\n" + '(X-Win-id (X-Event-win xev)) '(X-Win-id (X-Event-xdestroywindow-window xev))) + + (let ((dapp (xwem-tray-find-dapp (X-Event-xdestroywindow-window xev)))) + (if dapp + (progn + (xwem-message 'note "Removing dockapp from xwem tray.") + (xwem-tray-remove-dapp dapp) + ;; XXX: what if we removes not last dockapp? + (setq xwem-tray-curroffset + (+ xwem-tray-curroffset + xwem-tray-minib-docoffset + (X-Geom-width (xwem-dapp-geom dapp)))) + t) ;stop unmapnotify event processing + nil))) ;continue processing + +(defun xwem-tray-handle-prop-notify (win xev) + "Handles PropertyNotify event." + (X-Dpy-log (xwem-dpy) "TRAY: PropertyNotify\n") + nil) + +(defun xwem-tray-handle-expose (win xev) + "Handles Exposure event." + (X-Dpy-log (xwem-dpy) "TRAY: Exposure\n") + nil) + +(defun xwem-tray-handle-config-notify (win xev) + "Handles ConfigureNotify event." + (X-Dpy-log (xwem-dpy) "TRAY: ConfigureNotify\n") + nil) + +(defun xwem-tray-evhandler (xdpy win xev) + "X Events handler for xwem system tray." + (X-Dpy-log (xwem-dpy) "TRAY: event %S, descr: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev)) + + (let* ((evtype (X-Event-type xev)) + (fn (cond ((= evtype X-ClientMessage) 'xwem-tray-handle-client-message) +; ((= evtype X-MapRequest) nil) +; ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify) +; ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify) +; ((= evtype X-Expose) 'xwem-tray-handle-expose) +; ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify) +; ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify) + (t nil)))) + (when fn + (funcall fn win xev)) + nil)) + +(defun xwem-dapp-handle-client-message (win xev) + "Handle ClientMessage from dock application." + (X-Dpy-log (xwem-dpy) "DOCK APP: ClientMessage\n") + + (let ((dapp (xwem-tray-find-dapp win)) + (mes-type (X-Atom-id (X-Event-xclient-atom xev)))) + (cond ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 9))) + ;; part of some message arrived + (let* ((len (- (xwem-dapp-mess-waitlen dapp) + (xwem-dapp-mess-currlen dapp))) + (ltgo (if (> len 20) 20 len))) ;length to go + (setf (xwem-dapp-mess dapp) + (concat (xwem-dapp-mess dapp) + (xwem-list-to-string + (mapcar (lambda (el) (car el)) (X-Event-xclient-msg xev)) ltgo))) + (setf (xwem-dapp-mess-currlen dapp) (+ (xwem-dapp-mess-currlen dapp) ltgo))) + + (when (= (xwem-dapp-mess-currlen dapp) (xwem-dapp-mess-waitlen dapp)) + ;; message accomplished + (let ((dtype (xwem-dapp-mess-type dapp))) + (cond ((= dtype xwem-tc-message) + ;; TODO: run hook? + (when xwem-tray-message-hook + (funcall xwem-tray-message-hook dapp))) + + ((= dtype xwem-tc-run-lisp) + (X-Dpy-log (xwem-dpy) "DOCK APP: ELISP: %s" (xwem-dapp-mess dapp)) + (with-temp-buffer + (insert (xwem-dapp-mess dapp)) + (condition-case nil + (progn + (xwem-message 'info "evaling: %S" (xwem-dapp-mess dapp)) + (eval-buffer)) + (t nil)))) + ))) + ) + + ((= mes-type (X-Atom-id (aref (xwem-tray-atoms xwem-tray) 3))) + ;; opcode arrived + (let ((opc (truncate (car (nth 1 (X-Event-xclient-msg xev)))))) + (cond ((= opc xwem-tc-dock-req) nil) + + (t + (setf (xwem-dapp-mess dapp) "") + (setf (xwem-dapp-mess-currlen dapp) 0) + (setf (xwem-dapp-mess-waitlen dapp) (truncate (car (nth 3 (X-Event-xclient-msg xev))))) + (setf (xwem-dapp-mess-type dapp) opc)) + ))) + + (t (xwem-message 'warn "Unknown mes-type %d from dock app." mes-type))) + nil)) + +(defun xwem-dapp-evhandler (xdpy win xev) + "X Events handler for xwem dock applications." + (X-Dpy-log (xwem-dpy) "DOCK APP: event %S, info: %S\n" '(X-Event-name xev) '(X-Event-evinfo xev)) + + (let* ((evtype (X-Event-type xev)) + (fn (cond ((= evtype X-ClientMessage) 'xwem-dapp-handle-client-message) +; ((= evtype X-MapRequest) nil) +; ((= evtype X-UnmapNotify) 'xwem-tray-handle-unmap-or-destroy-notify) +; ((= evtype X-PropertyNotify) 'xwem-tray-handle-prop-notify) +; ((= evtype X-Expose) 'xwem-tray-handle-expose) +; ((= evtype X-DestroyNotify) 'xwem-tray-handle-unmap-or-destroy-notify) +; ((= evtype X-ConfigureNotify) 'xwem-tray-handle-config-notify) + (t nil)))) + (when fn + (funcall fn win xev)) + nil)) + +(defcustom xwem-tray-config nil + "*Config file for xwem-tray. +It is list of vectors in form [TYPE VALUE], TYPE is one of XWEM-TRAY-DOCK where VALUE for it is a string, which will be runned with `background' or XWEM-TRAY-DILEM where VALUE is offset in pixels which should delim docks. + +For example: + '([XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minitime -f 004400 -b bbbbbb\"] + [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-miniapm\"] + [XWEM-TRAY-DELIM 10] + [XWEM-TRAY-DOCK \"/home/lg/prog/xwem/modules/xwem-minilaunch /home/lg/prog/xwem/modules/icons/xterm_big.xpm xterm\"]" + :type 'list + :group 'xwem-tray) + +(defcustom xwem-tray-sit-for-pause 0.1 + "*Pause in seconds we should sit-for between launching XWEM-TRAY-DOCK. +UNUSED" + :type 'number + :group 'xwem-tray) + +(defun xwem-tray-run-config (config) + "Parse and execute xwem tray CONFIG." + (while config + (let ((type (aref (car config) 0)) + (data (aref (car config) 1))) + (cond ((eq type 'XWEM-TRAY-DOCK) + (xwem-execute-program data)) + + ((eq type 'XWEM-TRAY-DELIM) + (setq xwem-tray-curroffset (- xwem-tray-curroffset data))) + (t nil))) + (setq config (cdr config)))) + +(defun xwem-tray-create (dpy) + "Creates new XWEM system tray on DPY. +Window is InputOnly to be transparent." + (let ((win nil)) + (setq win (XCreateWindow + dpy nil + 0 0 1 1 + 0 0 X-InputOnly nil + (make-X-Attr :override-redirect 1 + :event-mask xwem-tray-evmask))) + + (X-Win-EventHandler-add-new win 'xwem-tray-evhandler 100) + + ;; Setup various hints + (XSetWMClass dpy win xwem-tray-class) + (XSetWMName dpy win xwem-tray-name) + + (setf (xwem-tray-xwin xwem-tray) win) + (setf (xwem-tray-props xwem-tray) nil) + + ;; TODO: install Selections and properties we will need + +; (XMapWindow dpy win) + )) + +(defun xwem-tray-init (dpy) + "Initialize xwem tray." + (setq xwem-tray + (make-xwem-tray :atoms (make-vector 40 nil))) + + (let ((xwem-atoms (xwem-tray-atoms xwem-tray))) + (aset xwem-atoms 0 (XInternAtom dpy "_NET_WM_WINDOW_TYPE" nil)) + (aset xwem-atoms 1 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_DOCK" nil)) + (aset xwem-atoms 3 (XInternAtom dpy "_NET_SYSTEM_TRAY_OPCODE" nil)) + (aset xwem-atoms 4 (XInternAtom dpy "_XEMBED_INFO" nil)) + (aset xwem-atoms 5 (XInternAtom dpy "_XEMBED" nil)) + (aset xwem-atoms 6 (XInternAtom dpy "MANAGER" nil)) + (aset xwem-atoms 7 (XInternAtom dpy "_MB_DOCK_ALIGN" nil)) + (aset xwem-atoms 8 (XInternAtom dpy "_MB_DOCK_ALIGN_EAST" nil)) + (aset xwem-atoms 9 (XInternAtom dpy "_NET_SYSTEM_TRAY_MESSAGE_DATA" nil)) + (aset xwem-atoms 10 (XInternAtom dpy "_NET_WM_WINDOW_TYPE_SPLASH" nil)) + (aset xwem-atoms 11 (XInternAtom dpy "WM_PROTOCOLS" nil)) + (aset xwem-atoms 12 (XInternAtom dpy "WM_DELETE_WINDOW" nil)) + (aset xwem-atoms 13 (XInternAtom dpy "_MB_THEME" nil)) + (aset xwem-atoms 14 (XInternAtom dpy "_MB_PANEL_TIMESTAMP" nil)) + (aset xwem-atoms 15 (XInternAtom dpy "_NET_WM_STRUT" nil)) + (aset xwem-atoms 16 (XInternAtom dpy "_MB_PANEL_BG" nil)) + (aset xwem-atoms 17 (XInternAtom dpy "WM_CLIENT_LEADER" nil)) + (aset xwem-atoms 18 (XInternAtom dpy "_NET_WM_ICON" nil)) + (aset xwem-atoms 19 (XInternAtom dpy "_NET_WM_PID" nil)) + (aset xwem-atoms 20 (XInternAtom dpy "_XROOTPMAP_ID" nil)) + + ;; Use emacs pid as tray identificator + (aset xwem-atoms 2 + (XInternAtom dpy (format "_NET_SYSTEM_TRAY_S%i" xwem-tray-id) nil))) + + (setenv "SYSTEM_TRAY_ID" (format "%i" xwem-tray-id)) + + ;; Must do: + ;; - Calculate start possition. + ;; - Add handler for UnmapNotify and DestroyNotify events. + (cond ((eq xwem-tray-minib-position 'right) + (setq xwem-tray-curroffset + (X-Geom-width (xwem-minib-xgeom xwem-minibuffer)))) + + (t (xwem-message "Unsupported `xwem-tray-minib-position': %S" + xwem-tray-minib-position))) + + ;; Subscribe on substructure change events for xwem minibuffer + ;; window. + (setf (xwem-minib-evmask xwem-minibuffer) + (Xmask-or (xwem-minib-evmask xwem-minibuffer) XM-SubstructureNotify)) + (XSelectInput (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) + (xwem-minib-evmask xwem-minibuffer)) + (X-Win-EventHandler-add-new (xwem-minib-xwin xwem-minibuffer) + 'xwem-tray-handle-unmap-or-destroy-notify + -1 (list X-UnmapNotify X-DestroyNotify)) + + ;; Configure systray cursor + (setq xwem-tray-cursor (xwem-make-cursor (eval xwem-tray-cursor-shape) + xwem-tray-cursor-foreground-color + xwem-tray-cursor-background-color)) + + (XChangeWindowAttributes (xwem-dpy) (xwem-minib-xwin xwem-minibuffer) + (make-X-Attr :cursor xwem-tray-cursor)) + ) + +;;;###autoload +(defun xwem-tray-startit (dpy) + "Start xwew tray on display DPY." + (xwem-tray-init dpy) + + (xwem-tray-create dpy) + + (XSetSelectionOwner dpy (aref (xwem-tray-atoms xwem-tray) 2) + (xwem-tray-xwin xwem-tray)) + ;; TODO: err check + (XMapWindow dpy (xwem-tray-xwin xwem-tray)) + ) + +;;;###autoload +(defun xwem-tray-fini () + "Finialize xwem-tray." + (mapc (lambda (dapp) + (XDestroyWindow (xwem-dpy) (xwem-dapp-xwin dapp))) + xwem-tray-dapp-list) + + (setq xwem-tray-dapp-list nil) + (setq xwem-tray-cursor nil) + (setq xwem-tray-curroffset 0) + (setq xwem-tray-dockapps 0) + ) + +(provide 'xwem-tray) + +;;; xwem-tray.el ends here diff --git a/lisp/xwem-win.el b/lisp/xwem-win.el new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bGlzcC94d2VtLXdpbi5lbA== --- /dev/null +++ b/lisp/xwem-win.el @@ -0,0 +1,1234 @@ +;;; xwem-win.el --- Windows ops for XWEM. + +;; Copyright (C) 2003 by Free Software Foundation, Inc. + +;; Author: Zajcev Evgeny <zevlg@yandex.ru> +;; Created: 21 Mar 2003 +;; Keywords: xlib, xwem +;; X-CVS: $Id$ + +;; This file is part of XWEM. + +;; XWEM 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. + +;; XWEM 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary +;; +;; This file contain operations on XWEM windows. Windows is part of +;; Frame, windows holds client X windows. +;; +;; window is a vector in form: +;; [XWEM-FrameWindow (clients-list) (window-plist) [geom] xwem-client] +;; +;;; Code + + +;;; Customization +(defgroup xwem-win nil + "Group to customize XWEM windows." + :prefix "xwem-win-" + :group 'xwem) + +;;;###autoload +(defcustom xwem-win-min-width 80 + "*Minimal width for window" + :type 'number + :group 'xwem-win) + +;;;###autoload +(defcustom xwem-win-min-height 80 + "*Minimal height for window" + :type 'number + :group 'xwem-win) + +;;;###autoload +(defcustom xwem-win-delim-width 3 + "*Window delimeter width, including shadowness." + :type 'number + :group 'xwem-win) + +(defcustom xwem-win-delim-shadow-thicksness 1 + "*How thick to draw 3D shadows around window delims." + :type 'number + :group 'xwem-win) + +(defcustom xwem-win-default-properties + (list 'attachable nil) + "*Default properties list for frame windows. + +dead - window that referenced but not workable. +deleted - deleted window have this equal to t +frame - frame window attached to. +next - next window in windows double linked list. +prev - previous window. +hchild - child window after horizontal split. +vchild - child window after vertical split. +parent - parent window (window in which we do split). +client - client currently active in window. (index in clients-list) +attachable - if non-nil then frame may be attached to some frame's + window. (not yet implemented [is it will be usefull?]) +expectances - list of expectances for window. +" + :type '(restricted-sexp :match-alternatives (valid-plist-p)) + :group 'xwem-win) + +(defcustom xwem-win-winmove-allow-jupming t + "*Non-nil allows jumping to opposite edge, when no window founded." + :type 'boolean + :group 'xwem-win) + +(defcustom xwem-win-collect-deleted-clients t + "*Non-nil mean clients managed in window that are deleting now, will +be placed in `xwem-window-other' window." + :type 'boolean + :group 'xwem-win) + +(defcustom xwem-win-max-clients 32 + "*Maximum clients in window. NOT USED NOW." + :type 'number + :group 'xwem-win) + + +;; Variables +(defvar xwem-win-switch-hook nil + "Hooks to be called when window switching occurs. +Function will receive two arguments OLD-WIN and NEW-WIN.") + +;;;###autoload +(defstruct (xwem-win (:include X-Geom) + (:predicate xwem-iswin-p)) + clients ; xwem clients list + props ; property list aka plist + cl ; xwem client + frame ; xwem frame + dead + deleted + next + prev + hchild + vchild + parent + expectances) ; expectances list + +(defstruct (xwem-win-saved (:include X-Geom) + (:predicate xwem-iswinsaved-p)) + cl ; xwem client + props ; properties + expectances ; expectances list + currentp ; non-nil for selected window + first-hchild first-vchild + next prev) + +(defstruct (xwem-win-config (:predicate xwem-iswinconfig-p)) + frame frame-width frame-height + current-cl ; cl in selected window + min-width min-height + saved-root-window) + + +;; Functions +;;;###autoload +(defun xwem-win-p (window &optional sig) + "Return t if WINDOW is XWEM frame's window." + (let ((iswin (xwem-iswin-p window))) + (if (and (not iswin) sig) + (signal 'wrong-type-argument (list sig 'xwem-win-p window)) + iswin))) + +(defun xwem-win-make-list-by-next (window) + "Create list of WINDOW and all next windows." + (let ((wins window) + rlist) + (while (xwem-win-p wins) + (setq rlist (cons wins rlist)) + (setq wins (xwem-win-next wins))) + (nreverse rlist))) + +;;;###autoload +(defun xwem-win-selected () + "Return selected window in selected frame." + (xwem-frame-selwin (xwem-frame-selected))) + +;;;###autoload +(defun xwem-win-selected-p (win &optional frame) + "Return non-nil if WIN is selected window. +If FRAME is given then check is WIN is selected in FRAME." + (eq win (if frame (xwem-frame-selwin frame) (xwem-win-selected)))) + +;;;###autoload +(defun xwem-win-new (&optional params props) + "Create new window with properties PROPS." + (let ((nwin (apply 'make-xwem-win params)) + (rplist (copy-sequence xwem-win-default-properties))) + + ;; Prepare window properties + (while props + (setq rplist (plist-put rplist (car props) (cadr props))) + (setq props (cddr props))) + + ;;TODO: * Window should have prop that allows window to have their + ;; own(not shared clients) + (setf (xwem-win-clients nwin) nil) ; list of clients + (setf (xwem-win-props nwin) rplist) ; window properties + (setf (xwem-win-cl nwin) nil) ; no visible client yet + + nwin)) + +(defun xwem-win-replace (old new) + "Replace OLD window with contents of NEW window." + (when (not (and (xwem-win-p old) (xwem-win-p new))) + (error "Hmm .. one of OLD or NEW is not a xwem window.")) + + (when (eq (xwem-frame-rootwin (xwem-win-frame old)) old) + (setf (xwem-frame-rootwin (xwem-win-frame old)) new)) + + (setf (xwem-win-x new) (xwem-win-x old)) + (setf (xwem-win-y new) (xwem-win-y old)) + (setf (xwem-win-width new) (xwem-win-width old)) + (setf (xwem-win-height new) (xwem-win-height old)) + + (let ((tem)) + (setq tem (xwem-win-next old)) + (setf (xwem-win-next new) tem) + (when (xwem-win-p tem) + (setf (xwem-win-prev tem) new)) + + (setq tem (xwem-win-prev old)) + (setf (xwem-win-prev new) tem) + (when (xwem-win-p tem) + (setf (xwem-win-next tem) new)) + + (setq tem (xwem-win-parent old)) + (setf (xwem-win-parent new) tem) + (when (xwem-win-p tem) + (when (eq (xwem-win-vchild tem) old) + (setf (xwem-win-vchild tem) new)) + (when (eq (xwem-win-hchild tem) old) + (setf (xwem-win-hchild tem) new)) + ))) + +(defun xwem-win-make-parent (window) + "Make dummy parent for WINDOW." + (let ((pwin (xwem-win-new + (list :frame (xwem-win-frame window) + :dead t ; XXX dead mean that window + ; can't contain clients + )))) + + (xwem-win-replace window pwin) + + (setf (xwem-win-next window) nil) + (setf (xwem-win-prev window) nil) + (setf (xwem-win-hchild window) nil) + (setf (xwem-win-vchild window) nil) + (setf (xwem-win-parent window) pwin) + )) + +;;;###autoload +(defun xwem-window-next (&optional window) + "Return next window after WINDOW in canonical ordering of windows. +If omitted, WINDOW defaults to the `(xwem-win-selected)'." + (let ((win (if window window (xwem-win-selected))) + (while-exit nil) + tem) + + (while (and (not while-exit) + (progn + (setq tem (xwem-win-next win)) + (null tem))) + + (if (progn + (setq tem (xwem-win-parent win)) + (xwem-win-p tem)) + (setq win tem) + + ;;else + (progn + (setq tem (xwem-frame-rootwin (xwem-win-frame win))) + (setq while-exit t) ;break from loop + ))) + + (setq win tem) + + ;; now if we have a horizontal or vertical combination - find the + ;; first child + (while (cond ((xwem-win-p (xwem-win-child win)) + (progn (setq win (xwem-win-child win)) t)) + (t nil))) ;break + win)) + +;;;###autoload +(defun xwem-window-next-vertical (&optional window) + "Return next window which is vertically after WINDOW. +If WINDOW is not given `(xwem-win-selected)' will be used." + (let* ((win (if window window (xwem-win-selected))) + (root-win (xwem-frame-rootwin (xwem-win-frame win))) + (rwin nil)) + + (when (eq root-win win) + (while (cond ((xwem-win-p (xwem-win-hchild win)) + (progn (setq win (xwem-win-hchild win)) t)) + ((xwem-win-p (xwem-win-vchild win)) + (progn (setq win (xwem-win-vchild win)) t)) + (t (progn (setq rwin win) nil))))) + (if rwin + rwin + (progn + + ;; TODO: check for root window in frame + (while (progn + (if (and (xwem-win-p (xwem-win-parent win)) + (xwem-win-p (xwem-win-vchild (xwem-win-parent win)))) + (if (xwem-win-p (xwem-win-next win)) + (setq rwin (xwem-win-next win)) + (setq win (xwem-win-parent win))) + (setq win (xwem-win-parent win))) + (and (null rwin) (not (eq win root-win))))) + + (if rwin + rwin + (progn + (while (progn + (if (xwem-win-p (xwem-win-hchild win)) + (setq win (xwem-win-hchild win)) + (if (xwem-win-p (xwem-win-vchild win)) + (setq win (xwem-win-vchild win)) + (setq rwin win))) + (null rwin))) + rwin)))) + )) + +;;;###autoload +(defun xwem-window-prev (&optional window) + "Retrun previous window before WINDOW in canonical ordering of windows. +If ommitted, WINDOW defaults to the `(xwem-win-selected)'." + (let* ((win (if window window (xwem-win-selected))) + (while-exit nil) + tem) + + (while (and (not while-exit) + (progn + (setq tem (xwem-win-prev win)) + (null tem))) + + (if (progn + (setq tem (xwem-win-parent win)) + (xwem-win-p tem)) + (setq win tem) + + ;;else + (progn + (setq tem (xwem-frame-rootwin (xwem-win-frame win))) + (setq while-exit t) ;break from loop + ))) + + (setq win tem) + + ;; now if we have a horizontal or vertical combination find + ;; the first child + (while (and + (cond ((xwem-win-p (xwem-win-child win)) + (progn (setq win (xwem-win-child win)) t)) + (t nil)) ;break + (progn + (while (xwem-win-p (xwem-win-next win)) + (setq win (xwem-win-next win))) + t))) + win)) + +;;;###autoload +(defun xwem-window-other (cnt &optional window) + "Return CNT's next window for WINDOW if CNT is greater then zero and + previous if negative." + (let ((ofn (if (>= cnt 0) 'xwem-window-next 'xwem-window-prev)) + (cnt (abs cnt)) + (win (or window (xwem-win-selected)))) + (while (> cnt 0) + (setq win (funcall ofn win)) + (setq cnt (1- cnt))) + win)) + +(defun xwem-win-xy-in-p (x y win &optional inc-gutter) + "Returns non-nil if X Y lies in WIN. +If INC-GUTTER is non-nil, than include gutters width as WIN area." + (let ((edges (xwem-win-pixel-edges win)) + (gw (if inc-gutter xwem-win-delim-width 0))) + (and (>= x (- (nth 0 edges) gw)) + (<= x (+ (nth 2 edges) gw)) + (>= y (- (nth 1 edges) gw)) + (<= y (+ (nth 3 edges) gw))))) + +(defun xwem-window-at (x y) + "Returns window where X and Y lies in it." + (catch 'found + (xwem-win-map (lambda (win) + (when (xwem-win-xy-in-p x y win t) + (throw 'found win)))) + )) + +;;; -- Moving around windows -- +;; +;; TODO: - implement (xwem-window-at X Y) +;; +(defun xwem-winmove-distance () + "Returns distance between windows." + (+ xwem-win-delim-width 0)) + +(defun xwem-winmove-refloc (&optional arg window) + "Calculates the reference location for directional window selection. +Returns cons cell in form (hpos . vpos)." + (let* ((effarg (if (null arg) 0 (prefix-numeric-value arg))) + (edges (xwem-win-pixel-edges window)) + (top-left (cons (nth 0 edges) (nth 1 edges))) + (bot-right (cons (1- (nth 2 edges)) (1- (nth 3 edges))))) + (cond ((> effarg 0) top-left) + ((< effarg 0) bot-right) + (t + ;; As if point in center of WINDOW + (cons (+ (nth 0 edges) (/ (- (nth 2 edges) (nth 0 edges)) 2)) + (+ (nth 1 edges) (/ (- (nth 3 edges) (nth 1 edges)) 2))))) + )) + +(defun xwem-winmove-other-window (dir &optional arg window) + "Calculates location of window to be moved to. +Returns cons cell (x . y)." + (let ((edges (xwem-win-pixel-edges window)) + (refpoint (xwem-winmove-refloc arg window))) + (cond ((eq dir 'left) + (cons (- (nth 0 edges) + (xwem-winmove-distance)) + (cdr refpoint))) + ((eq dir 'up) + (cons (car refpoint) + (- (nth 1 edges) + (xwem-winmove-distance)))) + ((eq dir 'right) + (cons (+ (nth 2 edges) + (xwem-winmove-distance)) + (cdr refpoint))) + ((eq dir 'down) + (cons (car refpoint) + (+ (nth 3 edges) + (xwem-winmove-distance)))) + (t (error "`xwem-winmove-other-window': Invalid direction %s" dir))))) + +(defun xwem-winmove-select (dir &optional arg window) + "Moves to the window in DIR direction." + (let* ((owin-loc (xwem-winmove-other-window dir arg window)) + (x (car owin-loc)) + (y (cdr owin-loc)) + (owin (xwem-window-at x y))) + + (when xwem-win-winmove-allow-jupming + (let ((rwin (xwem-frame-rootwin + (xwem-win-frame + (or window (xwem-win-selected)))))) + (when (not (xwem-win-xy-in-p x y rwin)) + ;; we are outside root window + (setq owin-loc + (cond ((eq dir 'left) + (cons (- (nth 2 (xwem-win-pixel-edges rwin)) + (abs x)) y)) + ((eq dir 'right) + (cons (- x (nth 2 (xwem-win-pixel-edges rwin))) + y)) + ((eq dir 'up) + (cons x (- (nth 3 (xwem-win-pixel-edges rwin)) + (abs y)))) + ((eq dir 'down) + (cons x (+ (- y (nth 3 (xwem-win-pixel-edges rwin))) (nth 1 (xwem-win-pixel-edges rwin))))) + (t (error "invalid direction.")))) + (setq owin (xwem-window-at (car owin-loc) (cdr owin-loc)))))) + (if (not (xwem-win-p owin)) + (xwem-message 'err "No window at %s" dir) + + (xwem-window-select owin) + (xwem-frame-redraw (xwem-win-frame owin))))) + +(define-xwem-command xwem-winmove-up (arg) + "Selects window that up for selected." + (xwem-interactive "P") + (xwem-winmove-select 'up arg)) + +(define-xwem-command xwem-winmove-down (arg) + "Selects window that down for selected." + (xwem-interactive "P") + (xwem-winmove-select 'down arg)) + +(define-xwem-command xwem-winmove-left (arg) + "Selects window that left for selected." + (xwem-interactive "P") + (xwem-winmove-select 'left arg)) + +(define-xwem-command xwem-winmove-right (arg) + "Selects window that right for selected." + (xwem-interactive "P") + (xwem-winmove-select 'right arg)) + +;;; +;;;###autoload +(defun xwem-window-select (window) + "Select WINDOW as current for WINDOW's frame. +Runs `xwem-win-switch-hook'." + (let* ((wframe (xwem-win-frame window)) + (ow (xwem-frame-selwin wframe))) + (setf (xwem-frame-selwin wframe) window) + (run-hook-with-args 'xwem-win-switch-hook ow window))) + +;;;###autoload +(defun xwem-window-select-maybe-redraw (window) + "Select window WINDOW and if maybe redraw WINDOW's frame." + (let* ((wframe (xwem-win-frame window)) + (ow (xwem-frame-selwin wframe))) + (xwem-window-select window) + (unless (eq ow window) + (xwem-frame-redraw wframe)))) + +;;;###autoload +(defun xwem-window-set-pixsize (window nsize nodelete is-height) + "Set pixsize for WINDOW." + (let ((old-pixsize (if is-height + (xwem-win-height window) + (xwem-win-width window))) + machild michild pos) + + (if is-height + (progn + (setf (xwem-win-height window) nsize) + (setq machild (xwem-win-vchild window)) + (setq michild (xwem-win-hchild window))) + (progn + (setf (xwem-win-width window) nsize) + (setq machild (xwem-win-hchild window)) + (setq michild (xwem-win-vchild window)))) + + ;; Also refit window's client + (when (xwem-cl-p (xwem-win-cl window)) + (xwem-manda-fun-run (xwem-cl-manda (xwem-win-cl window)) 'refit (xwem-win-cl window))) + + (cond ((xwem-win-p michild) + (mapc (lambda (child) + (if is-height + (setf (xwem-win-y child) (xwem-win-y window)) + (setf (xwem-win-x child) (xwem-win-x window))) + + (xwem-window-set-pixsize child nsize nodelete is-height)) + (xwem-win-make-list-by-next michild))) + + ((xwem-win-p machild) + ;; TODO: adjust geom for major child + (let* ((last-pos (if is-height + (xwem-win-y window) + (xwem-win-x window))) + (first last-pos) + (last-old-pos 0) + (delims-size 0) + (old-pos nil) + (mchils (xwem-win-make-list-by-next machild))) + + ;; Calculate width sum of all delimetrs + (mapc (lambda (el) + (when (xwem-win-p (xwem-win-next el)) + (setq delims-size (+ delims-size xwem-win-delim-width)))) + mchils) + + (mapc (lambda (child) + (if is-height + (progn + (setq old-pos + (+ last-old-pos + (xwem-win-height child))) + (setf (xwem-win-y child) last-pos)) + (progn + (setq old-pos (+ last-old-pos + (xwem-win-width child))) + (setf (xwem-win-x child) last-pos))) + + (setq pos (/ (+ (* old-pos + (if (xwem-win-p (xwem-win-next child)) + (- nsize delims-size) + nsize) + 2) + (- old-pixsize delims-size)) + (* 2 (- old-pixsize delims-size)))) + + (xwem-window-set-pixsize child (- (+ pos first) last-pos) t is-height) + + (setq last-pos (+ pos first xwem-win-delim-width)) + (setq last-old-pos old-pos)) + mchils)) + + ;; Now delete any children that became too small. + (when (not nodelete) + (mapc (lambda (child) + (if is-height + (xwem-window-set-pixsize + child (xwem-win-height child) nil t) + (xwem-window-set-pixsize + child (xwem-win-width child) nil nil))) + (xwem-win-make-list-by-next machild))) + )))) + +;;;###autoload +(defun xwem-window-delete (&optional window) + "Delete WINDOW. Default is `(xwem-win-selected)'." + (let ((win (or window (xwem-win-selected))) + dcl dclients owin par pwin) + + (if (null (xwem-win-parent win)) + (progn + ;; win is top level window + ;; TODO: should I delete frame? + nil) + + (progn + (setq par (xwem-win-parent win)) + (setq pwin (xwem-win-selected)) + (while (and (xwem-win-p pwin) (not (eq pwin win))) + (setq pwin (xwem-win-parent pwin))) + + ;; If we're going to delete selected window then we should + ;; update selected window and demanage client, and maybe + ;; collect its clients to other window. + (setq dcl (xwem-win-cl win)) + (setq dclients (xwem-win-make-cl-list win)) + (setq owin (xwem-window-other 1 win)) + (when (xwem-cl-p dcl) + (xwem-manda-fun-run (xwem-cl-manda dcl) 'demanage dcl t)) + + ;; Try to manage clients in other window + (when xwem-win-collect-deleted-clients + (mapc (lambda (cl) + (setf (xwem-cl-win cl) owin)) + dclients) + (xwem-tabber-regeom-window owin (xwem-win-selected-p owin (xwem-win-frame owin)))) + + (when (eq pwin win) + (xwem-window-select (xwem-window-next win))) + + ;; close that hole in list + ;; XXX: check h v h split then delete right win ... + (when (xwem-win-p (xwem-win-next win)) + (setf (xwem-win-prev (xwem-win-next win)) (xwem-win-prev win))) + (when (xwem-win-p (xwem-win-prev win)) + (setf (xwem-win-next (xwem-win-prev win)) (xwem-win-next win))) + (when (eq win (xwem-win-hchild par)) + (setf (xwem-win-hchild par) (xwem-win-next win))) + (when (eq win (xwem-win-vchild par)) + (setf (xwem-win-vchild par) (xwem-win-next win))) + + ;; TODO: adjust the geometry + (let ((sib (xwem-win-prev win))) + (when (null sib) + (setq sib (xwem-win-next win)) + (setf (xwem-win-x sib) (xwem-win-x win)) + (setf (xwem-win-y sib) (xwem-win-y win))) + + (when (xwem-win-p (xwem-win-vchild par)) + (xwem-window-set-pixsize + sib + (+ (xwem-win-height sib) + (xwem-win-height win) + xwem-win-delim-width) + t t)) + + (when (xwem-win-p (xwem-win-hchild par)) + (xwem-window-set-pixsize + sib + (+ (xwem-win-width sib) + (xwem-win-width win) + xwem-win-delim-width) + t nil))) + + ;; If parent now has only one child put child into parent + ;; place + (when (null (xwem-win-next (xwem-win-child par))) + (xwem-win-replace par (xwem-win-child par)) + (xwem-win-mark-deleted par)) + + ;; Since we deleting combination of windows we should delete + ;; all childs + (when (xwem-win-p (xwem-win-child win)) + (xwem-win-delete-subwindows (xwem-win-child win))) + + (xwem-win-mark-deleted win)) + ))) + +;;;###autoload +(defun xwem-window-delete-others (&optional window) + "Delete all xwem windows other then WINDOW." + (let ((win (when window window (xwem-win-selected)))) + (xwem-win-map + (lambda (ww) + (when (not (eq ww win)) + (xwem-window-delete ww))) + win))) + +(defun xwem-win-delete-subwindows (win) + "Delete all childs of WIN." + (when (xwem-win-p (xwem-win-next win)) + (xwem-win-delete-subwindows (xwem-win-next win))) + (when (xwem-win-child win) + (xwem-win-delete-subwindows (xwem-win-child win))) + + (xwem-win-mark-deleted win)) + +;;;###autoload +(defun xwem-win-map (fn &optional window) + "Apply FN to FRAME-WIN and each subwindow. +FN will be called with a window as argument. +If ommitted, WINDOW defaults to the `(xwem-win-selected)'." + (let* ((start-win (or window (xwem-win-selected))) + cur-win) + + (when start-win + (funcall fn start-win) + (setq cur-win (xwem-window-next start-win))) + + (while (not (eq cur-win start-win)) + (funcall fn cur-win) + (setq cur-win (xwem-window-next cur-win))))) + +(defun xwem-win-count (&optional window) + "Count windows." + (let ((cnt 0)) + (xwem-win-map (lambda (win) (setq cnt (+ cnt 1))) window) + cnt)) + +(define-xwem-command xwem-balance-windows (frame) + "Make all windows in FRAME the same height or width." + (xwem-interactive (list (xwem-frame-selected))) + + (let* ((frootw (xwem-frame-rootwin frame)) + (height-p (xwem-win-p (xwem-win-vchild frootw))) + (getsizefn (lambda (w) + (if height-p (xwem-win-height w) + (xwem-win-width w)))) + (wins (xwem-win-make-list-by-next (xwem-win-child frootw))) + size) + + (when wins + (setq size (/ (funcall getsizefn frootw) + (length wins))) + + (mapc (lambda (w) + (xwem-window-enlarge (- size (funcall getsizefn w)) height-p w)) + wins) + + (xwem-frame-draw frame nil)))) + +(define-xwem-command xwem-transpose-windows (arg) + "Transpose selected window with other window. +Prefix ARG directly passed to `xwem-window-other' to findout other +window." + (xwem-interactive "p") + + (let ((cw (xwem-win-selected)) + (ow (xwem-window-other arg))) + (if (eq cw ow) + (xwem-message 'warn "Can't transpose with self.") + + (let ((cwcl (xwem-win-cl cw)) + (cwcls (xwem-win-make-cl-list cw)) + (owcl (xwem-win-cl ow)) + (owcls (xwem-win-make-cl-list ow))) + + (setf (xwem-win-cl cw) nil) + (setf (xwem-win-cl ow) nil) + + (mapc (lambda (cl) + (setf (xwem-cl-win cl) ow)) + (delete cwcl cwcls)) + + (mapc (lambda (cl) + (setf (xwem-cl-win cl) cw)) + (delete owcl owcls)) + + (when (xwem-cl-p cwcl) + (xwem-manda-fun-run (xwem-cl-manda cwcl) 'manage cwcl ow)) + + (when (xwem-cl-p owcl) + (xwem-manda-fun-run (xwem-cl-manda owcl) 'manage owcl cw)) + )) + )) + +;;;###autoload +(defun xwem-win-only-one-p (&optional window) + "Return non-nil if WINDOW is only one in chain. +If WINDOW ommitted `(xwem-win-selected)' used." + (let ((sl-win (if window window (xwem-win-selected)))) + (= 1 (xwem-win-count sl-win)))) + +(defun xwem-window-list (&optional frame) + "Return list of windows for FRAME. +If FRAME ommitted then `xwem-current-frame' will be used." + (let* ((wlf (if frame frame (xwem-frame-selected))) + (win (xwem-frame-rootwin wlf)) + (rlist nil)) + (xwem-win-map + (function (lambda (win) + (setq rlist (cons win rlist)))) + win) + rlist)) + +(defun xwem-win-pixel-edges (&optional window) + "Return a list of the pixel edge coordinates of WINDOW. +\\(LEFT TOP RIGHT BOTTOM\\), all relative to 0, 0 at top left corner of +frame. The frame title are considered to be outside of this area." + (let* ((win (if window window (xwem-win-selected)))) + (list (xwem-win-x win) + (xwem-win-y win) + (+ (xwem-win-x win) (xwem-win-width win)) + (+ (xwem-win-y win) (xwem-win-height win))))) + +(defun xwem-win-pixel-width (&optional window) + "Retrun width in pixels of WINDOW." + (xwem-win-width (if window window (xwem-win-selected)))) + +(defun xwem-win-pixel-height (&optional window) + "Return height in pixels of WINDOW." + (xwem-win-height (if window window (xwem-win-selected)))) + +(defun xwem-win-pixels-steps (&optional window) + "Convert size in pixels to size in steps for WINDOW." + (error "xwem-win-pixels-steps not yet implemented.")) + +(defun xwem-win-steps-pixels (&optional window) + "Convert size in steps to size in pixels for WINDOW." + (error "xwem-win-steps-pixels not yet implemented.")) + +;;; START: Window configurations section + +;;;###autoload +(defun xwem-window-configuration (&optional frame) + "Return an object representing the current window configuration of xwem FRAME. +If FRAME is nil or ommited, use the sected frame." + (let ((frm (or frame (xwem-frame-selected)))) + (make-xwem-win-config + :frame frm + :frame-width (xwem-frame-width frm) + :frame-height (xwem-frame-height frm) + :current-cl (xwem-win-cl (xwem-frame-selwin frm)) + :min-width xwem-win-min-width :min-height xwem-win-min-height + :saved-root-window (xwem-win-root->saved-win (xwem-frame-rootwin frm))))) + +(defun xwem-win-root->saved-win (win) + "Convert an xwem root WIN into a tree of saved-window structures." + (let ((saved-win + (make-xwem-win-saved + :x (xwem-win-x win) :y (xwem-win-y win) :width (xwem-win-width win) :height (xwem-win-height win) + :cl (xwem-win-cl win) + :props (copy-sequence (xwem-win-props win)) + :expectances (copy-sequence (xwem-win-expectances win)) + :currentp (xwem-win-selected-p win (xwem-win-frame win)) + :first-hchild (and (xwem-win-p (xwem-win-hchild win)) + (xwem-win-root->saved-win (xwem-win-hchild win))) + :first-vchild (and (xwem-win-p (xwem-win-vchild win)) + (xwem-win-root->saved-win (xwem-win-vchild win))) + + :next (and (xwem-win-p (xwem-win-next win)) + (xwem-win-root->saved-win (xwem-win-next win))) + ))) + saved-win)) + +(defun xwem-win-config-equal (win-cfg0 win-cfg1) + "Return non-nil if two window configurations WIN-CFG0 and WIN-CFG1 are equal." + (equal win-cfg0 win-cfg1)) + +;;;###autoload +(defun xwem-set-window-configuration (config) + "Set window CONFIG." + (let ((frame (xwem-win-config-frame config))) + (when (and (xwem-frame-alive-p frame) + (not (xwem-win-config-equal config (xwem-window-configuration)))) + + (xwem-frame-reduce-to-one-window frame) + (xwem-frame-set-win-config-frame-size config) + + (let ((rwin (xwem-frame-rootwin frame)) + (xwem-win-config-current-window)) + (declare (special xwem-win-config-current-window)) + + (xwem-win-restore-saved-win config rwin + (xwem-win-config-saved-root-window config) + 'vertical) + + (when xwem-win-config-current-window + (xwem-window-select xwem-win-config-current-window) + (xwem-frame-select (xwem-win-frame xwem-win-config-current-window))) + + (setq xwem-win-min-width (xwem-win-config-min-width config)) + (setq xwem-win-min-height (xwem-win-config-min-height config)) + )))) + +(defun xwem-frame-reduce-to-one-window (frame) + "Delete all windows except the one." + (xwem-window-delete-others (xwem-frame-selwin frame))) + +(defun xwem-frame-set-win-config-frame-size (config) + "Restore FRAME size of a window configuration CONFIG." + (xwem-frame-set-size (xwem-win-config-frame config) + (xwem-win-config-frame-width config) + (xwem-win-config-frame-height config))) + +(defun xwem-win-restore-saved-win (config win saved-win direction) + "Within CONFIG, restore WIN to the state of SAVED-WIN." + (and (xwem-win-saved-next saved-win) + (progn + (xwem-win-split win direction) + (xwem-win-restore-saved-win config (xwem-win-next win) + (xwem-win-saved-next saved-win) + direction))) + + (when (xwem-win-saved-first-hchild saved-win) + (xwem-win-restore-saved-win config win + (xwem-win-saved-first-hchild saved-win) + 'horizontal)) + (when (xwem-win-saved-first-vchild saved-win) + (xwem-win-restore-saved-win config win + (xwem-win-saved-first-vchild saved-win) + 'vertical)) + + (xwem-win-restore-win-params config win saved-win) + ) + +(defun xwem-win-restore-win-params (config win saved-win) + "Restore the windown parameters stored in SAVED-WIN on WIN." + (declare (special xwem-win-config-current-window)) + (let ((cln (xwem-win-saved-cl saved-win))) + (setf (xwem-win-props win) (copy-sequence (xwem-win-saved-props saved-win))) + (setf (xwem-win-expectances win) (copy-sequence (xwem-win-saved-expectances saved-win))) + + (when (xwem-cl-p cln) + (xwem-manda-fun-run (xwem-cl-manda cln) 'manage cln win)) + + (when (and (not (xwem-win-saved-first-hchild saved-win)) + (not (xwem-win-saved-first-vchild saved-win))) + (when (not (eq win (xwem-frame-rootwin (xwem-win-frame win)))) + (xwem-window-enlarge (- (xwem-win-saved-width saved-win) + (xwem-win-width win)) + nil + win) + (xwem-window-enlarge (- (xwem-win-saved-height saved-win) + (xwem-win-height win)) + t + win))) + + (when (xwem-win-saved-currentp saved-win) + (setq xwem-win-config-current-window win)) + )) + +;;; END: + +(define-xwem-command xwem-window-configuration-to-register (reg) + "Save current window configuration to register." + (xwem-interactive "rRegister: ") + + (xwem-message 'todo "Save window configuration to `%S' register." reg)) + +;;;###autoload +(defvar xwem-win-after-split-hook nil + "Hook to be called after split. +Functions will be called with three arguments: WIN HOW and NEW-SIZE") + +;;;###autoload +(defun xwem-win-split (&optional window how new-size) + "Split WINDOW. +When WINDOW is ommitted `(xwem-win-selected)' used. +HOW is 'vertical of 'horizontal, default is 'horizontal. +If NEW-SIZE is given make WINDOW NEW-SIZE pixels bigger after split." + (let* ((sp-win (if window window (xwem-win-selected))) + (sp-how (if how how 'horizontal)) + (hor (equal sp-how 'horizontal)) + (nwin (xwem-win-new (list :frame (xwem-win-frame sp-win)))) + (nsiz (or new-size 0)) + psize psize1 psize2 remd) + + (if hor + (progn + (setq psize (/ (- (xwem-win-width sp-win) + xwem-win-delim-width) 2)) + (setq remd (% (- (xwem-win-width sp-win) + xwem-win-delim-width) 2))) + (progn + (setq psize (/ (- (xwem-win-height sp-win) + xwem-win-delim-width) 2)) + (setq remd (% (- (xwem-win-height sp-win) + xwem-win-delim-width) 2)))) + + (setq psize1 (+ psize nsiz)) + (setq psize2 (+ psize remd (- nsiz))) + ;; Check that minimal widht or height is not exceeded + (X-Dpy-log (xwem-dpy) "Doing split hor=%s psize=%d\n" 'hor 'psize) + (if hor + ;; horizontal split + (if (or (< psize1 xwem-win-min-width) + (< psize2 xwem-win-min-width)) + (error "Can't do split.") + + ;; TODO: + (when (or (null (xwem-win-parent sp-win)) + (null (xwem-win-hchild (xwem-win-parent sp-win)))) + (xwem-win-make-parent sp-win) + (setf (xwem-win-hchild (xwem-win-parent sp-win)) sp-win))) + + ;; vertical split + (if (or (< psize1 xwem-win-min-height) + (< psize2 xwem-win-min-height)) + (error "Can't do split.") + ;; TODO + (when (or (null (xwem-win-parent sp-win)) + (null (xwem-win-vchild (xwem-win-parent sp-win)))) + (xwem-win-make-parent sp-win) + (setf (xwem-win-vchild (xwem-win-parent sp-win)) sp-win)))) + + (setf (xwem-win-frame nwin) (xwem-win-frame sp-win)) + (setf (xwem-win-next nwin) (xwem-win-next sp-win)) + (when (xwem-win-p (xwem-win-next nwin)) + (setf (xwem-win-prev (xwem-win-next nwin)) nwin)) + (setf (xwem-win-prev nwin) sp-win) + (setf (xwem-win-next sp-win) nwin) + (setf (xwem-win-parent nwin) (xwem-win-parent sp-win)) + + ;; TODO: adjust geometry + (if hor + (progn + (setf (xwem-win-width sp-win) psize1) + (setf (xwem-win-x nwin) + (+ xwem-win-delim-width + (xwem-win-x sp-win) + (xwem-win-width sp-win))) + (setf (xwem-win-y nwin) (xwem-win-y sp-win)) + (setf (xwem-win-width nwin) psize2) + (setf (xwem-win-height nwin) (xwem-win-height sp-win))) + (progn + (setf (xwem-win-height sp-win) psize1) + (setf (xwem-win-x nwin) (xwem-win-x sp-win)) + (setf (xwem-win-y nwin) + (+ xwem-win-delim-width + (xwem-win-y sp-win) + (xwem-win-height sp-win))) + (setf (xwem-win-width nwin) (xwem-win-width sp-win)) + (setf (xwem-win-height nwin) psize2))) + + ;; Clients refitting if needed + (let ((spcl (xwem-win-cl sp-win))) + (when (xwem-cl-p spcl) + (xwem-manda-fun-run (xwem-cl-manda spcl) 'refit spcl))) + + (xwem-win-draw-delims (xwem-win-parent nwin)) + + ;; NOTE: nwin is (xwem-win-next sp-win) + (run-hook-with-args 'xwem-win-after-split-hook sp-win how new-size) + )) + +;;;###autoload +(defun xwem-win-draw-delims (win) + "Draw delimetrs in window WIN." + (let ((wf (xwem-win-frame win)) + (hc (xwem-win-hchild win)) + (vc (xwem-win-vchild win))) + + (X-Dpy-send-excursion (xwem-dpy) + (while (xwem-win-p hc) + ;; For horizontal split + (when (xwem-win-p (xwem-win-next hc)) + (xwem-misc-draw-bar + (xwem-dpy) (xwem-frame-xwin wf) + (xwem-face-get-gc 'xwem-face-win-delimeter) + (xwem-face-get-gc 'xwem-face-white) + (xwem-face-get-gc 'xwem-face-win-delimeter-shadow) + (+ (xwem-win-x hc) (xwem-win-width hc)) + (xwem-win-y hc) + xwem-win-delim-width + (xwem-win-height hc) + xwem-win-delim-shadow-thicksness)) + + (xwem-win-draw-delims hc) + (setq hc (xwem-win-next hc))) + + (while (xwem-win-p vc) + ;; For vertical split + (when (xwem-win-p (xwem-win-next vc)) + (xwem-misc-draw-bar + (xwem-dpy) (xwem-frame-xwin wf) + (xwem-face-get-gc 'xwem-face-win-delimeter) + (xwem-face-get-gc 'xwem-face-white) + (xwem-face-get-gc 'xwem-face-win-delimeter-shadow) + (xwem-win-x vc) + (+ (xwem-win-y vc) (xwem-win-height vc)) + (xwem-win-width vc) + xwem-win-delim-width + xwem-win-delim-shadow-thicksness)) + + (xwem-win-draw-delims vc) + (setq vc (xwem-win-next vc))) + ))) + +(defun xwem-window-change-size (win delta height-p) + "Change WIN size to old-size plus DELTA." + (let ((getsizefn (lambda (www) + (if height-p (xwem-win-height www) + (xwem-win-width www)))) + (setsizefn (lambda (www nsize) + (xwem-window-set-pixsize www nsize nil height-p))) + (par nil) + wsize minsize maxdelta) + + (if (eq win (xwem-frame-rootwin (xwem-win-frame win))) + (xwem-message 'warn "Can't change size of frame root window.") + + (setq par (xwem-win-parent win)) + (while (and par (not (if height-p + (xwem-win-vchild par) + (xwem-win-hchild par)))) + (setq win par) + (setq par (xwem-win-parent win))) + + (setq wsize (funcall getsizefn win)) + (setq minsize (if height-p xwem-win-min-height xwem-win-min-width)) + (if (< (+ wsize delta) minsize) + (xwem-message 'warn "Minimum size exceeded while in `xwem-window-change-size'") + + (setq maxdelta (if par (- (funcall getsizefn par) wsize) + (if (xwem-win-next win) (- (funcall getsizefn (xwem-win-next win)) + minsize) + (if (xwem-win-prev win) (- (funcall getsizefn (xwem-win-prev win)) + minsize) + (setq delta 0))))) + (when (> delta maxdelta) + (setq delta maxdelta)) + + (unless (= delta 0) + (if (and (xwem-win-p (xwem-win-next win)) + (>= (- (funcall getsizefn (xwem-win-next win)) delta) minsize)) + (progn + (X-Dpy-log (xwem-dpy) "HERE IN xwem-window-change-size: delta=%d\n" 'delta) + (if height-p + (setf (xwem-win-y (xwem-win-next win)) + (+ (xwem-win-y (xwem-win-next win)) delta)) + (setf (xwem-win-x (xwem-win-next win)) + (+ (xwem-win-x (xwem-win-next win)) delta))) + (funcall setsizefn (xwem-win-next win) + (- (funcall getsizefn (xwem-win-next win)) delta)) + (funcall setsizefn win (+ (funcall getsizefn win) delta))) + + (if (and (xwem-win-p (xwem-win-prev win)) + (>= (- (funcall getsizefn (xwem-win-prev win)) delta) minsize)) + (progn + (funcall setsizefn (xwem-win-prev win) + (- (funcall getsizefn (xwem-win-prev win)) delta)) + (if height-p + (setf (xwem-win-y win) (- (xwem-win-y win) delta)) + (setf (xwem-win-x win) (- (xwem-win-x win) delta))) + (funcall setsizefn win (+ (funcall getsizefn win) delta))) + + ;; If we are here than changing window size possible + ;; causes changing parent size. + (let ((opht (funcall getsizefn par)) + delta1) + (if (<= opht (+ delta wsize)) + (setq delta1 (* opht opht 2)) + + (setq delta1 (/ (* delta opht 100) (* (- opht wsize delta) 100)))) + + (if height-p + (setf (xwem-win-height par) (+ opht delta1)) + (setf (xwem-win-width par) (+ opht delta1))) + + (funcall setsizefn win (+ wsize delta1)) + (funcall setsizefn par opht) + )))) + )))) + +;;;###autoload +(defun xwem-window-enlarge (n &optional height-p window) + "Make WINDOW N pixels bigger. +If HEIGHT-P is non-nil then enlarge vertically. +If WINDOW is ommited then selected window will be used." + (xwem-window-change-size (if (xwem-win-p window) window (xwem-win-selected)) n height-p)) + +;;;###autoload +(defun xwem-window-shrink (n &optional height-p window) + "Make WINDON N pixels smaller. +If HEIGHT-P is non-nil then shrink vertically. +If WINDOW is ommited then selected window will be used." + (xwem-window-change-size (if window window (xwem-win-selected)) (- n) height-p)) + +(defun xwem-win-focus (owin nwin) + "Focus NWIN. To be used in `xwem-win-switch-hook'." + (X-Dpy-log (xwem-dpy) "xwem-win-focus\n") + (xwem-focus-set nwin) + nil) + +(defun xwem-win-title (owin nwin) + "Update NWIN's frame title when new focus. To be used in `xwem-win-switch-hook'." + (X-Dpy-log (xwem-dpy) "xwem-win-title\n") + (when (and (not (eq owin nwin)) + (xwem-frame-p (xwem-win-frame nwin))) + (xwem-tabber-draw (xwem-frame-tabber (xwem-win-frame nwin)))) + nil) + +;; Shutup compiler +(defvar xwem-clients nil) + +;;;###autoload +(defun xwem-win-make-cl-list (win) + "Makes list of CLs that belongs to WIN." + (let ((rcls nil)) + (mapc (lambda (cl) + (when (and (eq (xwem-cl-win cl) win) + (xwem-cl-managed-p cl)) + (setq rcls (nconc rcls (list cl))))) + xwem-clients) + rcls)) + +;;;###autoload +(defun xwem-win-make-cl-list-sort-by-recency (win) + "Return list of clients managed in WIN, sorted by recency field." + (let ((cls (xwem-win-make-cl-list win))) + (sort cls (lambda (cl1 cl2) + (let ((rc1 (xwem-cl-recency cl1)) + (rc2 (xwem-cl-recency cl2))) + + (if (or (not rc1) (not rc2)) + (not (null rc1)) + + (cond ((> (nth 0 rc1) (nth 0 rc2)) + t) + ((< (nth 0 rc1) (nth 0 rc2)) + nil) + (t (cond ((> (nth 1 rc1) (nth 1 rc2)) + t) + ((< (nth 1 rc1) (nth 1 rc2)) + nil) + (t (cond ((> (nth 2 rc1) (nth 2 rc2)) + t) + ((< (nth 2 rc1) (nth 2 rc2)) + nil) + (t t)))))))))))) + +;;;###autoload +(defun xwem-init-win () + "Initialize xwem windows. Now just installs `xwem-win-switch-hook'" + (add-hook 'xwem-win-switch-hook 'xwem-win-title) + (add-hook 'xwem-win-switch-hook 'xwem-win-focus) + ) + +(provide 'xwem-win) + +;;; xwem-win.el ends here diff --git a/logo.xpm b/logo.xpm new file mode 100644 index 0000000000000000000000000000000000000000..7aa1714735f9bd881449e6290a7a3244125782b8_bG9nby54cG0= --- /dev/null +++ b/logo.xpm @@ -0,0 +1,25 @@ +/* XPM */ +/* xwem logo by lg */ +static char * xwem_xpm[] = { +"34 13 8 1", +" s None c None", +". c black", +"W c red", +"E c green", +"M c blue", +"o c yellow", +"c c cyan", +"a c magenta", +"..... W . WEWEacMM M M", +" ..... W . WEWEWccMMM M M ", +" ..... W . WEWoWccEcMMM M M ", +" ..... W . WEWoWMMEEEcMMM M ", +" ..... . WEWEWMM EEEcM M ", +" ... . WEWEWcc EEEEM ", +" W. ... WEWoWccEE EEM ", +" W. .....EWoWMMEEEE M ", +" W. W .....EWMM EEEE M ", +" W. WWW .....EM EEEEM ", +" W. WWWWWE.....E EEM ", +"W. W WWWWE.....E M ", +".WW WWWWE.....E M "};