org-hacks.org

   1 #+OPTIONS:    H:3 num:nil toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t TeX:t LaTeX:t skip:nil d:(HIDE) tags:not-in-toc
   2 #+STARTUP:    align fold nodlcheck hidestars oddeven lognotestate
   3 #+SEQ_TODO:   TODO(t) INPROGRESS(i) WAITING(w@) | DONE(d) CANCELED(c@)
   4 #+TAGS:       Write(w) Update(u) Fix(f) Check(c)
   5 #+TITLE:      Org ad hoc code, quick hacks and workarounds
   6 #+AUTHOR:     Worg people
   7 #+EMAIL:      bzg AT altern DOT org
   8 #+LANGUAGE:   en
   9 #+PRIORITIES: A C B
  10 #+CATEGORY:   worg
  11
  12 # This file is the default header for new Org files in Worg.  Feel free
  13 # to tailor it to your needs.
  14
  15 [[file:index.org][{Back to Worg's index}]]
  16
  17 This page is for ad hoc bits of code.  Feel free to add quick hacks and
  18 workaround.  Go crazy.
  19
  20 * Automatically add an appointment when clocking in a task
  21
  22 #+BEGIN_SRC emacs-lisp
  23 ;; Make sure you have a sensible value for `appt-message-warning-time'
  24 (defvar bzg-org-clock-in-appt-delay 100
  25   "Number of minutes for setting an appointment by clocking-in")
  26 #+END_SRC
  27
  28 This function let's you add an appointment for the current entry.
  29 This can be useful when you need a reminder.
  30
  31 #+BEGIN_SRC emacs-lisp
  32 (defun bzg-org-clock-in-add-appt (&optional n)
  33   "Add an appointment for the Org entry at point in N minutes."
  34   (interactive)
  35   (save-excursion
  36     (org-back-to-heading t)
  37     (looking-at org-complex-heading-regexp)
  38     (let* ((msg (match-string-no-properties 4))
  39            (ct-time (decode-time))
  40            (appt-min (+ (cadr ct-time)
  41                         (or n bzg-org-clock-in-appt-delay)))
  42            (appt-time ; define the time for the appointment
  43             (progn (setf (cadr ct-time) appt-min) ct-time)))
  44       (appt-add (format-time-string
  45                  "%H:%M" (apply 'encode-time appt-time)) msg)
  46       (if (interactive-p) (message "New appointment for %s" msg)))))
  47 #+END_SRC
  48
  49 You can advise =org-clock-in= so that =C-c C-x C-i= will automatically
  50 add an appointment:
  51
  52 #+BEGIN_SRC emacs-lisp
  53 (defadvice org-clock-in (after org-clock-in-add-appt activate)
  54   "Add an appointment when clocking a task in."
  55   (bzg-org-clock-in-add-appt))
  56 #+END_SRC
  57
  58 You may also want to delete the associated appointment when clocking
  59 out.  This function does this:
  60
  61 #+BEGIN_SRC emacs-lisp
  62 (defun bzg-org-clock-out-delete-appt nil
  63   "When clocking out, delete any associated appointment."
  64   (interactive)
  65   (save-excursion
  66     (org-back-to-heading t)
  67     (looking-at org-complex-heading-regexp)
  68     (let* ((msg (match-string-no-properties 4)))
  69       (setq appt-time-msg-list
  70             (delete nil
  71                     (mapcar
  72                      (lambda (appt)
  73                        (if (not (string-match (regexp-quote msg)
  74                                               (cadr appt))) appt))
  75                      appt-time-msg-list)))
  76       (appt-check))))
  77 #+END_SRC
  78
  79 And here is the advice for =org-clock-out= (=C-c C-x C-o=)
  80
  81 #+BEGIN_SRC emacs-lisp
  82 (defadvice org-clock-out (before org-clock-out-delete-appt activate)
  83   "Delete an appointment when clocking a task out."
  84   (bzg-org-clock-out-delete-appt))
  85 #+END_SRC
  86
  87 *IMPORTANT*: You can add appointment by clocking in in both an
  88 =org-mode= and an =org-agenda-mode= buffer.  But clocking out from
  89 agenda buffer with the advice above will bring an error.
  90
  91 * Use Org-mode with Screen [Andrew Hyatt]
  92
  93 "The general idea is that you start a task in which all the work will
  94 take place in a shell.  This usually is not a leaf-task for me, but
  95 usually the parent of a leaf task.  From a task in your org-file, M-x
  96 ash-org-screen will prompt for the name of a session.  Give it a name,
  97 and it will insert a link.  Open the link at any time to go the screen
  98 session containing your work!"
  99
 100 http://article.gmane.org/gmane.emacs.orgmode/5276
 101
 102 #+BEGIN_SRC emacs-lisp
 103 (require 'term)
 104
 105 (defun ash-org-goto-screen (name)
 106   "Open the screen with the specified name in the window"
 107   (interactive "MScreen name: ")
 108   (let ((screen-buffer-name (ash-org-screen-buffer-name name)))
 109     (if (member screen-buffer-name
 110                 (mapcar 'buffer-name (buffer-list)))
 111         (switch-to-buffer screen-buffer-name)
 112       (switch-to-buffer (ash-org-screen-helper name "-dr")))))
 113
 114 (defun ash-org-screen-buffer-name (name)
 115   "Returns the buffer name corresponding to the screen name given."
 116   (concat "*screen " name "*"))
 117
 118 (defun ash-org-screen-helper (name arg)
 119   ;; Pick the name of the new buffer.
 120   (let ((term-ansi-buffer-name
 121          (generate-new-buffer-name
 122           (ash-org-screen-buffer-name name))))
 123     (setq term-ansi-buffer-name
 124           (term-ansi-make-term
 125            term-ansi-buffer-name "/usr/bin/screen" nil arg name))
 126     (set-buffer term-ansi-buffer-name)
 127     (term-mode)
 128     (term-char-mode)
 129     (term-set-escape-char ?\C-x)
 130     term-ansi-buffer-name))
 131
 132 (defun ash-org-screen (name)
 133   "Start a screen session with name"
 134   (interactive "MScreen name: ")
 135   (save-excursion
 136     (ash-org-screen-helper name "-S"))
 137   (insert-string (concat "[[screen:" name "]]")))
 138
 139 ;; And don't forget to add ("screen" . "elisp:(ash-org-goto-screen
 140 ;; \"%s\")") to org-link-abbrev-alist.
 141 #+END_SRC
 142
 143 * Org Agenda + Appt + Zenity
 144
 145 Russell Adams posted this setup [[http://article.gmane.org/gmane.emacs.orgmode/5806][on the list]].  It make sure your agenda
 146 appointments are known by Emacs, and it displays warnings in a [[http://live.gnome.org/Zenity][zenity]]
 147 popup window.
 148
 149 #+BEGIN_SRC emacs-lisp
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151 ; For org appointment reminders
 152
 153 ;; Get appointments for today
 154 (defun my-org-agenda-to-appt ()
 155   (interactive)
 156   (setq appt-time-msg-list nil)
 157   (let ((org-deadline-warning-days 0))    ;; will be automatic in org 5.23
 158         (org-agenda-to-appt)))
 159
 160 ;; Run once, activate and schedule refresh
 161 (my-org-agenda-to-appt)
 162 (appt-activate t)
 163 (run-at-time "24:01" nil 'my-org-agenda-to-appt)
 164
 165 ; 5 minute warnings
 166 (setq appt-message-warning-time 15)
 167 (setq appt-display-interval 5)
 168
 169 ; Update appt each time agenda opened.
 170 (add-hook 'org-finalize-agenda-hook 'my-org-agenda-to-appt)
 171
 172 ; Setup zenify, we tell appt to use window, and replace default function
 173 (setq appt-display-format 'window)
 174 (setq appt-disp-window-function (function my-appt-disp-window))
 175
 176 (defun my-appt-disp-window (min-to-app new-time msg)
 177   (save-window-excursion (shell-command (concat
 178     "/usr/bin/zenity --info --title='Appointment' --text='"
 179     msg "' &") nil nil)))
 180 #+END_SRC
 181
 182 * Org-Mode + gnome-osd
 183
 184 Richard Riley uses gnome-osd in interaction with Org-Mode to display
 185 appointments.  You can look at the code on the [[http://www.emacswiki.org/emacs-en/OrgMode-OSD][emacswiki]].
 186
 187 * remind2org
 188
 189   From Detlef Steuer
 190
 191 http://article.gmane.org/gmane.emacs.orgmode/5073
 192
 193 :remind (http://www.roaringpenguin.com/products/remind) is a very powerful
 194 :command line calendaring program. Its features superseed the possibilities
 195 :of orgmode in the area of date specifying, so that I want to use it
 196 :combined with orgmode.
 197 :
 198 :Using the script below I'm able use remind and incorporate its output in my
 199 :agenda views.  The default of using 13 months look ahead is easily
 200 :changed. It just happens I sometimes like to look a year into the
 201 :future. :-)
 202
 203 * org-remember-anything
 204
 205 [[http://www.emacswiki.org/cgi-bin/wiki/Anything][Anything]] users may find the snippet below interesting:
 206
 207 #+BEGIN_SRC emacs-lisp
 208 (defvar org-remember-anything
 209   '((name . "Org Remember")
 210     (candidates . (lambda () (mapcar 'car org-remember-templates)))
 211     (action . (lambda (name)
 212                 (let* ((orig-template org-remember-templates)
 213                        (org-remember-templates
 214                         (list (assoc name orig-template))))
 215                   (call-interactively 'org-remember))))))
 216 #+END_SRC
 217
 218 You can add it to your 'anything-sources' variable and open remember directly
 219 from anything. I imagine this would be more interesting for people with many
 220 remember templatesm, so that you are out of keys to assign those to. You should
 221 get something like this:
 222
 223 [[file:images/thumbs/org-remember-anything.png]]
 224
 225 * Reload Org
 226
 227 This function by Bernt Hansen reloads Org's compiled files.  This is
 228 useful when you update and compile Org often.
 229
 230 By default it reloads compiled org files.  If you call it with a prefix
 231 argument it reloads source files.
 232
 233 #+BEGIN_SRC emacs-lisp
 234 ;; Your org-mode directory
 235
 236 (setq my-org-mode-git-directory "~/git/org-mode")
 237
 238 (defun org-reload-org (&optional source)
 239   "Reload Compiled Org lisp files."
 240   (interactive "p")
 241   (message "source is %s" source)
 242   (if (equal source 4)
 243       (setq my-org-files "\\.el\\'")
 244     (setq my-org-files "\\.elc\\'"))
 245   (mapc (lambda(f) (load (car f)))
 246         (directory-files-and-attributes (concat my-org-mode-git-directory "/lisp") t my-org-files)))
 247
 248 (defun org-reload-org nil
 249   "Reload Org lisp files."
 250   (interactive)
 251   (mapc (lambda(f) (load (car f)))
 252         (directory-files-and-attributes
 253           (concat my-org-mode-git-directory "/lisp") t "\\.elc\\'")))
 254 #+END_SRC
 255
 256 Normally you want to use the compiled files since they are faster. If
 257 you run into a bug and want to generate a useful backtrace for the maintainer
 258 you can reload the source files and enter debugger on error with
 259
 260 :C-u M-x org-reload-org
 261
 262 and turn on the "Enter Debugger On Error" option.  Redo the action
 263 that generates the error and cut and paste the resulting backtrace
 264 into an email.  To switch back to the compiled version just reload again with
 265
 266 :M-x org-reload-org
 267
 268 * Split horizontally for agenda
 269
 270 If you would like to split the frame into two side-by-side windows when
 271 displaying the agenda, try this hack from Jan Rehders, which uses the
 272 `toggle-window-split' from
 273
 274 http://www.emacswiki.org/cgi-bin/wiki/ToggleWindowSplit
 275
 276 #+BEGIN_SRC emacs-lisp
 277 ;; Patch org-mode to use vertical splitting
 278 (defadvice org-prepare-agenda (after org-fix-split)
 279   (toggle-window-split))
 280 (ad-activate 'org-prepare-agenda)
 281 #+END_SRC
 282 * Highlight the agenda line under cursor
 283
 284 This is useful to make sure what task you are operating on.
 285
 286 #+BEGIN_SRC emacs-lisp
 287 (add-hook 'org-agenda-mode-hook '(lambda () (hl-line-mode 1)))
 288 #+END_SRC emacs-lisp
 289
 290 Under XEmacs:
 291
 292 #+BEGIN_SRC emacs-lisp
 293 ;; hl-line seems to be only for emacs
 294 (require 'highline)
 295 (add-hook 'org-agenda-mode-hook '(lambda () (highline-mode 1)))
 296
 297 ;; highline-mode does not work straightaway in tty mode.
 298 ;; I use a black background
 299 (custom-set-faces
 300   '(highline-face ((((type tty) (class color))
 301                     (:background "white" :foreground "black")))))
 302 #+END_SRC emacs-lisp
 303
 304 * Remove time grid lines that are in an appointment
 305
 306 The agenda shows lines for the time grid.  Some people think that
 307 these lines are a distraction when there are appointments at those
 308 times.  You can get rid of the lines which coincide exactly with the
 309 beginning of an appointment.  Michael Ekstrand has written a piece of
 310 advice that also removes lines that are somewhere inside an
 311 appointment:
 312
 313 #+begin_src emacs-lisp
 314 (defun org-time-to-minutes (time)
 315   "Convert an HHMM time to minutes"
 316   (+ (* (/ time 100) 60) (% time 100)))
 317
 318 (defun org-time-from-minutes (minutes)
 319   "Convert a number of minutes to an HHMM time"
 320   (+ (* (/ minutes 60) 100) (% minutes 60)))
 321
 322 (defadvice org-agenda-add-time-grid-maybe (around mde-org-agenda-grid-tweakify
 323                                                   (list ndays todayp))
 324   (if (member 'remove-match (car org-agenda-time-grid))
 325       (flet ((extract-window
 326               (line)
 327               (let ((start (get-text-property 1 'time-of-day line))
 328                     (dur (get-text-property 1 'duration line)))
 329                 (cond
 330                  ((and start dur)
 331                   (cons start
 332                         (org-time-from-minutes
 333                          (+ dur (org-time-to-minutes start)))))
 334                  (start start)
 335                  (t nil)))))
 336         (let* ((windows (delq nil (mapcar 'extract-window list)))
 337                (org-agenda-time-grid
 338                 (list (car org-agenda-time-grid)
 339                       (cadr org-agenda-time-grid)
 340                       (remove-if
 341                        (lambda (time)
 342                          (find-if (lambda (w)
 343                                     (if (numberp w)
 344                                         (equal w time)
 345                                       (and (>= time (car w))
 346                                            (< time (cdr w)))))
 347                                   windows))
 348                        (caddr org-agenda-time-grid)))))
 349           ad-do-it))
 350     ad-do-it))
 351 (ad-activate 'org-agenda-add-time-grid-maybe)
 352 #+end_src
 353
 354 * Group task list by a property
 355
 356 This advice allows you to group a task list in Org-Mode.  To use it,
 357 set the variable =org-agenda-group-by-property= to the name of a
 358 property in the option list for a TODO or TAGS search.  The resulting
 359 agenda view will group tasks by that property prior to searching.
 360
 361 #+begin_src emacs-lisp
 362 (defvar org-agenda-group-by-property nil
 363   "Set this in org-mode agenda views to group tasks by property")
 364
 365 (defun org-group-bucket-items (prop items)
 366   (let ((buckets ()))
 367     (dolist (item items)
 368       (let* ((marker (get-text-property 0 'org-marker item))
 369              (pvalue (org-entry-get marker prop t))
 370              (cell (assoc pvalue buckets)))
 371         (if cell
 372             (setcdr cell (cons item (cdr cell)))
 373           (setq buckets (cons (cons pvalue (list item))
 374                               buckets)))))
 375     (setq buckets (mapcar (lambda (bucket)
 376                             (cons (car bucket)
 377                                   (reverse (cdr bucket))))
 378                           buckets))
 379     (sort buckets (lambda (i1 i2)
 380                     (string< (car i1) (car i2))))))
 381
 382 (defadvice org-finalize-agenda-entries (around org-group-agenda-finalize
 383                                                (list &optional nosort))
 384   "Prepare bucketed agenda entry lists"
 385   (if org-agenda-group-by-property
 386       ;; bucketed, handle appropriately
 387       (let ((text ""))
 388         (dolist (bucket (org-group-bucket-items
 389                          org-agenda-group-by-property
 390                          list))
 391           (let ((header (concat "Property "
 392                                 org-agenda-group-by-property
 393                                 " is "
 394                                 (or (car bucket) "<nil>") ":\n")))
 395             (add-text-properties 0 (1- (length header))
 396                                  (list 'face 'org-agenda-structure)
 397                                  header)
 398             (setq text
 399                   (concat text header
 400                           ;; recursively process
 401                           (let ((org-agenda-group-by-property nil))
 402                             (org-finalize-agenda-entries
 403                              (cdr bucket) nosort))
 404                           "\n\n"))))
 405         (setq ad-return-value text))
 406     ad-do-it))
 407 (ad-activate 'org-finalize-agenda-entries)
 408 #+end_src
 409 * Link to Gnus messages by Message-Id
 410
 411 In a [[http://thread.gmane.org/gmane.emacs.orgmode/8860][recent thread]] on the Org-Mode mailing list, there was some
 412 discussion about linking to Gnus messages without encoding the folder
 413 name in the link.  The following code hooks in to the store-link
 414 function in Gnus to capture links by Message-Id when in nnml folders,
 415 and then provides a link type "mid" which can open this link.  The
 416 =mde-org-gnus-open-message-link= function uses the
 417 =mde-mid-resolve-methods= variable to determine what Gnus backends to
 418 scan.  It will go through them, in order, asking each to locate the
 419 message and opening it from the first one that reports success.
 420
 421 It has only been tested with a single nnml backend, so there may be
 422 bugs lurking here and there.
 423
 424 The logic for finding the message was adapted from [[http://www.emacswiki.org/cgi-bin/wiki/FindMailByMessageId][an Emacs Wiki
 425 article]].
 426
 427 #+begin_src emacs-lisp
 428 ;; Support for saving Gnus messages by Message-ID
 429 (defun mde-org-gnus-save-by-mid ()
 430   (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
 431     (when (eq major-mode 'gnus-article-mode)
 432       (gnus-article-show-summary))
 433     (let* ((group gnus-newsgroup-name)
 434            (method (gnus-find-method-for-group group)))
 435       (when (eq 'nnml (car method))
 436         (let* ((article (gnus-summary-article-number))
 437                (header (gnus-summary-article-header article))
 438                (from (mail-header-from header))
 439                (message-id
 440                 (save-match-data
 441                   (let ((mid (mail-header-id header)))
 442                     (if (string-match "<\\(.*\\)>" mid)
 443                         (match-string 1 mid)
 444                       (error "Malformed message ID header %s" mid)))))
 445                (date (mail-header-date header))
 446                (subject (gnus-summary-subject-string)))
 447           (org-store-link-props :type "mid" :from from :subject subject
 448                                 :message-id message-id :group group
 449                                 :link (org-make-link "mid:" message-id))
 450           (apply 'org-store-link-props
 451                  :description (org-email-link-description)
 452                  org-store-link-plist)
 453           t)))))
 454
 455 (defvar mde-mid-resolve-methods '()
 456   "List of methods to try when resolving message ID's.  For Gnus,
 457 it is a cons of 'gnus and the select (type and name).")
 458 (setq mde-mid-resolve-methods
 459       '((gnus nnml "")))
 460
 461 (defvar mde-org-gnus-open-level 1
 462   "Level at which Gnus is started when opening a link")
 463 (defun mde-org-gnus-open-message-link (msgid)
 464   "Open a message link with Gnus"
 465   (require 'gnus)
 466   (require 'org-table)
 467   (catch 'method-found
 468     (message "[MID linker] Resolving %s" msgid)
 469     (dolist (method mde-mid-resolve-methods)
 470       (cond
 471        ((and (eq (car method) 'gnus)
 472              (eq (cadr method) 'nnml))
 473         (funcall (cdr (assq 'gnus org-link-frame-setup))
 474                  mde-org-gnus-open-level)
 475         (when gnus-other-frame-object
 476           (select-frame gnus-other-frame-object))
 477         (let* ((msg-info (nnml-find-group-number
 478                           (concat "<" msgid ">")
 479                           (cdr method)))
 480                (group (and msg-info (car msg-info)))
 481                (message (and msg-info (cdr msg-info)))
 482                (qname (and group
 483                            (if (gnus-methods-equal-p
 484                                 (cdr method)
 485                                 gnus-select-method)
 486                                group
 487                              (gnus-group-full-name group (cdr method))))))
 488           (when msg-info
 489             (gnus-summary-read-group qname nil t)
 490             (gnus-summary-goto-article message nil t))
 491           (throw 'method-found t)))
 492        (t (error "Unknown link type"))))))
 493
 494 (eval-after-load 'org-gnus
 495   '(progn
 496      (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid)
 497      (org-add-link-type "mid" 'mde-org-gnus-open-message-link)))
 498 #+end_src