cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-vline.el

   1 ;;; xwem-vline.el --- Vertical line minor mode.
   2
   3 ;; Copyright (C) 2005 by XWEM Org.
   4
   5 ;; Author: Zajcev Evgeny <zevlg@yandex.ru>
   6 ;; Created: Thu Feb 17 00:07:38 MSK 2005
   7 ;; Keywords: xwem, mode
   8
   9 ;; This file is part of XWEM.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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
  24 ;; 02111-1307, USA.
  25
  26 ;;; Synched up with: Not in FSF
  27
  28 ;;; Commentary:
  29
  30 ;; Vertical minor mode.  Add some commentary here.
  31
  32 ;;; Code:
  33 \f
  34 (require 'xwem-modes)
  35
  36 (defcustom xwem-vline-width 1
  37   "*Width in pixels of vertical line."
  38   :type 'number
  39   :group 'xwem-modes)
  40
  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)
  47
  48     ;; Default
  49     (((eval t))
  50      :color "grey70" :column fill-column :column-width 8))
  51   "*Vline configuration for clients."
  52   :type 'list
  53   :group 'xwem-modes)
  54
  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)
  58
  59 \f
  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
  65                           (and xwem-prefix-arg
  66                                (prefix-numeric-value xwem-prefix-arg))
  67                           nil))
  68
  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)))))
  72       (setq vc (cdr vc)))
  73     (setq vc (cdr (car vc)))
  74     (when vc
  75       (with-selected-frame (or frame (selected-frame))
  76         (unless color
  77           (setq color (eval (plist-get vc :color))))
  78         (unless column
  79           (setq column (eval (plist-get vc :column))))
  80         (unless column-width
  81           (setq column-width (eval (plist-get vc :column-width)))))
  82
  83       (let ((vline-xwin (xwem-cl-get-sys-prop client 'vline-xwin))
  84             (xoff (* column column-width)))
  85         ;; XXX Adjust XOFF for Emacs frames
  86         (when (framep frame)
  87           (incf xoff (frame-property frame 'internal-border-width)))
  88
  89         (unless vline-xwin
  90           (setq vline-xwin
  91                 (XCreateWindow (xwem-dpy) (xwem-cl-xwin client)
  92                                0 0 1 1 0
  93                                nil nil nil
  94                                (make-X-Attr :event-mask 0)))
  95           (xwem-cl-put-sys-prop client 'vline-xwin vline-xwin))
  96
  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
 102                       (XAllocColor
 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))
 108
 109       (xwem-turn-on-minor-mode client 'xwem-vline-minor-mode))))
 110
 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)))
 115
 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))
 121
 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)))
 128
 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)))
 134
 135 \f
 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)))))))
 143
 144 \f
 145 ;;; On-load actions:
 146 (xwem-add-minor-mode 'xwem-vline-minor-mode "Vline")
 147
 148 (add-hook 'xwem-cl-refit-hook 'xwem-vline-refit)
 149
 150 \f
 151 (provide 'xwem-vline)
 152
 153 ;;; xwem-vline.el ends here