forked from mirrors/org-mode
Removed some old, no longer needed files.
This commit is contained in:
parent
85ded45fcc
commit
94cc1383ef
|
@ -1,70 +0,0 @@
|
||||||
(require 'org-install)
|
|
||||||
|
|
||||||
(add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
|
|
||||||
|
|
||||||
(define-key mode-specific-map [?a] 'org-agenda)
|
|
||||||
|
|
||||||
(eval-after-load "org"
|
|
||||||
'(progn
|
|
||||||
(define-prefix-command 'org-todo-state-map)
|
|
||||||
|
|
||||||
(define-key org-mode-map "\C-cx" 'org-todo-state-map)
|
|
||||||
|
|
||||||
(define-key org-todo-state-map "x"
|
|
||||||
#'(lambda nil (interactive) (org-todo "CANCELLED")))
|
|
||||||
(define-key org-todo-state-map "d"
|
|
||||||
#'(lambda nil (interactive) (org-todo "DONE")))
|
|
||||||
(define-key org-todo-state-map "f"
|
|
||||||
#'(lambda nil (interactive) (org-todo "DEFERRED")))
|
|
||||||
(define-key org-todo-state-map "l"
|
|
||||||
#'(lambda nil (interactive) (org-todo "DELEGATED")))
|
|
||||||
(define-key org-todo-state-map "s"
|
|
||||||
#'(lambda nil (interactive) (org-todo "STARTED")))
|
|
||||||
(define-key org-todo-state-map "w"
|
|
||||||
#'(lambda nil (interactive) (org-todo "WAITING")))
|
|
||||||
|
|
||||||
(define-key org-agenda-mode-map "\C-n" 'next-line)
|
|
||||||
(define-key org-agenda-keymap "\C-n" 'next-line)
|
|
||||||
(define-key org-agenda-mode-map "\C-p" 'previous-line)
|
|
||||||
(define-key org-agenda-keymap "\C-p" 'previous-line)))
|
|
||||||
|
|
||||||
(require 'remember)
|
|
||||||
|
|
||||||
(add-hook 'remember-mode-hook 'org-remember-apply-template)
|
|
||||||
|
|
||||||
(define-key global-map [(control meta ?r)] 'remember)
|
|
||||||
|
|
||||||
(custom-set-variables
|
|
||||||
'(org-agenda-files (quote ("~/todo.org")))
|
|
||||||
'(org-default-notes-file "~/notes.org")
|
|
||||||
'(org-agenda-ndays 7)
|
|
||||||
'(org-deadline-warning-days 14)
|
|
||||||
'(org-agenda-show-all-dates t)
|
|
||||||
'(org-agenda-skip-deadline-if-done t)
|
|
||||||
'(org-agenda-skip-scheduled-if-done t)
|
|
||||||
'(org-agenda-start-on-weekday nil)
|
|
||||||
'(org-reverse-note-order t)
|
|
||||||
'(org-fast-tag-selection-single-key (quote expert))
|
|
||||||
'(org-agenda-custom-commands
|
|
||||||
(quote (("d" todo "DELEGATED" nil)
|
|
||||||
("c" todo "DONE|DEFERRED|CANCELLED" nil)
|
|
||||||
("w" todo "WAITING" nil)
|
|
||||||
("W" agenda "" ((org-agenda-ndays 21)))
|
|
||||||
("A" agenda ""
|
|
||||||
((org-agenda-skip-function
|
|
||||||
(lambda nil
|
|
||||||
(org-agenda-skip-entry-if (quote notregexp) "\\=.*\\[#A\\]")))
|
|
||||||
(org-agenda-ndays 1)
|
|
||||||
(org-agenda-overriding-header "Today's Priority #A tasks: ")))
|
|
||||||
("u" alltodo ""
|
|
||||||
((org-agenda-skip-function
|
|
||||||
(lambda nil
|
|
||||||
(org-agenda-skip-entry-if (quote scheduled) (quote deadline)
|
|
||||||
(quote regexp) "<[^>\n]+>")))
|
|
||||||
(org-agenda-overriding-header "Unscheduled TODO entries: "))))))
|
|
||||||
'(org-remember-store-without-prompt t)
|
|
||||||
'(org-remember-templates
|
|
||||||
(quote ((116 "* TODO %?\n %u" "./todo.txt" "Tasks")
|
|
||||||
(110 "* %u %?" "./notes.txt" "Notes"))))
|
|
||||||
'(remember-annotation-functions (quote (org-remember-annotation)))
|
|
||||||
'(remember-handler-functions (quote (org-remember-handler))))
|
|
|
@ -1,135 +0,0 @@
|
||||||
;; Then I don't really thing you would have to be able to customize
|
|
||||||
;; this, as there are only very few operations for which this makes
|
|
||||||
;; sense:
|
|
||||||
|
|
||||||
;; A**** Archive
|
|
||||||
;; T**** Mark TODO
|
|
||||||
;; D**** Mark DONE
|
|
||||||
;; N**** Cycle TODO to the next state
|
|
||||||
|
|
||||||
;; Can't really think of anything else.
|
|
||||||
|
|
||||||
|
|
||||||
;; I prefer configurable, because then people can use numbers. This is
|
|
||||||
;; the idea that the editor may have limited UI. I'm using a j2me based
|
|
||||||
;; editor called JPE at the moment:
|
|
||||||
;; http://my-communicator.com/s80/software/applications.php?fldAuto=556&faq=2
|
|
||||||
|
|
||||||
;; But other people may be using something like this:
|
|
||||||
;; http://www.getjar.com/products/3960/TextEditor
|
|
||||||
|
|
||||||
;; Or this which i'm currently playing with:
|
|
||||||
;; http://www.bermin.net/index.html
|
|
||||||
|
|
||||||
;; As for other things, it depends on what you want emacs to be able to
|
|
||||||
;; do with an externally changed org mode file. For me this is about
|
|
||||||
;; using org mode in an intelligent way with my mobile phone/pda. I can
|
|
||||||
;; imagine wanting to write functions like:
|
|
||||||
|
|
||||||
;; * move this huge piece of text and tables down a level
|
|
||||||
;; <* move this huge piece of text and tables up a level
|
|
||||||
;; M* ask to recategorise this heading when i open org mode
|
|
||||||
;; +* remind me about this when i open org mode so i can brain dump on it
|
|
||||||
;; in a real editor.
|
|
||||||
;; D* ask me to schedule this as an event when i open org mode.
|
|
||||||
;; O* open my mail client to send an email to this email address i just got
|
|
||||||
;; C* search bbdb for the contact details of the phone no on this line.
|
|
||||||
;; c* search ldap for the contact details of this name
|
|
||||||
;; B* open a web browser to this link i wanted to check out when i got back to my machine
|
|
||||||
;; R* remind me to look at TheseSearchTags headings when i get back to my machine.
|
|
||||||
|
|
||||||
|
|
||||||
(defcustom org-fastup-action-alist
|
|
||||||
'((?A org-archive t)
|
|
||||||
(?T (org-todo 1) nil)
|
|
||||||
(?D (org-todo (length org-todo-keywords)) nil)
|
|
||||||
(?N org-todo nil)
|
|
||||||
(?< org-promote-subtree t)
|
|
||||||
(?> org-demote-subtree t)
|
|
||||||
(?M org-set-tags nil)
|
|
||||||
(?S org-schedule t))
|
|
||||||
"List of fastupdate actions.
|
|
||||||
Each entry in this list is a list of 3 items:
|
|
||||||
|
|
||||||
- A character representing the fastupdate action
|
|
||||||
- A function or form to be executed, with cursor at beginning of headline
|
|
||||||
- A flag indicating if execution of this action should normally be confirmed."
|
|
||||||
:group 'org-fastup
|
|
||||||
:type '(repeat
|
|
||||||
(list :value (?a nil t)
|
|
||||||
(character :tag "Prefix char")
|
|
||||||
(choice
|
|
||||||
(const :tag "Archive this subtree" org-archive)
|
|
||||||
(const :tag "Make TODO" (org-todo 1))
|
|
||||||
(const :tag "Mark DONE" (org-todo (length org-todo-keywords)))
|
|
||||||
(const :tag "Cycle TODO" org-todo)
|
|
||||||
(const :tag "Promote subtree" org-promote-subtree)
|
|
||||||
(const :tag "Demote subtree" org-demote-subtree)
|
|
||||||
(const :tag "Set Tags" org-set-tags)
|
|
||||||
(const :tag "Schedule" org-schedule)
|
|
||||||
(const :tag "Set Deadline" org-schedule)
|
|
||||||
(sexp))
|
|
||||||
(boolean :tag "Confirm"))))
|
|
||||||
|
|
||||||
(defun org-fastup-check-buffer ()
|
|
||||||
"Check for and execute fastupdate actions.
|
|
||||||
This first checks if there are any fastupdate actions in the buffer.
|
|
||||||
If yes, the user is asked for a processing mode, with three possibilities
|
|
||||||
with respect to confirming actions:
|
|
||||||
|
|
||||||
Always confirm each action before executing it
|
|
||||||
Never execute all actions without prior confirmation
|
|
||||||
Maybe get only confirmation for actions that have been configured
|
|
||||||
as requiring confirmation in `org-fastup-action-alist'.
|
|
||||||
|
|
||||||
The command will then walk through the buffer, stop at each eaction
|
|
||||||
and do the right thing there."
|
|
||||||
(interactive)
|
|
||||||
(show-all) ; make everything visible
|
|
||||||
(let ((start (point-min))
|
|
||||||
;; FIXME: should I limit the regexp to match existing actions?
|
|
||||||
;; I think not, to catch typos
|
|
||||||
(re "^\\([-a-zA-Z0-9!@#$%^&+?<>]\\)\\*+")
|
|
||||||
s action confirm)
|
|
||||||
(if (not (save-excursion
|
|
||||||
(goto-char (point-min))
|
|
||||||
(re-search-forward re nil t)))
|
|
||||||
(if (interactive-p) (message "No fastupdate actions in this buffer"))
|
|
||||||
(goto-char start)
|
|
||||||
(message "Fastupdate: Confirm actions [A]lways [Maybe] [N]ever, or [Q]uit?")
|
|
||||||
(setq reaction (read-char-exclusive))
|
|
||||||
(cond
|
|
||||||
((memq reaction '(?q ?Q)) (error "Abort"))
|
|
||||||
((memq reaction '(?a ?A)) (setq cf 'always))
|
|
||||||
((memq reaction '(?m ?M)) (setq cf 'maybe))
|
|
||||||
((memq reaction '(?n ?N)) (setq cf 'never)))
|
|
||||||
(while (re-search-forward re nil t)
|
|
||||||
(goto-char (setq start (match-beginning 0)))
|
|
||||||
(setq s (match-string 1)
|
|
||||||
entry (assoc (string-to-char s) org-fastup-action-alist)
|
|
||||||
action (nth 1 entry)
|
|
||||||
confirm (nth 2 entry))
|
|
||||||
(cond
|
|
||||||
((null action)
|
|
||||||
(if (y-or-n-p "Unknown action. Remove fastupdate character? ")
|
|
||||||
(delete-region start (1+ start))
|
|
||||||
(goto-char (1+ start))))
|
|
||||||
((or (equal cf 'never)
|
|
||||||
(and (eq cf 'maybe) (not confirm))
|
|
||||||
(y-or-n-p (format "execute action [%s] " s)))
|
|
||||||
(delete-region start (1+ start))
|
|
||||||
;; FIXME: wrap the following into condition-case and
|
|
||||||
;; handle any errors in some way.
|
|
||||||
(if (symbolp action) (funcall action) (eval action))
|
|
||||||
;; FIXME: remove the sit-for
|
|
||||||
(sit-for 2))
|
|
||||||
(t
|
|
||||||
(if (y-or-n-p "Action denied. Remove fastupdate character? ")
|
|
||||||
;; Remove the character, without action.
|
|
||||||
(delete-region start (1+ start))
|
|
||||||
;; Just leave the character in and skip this location
|
|
||||||
(goto-char (1+ start)))))))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,191 +0,0 @@
|
||||||
;;; Modified picture mode with extra functions and bindings
|
|
||||||
;; BUGS: The mouse stuff does not really work reliable
|
|
||||||
|
|
||||||
;; What it really needs:
|
|
||||||
;; Picture areas should always start with ":"
|
|
||||||
;; Automatic recognize the region and use the right commands, also
|
|
||||||
;; extending the region.
|
|
||||||
|
|
||||||
;; Picture mode
|
|
||||||
;; ------------
|
|
||||||
;; Simple ASCII drawings can be made in picture-mode. You can toggle
|
|
||||||
;; picture mode with `C-c C-c' (unless you have turned it off with the
|
|
||||||
;; variable `org-enable-picture-mode'). See the picture-mode
|
|
||||||
;; documentation for details. Some additional bindings are provided by
|
|
||||||
;; org-mode:
|
|
||||||
;;
|
|
||||||
;; M-up M-7 M-8 M-9 \
|
|
||||||
;; M-left M-right M-u M-o } Draw lines in keypad-like directions
|
|
||||||
;; M-down M-j M-k M-o /
|
|
||||||
;;
|
|
||||||
;; M-- Draw line from mark to point, set mark at end.
|
|
||||||
;; S-mouse1 Freehand drawing with the mouse.
|
|
||||||
;;
|
|
||||||
(defcustom org-enable-picture-mode t
|
|
||||||
"Non-nil means, C-c C-c switches to picture mode.
|
|
||||||
When nil, this command is disabled."
|
|
||||||
:group 'org
|
|
||||||
:type 'boolean)
|
|
||||||
(defun org-edit-picture ()
|
|
||||||
"Switch to picture mode and save the value of `transient-mark-mode'.
|
|
||||||
Turn transient-mark-mode off while in picture-mode."
|
|
||||||
(interactive)
|
|
||||||
(if (not org-enable-picture-mode)
|
|
||||||
(error
|
|
||||||
"Set variable `org-enable-picture-mode' to allow picture-mode."))
|
|
||||||
;; FIXME: This is not XEmacs compatible yet
|
|
||||||
(set (make-local-variable 'org-transient-mark-mode)
|
|
||||||
transient-mark-mode)
|
|
||||||
(set (make-local-variable 'org-cursor-color)
|
|
||||||
(frame-parameter nil 'cursor-color))
|
|
||||||
(set (make-local-variable 'transient-mark-mode) nil)
|
|
||||||
(set-cursor-color "red")
|
|
||||||
(picture-mode)
|
|
||||||
(message (substitute-command-keys
|
|
||||||
"Type \\[org-picture-mode-exit] in this buffer to return it to Org mode.")))
|
|
||||||
|
|
||||||
(defun org-picture-mode-exit (&optional arg)
|
|
||||||
"Turn off picture mode and restore `transient-mark-mode'."
|
|
||||||
(interactive "P")
|
|
||||||
(if (local-variable-p 'org-transient-mark-mode)
|
|
||||||
(setq transient-mark-mode org-transient-mark-mode))
|
|
||||||
(if (local-variable-p 'org-cursor-color)
|
|
||||||
(set-cursor-color org-cursor-color))
|
|
||||||
(if (fboundp 'deactivate-mark) (deactivate-mark))
|
|
||||||
(if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region))
|
|
||||||
(picture-mode-exit))
|
|
||||||
|
|
||||||
|
|
||||||
(eval-after-load "picture"
|
|
||||||
' (progn
|
|
||||||
(define-key picture-mode-map [(meta left)] (lambda (arg) (interactive "p") (org-picture-draw 4 arg)))
|
|
||||||
(define-key picture-mode-map [(meta right)] (lambda (arg) (interactive "p") (org-picture-draw 6 arg)))
|
|
||||||
(define-key picture-mode-map [(meta up)] (lambda (arg) (interactive "p") (org-picture-draw 8 arg)))
|
|
||||||
(define-key picture-mode-map [(meta down)] (lambda (arg) (interactive "p") (org-picture-draw 2 arg)))
|
|
||||||
(define-key picture-mode-map [(meta shift left)] (lambda (arg) (interactive "p") (org-picture-draw 7 arg)))
|
|
||||||
(define-key picture-mode-map [(meta shift right)] (lambda (arg) (interactive "p") (org-picture-draw 3 arg)))
|
|
||||||
(define-key picture-mode-map [(meta shift up)] (lambda (arg) (interactive "p") (org-picture-draw 9 arg)))
|
|
||||||
(define-key picture-mode-map [(meta shift down)] (lambda (arg) (interactive "p") (org-picture-draw 1 arg)))
|
|
||||||
|
|
||||||
(define-key picture-mode-map [(meta ?j)] (lambda (arg) (interactive "p") (org-picture-draw 1 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?k)] (lambda (arg) (interactive "p") (org-picture-draw 2 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?l)] (lambda (arg) (interactive "p") (org-picture-draw 3 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?u)] (lambda (arg) (interactive "p") (org-picture-draw 4 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?o)] (lambda (arg) (interactive "p") (org-picture-draw 6 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?7)] (lambda (arg) (interactive "p") (org-picture-draw 7 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?8)] (lambda (arg) (interactive "p") (org-picture-draw 8 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?9)] (lambda (arg) (interactive "p") (org-picture-draw 9 arg)))
|
|
||||||
(define-key picture-mode-map [(meta ?-)] 'org-picture-draw-line)
|
|
||||||
(define-key picture-mode-map [mouse-2] 'org-picture-mouse-line-to-here)
|
|
||||||
(define-key picture-mode-map [mouse-1] 'org-picture-mouse-set-point)
|
|
||||||
(define-key picture-mode-map [(shift down-mouse-1)] 'org-picture-draw-with-mouse)
|
|
||||||
(define-key picture-mode-map "\C-c\C-c" 'org-picture-mode-exit)))
|
|
||||||
|
|
||||||
(defun org-picture-draw (dir arg)
|
|
||||||
"Draw ARG character into the direction given by DIR."
|
|
||||||
(cond
|
|
||||||
((equal dir 1)
|
|
||||||
(picture-movement-sw)
|
|
||||||
(setq last-command-event ?/) (picture-self-insert arg))
|
|
||||||
((equal dir 2)
|
|
||||||
(picture-movement-down)
|
|
||||||
(setq last-command-event ?|) (picture-self-insert arg))
|
|
||||||
((equal dir 3)
|
|
||||||
(picture-movement-se)
|
|
||||||
(setq last-command-event ?\\) (picture-self-insert arg))
|
|
||||||
((equal dir 4)
|
|
||||||
(picture-movement-left)
|
|
||||||
(setq last-command-event ?-) (picture-self-insert arg))
|
|
||||||
((equal dir 5))
|
|
||||||
((equal dir 6)
|
|
||||||
(picture-movement-right)
|
|
||||||
(setq last-command-event ?-) (picture-self-insert arg))
|
|
||||||
((equal dir 7)
|
|
||||||
(picture-movement-nw)
|
|
||||||
(setq last-command-event ?\\) (picture-self-insert arg))
|
|
||||||
((equal dir 8)
|
|
||||||
(picture-movement-up)
|
|
||||||
(setq last-command-event ?|) (picture-self-insert arg))
|
|
||||||
((equal dir 9)
|
|
||||||
(picture-movement-ne)
|
|
||||||
(setq last-command-event ?/) (picture-self-insert arg)))
|
|
||||||
(picture-movement-right))
|
|
||||||
|
|
||||||
(defun org-picture-draw-line (&optional beg end)
|
|
||||||
"Draw a line from mark to point."
|
|
||||||
(interactive)
|
|
||||||
(unless (and beg end)
|
|
||||||
(setq beg (mark 'force)
|
|
||||||
end (point)))
|
|
||||||
(let (x1 x2 y1 y2 n i Dx Dy dx dy char lp x y x1a y1a lastx lasty)
|
|
||||||
(goto-char beg)
|
|
||||||
(setq x1 (current-column) y1 (count-lines (point-min) (point)))
|
|
||||||
(if (bolp) (setq y1 (1+ y1)))
|
|
||||||
(goto-char end)
|
|
||||||
(setq x2 (current-column) y2 (count-lines (point-min) (point)))
|
|
||||||
(if (bolp) (setq y2 (1+ y2)))
|
|
||||||
(setq Dx (- x2 x1) Dy (- y2 y1)
|
|
||||||
n (+ (abs Dx) (abs Dy))
|
|
||||||
n (sqrt (+ (* Dx Dx) (* Dy Dy)))
|
|
||||||
n (max (abs Dx) (abs Dy))
|
|
||||||
n (max (abs Dx) (abs Dy))
|
|
||||||
dx (/ (float Dx) (float n)) dy (/ (float Dy) (float n)))
|
|
||||||
(setq x1a (floor (+ x1 (* 1. dx) .5))
|
|
||||||
y1a (floor (+ y1 (* 1. dy) .5)))
|
|
||||||
;; Do the loop
|
|
||||||
(setq i -1)
|
|
||||||
(setq lastx x1a lasty y1a)
|
|
||||||
(while (< i n)
|
|
||||||
(setq i (1+ i)
|
|
||||||
x (floor (+ x1 (* (float i) dx) .5))
|
|
||||||
y (floor (+ y1 (* (float i) dy) .5)))
|
|
||||||
(setq char (cond ((= lastx x) ?|) ((= lasty y) ?-)
|
|
||||||
((> (* (- x lastx) (- y lasty)) 0) ?\\)
|
|
||||||
(t ?/))
|
|
||||||
lastx x lasty y)
|
|
||||||
(goto-line y)
|
|
||||||
(move-to-column x t)
|
|
||||||
(setq last-command-event char)
|
|
||||||
(setq lp (point))
|
|
||||||
(picture-self-insert 1))
|
|
||||||
(goto-char lp)
|
|
||||||
(set-mark lp)))
|
|
||||||
|
|
||||||
(defun org-picture-mouse-line-to-here (ev)
|
|
||||||
"Draw a line from point to the click position."
|
|
||||||
(interactive "e")
|
|
||||||
(let* ((beg (move-marker (make-marker) (point))))
|
|
||||||
(org-picture-mouse-set-point ev)
|
|
||||||
(org-picture-draw-line beg (point))
|
|
||||||
(move-marker beg nil)))
|
|
||||||
|
|
||||||
;; Draw with the mouse
|
|
||||||
(defun org-picture-mouse-set-point (ev)
|
|
||||||
"Mouse-set-point, but force position."
|
|
||||||
(interactive "e")
|
|
||||||
(let* ((colrow (posn-col-row (event-end ev)))
|
|
||||||
(col (car colrow)) (line (cdr colrow))
|
|
||||||
(realline (1+ (+ (count-lines (point-min) (window-start)) line))))
|
|
||||||
(goto-line realline)
|
|
||||||
(while (and (eobp)
|
|
||||||
(not (> (count-lines (point-min) (point-max)) realline)))
|
|
||||||
(newline))
|
|
||||||
(goto-line realline)
|
|
||||||
(move-to-column col t)))
|
|
||||||
|
|
||||||
(defun org-picture-draw-with-mouse (ev)
|
|
||||||
"Use the mouse like a brush and paint stars where it goes."
|
|
||||||
(interactive "e")
|
|
||||||
(let (lastcr cr)
|
|
||||||
(track-mouse
|
|
||||||
(catch 'exit
|
|
||||||
(while t
|
|
||||||
(setq e (read-event))
|
|
||||||
(if (not (eq (car e) 'mouse-movement)) (throw 'exit nil))
|
|
||||||
(setq cr (posn-col-row (event-end e)))
|
|
||||||
(when (not (equal cr lastcr))
|
|
||||||
(setq lastcr cr)
|
|
||||||
(org-picture-mouse-set-point e)
|
|
||||||
(setq last-command-event ?*)
|
|
||||||
(save-excursion
|
|
||||||
(picture-self-insert 1))))))))
|
|
|
@ -1,111 +0,0 @@
|
||||||
(defun sacha/org-show-load ()
|
|
||||||
"Show my unscheduled time and free time for the day."
|
|
||||||
(interactive)
|
|
||||||
(let ((time (sacha/org-calculate-free-time
|
|
||||||
;; today
|
|
||||||
(calendar-gregorian-from-absolute (time-to-days (current-time)))
|
|
||||||
;; now
|
|
||||||
(let* ((now (decode-time))
|
|
||||||
(cur-hour (nth 2 now))
|
|
||||||
(cur-min (nth 1 now)))
|
|
||||||
(+ (* cur-hour 60) cur-min))
|
|
||||||
;; until the last time in my time grid
|
|
||||||
(let ((last (car (last (elt org-agenda-time-grid 2)))))
|
|
||||||
(+ (* (/ last 100) 60) (% last 100))))))
|
|
||||||
(message "%.1f%% load: %d minutes to be scheduled, %d minutes free, %d minutes gap\n"
|
|
||||||
(/ (car time) (* .01 (cdr time)))
|
|
||||||
(car time)
|
|
||||||
(cdr time)
|
|
||||||
(- (cdr time) (car time)))))
|
|
||||||
|
|
||||||
(defun sacha/org-agenda-load (match)
|
|
||||||
"Can be included in `org-agenda-custom-commands'."
|
|
||||||
(let ((inhibit-read-only t)
|
|
||||||
(time (sacha/org-calculate-free-time
|
|
||||||
;; today
|
|
||||||
(calendar-gregorian-from-absolute org-starting-day)
|
|
||||||
;; now if today, else start of day
|
|
||||||
(if (= org-starting-day
|
|
||||||
(time-to-days (current-time)))
|
|
||||||
(let* ((now (decode-time))
|
|
||||||
(cur-hour (nth 2 now))
|
|
||||||
(cur-min (nth 1 now)))
|
|
||||||
(+ (* cur-hour 60) cur-min))
|
|
||||||
(let ((start (car (elt org-agenda-time-grid 2))))
|
|
||||||
(+ (* (/ start 100) 60) (% start 100))))
|
|
||||||
;; until the last time in my time grid
|
|
||||||
(let ((last (car (last (elt org-agenda-time-grid 2)))))
|
|
||||||
(+ (* (/ last 100) 60) (% last 100))))))
|
|
||||||
(goto-char (point-max))
|
|
||||||
(insert (format
|
|
||||||
"%.1f%% load: %d minutes to be scheduled, %d minutes free, %d minutes gap\n"
|
|
||||||
(/ (car time) (* .01 (cdr time)))
|
|
||||||
(car time)
|
|
||||||
(cdr time)
|
|
||||||
(- (cdr time) (car time))))))
|
|
||||||
|
|
||||||
(defun sacha/org-calculate-free-time (date start-time end-of-day)
|
|
||||||
"Return a cons cell of the form (TASK-TIME . FREE-TIME) for DATE, given START-TIME and END-OF-DAY.
|
|
||||||
DATE is a list of the form (MONTH DAY YEAR).
|
|
||||||
START-TIME and END-OF-DAY are the number of minutes past midnight."
|
|
||||||
(save-window-excursion
|
|
||||||
(let ((files org-agenda-files)
|
|
||||||
(total-unscheduled 0)
|
|
||||||
(total-gap 0)
|
|
||||||
file
|
|
||||||
rtn
|
|
||||||
rtnall
|
|
||||||
entry
|
|
||||||
(last-timestamp start-time)
|
|
||||||
scheduled-entries)
|
|
||||||
(while (setq file (car files))
|
|
||||||
(catch 'nextfile
|
|
||||||
(org-check-agenda-file file)
|
|
||||||
(setq rtn (org-agenda-get-day-entries file date :scheduled :timestamp))
|
|
||||||
(setq rtnall (append rtnall rtn)))
|
|
||||||
(setq files (cdr files)))
|
|
||||||
;; For each item on the list
|
|
||||||
(while (setq entry (car rtnall))
|
|
||||||
(let ((time (get-text-property 1 'time entry)))
|
|
||||||
(cond
|
|
||||||
((and time (string-match "\\([^-]+\\)-\\([^-]+\\)" time))
|
|
||||||
(setq scheduled-entries (cons (cons
|
|
||||||
(save-match-data (appt-convert-time (match-string 1 time)))
|
|
||||||
(save-match-data (appt-convert-time (match-string 2 time))))
|
|
||||||
scheduled-entries)))
|
|
||||||
((and time
|
|
||||||
(string-match "\\([^-]+\\)\\.+" time)
|
|
||||||
(string-match "^[A-Z]+ \\(\\[#[A-Z]\\]\\)? \\([0-9]+\\)" (get-text-property 1 'txt entry)))
|
|
||||||
(setq scheduled-entries
|
|
||||||
(let ((start (and (string-match "\\([^-]+\\)\\.+" time)
|
|
||||||
(appt-convert-time (match-string 1 time)))))
|
|
||||||
(cons (cons start
|
|
||||||
(and (string-match "^[A-Z]+ \\(\\[#[A-Z]\\]\\)? \\([0-9]+\\) " (get-text-property 1 'txt entry))
|
|
||||||
(+ start (string-to-number (match-string 2 (get-text-property 1 'txt entry))))))
|
|
||||||
scheduled-entries))))
|
|
||||||
((string-match "^[A-Z]+ \\([0-9]+\\)" (get-text-property 1 'txt entry))
|
|
||||||
(setq total-unscheduled (+ (string-to-number
|
|
||||||
(match-string 1 (get-text-property 1 'txt entry)))
|
|
||||||
total-unscheduled)))))
|
|
||||||
(setq rtnall (cdr rtnall)))
|
|
||||||
;; Sort the scheduled entries by time
|
|
||||||
(setq scheduled-entries (sort scheduled-entries (lambda (a b) (< (car a) (car b)))))
|
|
||||||
|
|
||||||
(while scheduled-entries
|
|
||||||
(let ((start (car (car scheduled-entries)))
|
|
||||||
(end (cdr (car scheduled-entries))))
|
|
||||||
(cond
|
|
||||||
;; are we in the middle of this timeslot?
|
|
||||||
((and (>= last-timestamp start)
|
|
||||||
(< = last-timestamp end))
|
|
||||||
;; move timestamp later, no change to time
|
|
||||||
(setq last-timestamp end))
|
|
||||||
;; are we completely before this timeslot?
|
|
||||||
((< last-timestamp start)
|
|
||||||
;; add gap to total, skip to the end
|
|
||||||
(setq total-gap (+ (- start last-timestamp) total-gap))
|
|
||||||
(setq last-timestamp end)))
|
|
||||||
(setq scheduled-entries (cdr scheduled-entries))))
|
|
||||||
(if (< last-timestamp end-of-day)
|
|
||||||
(setq total-gap (+ (- end-of-day last-timestamp) total-gap)))
|
|
||||||
(cons total-unscheduled total-gap))))
|
|
Loading…
Reference in New Issue