1 ;;; xwem-vline.el --- Vertical line minor mode.
3 ;; Copyright (C) 2005 by XWEM Org.
5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
6 ;; Created: Thu Feb 17 00:07:38 MSK 2005
7 ;; Keywords: xwem, mode
9 ;; This file is part of XWEM.
11 ;; XWEM is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
19 ;; License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
26 ;;; Synched up with: Not in FSF
30 ;; Vertical minor mode. Add some commentary here.
36 (defcustom xwem-vline-width 1
37 "*Width in pixels of vertical line."
41 (defcustom xwem-vline-config
42 `((((application "xemacs"))
43 :color "red2" :column fill-column
44 :column-width (font-width (face-font 'default)))
45 (((application "xterm"))
46 :color "grey70" :column fill-column :column-width 8)
50 :color "grey70" :column fill-column :column-width 8))
51 "*Vline configuration for clients."
55 (defvar xwem-vline-minor-mode nil
56 "Non-nil mean vline minor mode is enabled.")
57 (xwem-make-variable-client-local 'xwem-vline-minor-mode)
60 ;;;###autoload(autoload 'xwem-turn-on-vline "xwem-vline" nil t)
61 (define-xwem-command xwem-turn-on-vline
62 (client &optional color column column-width)
63 "Enable vertical line minor mode for CLIENT."
64 (xwem-interactive (list (xwem-cl-selected) nil
66 (prefix-numeric-value xwem-prefix-arg))
69 (let ((vc xwem-vline-config)
70 (frame (xwem-misc-find-emacs-frame client)))
71 (while (and vc (not (xwem-cl-match-p client (car (car vc)))))
73 (setq vc (cdr (car vc)))
75 (with-selected-frame (or frame (selected-frame))
77 (setq color (eval (plist-get vc :color))))
79 (setq column (eval (plist-get vc :column))))
81 (setq column-width (eval (plist-get vc :column-width)))))
83 (let ((vline-xwin (xwem-cl-get-sys-prop client 'vline-xwin))
84 (xoff (* column column-width)))
85 ;; XXX Adjust XOFF for Emacs frames
87 (incf xoff (frame-property frame 'internal-border-width)))
91 (XCreateWindow (xwem-dpy) (xwem-cl-xwin client)
94 (make-X-Attr :event-mask 0)))
95 (xwem-cl-put-sys-prop client 'vline-xwin vline-xwin))
97 (XMoveResizeWindow (xwem-dpy) vline-xwin xoff 0 xwem-vline-width
98 (X-Geom-height (xwem-cl-xgeom client)))
99 (XChangeWindowAttributes
100 (xwem-dpy) vline-xwin
101 (make-X-Attr :background-pixel
103 (xwem-dpy) (XDefaultColormap (xwem-dpy))
104 (xwem-make-color color))))
105 (XClearArea (xwem-dpy) vline-xwin
106 0 0 1 (X-Geom-height (xwem-cl-xgeom client)) nil)
107 (XMapWindow (xwem-dpy) vline-xwin))
109 (xwem-turn-on-minor-mode client 'xwem-vline-minor-mode))))
111 ;;;###autoload(autoload 'xwem-turn-off-vline "xwem-vline" nil t)
112 (define-xwem-command xwem-turn-off-vline (client)
113 "Disable vline minor mode for CLIENT."
114 (xwem-interactive (list (xwem-cl-selected)))
116 (let ((vline-xwin (xwem-cl-get-sys-prop client 'vline-xwin)))
117 (when (X-Win-p vline-xwin)
118 (XDestroyWindow (xwem-dpy) vline-xwin)
119 (xwem-cl-rem-sys-prop client 'vline-xwin)))
120 (xwem-turn-off-minor-mode client 'xwem-vline-minor-mode))
122 ;;;###autoload(autoload 'xwem-vline-minor-mode "xwem-vline" nil t)
123 (define-xwem-command xwem-vline-minor-mode (arg &optional client)
124 "According to prefix ARG toggle vline minor mode for CLIENT.
125 If ARG is positive - turn it on.
126 If ARG is negative - turn it off."
127 (xwem-interactive (list xwem-prefix-arg (xwem-cl-selected)))
129 (if (or (and (listp arg) (xwem-client-local-variable-value
130 client 'xwem-vline-minor-mode))
131 (and (numberp arg) (< arg 0)))
132 (xwem-turn-off-vline client)
133 (xwem-turn-on-vline client)))
136 (define-xwem-deffered xwem-vline-refit (cl)
137 "Halde CLIENT refiting."
138 (when (xwem-cl-alive-p cl)
139 (let ((vline-xwin (xwem-cl-get-sys-prop cl 'vline-xwin)))
140 (when (X-Win-p vline-xwin)
141 (XResizeWindow (xwem-dpy) vline-xwin xwem-vline-width
142 (X-Geom-height (xwem-cl-xgeom cl)))))))
146 (xwem-add-minor-mode 'xwem-vline-minor-mode "Vline")
148 (add-hook 'xwem-cl-refit-hook 'xwem-vline-refit)
151 (provide 'xwem-vline)
153 ;;; xwem-vline.el ends here