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:      mdl AT imapmail 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 * Hacking Org: Modifying orgmode itself
  21 ** Compiling Org without make
  22    :PROPERTIES:
  23    :CUSTOM_ID: compiling-org-without-make
  24    :END:
  25
  26    This file is the result of  [[http://article.gmane.org/gmane.emacs.orgmode/15264][one of our discussions]] on the mailing list.
  27    Enhancements wellcome.
  28
  29    To use this function, adjust the variables =my/org-lisp-directory= and
  30    =my/org-compile-sources= to suite your needs.
  31
  32    #+BEGIN_SRC emacs-lisp
  33    (defvar my/org-lisp-directory "~/.emacs.d/org/lisp"
  34      "Directory where your org-mode files live.")
  35
  36    (defvar my/org-compile-sources t
  37      "If `nil', never compile org-sources. `my/compile-org' will only create
  38    the autoloads file `org-install.el' then. If `t', compile the sources, too.")
  39
  40    ;; Customize:
  41    (setq my/org-lisp-directory "~/.emacs.d/org/lisp")
  42
  43    ;; Customize:
  44    (setq  my/org-compile-sources t)
  45
  46    (defun my/compile-org(&optional directory)
  47      "Compile all *.el files that come with org-mode."
  48      (interactive)
  49      (setq directory (concat
  50                         (file-truename
  51                        (or directory my/org-lisp-directory)) "/"))
  52
  53      (add-to-list 'load-path directory)
  54
  55      (let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
  56
  57        ;; create the org-install file
  58        (require 'autoload)
  59        (setq esf/org-install-file (concat directory "org-install.el"))
  60        (find-file esf/org-install-file)
  61        (erase-buffer)
  62        (mapc (lambda (x)
  63                (generate-file-autoloads x))
  64              list-of-org-files)
  65        (insert "\n(provide (quote org-install))\n")
  66        (save-buffer)
  67        (kill-buffer)
  68        (byte-compile-file esf/org-install-file t)
  69
  70        (dolist (f list-of-org-files)
  71          (if (file-exists-p (concat f "c")) ; delete compiled files
  72              (delete-file (concat f "c")))
  73          (if my/org-compile-sources     ; Compile, if `my/org-compile-sources' is t
  74              (byte-compile-file f)))))
  75    #+END_SRC
  76 ** Reload Org
  77
  78 As of Org version 6.23b (released Sunday Feb 22, 2009) there is a new
  79 function to reload org files.
  80
  81 Normally you want to use the compiled files since they are faster.
  82 If you update your org files you can easily reload them with
  83
  84 : M-x org-reload
  85
  86 If you run into a bug and want to generate a useful backtrace you can
  87 reload the source files instead of the compiled files with
  88
  89 : C-u M-x org-reload
  90
  91 and turn on the "Enter Debugger On Error" option.  Redo the action
  92 that generates the error and cut and paste the resulting backtrace.
  93 To switch back to the compiled version just reload again with
  94
  95 : M-x org-reload
  96
  97 ** Speed Commands
  98    Speed commands are described [[http://orgmode.org/manual/Speed-keys.html#Speed-keys][here]] in the manual. Add your own speed
  99    commands here.
 100 *** Show next/prev heading tidily
 101    - Dan Davison
 102      These close the current heading and open the next/previous heading.
 103
 104 #+begin_src emacs-lisp
 105 (defun ded/org-show-next-heading-tidily ()
 106   "Show next entry, keeping other entries closed."
 107   (if (save-excursion (end-of-line) (outline-invisible-p))
 108       (progn (org-show-entry) (show-children))
 109     (outline-next-heading)
 110     (unless (and (bolp) (org-on-heading-p))
 111       (org-up-heading-safe)
 112       (hide-subtree)
 113       (error "Boundary reached"))
 114     (org-overview)
 115     (org-reveal t)
 116     (org-show-entry)
 117     (show-children)))
 118
 119 (defun ded/org-show-previous-heading-tidily ()
 120   "Show previous entry, keeping other entries closed."
 121   (let ((pos (point)))
 122     (outline-previous-heading)
 123     (unless (and (< (point) pos) (bolp) (org-on-heading-p))
 124       (goto-char pos)
 125       (hide-subtree)
 126       (error "Boundary reached"))
 127     (org-overview)
 128     (org-reveal t)
 129     (org-show-entry)
 130     (show-children)))
 131
 132 (setq org-use-speed-commands t)
 133 (add-to-list 'org-speed-commands-user
 134              '("n" ded/org-show-next-heading-tidily))
 135 (add-to-list 'org-speed-commands-user
 136              '("p" ded/org-show-previous-heading-tidily))
 137 #+end_src
 138
 139 ** Easy customization of TODO colors
 140   -- Ryan C. Thompson
 141
 142   Here is some code I came up with some code to make it easier to
 143   customize the colors of various TODO keywords. As long as you just
 144   want a different color and nothing else, you can customize the
 145   variable org-todo-keyword-faces and use just a string color (i.e. a
 146   string of the color name) as the face, and then org-get-todo-face
 147   will convert the color to a face, inheriting everything else from
 148   the standard org-todo face.
 149
 150   To demonstrate, I currently have org-todo-keyword-faces set to
 151
 152 #+BEGIN_SRC emacs-lisp
 153 (("IN PROGRESS" . "dark orange")
 154  ("WAITING" . "red4")
 155  ("CANCELED" . "saddle brown"))
 156 #+END_SRC emacs-lisp
 157
 158   Here's the code, in a form you can put in your =.emacs=
 159
 160 #+BEGIN_SRC emacs-lisp
 161 (eval-after-load 'org-faces
 162  '(progn
 163     (defcustom org-todo-keyword-faces nil
 164       "Faces for specific TODO keywords.
 165 This is a list of cons cells, with TODO keywords in the car and
 166 faces in the cdr.  The face can be a symbol, a color, or a
 167 property list of attributes, like (:foreground \"blue\" :weight
 168 bold :underline t)."
 169       :group 'org-faces
 170       :group 'org-todo
 171       :type '(repeat
 172               (cons
 173                (string :tag "Keyword")
 174                (choice color (sexp :tag "Face")))))))
 175
 176 (eval-after-load 'org
 177  '(progn
 178     (defun org-get-todo-face-from-color (color)
 179       "Returns a specification for a face that inherits from org-todo
 180  face and has the given color as foreground. Returns nil if
 181  color is nil."
 182       (when color
 183         `(:inherit org-warning :foreground ,color)))
 184
 185     (defun org-get-todo-face (kwd)
 186       "Get the right face for a TODO keyword KWD.
 187 If KWD is a number, get the corresponding match group."
 188       (if (numberp kwd) (setq kwd (match-string kwd)))
 189       (or (let ((face (cdr (assoc kwd org-todo-keyword-faces))))
 190             (if (stringp face)
 191                 (org-get-todo-face-from-color face)
 192               face))
 193           (and (member kwd org-done-keywords) 'org-done)
 194           'org-todo))))
 195 #+END_SRC emacs-lisp
 196
 197 ** Changelog support for org headers
 198    -- James TD Smith
 199
 200    Put the following in your =.emacs=, and =C-x 4 a= and other functions which
 201    use =add-log-current-defun= like =magit-add-log= will pick up the nearest org
 202    headline as the "current function" if you add a changelog entry from an org
 203    buffer.
 204
 205    #+BEGIN_SRC emacs-lisp
 206      (defun org-log-current-defun ()
 207        (save-excursion
 208          (org-back-to-heading)
 209          (if (looking-at org-complex-heading-regexp)
 210              (match-string 4))))
 211
 212      (add-hook 'org-mode-hook
 213                (lambda ()
 214                  (make-variable-buffer-local 'add-log-current-defun-function)
 215                  (setq add-log-current-defun-function 'org-log-current-defun)))
 216    #+END_SRC
 217
 218 ** Remove redundant tags of headlines
 219   -- David Maus
 220
 221 A small function that processes all headlines in current buffer and
 222 removes tags that are local to a headline and inherited by a parent
 223 headline or the #+FILETAGS: statement.
 224
 225 #+BEGIN_SRC emacs-lisp
 226   (defun dmj/org-remove-redundant-tags ()
 227     "Remove redundant tags of headlines in current buffer.
 228
 229   A tag is considered redundant if it is local to a headline and
 230   inherited by a parent headline."
 231     (interactive)
 232     (when (eq major-mode 'org-mode)
 233       (save-excursion
 234         (org-map-entries
 235          '(lambda ()
 236             (let ((alltags (split-string (or (org-entry-get (point) "ALLTAGS") "") ":"))
 237                   local inherited tag)
 238               (dolist (tag alltags)
 239                 (if (get-text-property 0 'inherited tag)
 240                     (push tag inherited) (push tag local)))
 241               (dolist (tag local)
 242                 (if (member tag inherited) (org-toggle-tag tag 'off)))))
 243          t nil))))
 244 #+END_SRC
 245
 246 ** Remove empty property drawers
 247
 248 David Maus proposed this:
 249
 250 #+begin_src emacs-lisp
 251 (defun dmj:org:remove-empty-propert-drawers ()
 252   "*Remove all empty property drawers in current file."
 253   (interactive)
 254   (unless (eq major-mode 'org-mode)
 255     (error "You need to turn on Org mode for this function."))
 256   (save-excursion
 257     (goto-char (point-min))
 258     (while (re-search-forward ":PROPERTIES:" nil t)
 259       (save-excursion
 260         (org-remove-empty-drawer-at "PROPERTIES" (match-beginning 0))))))
 261 #+end_src
 262
 263 ** Different org-cycle-level behavior
 264   -- Ryan Thompson
 265
 266 In recent org versions, when your point (cursor) is at the end of an
 267 empty header line (like after you first created the header), the TAB
 268 key (=org-cycle=) has a special behavior: it cycles the headline through
 269 all possible levels. However, I did not like the way it determined
 270 "all possible levels," so I rewrote the whole function, along with a
 271 couple of supporting functions.
 272
 273 The original function's definition of "all possible levels" was "every
 274 level from 1 to one more than the initial level of the current
 275 headline before you started cycling." My new definition is "every
 276 level from 1 to one more than the previous headline's level." So, if
 277 you have a headline at level 4 and you use ALT+RET to make a new
 278 headline below it, it will cycle between levels 1 and 5, inclusive.
 279
 280 The main advantage of my custom =org-cycle-level= function is that it
 281 is stateless: the next level in the cycle is determined entirely by
 282 the contents of the buffer, and not what command you executed last.
 283 This makes it more predictable, I hope.
 284
 285 #+BEGIN_SRC emacs-lisp
 286 (require 'cl)
 287
 288 (defun org-point-at-end-of-empty-headline ()
 289   "If point is at the end of an empty headline, return t, else nil."
 290   (and (looking-at "[ \t]*$")
 291        (save-excursion
 292          (beginning-of-line 1)
 293          (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp "\\)?[ \t]*")))))
 294
 295 (defun org-level-increment ()
 296   "Return the number of stars that will be added or removed at a
 297 time to headlines when structure editing, based on the value of
 298 `org-odd-levels-only'."
 299   (if org-odd-levels-only 2 1))
 300
 301 (defvar org-previous-line-level-cached nil)
 302
 303 (defun org-recalculate-previous-line-level ()
 304   "Same as `org-get-previous-line-level', but does not use cached
 305 value. It does *set* the cached value, though."
 306   (set 'org-previous-line-level-cached
 307        (let ((current-level (org-current-level))
 308              (prev-level (when (> (line-number-at-pos) 1)
 309                            (save-excursion
 310                              (previous-line)
 311                              (org-current-level)))))
 312          (cond ((null current-level) nil) ; Before first headline
 313                ((null prev-level) 0)      ; At first headline
 314                (prev-level)))))
 315
 316 (defun org-get-previous-line-level ()
 317   "Return the outline depth of the last headline before the
 318 current line. Returns 0 for the first headline in the buffer, and
 319 nil if before the first headline."
 320   ;; This calculation is quite expensive, with all the regex searching
 321   ;; and stuff. Since org-cycle-level won't change lines, we can reuse
 322   ;; the last value of this command.
 323   (or (and (eq last-command 'org-cycle-level)
 324            org-previous-line-level-cached)
 325       (org-recalculate-previous-line-level)))
 326
 327 (defun org-cycle-level ()
 328   (interactive)
 329   (let ((org-adapt-indentation nil))
 330     (when (org-point-at-end-of-empty-headline)
 331       (setq this-command 'org-cycle-level) ;Only needed for caching
 332       (let ((cur-level (org-current-level))
 333             (prev-level (org-get-previous-line-level)))
 334         (cond
 335          ;; If first headline in file, promote to top-level.
 336          ((= prev-level 0)
 337           (loop repeat (/ (- cur-level 1) (org-level-increment))
 338                 do (org-do-promote)))
 339          ;; If same level as prev, demote one.
 340          ((= prev-level cur-level)
 341           (org-do-demote))
 342          ;; If parent is top-level, promote to top level if not already.
 343          ((= prev-level 1)
 344           (loop repeat (/ (- cur-level 1) (org-level-increment))
 345                 do (org-do-promote)))
 346          ;; If top-level, return to prev-level.
 347          ((= cur-level 1)
 348           (loop repeat (/ (- prev-level 1) (org-level-increment))
 349                 do (org-do-demote)))
 350          ;; If less than prev-level, promote one.
 351          ((< cur-level prev-level)
 352           (org-do-promote))
 353          ;; If deeper than prev-level, promote until higher than
 354          ;; prev-level.
 355          ((> cur-level prev-level)
 356           (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
 357                 do (org-do-promote))))
 358         t))))
 359 #+END_SRC
 360
 361 ** Add an effort estimate on the fly when clocking in
 362
 363 You can use =org-clock-in-prepare-hook= to add an effort estimate.
 364 This way you can easily have a "tea-timer" for your tasks when they
 365 don't already have an effort estimate.
 366
 367 #+begin_src emacs-lisp
 368 (add-hook 'org-clock-in-prepare-hook
 369           'my-org-mode-ask-effort)
 370
 371 (defun my-org-mode-ask-effort ()
 372   "Ask for an effort estimate when clocking in."
 373   (unless (org-entry-get (point) "Effort")
 374     (let ((effort
 375            (completing-read
 376             "Effort: "
 377             (org-entry-get-multivalued-property (point) "Effort"))))
 378       (unless (equal effort "")
 379         (org-set-property "Effort" effort)))))
 380 #+end_src
 381
 382 Or you can use a default effort for such a timer:
 383
 384 #+begin_src emacs-lisp
 385 (add-hook 'org-clock-in-prepare-hook
 386           'my-org-mode-add-default-effort)
 387
 388 (defvar org-clock-default-effort "1:00")
 389
 390 (defun my-org-mode-add-default-effort ()
 391   "Add a default effort estimation."
 392   (unless (org-entry-get (point) "Effort")
 393     (org-set-property "Effort" org-clock-default-effort)))
 394 #+end_src
 395
 396 ** Customize the size of the frame for remember
 397
 398 #FIXME: gmane link?
 399 On emacs-orgmode, Ryan C. Thompson suggested this:
 400
 401 #+begin_quote
 402 I am using org-remember set to open a new frame when used,
 403 and the default frame size is much too large. To fix this, I have
 404 designed some advice and a custom variable to implement custom
 405 parameters for the remember frame:
 406 #+end_quote
 407
 408 #+begin_src emacs-lisp
 409   (defcustom remember-frame-alist nil
 410     "Additional frame parameters for dedicated remember frame."
 411     :type 'alist
 412     :group 'remember)
 413
 414   (defadvice remember (around remember-frame-parameters activate)
 415     "Set some frame parameters for the remember frame."
 416     (let ((default-frame-alist (append remember-frame-alist
 417                                        default-frame-alist)))
 418       ad-do-it))
 419 #+end_src
 420
 421 Setting remember-frame-alist to =((width . 80) (height . 15)))= give a
 422 reasonable size for the frame.
 423 ** Org table
 424 *** Dates computation
 425
 426 **** Question ([[http://article.gmane.org/gmane.emacs.orgmode/15692][Xin Shi]])
 427
 428 I have a table in org which stores the date, I'm wondering if there is
 429 any function to calculate the duration? For example:
 430
 431 | Start Date |   End Date | Duration |
 432 |------------+------------+----------|
 433 | 2004.08.07 | 2005.07.08 |          |
 434
 435 I tried to use B&-C&, but failed ...
 436
 437 **** Answer ([[http://article.gmane.org/gmane.emacs.orgmode/15694][Nick Dokos]])
 438
 439 Try the following:
 440
 441 | Start Date |   End Date | Duration |
 442 |------------+------------+----------|
 443 | 2004.08.07 | 2005.07.08 |      335 |
 444 :#+TBLFM: $3=(date(<$2>)-date(<$1>))
 445
 446 See this thread:
 447
 448     http://thread.gmane.org/gmane.emacs.orgmode/7741
 449
 450 as well as this post (which is really a followup on the
 451 above):
 452
 453     http://article.gmane.org/gmane.emacs.orgmode/7753
 454
 455 The problem that this last article pointed out was solved
 456 in
 457
 458     http://article.gmane.org/gmane.emacs.orgmode/8001
 459
 460 and Chris Randle's original musings are at
 461
 462     http://article.gmane.org/gmane.emacs.orgmode/6536/
 463
 464 *** Field coordinates in formulas (=@#= and =$#=)
 465
 466 -- Michael Brand
 467
 468 Following are some use cases that can be implemented with the
 469 _field coordinates in formulas_ described in the corresponding
 470 chapter in the [[http://orgmode.org/manual/References.html#References][Org manual]], available since =org-version= 6.35.
 471
 472 **** Copy a column from a remote table into a column
 473
 474 current column =$3= = remote column =$2=:
 475 : #+TBLFM: $3 = remote(FOO, @@#$2)
 476
 477 **** Copy a row from a remote table transposed into a column
 478
 479 current column =$1= = transposed remote row =@1=:
 480 : #+TBLFM: $1 = remote(FOO, @$#$@#)
 481
 482 **** Transpose a table
 483
 484 -- Michael Brand
 485
 486 This is more like a demonstration of using _field coordinates in formulas_
 487 to [[http://en.wikipedia.org/wiki/Transpose][transpose]] a table or to do it without using org-babel.  The efficient
 488 and simple solution for this with the help of org-babel and Emacs Lisp has
 489 been provided by Thomas S. Dye on the [[http://thread.gmane.org/gmane.emacs.orgmode/23809/focus=23815][mailing list]].
 490
 491 To transpose this 4x7 table
 492
 493 : #+TBLNAME: FOO
 494 : | year | 2004 | 2005 | 2006 | 2007 | 2008 | 2009 |
 495 : |------+------+------+------+------+------+------|
 496 : | min  |  401 |  501 |  601 |  701 |  801 |  901 |
 497 : | avg  |  402 |  502 |  602 |  702 |  802 |  902 |
 498 : | max  |  403 |  503 |  603 |  703 |  803 |  903 |
 499
 500 start with a 7x4 table without any horizontal line (to have filled
 501 also the column header) and yet empty:
 502
 503 : |   |   |   |   |
 504 : |   |   |   |   |
 505 : |   |   |   |   |
 506 : |   |   |   |   |
 507 : |   |   |   |   |
 508 : |   |   |   |   |
 509 : |   |   |   |   |
 510
 511 Then add the =TBLFM= below with the same formula repeated for each column.
 512 After recalculation this will end up with the transposed copy:
 513
 514 : | year | min | avg | max |
 515 : | 2004 | 401 | 402 | 403 |
 516 : | 2005 | 501 | 502 | 503 |
 517 : | 2006 | 601 | 602 | 603 |
 518 : | 2007 | 701 | 702 | 703 |
 519 : | 2008 | 801 | 802 | 803 |
 520 : | 2009 | 901 | 902 | 903 |
 521 : #+TBLFM: $1 = remote(FOO, @$#$@#) :: $2 = remote(FOO, @$#$@#) :: $3 = remote(FOO, @$#$@#) :: $4 = remote(FOO, @$#$@#)
 522
 523 The formulas simply exchange row and column numbers by taking
 524 - the absolute remote row number =@$#= from the current column number =$#=
 525 - the absolute remote column number =$@#= from the current row number =@#=
 526
 527 Possible field formulas from the remote table will have to be transferred
 528 manually.  Since there are no row formulas yet there is no need to transfer
 529 column formulas to row formulas or vice versa.
 530
 531 **** Dynamic variation of ranges
 532
 533 -- Michael Brand
 534
 535 In this example all columns next to =quote= are calculated from the column
 536 =quote= and show the average change of the time series =quote[year]=
 537 during the period of the preceding =1=, =2=, =3= or =4= years:
 538
 539 : | year | quote |   1 a |   2 a |   3 a |   4 a |
 540 : |------+-------+-------+-------+-------+-------|
 541 : | 2005 |    10 |       |       |       |       |
 542 : | 2006 |    12 | 0.200 |       |       |       |
 543 : | 2007 |    14 | 0.167 | 0.183 |       |       |
 544 : | 2008 |    16 | 0.143 | 0.155 | 0.170 |       |
 545 : | 2009 |    18 | 0.125 | 0.134 | 0.145 | 0.158 |
 546 : #+TBLFM: $3=if(@# >= $#, ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1, string("")); f3::$4=if(@# >= $#, ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1, string("")); f3::$5=if(@# >= $#, ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1, string("")); f3::$6=if(@# >= $#, ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1, string("")); f3
 547
 548 The formula is the same for each column =$3= through =$6=.  This can easily
 549 be seen with the great formula editor invoked by C-c ' on the
 550 table. The important part of the formula without the field blanking is:
 551
 552 : ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1
 553
 554 which is the Emacs Calc implementation of the equation
 555
 556 /AvgChange(i, a) = (quote[i] / quote[i - a]) ^ 1 / n - 1/
 557
 558 where /i/ is the current time and /a/ is the length of the preceding period.
 559 ** Archive in a date tree
 560
 561 Posted to Org-mode mailing list by Osamu Okano
 562 [2010-04-21 Wed]
 563
 564 #+begin_src emacs-lisp
 565   ;; (setq org-archive-location "%s_archive::date-tree")
 566   (defadvice org-archive-subtree
 567     (around org-archive-subtree-to-data-tree activate)
 568     "org-archive-subtree to date-tree"
 569     (if
 570         (string= "date-tree"
 571                  (org-extract-archive-heading
 572                   (org-get-local-archive-location)))
 573         (let* ((dct (decode-time (org-current-time)))
 574                (y (nth 5 dct))
 575                (m (nth 4 dct))
 576                (d (nth 3 dct))
 577                (this-buffer (current-buffer))
 578                (location (org-get-local-archive-location))
 579                (afile (org-extract-archive-file location))
 580                (org-archive-location
 581                 (format "%s::*** %04d-%02d-%02d %s" afile y m d
 582                         (format-time-string "%A" (encode-time 0 0 0 d m y)))))
 583           (message "afile=%s" afile)
 584           (unless afile
 585             (error "Invalid `org-archive-location'"))
 586           (save-excursion
 587             (switch-to-buffer (find-file-noselect afile))
 588             (org-datetree-find-year-create y)
 589             (org-datetree-find-month-create y m)
 590             (org-datetree-find-day-create y m d)
 591             (widen)
 592             (switch-to-buffer this-buffer))
 593           ad-do-it)
 594       ad-do-it))
 595 #+end_src
 596
 597 ** Preserve top level headings when archiving to a file
 598    - Matt Lundin
 599
 600 To preserve (somewhat) the integrity of your archive structure while
 601 archiving lower level items to a file, you can use the following
 602 defadvice:
 603
 604 #+begin_src emacs-lisp
 605   (defadvice org-archive-subtree (around my-org-archive-subtree activate)
 606     (let ((org-archive-location
 607            (if (save-excursion (org-back-to-heading)
 608                                (> (org-outline-level) 1))
 609                (concat (car (split-string org-archive-location "::"))
 610                        "::* "
 611                        (car (org-get-outline-path)))
 612              org-archive-location)))
 613       ad-do-it))
 614 #+end_src
 615
 616 Thus, if you have an outline structure such as...
 617
 618 #+begin_src org
 619   ,* Heading
 620   ,** Subheading
 621   ,*** Subsubheading
 622 #+end_src
 623
 624 ...archiving "Subsubheading" to a new file will set the location in
 625 the new file to the top level heading:
 626
 627 #+begin_src org
 628
 629   ,* Heading
 630   ,** Subsubheading
 631 #+end_src
 632
 633 While this hack obviously destroys the outline hierarchy somewhat, it
 634 at least preserves the logic of level one groupings.
 635
 636 ** Promote all items in subtree
 637    - Matt Lundin
 638
 639  This function will promote all items in a subtree. Since I use
 640  subtrees primarily to organize projects, the function is somewhat
 641  unimaginatively called my-org-un-project:
 642
 643 #+begin_src emacs-lisp
 644   (defun my-org-un-project ()
 645     (interactive)
 646     (org-map-entries 'org-do-promote "LEVEL>1" 'tree)
 647     (org-cycle t))
 648 #+end_src
 649
 650 ** Make it easier to set org-agenda-files from multiple directories
 651   - Matt Lundin
 652
 653 #+begin_src emacs-lisp
 654   (defun my-org-list-files (dirs ext)
 655     "Function to create list of org files in multiple subdirectories.
 656   This can be called to generate a list of files for
 657   org-agenda-files or org-refile-targets.
 658
 659   DIRS is a list of directories.
 660
 661   EXT is a list of the extensions of files to be included."
 662     (let ((dirs (if (listp dirs)
 663                     dirs
 664                   (list dirs)))
 665           (ext (if (listp ext)
 666                    ext
 667                  (list ext)))
 668           files)
 669       (mapc
 670        (lambda (x)
 671          (mapc
 672           (lambda (y)
 673             (setq files
 674                   (append files
 675                           (file-expand-wildcards
 676                            (concat (file-name-as-directory x) "*" y)))))
 677           ext))
 678        dirs)
 679       (mapc
 680        (lambda (x)
 681          (when (or (string-match "/.#" x)
 682                    (string-match "#$" x))
 683            (setq files (delete x files))))
 684        files)
 685       files))
 686
 687   (defvar my-org-agenda-directories '("~/org/")
 688     "List of directories containing org files.")
 689   (defvar my-org-agenda-extensions '(".org")
 690     "List of extensions of agenda files")
 691
 692   (setq my-org-agenda-directories '("~/org/" "~/work/"))
 693   (setq my-org-agenda-extensions '(".org" ".ref"))
 694
 695   (defun my-org-set-agenda-files ()
 696     (interactive)
 697     (setq org-agenda-files (my-org-list-files
 698                             my-org-agenda-directories
 699                             my-org-agenda-extensions)))
 700
 701   (my-org-set-agenda-files)
 702 #+end_src
 703
 704 The code above will set your "default" agenda files to all files
 705 ending in ".org" and ".ref" in the directories "~/org/" and "~/work/".
 706 You can change these values by setting the variables
 707 my-org-agenda-extensions and my-org-agenda-directories. The function
 708 my-org-agenda-files-by-filetag uses these two variables to determine
 709 which files to search for filetags (i.e., the larger set from which
 710 the subset will be drawn).
 711
 712 You can also easily use my-org-list-files to "mix and match"
 713 directories and extensions to generate different lists of agenda
 714 files.
 715
 716 ** Restrict org-agenda-files by filetag
 717   :PROPERTIES:
 718   :CUSTOM_ID: set-agenda-files-by-filetag
 719   :END:
 720   - Matt Lundin
 721
 722 It is often helpful to limit yourself to a subset of your agenda
 723 files. For instance, at work, you might want to see only files related
 724 to work (e.g., bugs, clientA, projectxyz, etc.). The FAQ has helpful
 725 information on filtering tasks using [[file:org-faq.org::#limit-agenda-with-tag-filtering][filetags]] and [[file:org-faq.org::#limit-agenda-with-category-match][custom agenda
 726 commands]]. These solutions, however, require reapplying a filter each
 727 time you call the agenda or writing several new custom agenda commands
 728 for each context. Another solution is to use directories for different
 729 types of tasks and to change your agenda files with a function that
 730 sets org-agenda-files to the appropriate directory. But this relies on
 731 hard and static boundaries between files.
 732
 733 The following functions allow for a more dynamic approach to selecting
 734 a subset of files based on filetags:
 735
 736 #+begin_src emacs-lisp
 737   (defun my-org-agenda-restrict-files-by-filetag (&optional tag)
 738     "Restrict org agenda files only to those containing filetag."
 739     (interactive)
 740     (let* ((tagslist (my-org-get-all-filetags))
 741            (ftag (or tag
 742                      (completing-read "Tag: "
 743                                       (mapcar 'car tagslist)))))
 744       (org-agenda-remove-restriction-lock 'noupdate)
 745       (put 'org-agenda-files 'org-restrict (cdr (assoc ftag tagslist)))
 746       (setq org-agenda-overriding-restriction 'files)))
 747
 748   (defun my-org-get-all-filetags ()
 749     "Get list of filetags from all default org-files."
 750     (let ((files org-agenda-files)
 751           tagslist x)
 752       (save-window-excursion
 753         (while (setq x (pop files))
 754           (set-buffer (find-file-noselect x))
 755           (mapc
 756            (lambda (y)
 757              (let ((tagfiles (assoc y tagslist)))
 758                (if tagfiles
 759                    (setcdr tagfiles (cons x (cdr tagfiles)))
 760                  (add-to-list 'tagslist (list y x)))))
 761            (my-org-get-filetags)))
 762         tagslist)))
 763
 764   (defun my-org-get-filetags ()
 765     "Get list of filetags for current buffer"
 766     (let ((ftags org-file-tags)
 767           x)
 768       (mapcar
 769        (lambda (x)
 770          (org-substring-no-properties x))
 771        ftags)))
 772 #+end_src
 773
 774 Calling my-org-agenda-restrict-files-by-filetag results in a prompt
 775 with all filetags in your "normal" agenda files. When you select a
 776 tag, org-agenda-files will be restricted to only those files
 777 containing the filetag. To release the restriction, type C-c C-x >
 778 (org-agenda-remove-restriction-lock).
 779
 780 ** Split horizontally for agenda
 781
 782 If you would like to split the frame into two side-by-side windows when
 783 displaying the agenda, try this hack from Jan Rehders, which uses the
 784 `toggle-window-split' from
 785
 786 http://www.emacswiki.org/cgi-bin/wiki/ToggleWindowSplit
 787
 788 #+BEGIN_SRC emacs-lisp
 789 ;; Patch org-mode to use vertical splitting
 790 (defadvice org-prepare-agenda (after org-fix-split)
 791   (toggle-window-split))
 792 (ad-activate 'org-prepare-agenda)
 793 #+END_SRC
 794
 795 ** Automatically add an appointment when clocking in a task
 796
 797 #+BEGIN_SRC emacs-lisp
 798 ;; Make sure you have a sensible value for `appt-message-warning-time'
 799 (defvar bzg-org-clock-in-appt-delay 100
 800   "Number of minutes for setting an appointment by clocking-in")
 801 #+END_SRC
 802
 803 This function let's you add an appointment for the current entry.
 804 This can be useful when you need a reminder.
 805
 806 #+BEGIN_SRC emacs-lisp
 807 (defun bzg-org-clock-in-add-appt (&optional n)
 808   "Add an appointment for the Org entry at point in N minutes."
 809   (interactive)
 810   (save-excursion
 811     (org-back-to-heading t)
 812     (looking-at org-complex-heading-regexp)
 813     (let* ((msg (match-string-no-properties 4))
 814            (ct-time (decode-time))
 815            (appt-min (+ (cadr ct-time)
 816                         (or n bzg-org-clock-in-appt-delay)))
 817            (appt-time ; define the time for the appointment
 818             (progn (setf (cadr ct-time) appt-min) ct-time)))
 819       (appt-add (format-time-string
 820                  "%H:%M" (apply 'encode-time appt-time)) msg)
 821       (if (interactive-p) (message "New appointment for %s" msg)))))
 822 #+END_SRC
 823
 824 You can advise =org-clock-in= so that =C-c C-x C-i= will automatically
 825 add an appointment:
 826
 827 #+BEGIN_SRC emacs-lisp
 828 (defadvice org-clock-in (after org-clock-in-add-appt activate)
 829   "Add an appointment when clocking a task in."
 830   (bzg-org-clock-in-add-appt))
 831 #+END_SRC
 832
 833 You may also want to delete the associated appointment when clocking
 834 out.  This function does this:
 835
 836 #+BEGIN_SRC emacs-lisp
 837 (defun bzg-org-clock-out-delete-appt nil
 838   "When clocking out, delete any associated appointment."
 839   (interactive)
 840   (save-excursion
 841     (org-back-to-heading t)
 842     (looking-at org-complex-heading-regexp)
 843     (let* ((msg (match-string-no-properties 4)))
 844       (setq appt-time-msg-list
 845             (delete nil
 846                     (mapcar
 847                      (lambda (appt)
 848                        (if (not (string-match (regexp-quote msg)
 849                                               (cadr appt))) appt))
 850                      appt-time-msg-list)))
 851       (appt-check))))
 852 #+END_SRC
 853
 854 And here is the advice for =org-clock-out= (=C-c C-x C-o=)
 855
 856 #+BEGIN_SRC emacs-lisp
 857 (defadvice org-clock-out (before org-clock-out-delete-appt activate)
 858   "Delete an appointment when clocking a task out."
 859   (bzg-org-clock-out-delete-appt))
 860 #+END_SRC
 861
 862 *IMPORTANT*: You can add appointment by clocking in in both an
 863 =org-mode= and an =org-agenda-mode= buffer.  But clocking out from
 864 agenda buffer with the advice above will bring an error.
 865 ** Highlight the agenda line under cursor
 866
 867 This is useful to make sure what task you are operating on.
 868
 869 #+BEGIN_SRC emacs-lisp
 870 (add-hook 'org-agenda-mode-hook '(lambda () (hl-line-mode 1)))
 871 #+END_SRC emacs-lisp
 872
 873 Under XEmacs:
 874
 875 #+BEGIN_SRC emacs-lisp
 876 ;; hl-line seems to be only for emacs
 877 (require 'highline)
 878 (add-hook 'org-agenda-mode-hook '(lambda () (highline-mode 1)))
 879
 880 ;; highline-mode does not work straightaway in tty mode.
 881 ;; I use a black background
 882 (custom-set-faces
 883   '(highline-face ((((type tty) (class color))
 884                     (:background "white" :foreground "black")))))
 885 #+END_SRC emacs-lisp
 886
 887 ** Remove time grid lines that are in an appointment
 888
 889 The agenda shows lines for the time grid.  Some people think that
 890 these lines are a distraction when there are appointments at those
 891 times.  You can get rid of the lines which coincide exactly with the
 892 beginning of an appointment.  Michael Ekstrand has written a piece of
 893 advice that also removes lines that are somewhere inside an
 894 appointment:
 895
 896 #+begin_src emacs-lisp
 897 (defun org-time-to-minutes (time)
 898   "Convert an HHMM time to minutes"
 899   (+ (* (/ time 100) 60) (% time 100)))
 900
 901 (defun org-time-from-minutes (minutes)
 902   "Convert a number of minutes to an HHMM time"
 903   (+ (* (/ minutes 60) 100) (% minutes 60)))
 904
 905 (defadvice org-agenda-add-time-grid-maybe (around mde-org-agenda-grid-tweakify
 906                                                   (list ndays todayp))
 907   (if (member 'remove-match (car org-agenda-time-grid))
 908       (flet ((extract-window
 909               (line)
 910               (let ((start (get-text-property 1 'time-of-day line))
 911                     (dur (get-text-property 1 'duration line)))
 912                 (cond
 913                  ((and start dur)
 914                   (cons start
 915                         (org-time-from-minutes
 916                          (+ dur (org-time-to-minutes start)))))
 917                  (start start)
 918                  (t nil)))))
 919         (let* ((windows (delq nil (mapcar 'extract-window list)))
 920                (org-agenda-time-grid
 921                 (list (car org-agenda-time-grid)
 922                       (cadr org-agenda-time-grid)
 923                       (remove-if
 924                        (lambda (time)
 925                          (find-if (lambda (w)
 926                                     (if (numberp w)
 927                                         (equal w time)
 928                                       (and (>= time (car w))
 929                                            (< time (cdr w)))))
 930                                   windows))
 931                        (caddr org-agenda-time-grid)))))
 932           ad-do-it))
 933     ad-do-it))
 934 (ad-activate 'org-agenda-add-time-grid-maybe)
 935 #+end_src
 936
 937 ** Group task list by a property
 938
 939 This advice allows you to group a task list in Org-Mode.  To use it,
 940 set the variable =org-agenda-group-by-property= to the name of a
 941 property in the option list for a TODO or TAGS search.  The resulting
 942 agenda view will group tasks by that property prior to searching.
 943
 944 #+begin_src emacs-lisp
 945 (defvar org-agenda-group-by-property nil
 946   "Set this in org-mode agenda views to group tasks by property")
 947
 948 (defun org-group-bucket-items (prop items)
 949   (let ((buckets ()))
 950     (dolist (item items)
 951       (let* ((marker (get-text-property 0 'org-marker item))
 952              (pvalue (org-entry-get marker prop t))
 953              (cell (assoc pvalue buckets)))
 954         (if cell
 955             (setcdr cell (cons item (cdr cell)))
 956           (setq buckets (cons (cons pvalue (list item))
 957                               buckets)))))
 958     (setq buckets (mapcar (lambda (bucket)
 959                             (cons (car bucket)
 960                                   (reverse (cdr bucket))))
 961                           buckets))
 962     (sort buckets (lambda (i1 i2)
 963                     (string< (car i1) (car i2))))))
 964
 965 (defadvice org-finalize-agenda-entries (around org-group-agenda-finalize
 966                                                (list &optional nosort))
 967   "Prepare bucketed agenda entry lists"
 968   (if org-agenda-group-by-property
 969       ;; bucketed, handle appropriately
 970       (let ((text ""))
 971         (dolist (bucket (org-group-bucket-items
 972                          org-agenda-group-by-property
 973                          list))
 974           (let ((header (concat "Property "
 975                                 org-agenda-group-by-property
 976                                 " is "
 977                                 (or (car bucket) "<nil>") ":\n")))
 978             (add-text-properties 0 (1- (length header))
 979                                  (list 'face 'org-agenda-structure)
 980                                  header)
 981             (setq text
 982                   (concat text header
 983                           ;; recursively process
 984                           (let ((org-agenda-group-by-property nil))
 985                             (org-finalize-agenda-entries
 986                              (cdr bucket) nosort))
 987                           "\n\n"))))
 988         (setq ad-return-value text))
 989     ad-do-it))
 990 (ad-activate 'org-finalize-agenda-entries)
 991 #+end_src
 992 ** Dynamically adjust tag position
 993 Here is a bit of code that allows you to have the tags always
 994 right-adjusted in the buffer.
 995
 996 This is useful when you have bigger window than default window-size
 997 and you dislike the aesthetics of having the tag in the middle of the
 998 line.
 999
1000 This hack solves the problem of adjusting it whenever you change the
1001 window size.
1002 Before saving it will revert the file to having the tag position be
1003 left-adjusted so that if you track your files with version control,
1004 you won't run into artificial diffs just because the window-size
1005 changed.
1006
1007 *IMPORTANT*: This is probably slow on very big files.
1008
1009 #+begin_src emacs-lisp
1010   (setq ba/org-adjust-tags-column t)
1011
1012   (defun ba/org-adjust-tags-column-reset-tags ()
1013     "In org-mode buffers it will reset tag position according to
1014   `org-tags-column'."
1015     (when (and
1016            (not (string= (buffer-name) "*Remember*"))
1017            (eql major-mode 'org-mode))
1018       (let ((b-m-p (buffer-modified-p)))
1019         (condition-case nil
1020             (save-excursion
1021               (goto-char (point-min))
1022               (command-execute 'outline-next-visible-heading)
1023               ;; disable (message) that org-set-tags generates
1024               (flet ((message (&rest ignored) nil))
1025                 (org-set-tags 1 t))
1026               (set-buffer-modified-p b-m-p))
1027           (error nil)))))
1028
1029   (defun ba/org-adjust-tags-column-now ()
1030     "Right-adjust `org-tags-column' value, then reset tag position."
1031     (set (make-local-variable 'org-tags-column)
1032          (- (- (window-width) (length org-ellipsis))))
1033     (ba/org-adjust-tags-column-reset-tags))
1034
1035   (defun ba/org-adjust-tags-column-maybe ()
1036     "If `ba/org-adjust-tags-column' is set to non-nil, adjust tags."
1037     (when ba/org-adjust-tags-column
1038       (ba/org-adjust-tags-column-now)))
1039
1040   (defun ba/org-adjust-tags-column-before-save ()
1041     "Tags need to be left-adjusted when saving."
1042     (when ba/org-adjust-tags-column
1043        (setq org-tags-column 1)
1044        (ba/org-adjust-tags-column-reset-tags)))
1045
1046   (defun ba/org-adjust-tags-column-after-save ()
1047     "Revert left-adjusted tag position done by before-save hook."
1048     (ba/org-adjust-tags-column-maybe)
1049     (set-buffer-modified-p nil))
1050
1051   ; automatically align tags on right-hand side
1052   (add-hook 'window-configuration-change-hook
1053             'ba/org-adjust-tags-column-maybe)
1054   (add-hook 'before-save-hook 'ba/org-adjust-tags-column-before-save)
1055   (add-hook 'after-save-hook 'ba/org-adjust-tags-column-after-save)
1056   (add-hook 'org-agenda-mode-hook '(lambda ()
1057                                     (setq org-agenda-tags-column (- (window-width)))))
1058
1059   ; between invoking org-refile and displaying the prompt (which
1060   ; triggers window-configuration-change-hook) tags might adjust,
1061   ; which invalidates the org-refile cache
1062   (defadvice org-refile (around org-refile-disable-adjust-tags)
1063     "Disable dynamically adjusting tags"
1064     (let ((ba/org-adjust-tags-column nil))
1065       ad-do-it))
1066   (ad-activate 'org-refile)
1067 #+end_src
1068 ** Disable vc for Org mode agenda files
1069 -- David Maus
1070
1071 Even if you use Git to track your agenda files you might not need
1072 vc-mode to be enabled for these files.
1073
1074 #+begin_src emacs-lisp
1075   (add-hook 'find-file-hook 'dmj/disable-vc-for-agenda-files-hook)
1076   (defun dmj/disable-vc-for-agenda-files-hook ()
1077     "Disable vc-mode for Org agenda files."
1078     (if (and (fboundp 'org-agenda-file-p)
1079              (org-agenda-file-p (buffer-file-name)))
1080         (remove-hook 'find-file-hook 'vc-find-file-hook)
1081       (add-hook 'find-file-hook 'vc-find-file-hook)))
1082 #+end_src
1083 * Hacking Org and Emacs: Modify how org interacts with other Emacs packages.
1084 ** org-remember-anything
1085
1086 [[http://www.emacswiki.org/cgi-bin/wiki/Anything][Anything]] users may find the snippet below interesting:
1087
1088 #+BEGIN_SRC emacs-lisp
1089 (defvar org-remember-anything
1090   '((name . "Org Remember")
1091     (candidates . (lambda () (mapcar 'car org-remember-templates)))
1092     (action . (lambda (name)
1093                 (let* ((orig-template org-remember-templates)
1094                        (org-remember-templates
1095                         (list (assoc name orig-template))))
1096                   (call-interactively 'org-remember))))))
1097 #+END_SRC
1098
1099 You can add it to your 'anything-sources' variable and open remember directly
1100 from anything. I imagine this would be more interesting for people with many
1101 remember templatesm, so that you are out of keys to assign those to. You should
1102 get something like this:
1103
1104 [[file:images/thumbs/org-remember-anything.png]]
1105
1106 ** Org-mode and saveplace.el
1107
1108 Fix a problem with saveplace.el putting you back in a folded position:
1109
1110 #+begin_src emacs-lisp
1111 (add-hook 'org-mode-hook
1112           (lambda ()
1113             (when (outline-invisible-p)
1114               (save-excursion
1115                 (outline-previous-visible-heading 1)
1116                 (org-show-subtree)))))
1117 #+end_src
1118
1119 ** Using ido-completing-read to find attachments
1120   -- Matt Lundin
1121
1122 Org-attach is great for quickly linking files to a project. But if you
1123 use org-attach extensively you might find yourself wanting to browse
1124 all the files you've attached to org headlines. This is not easy to do
1125 manually, since the directories containing the files are not human
1126 readable (i.e., they are based on automatically generated ids). Here's
1127 some code to browse those files using ido (obviously, you need to be
1128 using ido):
1129
1130 #+begin_src emacs-lisp
1131   (load-library "find-lisp")
1132
1133   ;; Adapted from http://www.emacswiki.org/emacs/RecentFiles
1134
1135   (defun my-ido-find-org-attach ()
1136     "Find files in org-attachment directory"
1137     (interactive)
1138     (let* ((enable-recursive-minibuffers t)
1139            (files (find-lisp-find-files org-attach-directory "."))
1140            (file-assoc-list
1141             (mapcar (lambda (x)
1142                       (cons (file-name-nondirectory x)
1143                             x))
1144                     files))
1145            (filename-list
1146             (remove-duplicates (mapcar #'car file-assoc-list)
1147                                :test #'string=))
1148            (filename (ido-completing-read "Org attachments: " filename-list nil t))
1149            (longname (cdr (assoc filename file-assoc-list))))
1150       (ido-set-current-directory
1151        (if (file-directory-p longname)
1152            longname
1153          (file-name-directory longname)))
1154       (setq ido-exit 'refresh
1155             ido-text-init ido-text
1156             ido-rotate-temp t)
1157       (exit-minibuffer)))
1158
1159   (add-hook 'ido-setup-hook 'ido-my-keys)
1160
1161   (defun ido-my-keys ()
1162     "Add my keybindings for ido."
1163     (define-key ido-completion-map (kbd "C-;") 'my-ido-find-org-attach))
1164 #+end_src
1165
1166 To browse your org attachments using ido fuzzy matching and/or the
1167 completion buffer, invoke ido-find-file as usual (=C-x C-f=) and then
1168 press =C-;=.
1169
1170 ** Use idle timer for automatic agenda views
1171
1172 From John Wiegley's mailing list post (March 18, 2010):
1173
1174 #+begin_quote
1175 I have the following snippet in my .emacs file, which I find very
1176 useful. Basically what it does is that if I don't touch my Emacs for 5
1177 minutes, it displays the current agenda. This keeps my tasks "always
1178 in mind" whenever I come back to Emacs after doing something else,
1179 whereas before I had a tendency to forget that it was there.
1180 #+end_quote
1181
1182   - [[http://mid.gmane.org/55590EA7-C744-44E5-909F-755F0BBE452D@gmail.com][John Wiegley: Displaying your Org agenda after idle time]]
1183
1184 #+begin_src emacs-lisp
1185 (defun jump-to-org-agenda ()
1186   (interactive)
1187   (let ((buf (get-buffer "*Org Agenda*"))
1188         wind)
1189     (if buf
1190         (if (setq wind (get-buffer-window buf))
1191             (select-window wind)
1192           (if (called-interactively-p)
1193               (progn
1194                 (select-window (display-buffer buf t t))
1195                 (org-fit-window-to-buffer)
1196                 ;; (org-agenda-redo)
1197                 )
1198             (with-selected-window (display-buffer buf)
1199               (org-fit-window-to-buffer)
1200               ;; (org-agenda-redo)
1201               )))
1202       (call-interactively 'org-agenda-list)))
1203   ;;(let ((buf (get-buffer "*Calendar*")))
1204   ;;  (unless (get-buffer-window buf)
1205   ;;    (org-agenda-goto-calendar)))
1206   )
1207
1208 (run-with-idle-timer 300 t 'jump-to-org-agenda)
1209 #+end_src
1210
1211 #+results:
1212 : [nil 0 300 0 t jump-to-org-agenda nil idle]
1213
1214 ** Link to Gnus messages by Message-Id
1215
1216 In a [[http://thread.gmane.org/gmane.emacs.orgmode/8860][recent thread]] on the Org-Mode mailing list, there was some
1217 discussion about linking to Gnus messages without encoding the folder
1218 name in the link.  The following code hooks in to the store-link
1219 function in Gnus to capture links by Message-Id when in nnml folders,
1220 and then provides a link type "mid" which can open this link.  The
1221 =mde-org-gnus-open-message-link= function uses the
1222 =mde-mid-resolve-methods= variable to determine what Gnus backends to
1223 scan.  It will go through them, in order, asking each to locate the
1224 message and opening it from the first one that reports success.
1225
1226 It has only been tested with a single nnml backend, so there may be
1227 bugs lurking here and there.
1228
1229 The logic for finding the message was adapted from [[http://www.emacswiki.org/cgi-bin/wiki/FindMailByMessageId][an Emacs Wiki
1230 article]].
1231
1232 #+begin_src emacs-lisp
1233   ;; Support for saving Gnus messages by Message-ID
1234   (defun mde-org-gnus-save-by-mid ()
1235     (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
1236       (when (eq major-mode 'gnus-article-mode)
1237         (gnus-article-show-summary))
1238       (let* ((group gnus-newsgroup-name)
1239              (method (gnus-find-method-for-group group)))
1240         (when (eq 'nnml (car method))
1241           (let* ((article (gnus-summary-article-number))
1242                  (header (gnus-summary-article-header article))
1243                  (from (mail-header-from header))
1244                  (message-id
1245                   (save-match-data
1246                     (let ((mid (mail-header-id header)))
1247                       (if (string-match "<\\(.*\\)>" mid)
1248                           (match-string 1 mid)
1249                         (error "Malformed message ID header %s" mid)))))
1250                  (date (mail-header-date header))
1251                  (subject (gnus-summary-subject-string)))
1252             (org-store-link-props :type "mid" :from from :subject subject
1253                                   :message-id message-id :group group
1254                                   :link (org-make-link "mid:" message-id))
1255             (apply 'org-store-link-props
1256                    :description (org-email-link-description)
1257                    org-store-link-plist)
1258             t)))))
1259
1260   (defvar mde-mid-resolve-methods '()
1261     "List of methods to try when resolving message ID's.  For Gnus,
1262   it is a cons of 'gnus and the select (type and name).")
1263   (setq mde-mid-resolve-methods
1264         '((gnus nnml "")))
1265
1266   (defvar mde-org-gnus-open-level 1
1267     "Level at which Gnus is started when opening a link")
1268   (defun mde-org-gnus-open-message-link (msgid)
1269     "Open a message link with Gnus"
1270     (require 'gnus)
1271     (require 'org-table)
1272     (catch 'method-found
1273       (message "[MID linker] Resolving %s" msgid)
1274       (dolist (method mde-mid-resolve-methods)
1275         (cond
1276          ((and (eq (car method) 'gnus)
1277                (eq (cadr method) 'nnml))
1278           (funcall (cdr (assq 'gnus org-link-frame-setup))
1279                    mde-org-gnus-open-level)
1280           (when gnus-other-frame-object
1281             (select-frame gnus-other-frame-object))
1282           (let* ((msg-info (nnml-find-group-number
1283                             (concat "<" msgid ">")
1284                             (cdr method)))
1285                  (group (and msg-info (car msg-info)))
1286                  (message (and msg-info (cdr msg-info)))
1287                  (qname (and group
1288                              (if (gnus-methods-equal-p
1289                                   (cdr method)
1290                                   gnus-select-method)
1291                                  group
1292                                (gnus-group-full-name group (cdr method))))))
1293             (when msg-info
1294               (gnus-summary-read-group qname nil t)
1295               (gnus-summary-goto-article message nil t))
1296             (throw 'method-found t)))
1297          (t (error "Unknown link type"))))))
1298
1299   (eval-after-load 'org-gnus
1300     '(progn
1301        (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid)
1302        (org-add-link-type "mid" 'mde-org-gnus-open-message-link)))
1303 #+end_src
1304
1305 ** Store link upon sending a message in Gnus
1306
1307 Ulf Stegemann came up with this solution (see his [[http://www.mail-archive.com/emacs-orgmode@gnu.org/msg33278.html][original message]]):
1308
1309 #+begin_src emacs-lisp
1310 (defun ulf-message-send-and-org-gnus-store-link (&optional arg)
1311   "Send message with `message-send-and-exit' and store org link to message copy.
1312 If multiple groups appear in the Gcc header, the link refers to
1313 the copy in the last group."
1314   (interactive "P")
1315     (save-excursion
1316       (save-restriction
1317         (message-narrow-to-headers)
1318         (let ((gcc (car (last
1319                          (message-unquote-tokens
1320                           (message-tokenize-header
1321                            (mail-fetch-field "gcc" nil t) " ,")))))
1322               (buf (current-buffer))
1323               (message-kill-buffer-on-exit nil)
1324               id to from subject desc link newsgroup xarchive)
1325         (message-send-and-exit arg)
1326         (or
1327          ;; gcc group found ...
1328          (and gcc
1329               (save-current-buffer
1330                 (progn (set-buffer buf)
1331                        (setq id (org-remove-angle-brackets
1332                                  (mail-fetch-field "Message-ID")))
1333                        (setq to (mail-fetch-field "To"))
1334                        (setq from (mail-fetch-field "From"))
1335                        (setq subject (mail-fetch-field "Subject"))))
1336               (org-store-link-props :type "gnus" :from from :subject subject
1337                                     :message-id id :group gcc :to to)
1338               (setq desc (org-email-link-description))
1339               (setq link (org-gnus-article-link
1340                           gcc newsgroup id xarchive))
1341               (setq org-stored-links
1342                     (cons (list link desc) org-stored-links)))
1343          ;; no gcc group found ...
1344          (message "Can not create Org link: No Gcc header found."))))))
1345
1346 (define-key message-mode-map [(control c) (control meta c)]
1347   'ulf-message-send-and-org-gnus-store-link)
1348 #+end_src
1349
1350 ** Send html messages and attachments with Wanderlust
1351   -- David Maus
1352
1353 /Note/: The module [[file:org-contrib/org-mime.org][Org-mime]] in Org's contrib directory provides
1354 similar functionality for both Wanderlust and Gnus.  The hack below is
1355 still somewhat different: It allows you to toggle sending of html
1356 messages within Wanderlust transparently.  I.e. html markup of the
1357 message body is created right before sending starts.
1358
1359 *** Send HTML message
1360
1361 Putting the code below in your .emacs adds following four functions:
1362
1363    - dmj/wl-send-html-message
1364
1365      Function that does the job: Convert everything between "--text
1366      follows this line--" and first mime entity (read: attachment) or
1367      end of buffer into html markup using `org-export-region-as-html'
1368      and replaces original body with a multipart MIME entity with the
1369      plain text version of body and the html markup version.  Thus a
1370      recipient that prefers html messages can see the html markup,
1371      recipients that prefer or depend on plain text can see the plain
1372      text.
1373
1374      Cannot be called interactively: It is hooked into SEMI's
1375      `mime-edit-translate-hook' if message should be HTML message.
1376
1377    - dmj/wl-send-html-message-draft-init
1378
1379      Cannot be called interactively: It is hooked into WL's
1380      `wl-mail-setup-hook' and provides a buffer local variable to
1381      toggle.
1382
1383    - dmj/wl-send-html-message-draft-maybe
1384
1385      Cannot be called interactively: It is hooked into WL's
1386      `wl-draft-send-hook' and hooks `dmj/wl-send-html-message' into
1387      `mime-edit-translate-hook' depending on whether HTML message is
1388      toggled on or off
1389
1390    - dmj/wl-send-html-message-toggle
1391
1392      Toggles sending of HTML message.  If toggled on, the letters
1393      "HTML" appear in the mode line.
1394
1395      Call it interactively!  Or bind it to a key in `wl-draft-mode'.
1396
1397 If you have to send HTML messages regularly you can set a global
1398 variable `dmj/wl-send-html-message-toggled-p' to the string "HTML" to
1399 toggle on sending HTML message by default.
1400
1401 The image [[http://s11.directupload.net/file/u/15851/48ru5wl3.png][here]] shows an example of how the HTML message looks like in
1402 Google's web front end.  As you can see you have the whole markup of
1403 Org at your service: *bold*, /italics/, tables, lists...
1404
1405 So even if you feel uncomfortable with sending HTML messages at least
1406 you send HTML that looks quite good.
1407
1408 #+begin_src emacs-lisp
1409   (defun dmj/wl-send-html-message ()
1410     "Send message as html message.
1411   Convert body of message to html using
1412     `org-export-region-as-html'."
1413     (require 'org)
1414     (save-excursion
1415       (let (beg end html text)
1416         (goto-char (point-min))
1417         (re-search-forward "^--text follows this line--$")
1418         ;; move to beginning of next line
1419         (beginning-of-line 2)
1420         (setq beg (point))
1421         (if (not (re-search-forward "^--\\[\\[" nil t))
1422             (setq end (point-max))
1423           ;; line up
1424           (end-of-line 0)
1425           (setq end (point)))
1426         ;; grab body
1427         (setq text (buffer-substring-no-properties beg end))
1428         ;; convert to html
1429         (with-temp-buffer
1430           (org-mode)
1431           (insert text)
1432           ;; handle signature
1433           (when (re-search-backward "^-- \n" nil t)
1434             ;; preserve link breaks in signature
1435             (insert "\n#+BEGIN_VERSE\n")
1436             (goto-char (point-max))
1437             (insert "\n#+END_VERSE\n")
1438             ;; grab html
1439             (setq html (org-export-region-as-html
1440                         (point-min) (point-max) t 'string))))
1441         (delete-region beg end)
1442         (insert
1443          (concat
1444           "--" "<<alternative>>-{\n"
1445           "--" "[[text/plain]]\n" text
1446           "--" "[[text/html]]\n"  html
1447           "--" "}-<<alternative>>\n")))))
1448
1449   (defun dmj/wl-send-html-message-toggle ()
1450     "Toggle sending of html message."
1451     (interactive)
1452     (setq dmj/wl-send-html-message-toggled-p
1453           (if dmj/wl-send-html-message-toggled-p
1454               nil "HTML"))
1455     (message "Sending html message toggled %s"
1456              (if dmj/wl-send-html-message-toggled-p
1457                  "on" "off")))
1458
1459   (defun dmj/wl-send-html-message-draft-init ()
1460     "Create buffer local settings for maybe sending html message."
1461     (unless (boundp 'dmj/wl-send-html-message-toggled-p)
1462       (setq dmj/wl-send-html-message-toggled-p nil))
1463     (make-variable-buffer-local 'dmj/wl-send-html-message-toggled-p)
1464     (add-to-list 'global-mode-string
1465                  '(:eval (if (eq major-mode 'wl-draft-mode)
1466                              dmj/wl-send-html-message-toggled-p))))
1467
1468   (defun dmj/wl-send-html-message-maybe ()
1469     "Maybe send this message as html message.
1470
1471   If buffer local variable `dmj/wl-send-html-message-toggled-p' is
1472   non-nil, add `dmj/wl-send-html-message' to
1473   `mime-edit-translate-hook'."
1474     (if dmj/wl-send-html-message-toggled-p
1475         (add-hook 'mime-edit-translate-hook 'dmj/wl-send-html-message)
1476       (remove-hook 'mime-edit-translate-hook 'dmj/wl-send-html-message)))
1477
1478   (add-hook 'wl-draft-reedit-hook 'dmj/wl-send-html-message-draft-init)
1479   (add-hook 'wl-mail-setup-hook 'dmj/wl-send-html-message-draft-init)
1480   (add-hook 'wl-draft-send-hook 'dmj/wl-send-html-message-maybe)
1481 #+end_src
1482
1483 *** Attach HTML of region or subtree
1484
1485 Instead of sending a complete HTML message you might only send parts
1486 of an Org file as HTML for the poor souls who are plagued with
1487 non-proportional fonts in their mail program that messes up pretty
1488 ASCII tables.
1489
1490 This short function does the trick: It exports region or subtree to
1491 HTML, prefixes it with a MIME entity delimiter and pushes to killring
1492 and clipboard.  If a region is active, it uses the region, the
1493 complete subtree otherwise.
1494
1495 #+begin_src emacs-lisp
1496 (defun dmj/org-export-region-as-html-attachment (beg end arg)
1497   "Export region between BEG and END as html attachment.
1498 If BEG and END are not set, use current subtree.  Region or
1499 subtree is exported to html without header and footer, prefixed
1500 with a mime entity string and pushed to clipboard and killring.
1501 When called with prefix, mime entity is not marked as
1502 attachment."
1503   (interactive "r\nP")
1504   (save-excursion
1505     (let* ((beg (if (region-active-p) (region-beginning)
1506                   (progn
1507                     (org-back-to-heading)
1508                     (point))))
1509            (end (if (region-active-p) (region-end)
1510                   (progn
1511                     (org-end-of-subtree)
1512                     (point))))
1513            (html (concat "--[[text/html"
1514                          (if arg "" "\nContent-Disposition: attachment")
1515                          "]]\n"
1516                          (org-export-region-as-html beg end t 'string))))
1517       (when (fboundp 'x-set-selection)
1518         (ignore-errors (x-set-selection 'PRIMARY html))
1519         (ignore-errors (x-set-selection 'CLIPBOARD html)))
1520       (message "html export done, pushed to kill ring and clipboard"))))
1521 #+end_src
1522
1523 *** Adopting for Gnus
1524
1525 The whole magic lies in the special strings that mark a HTML
1526 attachment.  So you might just have to find out what these special
1527 strings are in message-mode and modify the functions accordingly.
1528 * Hacking Org and external Programs.
1529 ** Use Org-mode with Screen [Andrew Hyatt]
1530
1531 "The general idea is that you start a task in which all the work will
1532 take place in a shell.  This usually is not a leaf-task for me, but
1533 usually the parent of a leaf task.  From a task in your org-file, M-x
1534 ash-org-screen will prompt for the name of a session.  Give it a name,
1535 and it will insert a link.  Open the link at any time to go the screen
1536 session containing your work!"
1537
1538 http://article.gmane.org/gmane.emacs.orgmode/5276
1539
1540 #+BEGIN_SRC emacs-lisp
1541 (require 'term)
1542
1543 (defun ash-org-goto-screen (name)
1544   "Open the screen with the specified name in the window"
1545   (interactive "MScreen name: ")
1546   (let ((screen-buffer-name (ash-org-screen-buffer-name name)))
1547     (if (member screen-buffer-name
1548                 (mapcar 'buffer-name (buffer-list)))
1549         (switch-to-buffer screen-buffer-name)
1550       (switch-to-buffer (ash-org-screen-helper name "-dr")))))
1551
1552 (defun ash-org-screen-buffer-name (name)
1553   "Returns the buffer name corresponding to the screen name given."
1554   (concat "*screen " name "*"))
1555
1556 (defun ash-org-screen-helper (name arg)
1557   ;; Pick the name of the new buffer.
1558   (let ((term-ansi-buffer-name
1559          (generate-new-buffer-name
1560           (ash-org-screen-buffer-name name))))
1561     (setq term-ansi-buffer-name
1562           (term-ansi-make-term
1563            term-ansi-buffer-name "/usr/bin/screen" nil arg name))
1564     (set-buffer term-ansi-buffer-name)
1565     (term-mode)
1566     (term-char-mode)
1567     (term-set-escape-char ?\C-x)
1568     term-ansi-buffer-name))
1569
1570 (defun ash-org-screen (name)
1571   "Start a screen session with name"
1572   (interactive "MScreen name: ")
1573   (save-excursion
1574     (ash-org-screen-helper name "-S"))
1575   (insert-string (concat "[[screen:" name "]]")))
1576
1577 ;; And don't forget to add ("screen" . "elisp:(ash-org-goto-screen
1578 ;; \"%s\")") to org-link-abbrev-alist.
1579 #+END_SRC
1580
1581 ** Org Agenda + Appt + Zenity
1582
1583 Russell Adams posted this setup [[http://article.gmane.org/gmane.emacs.orgmode/5806][on the list]].  It make sure your agenda
1584 appointments are known by Emacs, and it displays warnings in a [[http://live.gnome.org/Zenity][zenity]]
1585 popup window.
1586
1587 #+BEGIN_SRC emacs-lisp
1588 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1589 ; For org appointment reminders
1590
1591 ;; Get appointments for today
1592 (defun my-org-agenda-to-appt ()
1593   (interactive)
1594   (setq appt-time-msg-list nil)
1595   (let ((org-deadline-warning-days 0))    ;; will be automatic in org 5.23
1596         (org-agenda-to-appt)))
1597
1598 ;; Run once, activate and schedule refresh
1599 (my-org-agenda-to-appt)
1600 (appt-activate t)
1601 (run-at-time "24:01" nil 'my-org-agenda-to-appt)
1602
1603 ; 5 minute warnings
1604 (setq appt-message-warning-time 15)
1605 (setq appt-display-interval 5)
1606
1607 ; Update appt each time agenda opened.
1608 (add-hook 'org-finalize-agenda-hook 'my-org-agenda-to-appt)
1609
1610 ; Setup zenify, we tell appt to use window, and replace default function
1611 (setq appt-display-format 'window)
1612 (setq appt-disp-window-function (function my-appt-disp-window))
1613
1614 (defun my-appt-disp-window (min-to-app new-time msg)
1615   (save-window-excursion (shell-command (concat
1616     "/usr/bin/zenity --info --title='Appointment' --text='"
1617     msg "' &") nil nil)))
1618 #+END_SRC
1619
1620 ** Org-Mode + gnome-osd
1621
1622 Richard Riley uses gnome-osd in interaction with Org-Mode to display
1623 appointments.  You can look at the code on the [[http://www.emacswiki.org/emacs-en/OrgMode-OSD][emacswiki]].
1624
1625 ** remind2org
1626
1627   From Detlef Steuer
1628
1629 http://article.gmane.org/gmane.emacs.orgmode/5073
1630
1631 #+BEGIN_QUOTE
1632 Remind (http://www.roaringpenguin.com/products/remind) is a very powerful
1633 command line calendaring program. Its features superseed the possibilities
1634 of orgmode in the area of date specifying, so that I want to use it
1635 combined with orgmode.
1636
1637 Using the script below I'm able use remind and incorporate its output in my
1638 agenda views.  The default of using 13 months look ahead is easily
1639 changed. It just happens I sometimes like to look a year into the
1640 future. :-)
1641 #+END_QUOTE
1642
1643 ** Useful webjumps for conkeror
1644
1645 If you are using the [[http://conkeror.org][conkeror browser]], maybe you want to put this into
1646 your =~/.conkerorrc= file:
1647
1648 #+begin_example
1649 define_webjump("orglist", "http://search.gmane.org/?query=%s&group=gmane.emacs.orgmode");
1650 define_webjump("worg", "http://www.google.com/cse?cx=002987994228320350715%3Az4glpcrritm&ie=UTF-8&q=%s&sa=Search&siteurl=orgmode.org%2Fworg%2F");
1651 #+end_example
1652
1653 It creates two [[http://conkeror.org/Webjumps][webjumps]] for easily searching the Worg website and the
1654 Org-mode mailing list.
1655
1656 ** Use MathJax for HTML export without requiring JavaScript
1657 As of 2010-08-14, MathJax is the default method used to export math to HTML.
1658
1659 If you like the results but do not want JavaScript in the exported pages,
1660 check out [[http://www.jboecker.de/2010/08/15/staticmathjax.html][Static MathJax]], a XULRunner application which generates a static
1661 HTML file from the exported version. It can also embed all referenced fonts
1662 within the HTML file itself, so there are no dependencies to external files.
1663
1664 The download archive contains an elisp file which integrates it into the Org
1665 export process (configurable per file with a "#+StaticMathJax:" line).
1666
1667 Read README.org and the comments in org-static-mathjax.el for usage instructions.
1668 ** Search Org files using lgrep
1669
1670 Matt Lundi suggests this:
1671
1672 #+begin_src emacs-lisp
1673   (defun my-org-grep (search &optional context)
1674     "Search for word in org files.
1675
1676 Prefix argument determines number of lines."
1677     (interactive "sSearch for: \nP")
1678     (let ((grep-find-ignored-files '("#*" ".#*"))
1679           (grep-template (concat "grep <X> -i -nH "
1680                                  (when context
1681                                    (concat "-C" (number-to-string context)))
1682                                  " -e <R> <F>")))
1683       (lgrep search "*org*" "/home/matt/org/")))
1684
1685   (global-set-key (kbd "<f8>") 'my-org-grep)
1686 #+end_src
1687