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