1. xemacs
  2. xwem

Source

xwem / dockapp / xwem-pager.el

;;; xwem-pager.el --- Simple frame pager.

;; Copyright (C) 2004 by Free Software Foundation, Inc.

;; Author: Richard Klinda <ignotus@hixsplit.hu>
;;         Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Wed Aug 18 08:05:09 MSD 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:

;; Simple dockapp to show xwem frames.  Somekind of extension of
;; xwem-framei.el

;;; Code:


(defvar xwem-pager-xwin nil
  "XWIN of xwem pager.")

(defvar xwem-pager-background-active "grey30")
(defvar xwem-pager-background-inactive "grey55")
(defvar xwem-pager-border-shadow-active "grey55")
(defvar xwem-pager-border-shadow-inactive "grey55")

;; veryvery simple pager / 2d viewport support
;; the code works, do the following:
;; 
;; add to XWEM-after-init-hook:
;; 
;;    (setq *pager-dockapp* (xwem-2dframes-start-dockapp))
;; 
;; ugly i know, that starts the dockapp
;; 
;;   (xwem-2dframes-make-frames)
;; 
;; that will create the frames
;; 
;; load this code, restart your XWEM and be happy.  If you want to try it
;; out without restarting then MAKE SURE you have only 1 frame, load the
;; code then:
;; M-x xwem-2dframes-make-frames
;; 
;; eval (setq *pager-dockapp* (xwem-2dframes-start-dockapp))
;; 
;; change viewports / frames somehow so the dockapp gets updated
;; 
;; i know this code is hackis, but if you rename the variables / sturcture
;; the code like you want it to be i'll work on it to make it full featured
;; + add more comments / docstrings.

;;; //////////////////////////////////////////////////////////////////////

(defvar xwem-2dframes-dim '(4 . 4)
  "X*Y viewports")

(defun xwem-2dframes-make-frames ()
  "Make the frames, call from XWEM-AFTER-INIT-HOOK!"
  (let ((num (1- (* (car xwem-2dframes-dim)
                    (cdr xwem-2dframes-dim)))))
    (dotimes (i num)
      (xwem-make-frame-1 'desktop :noselect t))))

(define-xwem-command xwem-2dframes-move-up ()
  "Move one viewport up."
  (xwem-interactive)
  (xwem-2dframes-move 'up))

(define-xwem-command xwem-2dframes-move-down ()
  "Move one viewport down."
  (xwem-interactive)
  (xwem-2dframes-move 'down))

(define-xwem-command xwem-2dframes-move-left ()
  "Move one viewport left."
  (xwem-interactive)
  (xwem-2dframes-move 'left))

(define-xwem-command xwem-2dframes-move-right ()
  "Move one viewport right."
  (xwem-interactive)
  (xwem-2dframes-move 'right))

(defun xwem-2dframes-move (dir)
  (case dir
    ('up (xwem-frame-switch-nth (- (xwem-frame-num (xwem-frame-selected))
                                   (car xwem-2dframes-dim))))
    ('down (xwem-frame-switch-nth (+ (xwem-frame-num (xwem-frame-selected))
                                     (car xwem-2dframes-dim))))
    ('left (xwem-frame-switch-nth (1- (xwem-frame-num (xwem-frame-selected)))))
    ('right (xwem-frame-switch-nth
             (1+ (xwem-frame-num (xwem-frame-selected)))))))

;;; //////////////////////////////////////////////////////////////////////

;; bindings

(xwem-global-set-key [(super h)] 'xwem-2dframes-move-left)
(xwem-global-set-key [(super t)] 'xwem-2dframes-move-down)
(xwem-global-set-key [(super n)] 'xwem-2dframes-move-up)
(xwem-global-set-key [(super s)] 'xwem-2dframes-move-right)
;(xwem-global-set-key [(alt left)] 'xwem-2dframes-move-left)
;(xwem-global-set-key [(alt down)] 'xwem-2dframes-move-down)
;(xwem-global-set-key [(alt up)] 'xwem-2dframes-move-up)
;(xwem-global-set-key [(alt right)] 'xwem-2dframes-move-right)

;;; //////////////////////////////////////////////////////////////////////

;; simple pager

(defvar xwem-2dframes-dockapp-size 8
  "X*X pixel will represent one viewport.")

(defvar xwem-2dframes-dockapp-grid-p t
  "If you want a dark line separating the viewports, set this to T.")

(defstruct xwem-2dframes-dockapp
  win
  update-itimer                         ; itimer to update worklog-dockapp

  ;; dockapp and sector geometry
  width height
  sector-width)

(defun xwem-2dframes-start-dockapp (&optional dockid dockgroup dockalign)
  "Start xwem worklog dockapp put
(setq *pager-dockapp* (xwem-2dframes-start-dockapp))
onto XWEM-AFTER-INIT-HOOK!"
  (let* ((w (+ (* (car xwem-2dframes-dim) xwem-2dframes-dockapp-size)
               (if xwem-2dframes-dockapp-grid-p
                  (- (car xwem-2dframes-dim) 1)
                  0)))
         (h (+ (* (cdr xwem-2dframes-dim) xwem-2dframes-dockapp-size)
               (if xwem-2dframes-dockapp-grid-p
                   (- (cdr xwem-2dframes-dim) 1)
                   0)))
         (sw 0)
         (wd (make-xwem-2dframes-dockapp
              :win (XCreateWindow (xwem-dpy) nil 0 0 (+ 1 w) (+ 1 h (* 2 sw))
                                  0 nil nil nil
                                  (make-X-Attr :override-redirect t
                                               :background-pixel
                                               (XAllocNamedColor (xwem-dpy) (XDefaultColormap (xwem-dpy))
                                                                 (face-background-name 'default)) ; XXX
                                               ))
              :width w :height h :sector-width sw)))

    (X-Win-put-prop (xwem-2dframes-dockapp-win wd) 'xwem-2dframes-dockapp wd)

;    (XSelectInput (xwem-dpy) (xwem-2dframes-dockapp-win wd)
;                  (apply 'Xmask-or xwem-2dframes-dockapp-event-mask))

;    (X-Win-EventHandler-add (xwem-2dframes-dockapp-win wd) 'xwem-2dframes-dockapp-event-handler nil
;			    (list X-Expose X-MapNotify X-ButtonPress X-ButtonRelease X-DestroyNotify))

    ;; Initialize wd in sys tray
    (xwem-XTrayInit (xwem-dpy) (xwem-2dframes-dockapp-win wd) dockid dockgroup dockalign)

    ;; Start updater
;    (setf (xwem-2dframes-dockapp-update-itimer wd)
;          (start-itimer "xwem-2dframes-dockapp-updater"
;                        `(lambda () (xwem-2dframes-dockapp-update ,wd))
;                        (xwem-worklog-meaning-update-time)
;                        (xwem-worklog-meaning-update-time)))

;    (add-hook 'xwem-worklog-task-start-hook
;                 `(lambda () (xwem-2dframes-dockapp-update ,wd)))
    wd))

;(setq *pager-dockapp* (xwem-2dframes-start-dockapp))

(defun xwem-2dframes-positions (&optional frame)
  (unless frame
    (setq frame (xwem-frame-selected)))
  (let* ((n (xwem-frame-num frame))
         (row (truncate (/ n (car xwem-2dframes-dim))))
	 (column (- n (* row (car xwem-2dframes-dim)))))
    (list n column row)))
(defvar *pager-dockapp* nil)
;(xwem-2dframes-dockapp-update *pager-dockapp*)

(defun xwem-2dframes-dockapp-update (dockapp)
  "Update 2dframes dockapp."
  (when (xwem-2dframes-dockapp-p dockapp)
    (let* ((win (xwem-2dframes-dockapp-win dockapp))
           (xdpy (X-Win-dpy win))
           (w (xwem-2dframes-dockapp-width dockapp))
           (h (xwem-2dframes-dockapp-height dockapp)))
      (multiple-value-bind (num row column)
          (values-list (xwem-2dframes-positions))

        (setq num num)                  ; shutup compiler

        ;(XClearArea xdpy win 0 0 (1+ w) (1+ h) t) ; doesnt work:-/
        ;; clear
        (xwem-set-face-foreground 'xwem-worklog-temp-face
                                  "gray24")
        (XFillRectangle xdpy win
                        (xwem-face-get-gc 'xwem-worklog-temp-face)
                        0 0 w h)

        ;; grid
        (when xwem-2dframes-dockapp-grid-p
          (xwem-set-face-foreground 'xwem-worklog-temp-face
                                    "gray13")
          (dotimes (i (car xwem-2dframes-dim))
            (XDrawLine xdpy win (xwem-face-get-gc 'xwem-worklog-temp-face)
                       (+ (* i xwem-2dframes-dockapp-size)
                          i)
                       0
                       (+ (* i xwem-2dframes-dockapp-size)
                          i)
                       h))
          (dotimes (i (cdr xwem-2dframes-dim))
            (XDrawLine xdpy win (xwem-face-get-gc 'xwem-worklog-temp-face)
                       0
                       (+ (* i xwem-2dframes-dockapp-size)
                          i)
                       w
                       (+ (* i xwem-2dframes-dockapp-size)
                          i))))

        ;; active part
        (xwem-set-face-foreground 'xwem-worklog-temp-face
                                  "white")
        (XFillRectangle xdpy win
                        (xwem-face-get-gc 'xwem-worklog-temp-face)
                        (+ (* row xwem-2dframes-dockapp-size)
                           (if xwem-2dframes-dockapp-grid-p
                               row
                               0))
                        (+ (* column xwem-2dframes-dockapp-size)
                           (if xwem-2dframes-dockapp-grid-p
                               column
                               0))
                        xwem-2dframes-dockapp-size
                        xwem-2dframes-dockapp-size)))))

(defun xwem-pager-init (&optional dockid dockgroup dockalign)
  "Initialize xwem pager."
  (xwem-2dframes-start-dockapp dockid dockgroup dockalign))


(provide 'xwem-pager)

;;; On-load actions
(add-hook 'xwem-frame-select-hook
          '(lambda nil
	    (when *pager-dockapp*
              (xwem-2dframes-dockapp-update *pager-dockapp*))))


;;; xwem-pager.el ends here