Location: lg@xxxxxxxxxxxxxx http://arch.xwem.org/2005/
Revision: xwem--main--2.1--patch-19
Archive: lg@xxxxxxxxxxxxxx
Creator: Zajcev Evgeny <lg@xxxxxxxx>
Date: Wed Feb 9 03:37:13 MSK 2005
Standard-date: 2005-02-09 00:37:13 GMT
Modified-files: dockapp/xwem-pager.el lisp/xwem-launcher.el
lisp/xwem-minibuffer.el lisp/xwem-misc.el
lisp/xwem-mouse.el utils/xwem-diagram.el
utils/xwem-worklog.el
New-patches: lg@xxxxxxxxxxxxxx/xwem--main--2.1--patch-19
Summary: bug fixes, addons, cleanup
Keywords: menu, worklog, diagram, pager
* dockapp/xwem-pager.el (xwem-pager-dim): [change] default minimal pager
size is 3x3.
* lisp/xwem-launcher.el (xwem-file-find-command): [new] Return
coresponding command from `xwem-open-file-commands-alist' for given
FILENAME.
* lisp/xwem-launcher.el (xwem-open-file): [fix] adjust FILE and COMMAND
in case of non-interactive call.
* lisp/xwem-minibuffer.el (xwem-minib-create):
* lisp/xwem-minibuffer.el (xwem-minibuffer-init): [fix] workaround some
problem when creating xwem minibuffer after window-setup-hook is done.
This fix will create initial xemacs minibuffer only frame for xwem
minibuffer before window-setup-hook.
* lisp/xwem-misc.el (xwem-misc-find-frame): [addon] FRAMES-LIST parameter
added.
* lisp/xwem-mouse.el (xwem-mouse-ungrab): [feature-bug-fix] I think
everybody noticed how ugly popup menus behaves when they have more then
one leafs. This will fix this issue. The thing is that when menu pops
up xemacs needs to grab mouse in order to track the motions, but
issuing `xwem-mouse-ungrab' was not guaranties that pointer ungrabs,
because xlib caches X requests.
* lisp/xwem-mouse.el (xwem-generate-recent-files): [addon] new menu
generator function.
* lisp/xwem-mouse.el (xwem-generate-menu): [addon]
`xwem-generate-recent-files' added.
* utils/xwem-diagram.el (many): clarification. 80th column stuff, etc.
* utils/xwem-worklog.el (many): clarification, 80th column stuff, etc.
* utils/xwem-worklog.el (dockapp): [addon] Shape masking for worklog
dockapp added.
* added files
{arch}/xwem/xwem--main/xwem--main--2.1/lg@xxxxxxxxxxxxxx/patch-log/patch-19
* modified files
--- orig/dockapp/xwem-pager.el
+++ mod/dockapp/xwem-pager.el
@@ -73,7 +73,7 @@
:prefix "xwem-pager-"
:group 'xwem-tray)
-(defcustom xwem-pager-dim (cons '(2 . 2) '(4 . 4))
+(defcustom xwem-pager-dim (cons '(3 . 3) '(4 . 4))
"Minimum and maximum viewports to show at X and Y."
:type '(cons (cons :tag "Minimum"
(number :tag "X")
--- orig/lisp/xwem-launcher.el
+++ mod/lisp/xwem-launcher.el
@@ -890,16 +890,21 @@
(const :tag "Auto registration" t)
(const :tag "Query for registration" query)))
+;;;###xwem-autoload
+(defun xwem-file-find-command (filename)
+ "Find appropriate command to open FILENAME file."
+ (let ((cmds xwem-open-file-commands-alist))
+ (while (and cmds (not (string-match (caar cmds) file)))
+ (setq cmds (cdr cmds)))
+ (cdr (car cmds))))
+
;;;###autoload(autoload 'xwem-open-file "xwem-launcher" "Open file with
appopriate command" t)
(define-xwem-command xwem-open-file (file &optional command)
"Open FILE with command specified by COMMAND.
If prefix arg is specified, expicitely query for the COMMAND."
(xwem-interactive
(let* ((file (expand-file-name (xwem-read-filename "Find File: ")))
- cmd)
- (dolist (elt xwem-open-file-commands-alist)
- (if (string-match (car elt) file)
- (setq cmd (cdr elt))))
+ (cmd (xwem-file-find-command file)))
(when (or xwem-prefix-arg
(not cmd))
(setq cmd (xwem-read-external-command "Command: "))
@@ -918,6 +923,11 @@
xwem-open-file-commands-alist)))))
(list file cmd)))
+ ;; Fixate FILE in case `xwem-open-file' called non-interactively
+ (setq file (expand-file-name file))
+ (unless command
+ (setq command (xwem-file-find-command file)))
+
(xwem-launch (format "%s %s" command file)))
--- orig/lisp/xwem-minibuffer.el
+++ mod/lisp/xwem-minibuffer.el
@@ -271,21 +271,22 @@
(defun xwem-minib-create ()
"Create minibuffer that will be used by xwem, or use existen."
- (let ((mframe (xwem-misc-find-frame xwem-minibuffer-name))
+ (let ((mframe (or (xwem-misc-find-frame xwem-minibuffer-name
+ (minibuffer-frame-list))
+ (make-frame minibuffer-frame-plist
+ (default-x-device))))
(dd default-directory))
- (when (null mframe)
- ;; xwem minib not yet created
- (setq mframe (make-frame minibuffer-frame-plist (default-x-device))))
(setf (xwem-minib-frame xwem-minibuffer) mframe)
+ ;; Set specifiers values for MFRAME
+ (xwem-minib-apply-specifiers mframe)
+ (redraw-frame mframe t) ; KEEP THIS!
+
;; Hack over default-directory for minibuffer buffer
(with-current-buffer
(window-buffer (frame-root-window mframe))
(setq default-directory dd))
- ;; Set specifiers values for MFRAME
- (xwem-minib-apply-specifiers mframe)
- (redraw-frame mframe t) ; KEEP THIS!
mframe))
(defmacro xwem-cl-minibuffer (cl)
@@ -567,7 +568,10 @@
(setq default-x-frame-plist
(plist-put default-x-frame-plist 'wait-for-wm nil))
+ ;; Create XEmacs minibuffer only frame for xwem minibuffer
(setq xwem-minibuffer (make-xwem-minib))
+ (setf (xwem-minib-frame xwem-minibuffer)
+ (make-initial-minibuffer-frame nil))
(xwem-message 'init "Initializing minibuffer ... done"))
;;; Resize-minibuffer mode
--- orig/lisp/xwem-misc.el
+++ mod/lisp/xwem-misc.el
@@ -596,9 +596,9 @@
(- w (* th 2)) (- h (* th 2))))
;;;###xwem-autoload
-(defun xwem-misc-find-frame (name)
+(defun xwem-misc-find-frame (name &optional frames-list)
"Find Emacs frame by its NAME."
- (let ((fl (frame-list))
+ (let ((fl (or frames-list (frame-list)))
(rf nil))
(while fl
--- orig/lisp/xwem-mouse.el
+++ mod/lisp/xwem-mouse.el
@@ -61,14 +61,13 @@
(XGrabPointer (xwem-dpy)
(or win (xwem-rootwin))
(or mask (Xmask-or XM-ButtonPress XM-ButtonRelease))
- cursor)
- )
+ cursor))
;;;###autoload
(defun xwem-mouse-ungrab ()
"Stop grabing mouse."
(XUngrabPointer (xwem-dpy))
- )
+ (XFlush (xwem-dpy)))
;;; Menus
;;;###autoload
@@ -194,6 +193,23 @@
(list (xwem-generate-applications-cl-menu "Applications"
max-mwidth))
)))
+(defun xwem-generate-recent-files (&optional title limit)
+ "Generate recent files menu."
+ (unless title (setq title "Recent Files"))
+ (unless limit (setq limit 10))
+ (list title
+ :filter `(lambda (not-used)
+ (mapcar (lambda (file)
+ (vector file `(xwem-open-file ,file)))
+ (let ((files xwem-read-filename-history)
+ (ret-files nil)
+ (ci 0))
+ (while (and files (< ci ,limit))
+ (setq ret-files (cons (car files) ret-files)
+ files (cdr files))
+ (incf ci))
+ (nreverse ret-files))))))
+
;;;###xwem-autoload
(defun xwem-generate-menu ()
"Generate xwem menu on fly."
@@ -241,7 +257,8 @@
(and (xwem-cl-selected) (cdr (xwem-generate-cl-menu
(xwem-cl-selected) 32))))))
"--"
xwem-applications-submenu
-
+
+ (xwem-generate-recent-files)
;; XXX - it is just demo of popup menus
))
--- orig/utils/xwem-diagram.el
+++ mod/utils/xwem-diagram.el
@@ -113,17 +113,16 @@
(d2 (xwem-diag-calc-arc-dot-at mcnt (/ w 2) (/ h 2) (+ a2 a1))))
(list d1 mcnt d2)))
-(defun xwem-diag-draw-sector (xwin gc x y w h a1 a2 &optional fill-gc)
+(defun xwem-diag-draw-sector (d gc x y w h a1 a2 &optional fill-gc)
"Draw sector, return new dots."
(let ((dots (xwem-diag-calc-sector-dots x y w h a1 a2)))
(when (X-Gc-p fill-gc)
- (XFillArc (X-Win-dpy xwin) xwin fill-gc x y w h a1 a2))
+ (XFillArc (X-Drawable-dpy d) d fill-gc x y w h a1 a2))
- (XDrawLines (X-Win-dpy xwin) xwin gc dots)
- (XDrawArc (X-Win-dpy xwin) xwin gc x y w h a1 a2)
- dots
- ))
+ (XDrawLines (X-Drawable-dpy d) d gc dots)
+ (XDrawArc (X-Drawable-dpy d) d gc x y w h a1 a2)
+ dots))
(defun xwem-diag-calc-butt-center (ds1 ds2)
"Evil stuff."
@@ -356,7 +355,9 @@
(list d1 dd1 dd2 dd3 d3 d4 d1 d2 d3 d2 dd2))
))
-(defun xwem-diag-draw-percentage (type spec d edge-gc x y width height
&optional sector-width label-factor label-font)
+(defun xwem-diag-draw-percentage (type spec d edge-gc x y width height
+ &optional sector-width label-factor
+ label-font override-gc)
"Draw percentage sector of TYPE.
TYPE is one of 'plain or '3d.
SPEC specifies percentage to display, it is an array in form
@@ -377,51 +378,52 @@
(let ((xdpy (X-Drawable-dpy d))
(temp-fill-face (make-face 'temp-fill-face))
(start-angle 0)
- angle-begin
- curel curang)
+ angle-begin curang)
;; Validate spec
; (when (> (apply '+ (mapcar (lambda (el) (aref el 0)) spec)) 100)
; (error "XWEM Invalid spec" spec))
- (let ((draw-sector (lambda (sel angbeg angle)
- (xwem-set-face-foreground temp-fill-face (aref sel 2))
- (let ((xint-off 0)
- (yint-off 0))
-
- (when (not (zerop (aref sel 3)))
- (let ((ra (/ (* pi (+ angbeg (/ angle 2))) 180)))
- (setq xint-off (round (* (aref sel 3) (cos
ra))))
- (setq yint-off (- (round (* (aref sel 3) (sin
ra)))))))
-
- (if (eq type 'plain)
- (xwem-diag-draw-sector d edge-gc (+ x xint-off
(aref sel 4))
- (+ y yint-off (aref sel
5)) width height
- angbeg angle
(xwem-face-get-gc temp-fill-face))
-
- (xwem-diag-draw-3d-sector d edge-gc (+ x xint-off
(aref sel 4))
- (+ y yint-off (aref sel
5)) width height
- angbeg angle (or
sector-width 10)
- (xwem-face-get-gc
temp-fill-face)))
-
- ;; Draw label
- (when (aref sel 1)
- (let* ((k (or label-factor 0.8))
- (nw (* width k))
- (nh (* height k))
- (nx (+ (aref sel 4) x xint-off (/ (- width
nw) 2)))
- (ny (+ (aref sel 5) y yint-off (/ (-
height nh) 2)))
- (cd (xwem-diag-calc-sector-dots nx ny nw
nh angbeg (/ angle 2)))
- (gc edge-gc)
- (text (if (stringp (aref sel 1)) (aref sel
1) (format "%d%%" (aref sel 0)))))
- (XDrawString xdpy d gc
- (- (X-Point-x (nth 2 cd))
- (/ (X-Text-width xdpy
(X-Gc-font gc) text) 2))
- (+ (/ (X-Text-height xdpy
(X-Gc-font gc) text) 2)
- (X-Point-y (nth 2 cd)))
- text)))
- ))))
-
+ (let ((draw-sector
+ (lambda (sel angbeg angle)
+ (xwem-set-face-foreground temp-fill-face (aref sel 2))
+ (let ((xint-off 0)
+ (yint-off 0))
+
+ (when (not (zerop (aref sel 3)))
+ (let ((ra (/ (* pi (+ angbeg (/ angle 2))) 180)))
+ (setq xint-off (round (* (aref sel 3) (cos ra))))
+ (setq yint-off (- (round (* (aref sel 3) (sin ra)))))))
+
+ (if (eq type 'plain)
+ (xwem-diag-draw-sector
+ d edge-gc (+ x xint-off (aref sel 4))
+ (+ y yint-off (aref sel 5)) width height
+ angbeg angle
+ (or override-gc (xwem-face-get-gc temp-fill-face)))
+ (xwem-diag-draw-3d-sector
+ d edge-gc (+ x xint-off (aref sel 4))
+ (+ y yint-off (aref sel 5)) width height
+ angbeg angle (or sector-width 10)
+ (or override-gc (xwem-face-get-gc temp-fill-face))))
+
+ ;; Draw label
+ (when (aref sel 1)
+ (let* ((k (or label-factor 0.8))
+ (nw (* width k))
+ (nh (* height k))
+ (nx (+ (aref sel 4) x xint-off (/ (- width nw) 2)))
+ (ny (+ (aref sel 5) y yint-off (/ (- height nh) 2)))
+ (cd (xwem-diag-calc-sector-dots nx ny nw nh angbeg (/
angle 2)))
+ (gc edge-gc)
+ (text (if (stringp (aref sel 1)) (aref sel 1) (format
"%d%%" (aref sel 0)))))
+ (XDrawString xdpy d gc
+ (- (X-Point-x (nth 2 cd))
+ (/ (X-Text-width xdpy (X-Gc-font gc) text)
2))
+ (+ (/ (X-Text-height xdpy (X-Gc-font gc) text)
2)
+ (X-Point-y (nth 2 cd)))
+ text)))
+ ))))
;; Sort SPEC by percentage
(setq spec (sort spec (lambda (el1 el2) (> (aref el1 0) (aref el2 0)))))
@@ -436,25 +438,18 @@
(while (and spec (< (+ (* 100 (/ angle-begin 360.0))
(aref (car spec) 0))
75))
- (setq curel (car spec))
- (setq curang (* 360.0 (/ (aref curel 0) 100.0)))
-
- (funcall draw-sector curel angle-begin curang)
-
+ (setq curang (* 360.0 (/ (aref (car spec) 0) 100.0)))
+ (funcall draw-sector (car spec) angle-begin curang)
(setq angle-begin (+ angle-begin curang))
(setq spec (cdr spec)))
;; Draw little sectors
(setq angle-begin start-angle)
- (setq spec (nreverse spec))
- (while spec
- (setq curel (car spec))
- (setq curang (* 360.0 (/ (aref curel 0) 100.0)))
- (setq angle-begin (- angle-begin curang))
-
- (funcall draw-sector curel angle-begin curang)
-
- (setq spec (cdr spec)))
+ (mapc (lambda (ssec)
+ (setq curang (* 360.0 (/ (aref ssec 0) 100.0))
+ angle-begin (- angle-begin curang))
+ (funcall draw-sector ssec angle-begin curang))
+ (nreverse spec))
;; Draw other sectors, XXX not used
(setq angle-begin 0)
@@ -462,10 +457,7 @@
(setq curang (* 360.0 (/ (aref el 0) 100.0)))
(funcall draw-sector el angle-begin curang)
(setq angle-begin (+ angle-begin curang)))
- spec)
-
- (X-Dpy-message-buffer xdpy)
- )))
+ spec))))
(defun xwem-diag-plot-coordinates (d gc x y w h x-step y-step &rest params)
--- orig/utils/xwem-worklog.el
+++ mod/utils/xwem-worklog.el
@@ -50,6 +50,7 @@
)
(require 'xlib-xlib)
+(require 'xlib-xshape)
(require 'xwem-load)
(require 'xwem-misc)
@@ -445,7 +446,8 @@
(defun xwem-worklog-create-cmd (template)
"Create symbol from TEMPLATE string."
- (let ((fsym (intern (concat "xwem-worklog-custom-" (replace-in-string
template " " "-")))))
+ (let ((fsym (intern (concat "xwem-worklog-custom-"
+ (replace-in-string template " " "-")))))
(fset fsym `(lambda ()
(interactive)
(xwem-worklog-begin-task ,template)))
@@ -460,8 +462,10 @@
Query for keybinding unless NO-BINDING is non-nil."
(unless (xwem-worklog-lookup-description name)
(let ((key (and (not no-binding)
- (xwem-read-key (format "Key for '%s' task: " name))))
- (col (xwem-read-from-minibuffer (format "Color for '%s' task: "
name))))
+ (xwem-read-key
+ (format "Key for '%s' task: " name))))
+ (col (xwem-read-from-minibuffer
+ (format "Color for '%s' task: " name))))
(when key
(setq key (events-to-keys (vector key)))
(define-key xwem-worklog-map key (xwem-worklog-create-cmd name)))
@@ -567,7 +571,8 @@
(run-hooks 'xwem-worklog-task-stop-hook)
(unless xwem-worklog-silent
- (xwem-message 'worklog "Task '%s' stoped." (xwem-worklog-task-name
xwem-worklog-current-task)))
+ (xwem-message 'worklog "Task '%s' stoped."
+ (xwem-worklog-task-name xwem-worklog-current-task)))
(setq xwem-worklog-current-task nil)))
@@ -576,7 +581,8 @@
HOW is one of '- or '+."
(when (and xwem-worklog-current-task
(caar (xwem-worklog-task-times xwem-worklog-current-task)))
- (let ((ctime (decode-time (caar (xwem-worklog-task-times
xwem-worklog-current-task)))))
+ (let ((ctime (decode-time (caar (xwem-worklog-task-times
+ xwem-worklog-current-task)))))
(setcar (cdr ctime)
(funcall how (cadr ctime) arg))
(setcar (car (xwem-worklog-task-times xwem-worklog-current-task))
@@ -585,13 +591,11 @@
(define-xwem-command xwem-worklog-task-time-increase (arg)
"Increase runtime of current task by ARG minutes."
(xwem-interactive "p")
-
(xwem-worklog-task-change-time '- arg))
(define-xwem-command xwem-worklog-task-time-decrease (arg)
"Decrease runtime of current task by ARG minutes."
(xwem-interactive "p")
-
(xwem-worklog-task-change-time '+ arg))
(defun xwem-worklog-pause-task (task &optional time)
@@ -601,19 +605,18 @@
(or time (current-time)))
(unless time
- (run-hooks 'xwem-worklog-task-pause-hook))
- ))
+ (run-hooks 'xwem-worklog-task-pause-hook))))
(defun xwem-worklog-resume-task (task &optional time)
"Resume TASK."
(when (or (null (xwem-worklog-task-times task))
(cdr (car (xwem-worklog-task-times task))))
(setf (xwem-worklog-task-times task)
- (cons (cons (or time (current-time)) nil) (xwem-worklog-task-times
task)))
+ (cons (cons (or time (current-time)) nil)
+ (xwem-worklog-task-times task)))
(unless time
- (run-hooks 'xwem-worklog-task-resume-hook))
- ))
+ (run-hooks 'xwem-worklog-task-resume-hook))))
(defun xwem-worklog-task-update-total-time (task)
"Update total-time entry of TASK."
@@ -694,7 +697,8 @@
(when xwem-worklog-pause-p
(let ((wfuncs (xwem-worklog-keymap-functions xwem-worklog-pause-map)))
(when (and (memq xwem-last-command wfuncs)
- (not (memq xwem-last-command
xwem-worklog-keymap-functions-skip)))
+ (not (memq xwem-last-command
+ xwem-worklog-keymap-functions-skip)))
(xwem-worklog-pause-update t)
(xwem-kbd-stop-command-keys-echoing))))
@@ -739,7 +743,8 @@
(setq xev (xwem-next-event 1))
(if (not xev)
;; Timeout
- (let ((xwem-worklog-pause-window-update-hook
'xwem-worklog-show-color-breaks))
+ (let ((xwem-worklog-pause-window-update-hook
+ 'xwem-worklog-show-color-breaks))
(xwem-worklog-pause-update))
;; Event arrived
@@ -762,7 +767,8 @@
(let ((xwem-worklog-pause-window-update-hook
(if xwem-worklog-use-diagram
- (list 'xwem-worklog-show-color-breaks
'xwem-worklog-draw-today-diagram)
+ (list 'xwem-worklog-show-color-breaks
+ 'xwem-worklog-draw-today-diagram)
(list 'xwem-worklog-show-color-breaks))))
(xwem-worklog-pause arg 'list)))
@@ -786,22 +792,23 @@
;; Create new pause window
(setq xwem-worklog-pause-p
- (make-xwem-worklog-pause :type type
- :prefix-arg arg
- :pwin (xwem-worklog-pause-create-xwin)
- :pbuf (get-buffer-create " *worklog-pause*")
- :start-time (current-time)))
+ (make-xwem-worklog-pause
+ :type type
+ :prefix-arg arg
+ :pwin (xwem-worklog-pause-create-xwin)
+ :pbuf (get-buffer-create " *worklog-pause*")
+ :start-time (current-time)))
;; TODO: need to wait exposure event?
- (xwem-worklog-pause-update t)
- ))
+ (xwem-worklog-pause-update t)))
(defun xwem-worklog-pause-stop ()
"Stop xwem worklog pausing."
(when xwem-worklog-pause-p
(when (X-Win-p (xwem-worklog-pause-pwin xwem-worklog-pause-p))
- (XDestroyWindow (xwem-dpy) (xwem-worklog-pause-pwin
xwem-worklog-pause-p)))
+ (XDestroyWindow
+ (xwem-dpy) (xwem-worklog-pause-pwin xwem-worklog-pause-p)))
(when (bufferp (xwem-worklog-pause-pbuf xwem-worklog-pause-p))
(kill-buffer (xwem-worklog-pause-pbuf xwem-worklog-pause-p)))
@@ -817,19 +824,28 @@
xwem-worklog-pause-cursor-background-color)))
(let* ((xfgeom (xwem-frame-xgeom (xwem-frame-selected)))
- (xwin (XCreateWindow (xwem-dpy) nil
- (+ (X-Geom-x xfgeom) (/ (- (X-Geom-width xfgeom)
xwem-worklog-pwin-width) 2))
- (+ (X-Geom-y xfgeom) (/ (- (X-Geom-height
xfgeom) xwem-worklog-pwin-height) 2))
- xwem-worklog-pwin-width xwem-worklog-pwin-height
xwem-worklog-pwin-border-width nil nil nil
- (make-X-Attr :override-redirect t
- :backing-store X-Always
- :background-pixel (XAllocNamedColor
(xwem-dpy) (XDefaultColormap (xwem-dpy))
-
xwem-worklog-pwin-background)
- :border-pixel (XAllocNamedColor
(xwem-dpy) (XDefaultColormap (xwem-dpy))
-
xwem-worklog-pwin-border-color)
- :event-mask (Xmask-or XM-Exposure
-
XM-StructureNotify
-
XM-ButtonPress XM-ButtonRelease)))))
+ (xwin (XCreateWindow
+ (xwem-dpy) nil
+ (+ (X-Geom-x xfgeom)
+ (/ (- (X-Geom-width xfgeom) xwem-worklog-pwin-width) 2))
+ (+ (X-Geom-y xfgeom)
+ (/ (- (X-Geom-height xfgeom) xwem-worklog-pwin-height) 2))
+ xwem-worklog-pwin-width xwem-worklog-pwin-height
+ xwem-worklog-pwin-border-width nil nil nil
+ (make-X-Attr :override-redirect t
+ :backing-store X-Always
+ :background-pixel
+ (XAllocNamedColor
+ (xwem-dpy) (XDefaultColormap (xwem-dpy))
+ xwem-worklog-pwin-background)
+ :border-pixel
+ (XAllocNamedColor
+ (xwem-dpy) (XDefaultColormap (xwem-dpy))
+ xwem-worklog-pwin-border-color)
+ :event-mask
+ (Xmask-or XM-Exposure
+ XM-StructureNotify
+ XM-ButtonPress XM-ButtonRelease)))))
(XMapWindow (xwem-dpy) xwin)
(XRaiseWindow (xwem-dpy) xwin)
xwin))
@@ -894,8 +910,9 @@
(insert "XWEM Worklog mode ")
(insert-face "PAUSE: " 'red)
(insert (xwem-worklog-format-time
- (xwem-worklog-time-diff (current-time)
- (xwem-worklog-pause-start-time
xwem-worklog-pause-p))
+ (xwem-worklog-time-diff
+ (current-time)
+ (xwem-worklog-pause-start-time xwem-worklog-pause-p))
20))
(insert "\n\n")
@@ -906,7 +923,8 @@
(insert "\n")
(insert "Press any key to continue with current task.\n")
(if (eq (xwem-worklog-pause-type xwem-worklog-pause-p) 'list)
- (insert (substitute-command-keys "Press
``\\<xwem-worklog-pause-map>\\[xwem-worklog-pause]'' to show pause buffer.\n"))
+ (insert (substitute-command-keys
+ "Press ``\\<xwem-worklog-pause-map>\\[xwem-worklog-pause]''
to show pause buffer.\n"))
(insert "Bindings:\n")
(insert "Key Binding\n")
@@ -927,8 +945,8 @@
(let ((ctime (or (cdr (car (xwem-worklog-task-times task))) (current-time))))
(if (caar (xwem-worklog-task-times xwem-worklog-current-task))
(xwem-worklog-format-time
- (xwem-worklog-time-diff ctime
- (caar (xwem-worklog-task-times
xwem-worklog-current-task)))
+ (xwem-worklog-time-diff
+ ctime (caar (xwem-worklog-task-times xwem-worklog-current-task)))
padlen)
(if padlen
@@ -943,7 +961,8 @@
;; Task not paused
(if (caar (xwem-worklog-task-times task))
(xwem-worklog-calc-time
- (xwem-worklog-time-diff (current-time) (caar
(xwem-worklog-task-times task)))
+ (xwem-worklog-time-diff
+ (current-time) (caar (xwem-worklog-task-times task)))
(xwem-worklog-task-today-time task))
'(0 0))))
@@ -955,7 +974,8 @@
;; Task not paused
(if (caar (xwem-worklog-task-times task))
(xwem-worklog-calc-time
- (xwem-worklog-time-diff (current-time) (caar
(xwem-worklog-task-times task)))
+ (xwem-worklog-time-diff
+ (current-time) (caar (xwem-worklog-task-times task)))
(xwem-worklog-task-total-time task))
'(0 0))))
@@ -963,8 +983,8 @@
"Return time string for today time of TASK."
(if (cdr (car (xwem-worklog-task-times task)))
(if (xwem-worklog-task-today-time task)
- (xwem-worklog-format-time (xwem-worklog-task-today-time task) padlen)
-
+ (xwem-worklog-format-time
+ (xwem-worklog-task-today-time task) padlen)
(if padlen
(concat "---" (make-string (- padlen 3) ?\x20)) ; XXX
"---"))
@@ -973,7 +993,8 @@
(if (caar (xwem-worklog-task-times task))
(xwem-worklog-format-time
(xwem-worklog-calc-time
- (xwem-worklog-time-diff (current-time) (caar
(xwem-worklog-task-times task)))
+ (xwem-worklog-time-diff
+ (current-time) (caar (xwem-worklog-task-times task)))
(xwem-worklog-task-today-time task))
padlen)
@@ -995,7 +1016,8 @@
(if (caar (xwem-worklog-task-times task))
(xwem-worklog-format-time
(xwem-worklog-calc-time
- (xwem-worklog-time-diff (current-time) (caar
(xwem-worklog-task-times task)))
+ (xwem-worklog-time-diff
+ (current-time) (caar (xwem-worklog-task-times task)))
(xwem-worklog-task-total-time task))
padlen)
@@ -1007,9 +1029,10 @@
"Insert into pause buffer list of registered tasks and their values."
(let* ((noff 10)
(mlen (or (and xwem-worklog-task-list
- (+ (apply 'max (mapcar (lambda (el)
- (length
(xwem-worklog-task-name el)))
- xwem-worklog-task-list))
+ (+ (apply 'max (mapcar
+ (lambda (el)
+ (length (xwem-worklog-task-name el)))
+ xwem-worklog-task-list))
noff))
20))
(task-hdr "Task"))
@@ -1036,9 +1059,12 @@
;; Insert grand total
(let ((tl (copy-list xwem-worklog-task-list)))
;; Remove 'login', 'logout' tasks from task list
- (setq tl (delete* nil tl :test (lambda (e1 e2)
- (or (string= "login"
(xwem-worklog-task-name e2))
- (string= "logout"
(xwem-worklog-task-name e2))))))
+ (setq tl (delete* nil tl
+ :test (lambda (e1 e2)
+ (or (string= (xwem-worklog-task-name e2)
+ "login")
+ (string= (xwem-worklog-task-name e2)
+ "logout")))))
(insert (concat (make-string (+ 14 10 mlen) ?-) "\n"))
(insert "Grand Total:")
@@ -1066,11 +1092,14 @@
(unless (cdr (car (xwem-worklog-task-times xwem-worklog-current-task)))
;; Task not paused
(insert (format " Task time: %s\n"
- (xwem-worklog-last-time-string xwem-worklog-current-task
20)))
+ (xwem-worklog-last-time-string
+ xwem-worklog-current-task 20)))
(insert (format " Today time: %s\n"
- (xwem-worklog-today-time-string
xwem-worklog-current-task 20)))
+ (xwem-worklog-today-time-string
+ xwem-worklog-current-task 20)))
(insert (format " Total time: %s\n"
- (xwem-worklog-total-time-string
xwem-worklog-current-task 20)))
+ (xwem-worklog-total-time-string
+ xwem-worklog-current-task 20)))
)))
(defun xwem-worklog-time-> (a-time b-time)
@@ -1244,19 +1273,23 @@
(let* ((face-height (font-height (face-font 'default)))
(w 10) (y (- (* 5 face-height) (/ w 2))) (x 6))
(mapc (lambda (task)
- (xwem-set-face-foreground 'xwem-worklog-temp-face
- (or (plist-get (cadr (xwem-worklog-lookup-description
- (xwem-worklog-task-name task))) :color)
"black"))
- (xwem-diag-draw-rect (xwem-worklog-pause-pwin
xwem-worklog-pause-p)
- (xwem-face-get-gc 'default)
- (cons x y) (cons (+ x w) y)
- (cons (+ x w) (+ y w)) (cons x (+ y w))
- (xwem-face-get-gc 'xwem-worklog-temp-face))
+ (xwem-set-face-foreground
+ 'xwem-worklog-temp-face
+ (or (plist-get (cadr (xwem-worklog-lookup-description
+ (xwem-worklog-task-name task))) :color)
+ "black"))
+ (xwem-diag-draw-rect
+ (xwem-worklog-pause-pwin xwem-worklog-pause-p)
+ (xwem-face-get-gc 'default)
+ (cons x y) (cons (+ x w) y)
+ (cons (+ x w) (+ y w)) (cons x (+ y w))
+ (xwem-face-get-gc 'xwem-worklog-temp-face))
(setq y (+ y face-height)))
(xwem-worklog-sorted-task-list)))
(XFlush (xwem-dpy))))
-(defun xwem-worklog-generate-percentage-spec (sector-width &optional no-labels
no-yoff)
+(defun xwem-worklog-generate-percentage-spec
+ (sector-width &optional no-labels no-yoff)
"Generates percentage diagram spec.
If NO-LABELS is non-nil, labels will be avoided."
(let* ((today-seconds
@@ -1265,18 +1298,24 @@
(- xwem-worklog-day-ends xwem-worklog-day-start)
(- (+ 24 xwem-worklog-day-ends)
xwem-worklog-day-start))))
- (spec1 (mapcar (lambda (task)
- (let* ((td (xwem-worklog-lookup-description
(xwem-worklog-task-name task)))
- (tt (xwem-worklog-get-today-time task))
- (ts (+ (* (car tt) 65536.0) (cadr tt)))
- (per (truncate (* 100.0 (/ ts
today-seconds))))
- (rv (and td (> per 0)
- (vector per (not no-labels)
(plist-get (cadr td) :color) 0 0
- (if (and (not no-yoff) (eq
task xwem-worklog-current-task))
- (- (/ sector-width 2))
- 0)))))
- rv))
- xwem-worklog-task-list))
+ (spec1 (mapcar
+ (lambda (task)
+ (let* ((td (xwem-worklog-lookup-description
+ (xwem-worklog-task-name task)))
+ (tt (xwem-worklog-get-today-time task))
+ (ts (+ (* (car tt) 65536.0) (cadr tt)))
+ (per (truncate (* 100.0 (/ ts today-seconds))))
+ (rv (and td (> per 0)
+ (vector
+ per (not no-labels)
+ (plist-get (cadr td) :color) 0 0
+ (if (and (not no-yoff)
+ (eq task
+ xwem-worklog-current-task))
+ (- (/ sector-width 2))
+ 0)))))
+ rv))
+ xwem-worklog-task-list))
spec)
;; Remove invalid fields
@@ -1290,7 +1329,8 @@
"Draw stuff for today."
(when (eq (xwem-worklog-pause-type xwem-worklog-pause-p) 'list)
;; Do it only in listing
- (let* ((buf-lines (with-current-buffer (xwem-worklog-pause-pbuf
xwem-worklog-pause-p)
+ (let* ((buf-lines (with-current-buffer
+ (xwem-worklog-pause-pbuf xwem-worklog-pause-p)
(count-lines (point-min) (point-max))))
(face-height (font-height (face-font 'default)))
(t-off 2)
@@ -1298,15 +1338,16 @@
(x-off 50)
(sec-hei 20)
(wwid (- xwem-worklog-pwin-width (* x-off 2)))
- (whei (- xwem-worklog-pwin-height y-off (* face-height 2 t-off)
sec-hei))
+ (whei (- xwem-worklog-pwin-height
+ y-off (* face-height 2 t-off) sec-hei))
(spec (xwem-worklog-generate-percentage-spec sec-hei)))
;; XXX
(when spec
(xwem-diag-draw-percentage
- xwem-worklog-diagram-type spec (xwem-worklog-pause-pwin
xwem-worklog-pause-p)
- (xwem-face-get-gc 'default) x-off y-off wwid whei sec-hei))
- )))
+ xwem-worklog-diagram-type spec
+ (xwem-worklog-pause-pwin xwem-worklog-pause-p)
+ (xwem-face-get-gc 'default) x-off y-off wwid whei sec-hei)))))
(defvar xwem-worklog-dockapp-map
(let ((map (make-sparse-keymap)))
@@ -1316,7 +1357,8 @@
"Keymap used by worklog dockapp.")
(defstruct xwem-worklog-dockapp
- win
+ win ; X Window for dockapp
+ mask ; Mask Pixmap for dockapp
update-itimer ; itimer to update worklog-dockapp
;; dockapp and sector geometry
@@ -1333,29 +1375,52 @@
(/ (* 60 60 (- (+ 24 xwem-worklog-day-ends) xwem-worklog-day-start))
100)))
+;; TODO:
+;; - Get rid of double call to `xwem-worklog-generate-percentage-spec'
+;; - Implement separated update for current task brick
+
(define-xwem-deffered xwem-worklog-dockapp-update (dockapp)
"Update worklog dockapp."
(when (xwem-worklog-dockapp-p dockapp)
(let* ((win (xwem-worklog-dockapp-win dockapp))
+ (mask (xwem-worklog-dockapp-mask dockapp))
(xdpy (X-Win-dpy win))
(w (xwem-worklog-dockapp-width dockapp))
(h (xwem-worklog-dockapp-height dockapp))
(sec-w (xwem-worklog-dockapp-sector-width dockapp))
(spec (xwem-worklog-generate-percentage-spec sec-w t t))
+ (spec-copy (xwem-worklog-generate-percentage-spec sec-w t t))
td)
(XClearArea xdpy win 0 0 (+ 1 w) (+ 1 h (* 2 sec-w)) nil)
+ (XFillRectangle
+ xdpy mask xwem-misc-mask-bgc 0 0 (+ 1 w) (+ 1 h (* 2 sec-w)))
(when spec
(xwem-diag-draw-percentage
xwem-worklog-dockapp-diagram-type
spec win (xwem-face-get-gc 'default)
- (/ sec-w 2) (/ sec-w 2) w h sec-w))
+ (/ sec-w 2) (/ sec-w 2) w h sec-w)
+
+ (xwem-diag-draw-percentage
+ xwem-worklog-dockapp-diagram-type
+ spec-copy mask xwem-misc-mask-fgc
+ (/ sec-w 2) (/ sec-w 2) w h sec-w nil nil
+ xwem-misc-mask-fgc))
(when (and xwem-worklog-current-task
(setq td (xwem-worklog-lookup-description
(xwem-worklog-task-name
xwem-worklog-current-task))))
- (xwem-set-face-foreground 'xwem-worklog-temp-face (or (plist-get (cadr
td) :color) "black"))
- (XFillRectangle xdpy win (xwem-face-get-gc 'xwem-worklog-temp-face) 0
0 6 6)))))
+ (xwem-set-face-foreground 'xwem-worklog-temp-face
+ (or (plist-get (cadr td) :color) "black"))
+ (XFillRectangle
+ xdpy win (xwem-face-get-gc 'xwem-worklog-temp-face) 0 0 6 6)
+
+ (XFillRectangle
+ xdpy mask xwem-misc-mask-fgc 0 0 6 6))
+
+ ;; Apply mask
+ (X-XShapeMask xdpy win X-XShape-Bounding X-XShapeSet 0 0 mask)
+ )))
(defun xwem-worklog-dockapp-event-handler (xdpy xwin xev)
"Event handler for worklog dockapp."
@@ -1379,24 +1444,36 @@
(h xwem-worklog-dockapp-height)
(sw xwem-worklog-dockapp-sector-width)
(wd (make-xwem-worklog-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
- ))
+ :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)))
+
+ ;; Create mask for worklog dockapp
+ (setf (xwem-worklog-dockapp-mask wd)
+ (XCreatePixmap
+ (xwem-dpy) (make-X-Pixmap :dpy (xwem-dpy)
+ :id (X-Dpy-get-id (xwem-dpy)))
+ (xwem-worklog-dockapp-win wd)
+ 1 (+ 1 w) (+ 1 h (* 2 sw))))
(X-Win-put-prop (xwem-worklog-dockapp-win wd) 'xwem-worklog-dockapp wd)
(XSelectInput (xwem-dpy) (xwem-worklog-dockapp-win wd)
(apply 'Xmask-or xwem-worklog-dockapp-event-mask))
- (X-Win-EventHandler-add (xwem-worklog-dockapp-win wd)
'xwem-worklog-dockapp-event-handler nil
- (list X-Expose X-MapNotify X-ButtonPress
X-ButtonRelease X-DestroyNotify))
+ (X-Win-EventHandler-add
+ (xwem-worklog-dockapp-win wd) 'xwem-worklog-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-worklog-dockapp-win wd) dockid dockgroup
dockalign)
+ (xwem-XTrayInit (xwem-dpy) (xwem-worklog-dockapp-win wd)
+ dockid dockgroup dockalign)
;; Start updater
(setf (xwem-worklog-dockapp-update-itimer wd)
@@ -1430,14 +1507,17 @@
(xwem-interactive)
(unless (button-event-p xwem-last-event)
- (error 'xwem-error "`xwem-worklog-dockapp-menu' must be bound to mouse
event"))
+ (error 'xwem-error
+ "`xwem-worklog-dockapp-menu' must be bound to mouse event"))
(xwem-popup-menu
(list "Worklog"
- (vector "Current Task Info" `(xwem-worklog-task-info
,xwem-worklog-current-task))
+ (vector "Current Task Info"
+ `(xwem-worklog-task-info ,xwem-worklog-current-task))
(cons "Start task"
(mapcar (lambda (td)
- (vector (car td) `(xwem-worklog-begin-task ,(car
td))))
+ (vector
+ (car td) `(xwem-worklog-begin-task ,(car td))))
xwem-worklog-tasks-description))
"---"
(vector "Pause" `(xwem-worklog-pause nil))
@@ -1456,9 +1536,8 @@
(when (xwem-cl-selected-p cl)
(let ((td (xwem-manda-find-match-1 cl xwem-worklog-tasks-description)))
- (when (and td
- (not (string= (xwem-worklog-task-name
xwem-worklog-current-task)
- (car td))))
+ (when (and td (not (string= (xwem-worklog-task-name
+ xwem-worklog-current-task) (car td))))
(xwem-worklog-begin-task (car td))))))
(defun xwem-worklog-init ()
@@ -1590,16 +1669,20 @@
(defun xwem-worklog-history-on-start ()
"Called when new task just started.
To be used in `xwem-worklog-task-start-hook'."
- (xwem-worklog-history-add-entry (xwem-worklog-task-name
(xwem-worklog-current-task)))
- (when (string= (xwem-worklog-task-name (xwem-worklog-current-task)) "logout")
+ (xwem-worklog-history-add-entry
+ (xwem-worklog-task-name (xwem-worklog-current-task)))
+ (when (string= (xwem-worklog-task-name (xwem-worklog-current-task))
+ "logout")
;; When logging out, also save history
(xwem-worklog-history-save)))
(defun xwem-worklog-history-on-stop ()
"Called when task just stoped.
To be used in `xwem-worklog-task-stop-hook'."
- (unless (or (string= (xwem-worklog-task-name (xwem-worklog-current-task))
"logout")
- (string= (xwem-worklog-task-name (xwem-worklog-current-task))
"login"))
+ (unless (or (string= (xwem-worklog-task-name (xwem-worklog-current-task))
+ "logout")
+ (string= (xwem-worklog-task-name (xwem-worklog-current-task))
+ "login"))
(xwem-worklog-history-add-entry "stop")))
@@ -1608,7 +1691,8 @@
(mapc (lambda (el)
(let ((key (plist-get (cadr el) :key)))
(when key
- (define-key xwem-worklog-map key (xwem-worklog-create-cmd (car
el))))))
+ (define-key xwem-worklog-map key
+ (xwem-worklog-create-cmd (car el))))))
xwem-worklog-tasks-description)
;; - Initialize worklog
|