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