;; buffer-timer.el: Track your time based on the buffers you edit. ;; ;; Copyright (C) 2002-2004 Wes Hardaker ;; ;; This program 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. ;; ;; This program 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. ;; ;; A copy of the GNU General Public License can be obtained from this ;; program's author (send electronic mail to psmith@BayNetworks.com) or ;; from the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;; 02139, USA. ;; ;; $Revision: 1.15 $ (require 'gnus-spec) ; ; user setable variables ; (defvar buffer-timer-idle-limit 300 "the amount of time to wait for user input before switching to the buffer-timer-idle-buffer buffer") (defvar buffer-timer-output-file "/home/hardaker/.buffer-timer" "the location to store buffer-timer data. Will get formated using format-time-string, so date specifications (like file-%Y-%m-%d) will work.") (defvar buffer-timer-clear-data-on-filename-change t "If t, clears data from the buffer-timer on a filename change. If a date format string is included in the buffer-timer-output-file variable then the variable name will not be constant. When it changes, this variable indicates if the timers data should be cleared for the new time period.") (defvar buffer-timer-idle-buffer "*idle*" "The buffer to switch to when no events have been detected. Swiched to after buffer-timer-idle-limit seconds.") (defvar buffer-timer-load-previous t "If t, load the previous existing data file if present") (defvar buffer-timer-summarize-sort-by 'time "Sort reports either by 'time or by 'name'") (defvar buffer-timer-save-when-idle t "Whether we should save buffer-timer data every so often automatically.") (defvar buffer-timer-small-idle-time 5 "minimum idle time to wait before saving data") (defvar buffer-timer-save-every-x-idletimes 5 "save data only every buffer-timer-save-every-x-idletimes number of idle times.") (defvar buffer-timer-rename-always nil "if t, sort/classify the buffer names as they are processed.") (defvar buffer-timer-regexp-merge-list '(("^\\*Group\\*" . "news") ; or maybe mail! ("^\\*Summary\\*" . "news") ("drafts/[0-9]+$" . "news-post") ("^\\*idle\\*" . "idle") ("^\\*cvs.*\\*" . "cvs") ("^\\*compilation\\*" . "compiling") ("^\\*" . "emacs-internal") ("^ " . "emacs-really-internal")) "A list of (regexp . summary) pairs to make condensed reports from.") (defvar buffer-timer-regexp-master-list '(("news" . (("group" . "^\\*Group\\*") ("summary" . "^\\*Summary\\*") ("out" . "drafts/[0-9]+$"))) ("idle" . "^\\*idle\\*") ("cvs" . "^\\*cvs.*\\*") ("compiling" . "^\\*compilation\\*") ("emacs" . (("emacs-internal" . "^\\*") ("emacs-really-internal" . "^ "))) ) "A list of (name . regexp) or (name . ((subname . regexp)...)) type things..." ) (defvar buffer-timer-munge-dont-show-zeros t "if t, dont display munge results for zero time matches") (defvar buffer-timer-munge-visible-depth 100 "Maximum hierarchial depth to show as visible by default.") (defvar buffer-timer-mouse-face 'highlight "*Face used for mouse highlighting in the summary buffer.") (defvar buffer-timer-display-status-in-modeline t "Should the buffer-timer status be displayed in the modeline.") (defvar buffer-timer-do-idle-buttons t "Put transfer buttons into the idle buffer for easy switch away.") (defvar buffer-timer-frequent-topic-list nil "A list of frequent topics utilized a user of the buffer-timer") (defvar buffer-timer-use-gutter t "display buffer-timer status information in the default-gutter") (defface buffer-timer-locked-face '((((class color) (background dark)) (:foreground "red" :bold t)) (((class color) (background light)) (:foreground "red" :bold t)) (t (:bold t))) "Locked face.") (defface buffer-timer-normal-face '((((class color) (background dark)) (:foreground "black")) (((class color) (background light)) (:foreground "black"))) "normal face.") (defvar buffer-timer-gutter-format "%l this: %t") (defvar buffer-timer-recent-transfer-list-max 5 "Maximum number of recent tranfsers to keep for buttons in the idle window") (defvar buffer-timer-recent-buffer-max 5 "Maximum number of recent buffers to make a button for in the idle window") ; ; internal variables ; (defvar buffer-timer-mytime 0) (defvar buffer-timer-gutter-format-alist `((?l (or buffer-timer-locked "") ?s) (?L (let* ((mystr (copy-sequence " ")) (myext (make-extent 0 1 mystr))) (set-extent-begin-glyph myext buffer-timer-locked-gl) mystr)) (?t (buffer-timer-time-string buffer-timer-mytime) ?s) (?a buffer-timer-search-string-a ?s) (?b buffer-timer-search-string-b ?s) (?c buffer-timer-search-string-c ?s) (?d buffer-timer-search-string-d ?s) (?T buffer-timer-mytime ?d))) (defvar buffer-timer-do-warnings nil) (defvar buffer-timer-locked nil) (defvar buffer-timer-debug 'file) (defvar buffer-timer-debug-file "/home/hardaker/.buffer-timer-log") (defvar buffer-timer-debug-buffer "*buffer-timer-log*") (defvar buffer-timer-debug-buf nil) (defvar buffer-timer-last-file-name nil) (defvar buffer-timer-last-outputfile-name nil) (defvar buffer-timer-data nil) (defvar buffer-timer-start-time (current-time)) (defvar buffer-timer-switch-time nil) (defvar buffer-timer-switch-idle-time nil) (defvar buffer-timer-lock-started nil) (defvar buffer-timer-search-a nil) (defvar buffer-timer-search-string-a "") (defvar buffer-timer-search-int-a 0) (defvar buffer-timer-status "") (defvar buffer-timer-locked-xpm "/* XPM */ static char *magick[] = { /* columns rows colors chars-per-pixel */ \"13 13 118 2\", \" c #19191a\", \". c #1b1b1a\", \"X c #1e1e1e\", \"o c #1e1e22\", \"O c #1e1e25\", \"+ c #1e1e28\", \"@ c #232320\", \"# c Gray17\", \"$ c Gray18\", \"% c #222232\", \"& c #333338\", \"* c #3c3c3a\", \"= c #3c3c3c\", \"- c #3f3f3f\", \"; c #3e402b\", \": c #44442d\", \"> c #444434\", \", c #434338\", \". c #f5f7f7\", \",. c #f9f9f9\", \"<. c gray99 gray100 pixels p r t j u s o. i : y d n> 6 7.\", \"1.7.q m -.J G C Z v 0 O 7.\", \"1.7., F <.k h s m n w o a>.@.} _ W Q p X 7.\", \"1.7.@ ] 7.=.[ ' E B 4 + 7.\", \"1.7.u 1 ` V b 3 c (length buffer-timer-recent-transfer-list) buffer-timer-recent-transfer-list-max) (pop buffer-timer-recent-transfer-list))) (defun buffer-timer-adjust-older-time (daysago to timeamount) "add TIMEAMOUNT seconds to TO for DAYSAGO in time (appends .el file)" (interactive (list (read-number "Add to how many days ago: ") (completing-read (concat "To Subject: [" (caar buffer-timer-data) "]: ") buffer-timer-data nil nil nil nil (caar buffer-timer-data)) (buffer-timer-convert-time-string (let ((tstring (buffer-timer-time-string (if buffer-timer-switch-idle-time (+ 300 (- (buffer-timer-current-time) buffer-timer-switch-idle-time)) 0)))) (read-string (format "Transfer time [%s]: " tstring) nil nil tstring))))) (setq daysago (- 0 daysago)) (save-excursion (let* ((date (buffer-timer-get-days-ago daysago)) (filename (format-time-string (concat buffer-timer-output-file ".el") date)) buf) (if (file-exists-p filename) (progn (setq buf (find-file-noselect filename)) (set-buffer buf) (goto-char (point-max)) (insert (format "(buffer-timer-adjust-time \"%s\" %d)\n" to timeamount)) (save-buffer) (message (format "added %s to %s, %d days ago in %s" (buffer-timer-time-string timeamount) to daysago filename))) (error (format "no file for that day: %s" filename)))))) (defun buffer-timer-adjust-time (to timeamount) "add TIMEAMOUNT seconds to TO" (interactive (list (completing-read (concat "To Subject: [" (caar buffer-timer-data) "]: ") buffer-timer-data nil nil nil nil (caar buffer-timer-data)) (buffer-timer-convert-time-string (let ((tstring (buffer-timer-time-string (if buffer-timer-switch-idle-time (+ 300 (- (buffer-timer-current-time) buffer-timer-switch-idle-time)) 0)))) (read-string (format "Transfer time [%s]: " tstring) nil nil tstring))))) (buffer-timer-remember to timeamount) (message (format "added %s to %s" (buffer-timer-time-string timeamount) to))) ; ; write out our data to a save file ; (defun buffer-timer-write-results () (interactive) (buffer-timer-write-el-results) (buffer-timer-write-text-results) (if (and (eq buffer-timer-debug 'file) (bufferp buffer-timer-debug-buf)) (progn (set-buffer buffer-timer-debug-buf) (save-buffer))) ) (defun buffer-timer-create-file-name (&optional inputfilename) (let* ((inputfilename (or inputfilename buffer-timer-output-file)) (newname (format-time-string inputfilename))) (if buffer-timer-clear-data-on-filename-change (progn (if (not (equal buffer-timer-last-outputfile-name newname)) (buffer-timer-clear)) (setq buffer-timer-last-outputfile-name newname))) newname)) (defun buffer-timer-write-text-results () (save-excursion (let ((buf (find-file-noselect (buffer-timer-create-file-name))) (list buffer-timer-data)) (set-buffer buf) (erase-buffer) (while list (insert (format "%2d\t%s\n" (cdar list) (caar list))) (setq list (cdr list)))) (save-buffer))) (defun buffer-timer-write-el-results () (interactive) (save-excursion (let ((buf (find-file-noselect (concat (buffer-timer-create-file-name) ".el"))) (list buffer-timer-data)) (set-buffer buf) (erase-buffer) (insert "(setq buffer-timer-data '(\n") (while list (insert (format " (\"%s\" . %2d)\n" (caar list) (cdar list))) (setq list (cdr list)))) (insert "))\n") (save-buffer))) ; ; summarize timed data into a seperate buffer ; (defun buffer-timer-break-time (intime) (let* ((hours (/ intime 3600)) (minutes (/ (- intime (* hours 3600)) 60)) (seconds (mod intime 60))) (list seconds minutes hours))) (defun buffer-timer-time-string (intime) (let* ((tlist (buffer-timer-break-time intime)) (seconds (first tlist)) (minutes (second tlist)) (hours (third tlist))) (format "%2dh %2dm %2ds" hours minutes seconds))) (defun buffer-timer-reclassify () (interactive) (setq buffer-timer-backup-data buffer-timer-data) (let ((list buffer-timer-data)) (setq buffer-timer-data nil) (while list (buffer-timer-remember (caar list) (cdar list)) (setq list (cdr list))))) (defun buffer-timer-sort-by-seconds (a b) ( totaltime 0) (progn (setq addedtime (+ addedtime totaltime)) (if (or (equal bufname buffer-timer-idle-buffer) (equal bufname "idle")) (setq idletime (+ idletime totaltime))) (insert (format "%s\t%s\n" tstring bufname)))) (setq list (cdr list)))) (insert "----------------------------------------------------------------------\n") (if (> idletime 0) (insert (format "%s\tTotal not idle\n" (buffer-timer-time-string (- addedtime idletime))))) (insert (format "%s\tTotal\n" (buffer-timer-time-string addedtime))) (insert (format "\nTimer Started: %s\n" (current-time-string buffer-timer-start-time))) (insert (format "Running for: %s" (buffer-timer-time-string (- (buffer-timer-current-time) (buffer-timer-convert-time buffer-timer-start-time))))) ))) ; ; convert a string like "15m 30s" and "1h 20s" to a second count. ; (defun buffer-timer-convert-time-string (timestr) (if (not (string-match "[hsm]" timestr)) ; straight seconds, no specfiers (string-to-int timestr) (let ((time 0)) (if (string-match "\\([0-9]+s\\)" timestr) (setq time (string-to-int (substring timestr (match-beginning 1) (1- (match-end 1)))))) (if (string-match "\\([0-9]+m\\)" timestr) (setq time (+ time (* 60 (string-to-int (substring timestr (match-beginning 1) (1- (match-end 1)))))))) (if (string-match "\\([0-9]+h\\)" timestr) (setq time (+ time (* 3600 (string-to-int (substring timestr (match-beginning 1) (1- (match-end 1)))))))) time))) ; (buffer-timer-convert-time-string "4h") ; ; print the regexp merged stuff ; (defun buffer-timer-report (&optional sortby) (interactive) (save-excursion (switch-to-buffer-other-window "*buffer-timer-results*") (erase-buffer) (let ((list (copy-sequence buffer-timer-data)) (addedtime 0) (sortby (or sortby buffer-timer-summarize-sort-by)) (idletime 0) (reportlist (cons (cons "dummy" 0) nil)) ) ; reclassify the list (while list (setq reportlist (buffer-timer-remember (if buffer-timer-rename-always (caar list) (buffer-timer-maybe-rename (caar list))) (cdar list) reportlist)) (setq list (cdr list))) ; sort the list (cond ((eq sortby 'time) (setq reportlist (sort reportlist 'buffer-timer-sort-by-seconds))) ((eq sortby 'name) (setq reportlist (sort reportlist 'buffer-timer-sort-by-name)))) ; display the list (while reportlist (let* ((totaltime (cdar reportlist)) (bufname (caar reportlist)) (tstring (buffer-timer-time-string totaltime))) (if (> totaltime 0) (progn (setq addedtime (+ addedtime totaltime)) (if (or (equal bufname buffer-timer-idle-buffer) (equal bufname "idle")) (setq idletime (+ idletime totaltime))) (insert (format "%s\t%s\n" tstring bufname)))) (setq reportlist (cdr reportlist)))) ; display a summary count (insert "----------------------------------------------------------------------\n") (if (> idletime 0) (insert (format "%s\tTotal not idle\n" (buffer-timer-time-string (- addedtime idletime))))) (insert (format "%s\tTotal\n" (buffer-timer-time-string addedtime))) (insert (format "\nTimer Started: %s\n" (current-time-string buffer-timer-start-time))) (insert (format "Running for: %s" (buffer-timer-time-string (- (buffer-timer-current-time) (buffer-timer-convert-time buffer-timer-start-time))))) ))) ; ; idle timer functions ; (defvar buffer-timer-do-early-idle-count 0) (defun buffer-timer-do-early-idle () (interactive) ; (message (format "saving data %d" buffer-timer-do-early-idle-count)) (setq buffer-timer-do-early-idle-count (+ buffer-timer-do-early-idle-count 1)) (if (> buffer-timer-do-early-idle-count buffer-timer-save-every-x-idletimes) (progn (setq buffer-timer-do-early-idle-count 0) (if buffer-timer-search-a (setq buffer-timer-search-string-a (buffer-timer-find-munge-string buffer-timer-search-a))) (if buffer-timer-save-when-idle (progn (buffer-timer-write-results)))))) (defun buffer-timer-do-idle-application (event) (interactive "e") (let* ((ext (event-glyph-extent event)) (pt (event-closest-point event)) to) (if (not ext) (when pt (setq ext (extent-at pt (event-buffer event) nil ext 'at)))) (if (and (extentp ext) (extent-property ext 'unlock)) (buffer-timer-unlock) (if ext (setq to (extent-property ext 'towhat))) (if (symbolp to) (setq to (symbol-name to))) (if to (buffer-timer-transfer-time buffer-timer-idle-buffer to (+ 300 (- (buffer-timer-current-time) buffer-timer-switch-idle-time)) t) (call-interactively 'buffer-timer-transfer-time))))) (defun buffer-timer-idle-message () (interactive) (erase-buffer) (insert "Ok.... You've gone idle. Do you want to:\n\n") (let ((here (point)) (frequent buffer-timer-frequent-topic-list) (frequent2 buffer-timer-recent-transfer-list) (lastbuf (buffer-name (other-buffer))) (bufferlist (buffer-list)) (count 0) newext) (if buffer-timer-locked (progn (insert (concat "\tUnlock from " buffer-timer-locked "\n")) (setq newext (make-extent here (point))) (set-extent-property newext 'unlock t) (buffer-timer-make-invis-button newext nil nil buffer-timer-idle-button-map (concat "Unlock from" buffer-timer-locked "\n"))) ;; not locked ;; generic button (insert "\tApply current idle time to something generic\n") (setq newext (make-extent here (point))) (buffer-timer-make-invis-button newext nil nil buffer-timer-idle-button-map "apply idle time to something else") ;; last visited buffers (insert "\nRecent buffers:\n\n") (while (and ( (+ buffer-timer-switch-time subtracttime) (buffer-timer-current-time)) (bt-warn "buffer-timer: idle timer gave too few seconds") ;(format "buffer-timer: idle timer gave too few seconds: %d" ; (- (buffer-timer-current-time) ; buffer-timer-switch-time))) (buffer-timer-remember buffer-timer-idle-buffer (- (buffer-timer-current-time) buffer-timer-switch-time))) ;; we've switched and need to remember an amount of time spent ;; in the current buffer. (( (car a) (car b))) (defun buffer-timer-munge-sort-by-name (a b) (string-lessp (cadr a) (cadr b))) (defun buffer-timer-display-munge-results (master indent depth) (let ((sorted (cond ((eq buffer-timer-summarize-sort-by 'time) (sort master 'buffer-timer-munge-sort-by-seconds)) ((eq buffer-timer-summarize-sort-by 'name) (sort master 'buffer-timer-munge-sort-by-name))))) (while sorted (let ((ourstart (point)) ;ext1 ext2 ) (if (and buffer-timer-munge-dont-show-zeros (not (eq 0 (caar sorted)))) (progn (insert (format "%s %-30s %10s %d\n" indent (cadar sorted) (buffer-timer-time-string (caar sorted)) (caar sorted))) (if (and (listp (cddar sorted)) (stringp (caddar sorted))) (let ((startpt (point)) (startlist (cdddar sorted))) (while startlist (insert (format " %s %-30s %10s %d\n" indent (car startlist) (buffer-timer-time-string (second startlist)) (second startlist))) (setq startlist (cddr startlist))) ; (setq ext1 (make-extent ourstart startpt)) ; (setq ext2 (make-extent startpt (1- (point)))) (let ((newext (make-extent ourstart startpt)) (subext (make-extent startpt (point)))) (buffer-timer-make-invis-button newext subext (> 1 depth))) )))) (if (and (listp (cddar sorted)) (listp (caddar sorted)) (integerp (car (caddar sorted)))) (let ((substart (point))) (buffer-timer-display-munge-results (cddar sorted) (concat " " indent) (1- depth)) (let ((newext (make-extent ourstart substart)) (subext (make-extent substart (point)))) (buffer-timer-make-invis-button newext subext (> 1 depth))))) ; (if (and ext1 ext2) ; (buffer-timer-make-invis-button ext1 ext2 ; (> 1 depth))) ) (setq sorted (cdr sorted))))) ;(progn ; (switch-to-buffer-other-window "*buffer-timer-results*") ; (make-local-variable 'buffer-timer-data) ; (load "/home/hardaker/.buffer-timer/timesheet-2000-12-04.el") ; (buffer-timer-munge buffer-timer-data t) ; (load "/home/hardaker/.buffer-timer/timesheet-2000-12-05.el") ; (buffer-timer-munge buffer-timer-data t) ; (load "/home/hardaker/.buffer-timer/timesheet-2000-12-06.el") ; (buffer-timer-munge buffer-timer-data t) ; (kill-local-variable 'buffer-timer-data)) (defun buffer-timer-get-days-ago (num) "return (high low) representing emacs' stupid date method for NUM days ago" (let* ((now (current-time)) (low (+ (second now) (* num 60 60 24))) (high (first now))) ;; stupid stupid time format. Who uses 16 bit machines anymore? (while ( low 65535) (setq low (- low 65536)) (setq high (+ high 1))) (list high low))) (defun buffer-timer-munge-date-range (daychgone daychgtwo) "display info from TODAY-DAYCHGONE to TODAY-DAYCHGTWO" (interactive "nNumber of days ago marking start of range to view: \nnNumber of days ago marking end of range to view: ") (switch-to-buffer-other-window "*buffer-timer-results*") (erase-buffer) (kill-local-variable 'buffer-timer-data) (make-local-variable 'buffer-timer-data) (setq daychgone (- 0 daychgone)) (setq daychgtwo (- 0 daychgtwo)) (while (