xwem / lisp / xwem-vline.el

Full commit
;;; xwem-vline.el --- Vertical line minor mode.

;; Copyright (C) 2005 by XWEM Org.

;; Author: Zajcev Evgeny <>
;; Created: Thu Feb 17 00:07:38 MSK 2005
;; Keywords: xwem, mode

;; 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
;; 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:

;; Vertical minor mode.  Add some commentary here.

;;; Code:
(require 'xwem-modes)

(defcustom xwem-vline-width 1
  "*Width in pixels of vertical line."
  :type 'number
  :group 'xwem-modes)

(defcustom xwem-vline-config
  `((((application "xemacs"))
     :color "red2" :column fill-column
     :column-width (font-width (face-font 'default)))
    (((application "xterm"))
     :color "grey70" :column fill-column :column-width 8)

    ;; Default
    (((eval t))
     :color "grey70" :column fill-column :column-width 8))
  "*Vline configuration for clients."
  :type 'list
  :group 'xwem-modes)

(defvar xwem-vline-minor-mode nil
  "Non-nil mean vline minor mode is enabled.")
(xwem-make-variable-client-local 'xwem-vline-minor-mode)

;;;###autoload(autoload 'xwem-turn-on-vline "xwem-vline" nil t)
(define-xwem-command xwem-turn-on-vline
  (client &optional color column column-width)
  "Enable vertical line minor mode for CLIENT."
  (xwem-interactive (list (xwem-cl-selected) nil
                          (and xwem-prefix-arg
                               (prefix-numeric-value xwem-prefix-arg))

  (let ((vc xwem-vline-config)
        (frame (xwem-misc-find-emacs-frame client)))
    (while (and vc (not (xwem-cl-match-p client (car (car vc)))))
      (setq vc (cdr vc)))
    (setq vc (cdr (car vc)))
    (when vc
      (with-selected-frame (or frame (selected-frame))
        (unless color
          (setq color (eval (plist-get vc :color))))
        (unless column
          (setq column (eval (plist-get vc :column))))
        (unless column-width
          (setq column-width (eval (plist-get vc :column-width)))))

      (let ((vline-xwin (xwem-cl-get-sys-prop client 'vline-xwin))
            (xoff (* column column-width)))
        ;; XXX Adjust XOFF for Emacs frames
        (when (framep frame)
          (incf xoff (frame-property frame 'internal-border-width)))

        (unless vline-xwin
          (setq vline-xwin
                (XCreateWindow (xwem-dpy) (xwem-cl-xwin client)
                               0 0 1 1 0
                               nil nil nil
                               (make-X-Attr :event-mask 0)))
          (xwem-cl-put-sys-prop client 'vline-xwin vline-xwin))

        (XMoveResizeWindow (xwem-dpy) vline-xwin xoff 0 xwem-vline-width
                           (X-Geom-height (xwem-cl-xgeom client)))
         (xwem-dpy) vline-xwin
         (make-X-Attr :background-pixel
                       (xwem-dpy) (XDefaultColormap (xwem-dpy))
                       (xwem-make-color color))))
        (XClearArea (xwem-dpy) vline-xwin
                    0 0 1 (X-Geom-height (xwem-cl-xgeom client)) nil)
        (XMapWindow (xwem-dpy) vline-xwin))

      (xwem-turn-on-minor-mode client 'xwem-vline-minor-mode))))

;;;###autoload(autoload 'xwem-turn-off-vline "xwem-vline" nil t)
(define-xwem-command xwem-turn-off-vline (client)
  "Disable vline minor mode for CLIENT."
  (xwem-interactive (list (xwem-cl-selected)))

  (let ((vline-xwin (xwem-cl-get-sys-prop client 'vline-xwin)))
    (when (X-Win-p vline-xwin)
      (XDestroyWindow (xwem-dpy) vline-xwin)
      (xwem-cl-rem-sys-prop client 'vline-xwin)))
  (xwem-turn-off-minor-mode client 'xwem-vline-minor-mode))

;;;###autoload(autoload 'xwem-vline-minor-mode "xwem-vline" nil t)
(define-xwem-command xwem-vline-minor-mode (arg &optional client)
  "According to prefix ARG toggle vline minor mode for CLIENT.
If ARG is positive - turn it on.
If ARG is negative - turn it off."
  (xwem-interactive (list xwem-prefix-arg (xwem-cl-selected)))

  (if (or (and (listp arg) (xwem-client-local-variable-value
                            client 'xwem-vline-minor-mode))
          (and (numberp arg) (< arg 0)))
      (xwem-turn-off-vline client)
    (xwem-turn-on-vline client)))

(define-xwem-deffered xwem-vline-refit (cl)
  "Halde CLIENT refiting."
  (when (xwem-cl-alive-p cl)
    (let ((vline-xwin (xwem-cl-get-sys-prop cl 'vline-xwin)))
      (when (X-Win-p vline-xwin)
        (XResizeWindow (xwem-dpy) vline-xwin xwem-vline-width
                       (X-Geom-height (xwem-cl-xgeom cl)))))))

;;; On-load actions:
(xwem-add-minor-mode 'xwem-vline-minor-mode "Vline")

(add-hook 'xwem-cl-refit-hook 'xwem-vline-refit)

(provide 'xwem-vline)

;;; xwem-vline.el ends here