fix typos in org-publish-html tutorial

[Worg.git] / org-hacks.org

#+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
#+STARTUP:    align fold nodlcheck hidestars oddeven lognotestate
#+SEQ_TODO:   TODO(t) INPROGRESS(i) WAITING(w@) | DONE(d) CANCELED(c@)
#+TAGS:       Write(w) Update(u) Fix(f) Check(c)
#+TITLE:      Org ad hoc code, quick hacks and workarounds
#+AUTHOR:     Worg people
#+EMAIL:      bzg AT altern DOT org
#+LANGUAGE:   en
#+PRIORITIES: A C B
#+CATEGORY:   worg

# This file is the default header for new Org files in Worg.  Feel free
# to tailor it to your needs.

[[file:index.org][{Back to Worg's index}]]

This page is for ad hoc bits of code.  Feel free to add quick hacks and
workaround.  Go crazy.

* Automatically add an appointment when clocking in a task

#+BEGIN_SRC emacs-lisp
;; Make sure you have a sensible value for `appt-message-warning-time'
(defvar bzg-org-clock-in-appt-delay 100
  "Number of minutes for setting an appointment by clocking-in")
#+END_SRC

This function let's you add an appointment for the current entry.
This can be useful when you need a reminder.

#+BEGIN_SRC emacs-lisp
(defun bzg-org-clock-in-add-appt (&optional n)
  "Add an appointment for the Org entry at point in N minutes."
  (interactive)
  (save-excursion
    (org-back-to-heading t)
    (looking-at org-complex-heading-regexp)
    (let* ((msg (match-string-no-properties 4))
           (ct-time (decode-time))
           (appt-min (+ (cadr ct-time)
                        (or n bzg-org-clock-in-appt-delay)))
           (appt-time ; define the time for the appointment
            (progn (setf (cadr ct-time) appt-min) ct-time)))
      (appt-add (format-time-string
                 "%H:%M" (apply 'encode-time appt-time)) msg)
      (if (interactive-p) (message "New appointment for %s" msg)))))
#+END_SRC

You can advise =org-clock-in= so that =C-c C-x C-i= will automatically
add an appointment:

#+BEGIN_SRC emacs-lisp
(defadvice org-clock-in (after org-clock-in-add-appt activate)
  "Add an appointment when clocking a task in."
  (bzg-org-clock-in-add-appt))
#+END_SRC

You may also want to delete the associated appointment when clocking
out.  This function does this:

#+BEGIN_SRC emacs-lisp
(defun bzg-org-clock-out-delete-appt nil
  "When clocking out, delete any associated appointment."
  (interactive)
  (save-excursion
    (org-back-to-heading t)
    (looking-at org-complex-heading-regexp)
    (let* ((msg (match-string-no-properties 4)))
      (setq appt-time-msg-list
            (delete nil
                    (mapcar
                     (lambda (appt)
                       (if (not (string-match (regexp-quote msg)
                                              (cadr appt))) appt))
                     appt-time-msg-list)))
      (appt-check))))
#+END_SRC

And here is the advice for =org-clock-out= (=C-c C-x C-o=)

#+BEGIN_SRC emacs-lisp
(defadvice org-clock-out (before org-clock-out-delete-appt activate)
  "Delete an appointment when clocking a task out."
  (bzg-org-clock-out-delete-appt))
#+END_SRC

*IMPORTANT*: You can add appointment by clocking in in both an
=org-mode= and an =org-agenda-mode= buffer.  But clocking out from
agenda buffer with the advice above will bring an error.

* Use Org-mode with Screen [Andrew Hyatt]

"The general idea is that you start a task in which all the work will
take place in a shell.  This usually is not a leaf-task for me, but
usually the parent of a leaf task.  From a task in your org-file, M-x
ash-org-screen will prompt for the name of a session.  Give it a name,
and it will insert a link.  Open the link at any time to go the screen
session containing your work!"

http://article.gmane.org/gmane.emacs.orgmode/5276

#+BEGIN_SRC emacs-lisp
(require 'term)

(defun ash-org-goto-screen (name)
  "Open the screen with the specified name in the window"
  (interactive "MScreen name: ")
  (let ((screen-buffer-name (ash-org-screen-buffer-name name)))
    (if (member screen-buffer-name
                (mapcar 'buffer-name (buffer-list)))
        (switch-to-buffer screen-buffer-name)
      (switch-to-buffer (ash-org-screen-helper name "-dr")))))

(defun ash-org-screen-buffer-name (name)
  "Returns the buffer name corresponding to the screen name given."
  (concat "*screen " name "*"))

(defun ash-org-screen-helper (name arg)
  ;; Pick the name of the new buffer.
  (let ((term-ansi-buffer-name
         (generate-new-buffer-name
          (ash-org-screen-buffer-name name))))
    (setq term-ansi-buffer-name
          (term-ansi-make-term
           term-ansi-buffer-name "/usr/bin/screen" nil arg name))
    (set-buffer term-ansi-buffer-name)
    (term-mode)
    (term-char-mode)
    (term-set-escape-char ?\C-x)
    term-ansi-buffer-name))

(defun ash-org-screen (name)
  "Start a screen session with name"
  (interactive "MScreen name: ")
  (save-excursion
    (ash-org-screen-helper name "-S"))
  (insert-string (concat "[[screen:" name "]]")))

;; And don't forget to add ("screen" . "elisp:(ash-org-goto-screen
;; \"%s\")") to org-link-abbrev-alist.
#+END_SRC

* Org Agenda + Appt + Zenity

Russell Adams posted this setup [[http://article.gmane.org/gmane.emacs.orgmode/5806][on the list]].  It make sure your agenda
appointments are known by Emacs, and it displays warnings in a [[http://live.gnome.org/Zenity][zenity]]
popup window.

#+BEGIN_SRC emacs-lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; For org appointment reminders

;; Get appointments for today
(defun my-org-agenda-to-appt ()
  (interactive)
  (setq appt-time-msg-list nil)
  (let ((org-deadline-warning-days 0))    ;; will be automatic in org 5.23
        (org-agenda-to-appt)))

;; Run once, activate and schedule refresh
(my-org-agenda-to-appt)
(appt-activate t)
(run-at-time "24:01" nil 'my-org-agenda-to-appt)

; 5 minute warnings
(setq appt-message-warning-time 15)
(setq appt-display-interval 5)

; Update appt each time agenda opened.
(add-hook 'org-finalize-agenda-hook 'my-org-agenda-to-appt)

; Setup zenify, we tell appt to use window, and replace default function
(setq appt-display-format 'window)
(setq appt-disp-window-function (function my-appt-disp-window))

(defun my-appt-disp-window (min-to-app new-time msg)
  (save-window-excursion (shell-command (concat
    "/usr/bin/zenity --info --title='Appointment' --text='"
    msg "' &") nil nil)))
#+END_SRC

* Org-Mode + gnome-osd

Richard Riley uses gnome-osd in interaction with Org-Mode to display
appointments.  You can look at the code on the [[http://www.emacswiki.org/emacs-en/OrgMode-OSD][emacswiki]].

* remind2org

  From Detlef Steuer

http://article.gmane.org/gmane.emacs.orgmode/5073

#+BEGIN_QUOTE
Remind (http://www.roaringpenguin.com/products/remind) is a very powerful
command line calendaring program. Its features superseed the possibilities
of orgmode in the area of date specifying, so that I want to use it
combined with orgmode.

Using the script below I'm able use remind and incorporate its output in my
agenda views.  The default of using 13 months look ahead is easily
changed. It just happens I sometimes like to look a year into the
future. :-)
#+END_QUOTE

* org-remember-anything

[[http://www.emacswiki.org/cgi-bin/wiki/Anything][Anything]] users may find the snippet below interesting:

#+BEGIN_SRC emacs-lisp
(defvar org-remember-anything
  '((name . "Org Remember")
    (candidates . (lambda () (mapcar 'car org-remember-templates)))
    (action . (lambda (name)
                (let* ((orig-template org-remember-templates)
                       (org-remember-templates
                        (list (assoc name orig-template))))
                  (call-interactively 'org-remember))))))
#+END_SRC

You can add it to your 'anything-sources' variable and open remember directly
from anything. I imagine this would be more interesting for people with many
remember templatesm, so that you are out of keys to assign those to. You should
get something like this:

[[file:images/thumbs/org-remember-anything.png]]

* Reload Org

As of Org version 6.23b (released Sunday Feb 22, 2009) there is a new
function to reload org files.

Normally you want to use the compiled files since they are faster.
If you update your org files you can easily reload them with

: M-x org-reload

If you run into a bug and want to generate a useful backtrace you can
reload the source files instead of the compiled files with

: C-u M-x org-reload

and turn on the "Enter Debugger On Error" option.  Redo the action
that generates the error and cut and paste the resulting backtrace.
To switch back to the compiled version just reload again with

: M-x org-reload

* Split horizontally for agenda

If you would like to split the frame into two side-by-side windows when
displaying the agenda, try this hack from Jan Rehders, which uses the
`toggle-window-split' from

http://www.emacswiki.org/cgi-bin/wiki/ToggleWindowSplit

#+BEGIN_SRC emacs-lisp
;; Patch org-mode to use vertical splitting
(defadvice org-prepare-agenda (after org-fix-split)
  (toggle-window-split))
(ad-activate 'org-prepare-agenda)
#+END_SRC
* Highlight the agenda line under cursor

This is useful to make sure what task you are operating on.

#+BEGIN_SRC emacs-lisp
(add-hook 'org-agenda-mode-hook '(lambda () (hl-line-mode 1)))
#+END_SRC emacs-lisp

Under XEmacs:

#+BEGIN_SRC emacs-lisp
;; hl-line seems to be only for emacs
(require 'highline)
(add-hook 'org-agenda-mode-hook '(lambda () (highline-mode 1)))

;; highline-mode does not work straightaway in tty mode.
;; I use a black background
(custom-set-faces
  '(highline-face ((((type tty) (class color))
                    (:background "white" :foreground "black")))))
#+END_SRC emacs-lisp

* Remove time grid lines that are in an appointment

The agenda shows lines for the time grid.  Some people think that
these lines are a distraction when there are appointments at those
times.  You can get rid of the lines which coincide exactly with the
beginning of an appointment.  Michael Ekstrand has written a piece of
advice that also removes lines that are somewhere inside an
appointment:

#+begin_src emacs-lisp
(defun org-time-to-minutes (time)
  "Convert an HHMM time to minutes"
  (+ (* (/ time 100) 60) (% time 100)))

(defun org-time-from-minutes (minutes)
  "Convert a number of minutes to an HHMM time"
  (+ (* (/ minutes 60) 100) (% minutes 60)))

(defadvice org-agenda-add-time-grid-maybe (around mde-org-agenda-grid-tweakify
                                                  (list ndays todayp))
  (if (member 'remove-match (car org-agenda-time-grid))
      (flet ((extract-window
              (line)
              (let ((start (get-text-property 1 'time-of-day line))
                    (dur (get-text-property 1 'duration line)))
                (cond
                 ((and start dur)
                  (cons start
                        (org-time-from-minutes
                         (+ dur (org-time-to-minutes start)))))
                 (start start)
                 (t nil)))))
        (let* ((windows (delq nil (mapcar 'extract-window list)))
               (org-agenda-time-grid
                (list (car org-agenda-time-grid)
                      (cadr org-agenda-time-grid)
                      (remove-if
                       (lambda (time)
                         (find-if (lambda (w)
                                    (if (numberp w)
                                        (equal w time)
                                      (and (>= time (car w))
                                           (< time (cdr w)))))
                                  windows))
                       (caddr org-agenda-time-grid)))))
          ad-do-it))
    ad-do-it))
(ad-activate 'org-agenda-add-time-grid-maybe)
#+end_src

* Group task list by a property

This advice allows you to group a task list in Org-Mode.  To use it,
set the variable =org-agenda-group-by-property= to the name of a
property in the option list for a TODO or TAGS search.  The resulting
agenda view will group tasks by that property prior to searching.

#+begin_src emacs-lisp
(defvar org-agenda-group-by-property nil
  "Set this in org-mode agenda views to group tasks by property")

(defun org-group-bucket-items (prop items)
  (let ((buckets ()))
    (dolist (item items)
      (let* ((marker (get-text-property 0 'org-marker item))
             (pvalue (org-entry-get marker prop t))
             (cell (assoc pvalue buckets)))
        (if cell
            (setcdr cell (cons item (cdr cell)))
          (setq buckets (cons (cons pvalue (list item))
                              buckets)))))
    (setq buckets (mapcar (lambda (bucket)
                            (cons (car bucket)
                                  (reverse (cdr bucket))))
                          buckets))
    (sort buckets (lambda (i1 i2)
                    (string< (car i1) (car i2))))))

(defadvice org-finalize-agenda-entries (around org-group-agenda-finalize
                                               (list &optional nosort))
  "Prepare bucketed agenda entry lists"
  (if org-agenda-group-by-property
      ;; bucketed, handle appropriately
      (let ((text ""))
        (dolist (bucket (org-group-bucket-items
                         org-agenda-group-by-property
                         list))
          (let ((header (concat "Property "
                                org-agenda-group-by-property
                                " is "
                                (or (car bucket) "<nil>") ":\n")))
            (add-text-properties 0 (1- (length header))
                                 (list 'face 'org-agenda-structure)
                                 header)
            (setq text
                  (concat text header
                          ;; recursively process
                          (let ((org-agenda-group-by-property nil))
                            (org-finalize-agenda-entries
                             (cdr bucket) nosort))
                          "\n\n"))))
        (setq ad-return-value text))
    ad-do-it))
(ad-activate 'org-finalize-agenda-entries)
#+end_src
* Link to Gnus messages by Message-Id

In a [[http://thread.gmane.org/gmane.emacs.orgmode/8860][recent thread]] on the Org-Mode mailing list, there was some
discussion about linking to Gnus messages without encoding the folder
name in the link.  The following code hooks in to the store-link
function in Gnus to capture links by Message-Id when in nnml folders,
and then provides a link type "mid" which can open this link.  The
=mde-org-gnus-open-message-link= function uses the
=mde-mid-resolve-methods= variable to determine what Gnus backends to
scan.  It will go through them, in order, asking each to locate the
message and opening it from the first one that reports success.

It has only been tested with a single nnml backend, so there may be
bugs lurking here and there.

The logic for finding the message was adapted from [[http://www.emacswiki.org/cgi-bin/wiki/FindMailByMessageId][an Emacs Wiki
article]].

#+begin_src emacs-lisp
;; Support for saving Gnus messages by Message-ID
(defun mde-org-gnus-save-by-mid ()
  (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
    (when (eq major-mode 'gnus-article-mode)
      (gnus-article-show-summary))
    (let* ((group gnus-newsgroup-name)
           (method (gnus-find-method-for-group group)))
      (when (eq 'nnml (car method))
        (let* ((article (gnus-summary-article-number))
               (header (gnus-summary-article-header article))
               (from (mail-header-from header))
               (message-id
                (save-match-data
                  (let ((mid (mail-header-id header)))
                    (if (string-match "<\\(.*\\)>" mid)
                        (match-string 1 mid)
                      (error "Malformed message ID header %s" mid)))))
               (date (mail-header-date header))
               (subject (gnus-summary-subject-string)))
          (org-store-link-props :type "mid" :from from :subject subject
                                :message-id message-id :group group
                                :link (org-make-link "mid:" message-id))
          (apply 'org-store-link-props
                 :description (org-email-link-description)
                 org-store-link-plist)
          t)))))

(defvar mde-mid-resolve-methods '()
  "List of methods to try when resolving message ID's.  For Gnus,
it is a cons of 'gnus and the select (type and name).")
(setq mde-mid-resolve-methods
      '((gnus nnml "")))

(defvar mde-org-gnus-open-level 1
  "Level at which Gnus is started when opening a link")
(defun mde-org-gnus-open-message-link (msgid)
  "Open a message link with Gnus"
  (require 'gnus)
  (require 'org-table)
  (catch 'method-found
    (message "[MID linker] Resolving %s" msgid)
    (dolist (method mde-mid-resolve-methods)
      (cond
       ((and (eq (car method) 'gnus)
             (eq (cadr method) 'nnml))
        (funcall (cdr (assq 'gnus org-link-frame-setup))
                 mde-org-gnus-open-level)
        (when gnus-other-frame-object
          (select-frame gnus-other-frame-object))
        (let* ((msg-info (nnml-find-group-number
                          (concat "<" msgid ">")
                          (cdr method)))
               (group (and msg-info (car msg-info)))
               (message (and msg-info (cdr msg-info)))
               (qname (and group
                           (if (gnus-methods-equal-p
                                (cdr method)
                                gnus-select-method)
                               group
                             (gnus-group-full-name group (cdr method))))))
          (when msg-info
            (gnus-summary-read-group qname nil t)
            (gnus-summary-goto-article message nil t))
          (throw 'method-found t)))
       (t (error "Unknown link type"))))))

(eval-after-load 'org-gnus
  '(progn
     (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid)
     (org-add-link-type "mid" 'mde-org-gnus-open-message-link)))
#+end_src
* Dynamically adjust tag position
Here is a bit of code that allows you to have the tags always
right-adjusted in the buffer.

This is useful when you have bigger window than default window-size
and you dislike the aesthetics of having the tag in the middle of the
line.

This hack solves the problem of adjusting it whenever you change the
window size.
Before saving it will revert the file to having the tag position be
left-adjusted so that if you track your files with version control,
you won't run into artificial diffs just because the window-size
changed.

*IMPORTANT*: This is probably slow on very big files.

#+begin_src emacs-lisp
(setq ba/org-adjust-tags-column t)

(defun ba/org-adjust-tags-column-reset-tags ()
  "In org-mode buffers it will reset tag position according to
`org-tags-column'."
  (when (and
         (not (string= (buffer-name) "*Remember*"))
         (eql major-mode 'org-mode))
    (let ((b-m-p (buffer-modified-p)))
      (condition-case nil
          (save-excursion
            (goto-char (point-min))
            (command-execute 'outline-next-visible-heading)
            ;; disable (message) that org-set-tags generates
            (flet ((message (&rest ignored) nil))
              (org-set-tags 1 t))
            (set-buffer-modified-p b-m-p))
        (error nil)))))

(defun ba/org-adjust-tags-column-now ()
  "Right-adjust `org-tags-column' value, then reset tag position."
  (set (make-local-variable 'org-tags-column)
       (- (- (window-width) (length org-ellipsis))))
  (ba/org-adjust-tags-column-reset-tags))

(defun ba/org-adjust-tags-column-maybe ()
  "If `ba/org-adjust-tags-column' is set to non-nil, adjust tags."
  (when ba/org-adjust-tags-column
    (ba/org-adjust-tags-column-now)))

(defun ba/org-adjust-tags-column-before-save ()
  "Tags need to be left-adjusted when saving."
  (when ba/org-adjust-tags-column
     (setq org-tags-column 1)
     (ba/org-adjust-tags-column-reset-tags)))

(defun ba/org-adjust-tags-column-after-save ()
  "Revert left-adjusted tag position done by before-save hook."
  (ba/org-adjust-tags-column-maybe)
  (set-buffer-modified-p nil))

; automatically align tags on right-hand side
(add-hook 'window-configuration-change-hook
          'ba/org-adjust-tags-column-maybe)
(add-hook 'before-save-hook 'ba/org-adjust-tags-column-before-save)
(add-hook 'after-save-hook 'ba/org-adjust-tags-column-after-save)
(add-hook 'org-agenda-mode-hook '(lambda ()
                                  (setq org-agenda-tags-column (- (window-width)))))
#+end_src
* Compiling Org without make
  :PROPERTIES:
  :CUSTOM_ID: compiling-org-without-make
  :END:

  This file is the result of  [[http://article.gmane.org/gmane.emacs.orgmode/15264][one of our discussions]] on the mailing list.
  Enhancements wellcome.

  To use this function, adjust the variables =my/org-lisp-directory= and
  =my/org-compile-sources= to suite your needs.

  #+BEGIN_SRC emacs-lisp
    (defvar my/org-lisp-directory "~/.emacs.d/org/lisp"
      "Directory where your org-mode files live.")

    (defvar my/org-compile-sources t
      "If `nil', never compile org-sources. `my/compile-org' will only create
    the autoloads file `org-install.el' then. If `t', compile the sources, too.")

    ;; Customize:
    (setq my/org-lisp-directory "~/.emacs.d/org/lisp")

    ;; Customize:
    (setq  my/org-compile-sources t)

    (defun my/compile-org(&optional directory)
      "Compile all *.el files that come with org-mode."
      (interactive)
      (setq directory (concat
                       (file-truename
                        (or directory my/org-lisp-directory)) "/"))

      (add-to-list 'load-path directory)

      (let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))

        ;; create the org-install file
        (require 'autoload)
        (setq esf/org-install-file (concat directory "org-install.el"))
        (find-file esf/org-install-file)
        (erase-buffer)
        (mapc (lambda (x)
                (generate-file-autoloads x))
              list-of-org-files)
        (insert "\n(provide (quote org-install))\n")
        (save-buffer)
        (kill-buffer)
        (byte-compile-file esf/org-install-file t)

        (dolist (f list-of-org-files)
          (if (file-exists-p (concat f "c")) ; delete compiled files
              (delete-file (concat f "c")))
          (if my/org-compile-sources     ; Compile, if `my/org-compile-sources' is t
              (byte-compile-file f)))))
  #+END_SRC
* Customize the size of the frame for remember

#FIXME: gmane link?
On emacs-orgmode, Ryan C. Thompson suggested this:

#+begin_quote
I am using org-remember set to open a new frame when used,
and the default frame size is much too large. To fix this, I have
designed some advice and a custom variable to implement custom
parameters for the remember frame:
#+end_quote

#+begin_src emacs-lisp
  (defcustom remember-frame-alist nil
    "Additional frame parameters for dedicated remember frame."
    :type 'alist
    :group 'remember)

  (defadvice remember (around remember-frame-parameters activate)
    "Set some frame parameters for the remember frame."
    (let ((default-frame-alist (append remember-frame-alist
                                       default-frame-alist)))
      ad-do-it))
#+end_src

Setting remember-frame-alist to =((width . 80) (height . 15)))= give a
reasonable size for the frame.


* Add an effort estimate on the fly when clocking in

You can use =org-clock-in-prepare-hook= to add an effort estimate.
This way you can easily have a "tea-timer" for your tasks when they
don't already have an effort estimate.

#+begin_src emacs-lisp
(add-hook 'org-clock-in-prepare-hook
          'my-org-mode-ask-effort)

(defun my-org-mode-ask-effort ()
  "Ask for an effort estimate when clocking in."
  (unless (org-entry-get (point) "Effort")
    (let ((effort
           (completing-read
            "Effort: "
            (org-entry-get-multivalued-property (point) "Effort"))))
      (unless (equal effort "")
        (org-set-property "Effort" effort)))))
#+end_src

Or you can use a default effort for such a timer:

#+begin_src emacs-lisp
(add-hook 'org-clock-in-prepare-hook
          'my-org-mode-add-default-effort)

(defvar org-clock-default-effort "1:00")

(defun my-org-mode-add-default-effort ()
  "Add a default effort estimation."
  (unless (org-entry-get (point) "Effort")
    (org-set-property "Effort" org-clock-default-effort)))
#+end_src
* Org table
** Dates computation

*** Question ([[http://article.gmane.org/gmane.emacs.orgmode/15692][Xin Shi]])

I have a table in org which stores the date, I'm wondering if there is
any function to calculate the duration? For example:

| Start Date |   End Date | Duration |
|------------+------------+----------|
| 2004.08.07 | 2005.07.08 |          |

I tried to use B&-C&, but failed ...

*** Answer ([[http://article.gmane.org/gmane.emacs.orgmode/15694][Nick Dokos]])

Try the following:

| Start Date |   End Date | Duration |
|------------+------------+----------|
| 2004.08.07 | 2005.07.08 |      335 |
:#+TBLFM: $3=(date(<$2>)-date(<$1>))

See this thread:

    http://thread.gmane.org/gmane.emacs.orgmode/7741

as well as this post (which is really a followup on the
above):

    http://article.gmane.org/gmane.emacs.orgmode/7753

The problem that this last article pointed out was solved
in

    http://article.gmane.org/gmane.emacs.orgmode/8001

and Chris Randle's original musings are at

    http://article.gmane.org/gmane.emacs.orgmode/6536/

** Field coordinates in formulas (=@#= and =$#=)

-- Michael Brand

Following are some use cases that can be implemented with the
_field coordinates in formulas_ described in the corresponding
chapter in the [[http://orgmode.org/manual/References.html#References][Org manual]], available since =org-version= 6.35.

*** Copy a column from a remote table into a column

current column =$3= = remote column =$2=:
: #+TBLFM: $3 = remote(FOO, @@#$2)

*** Copy a row from a remote table transposed into a column

current column =$1= = transposed remote row =@1=:
: #+TBLFM: $1 = remote(FOO, @$#$@#)

*** Transpose a table

-- Michael Brand

This is more like a demonstration of using _field coordinates in formulas_
to [[http://en.wikipedia.org/wiki/Transpose][transpose]] a table or to do it without using org-babel.  The efficient
and simple solution for this with the help of org-babel and Emacs Lisp has
been provided by Thomas S. Dye on the [[http://thread.gmane.org/gmane.emacs.orgmode/23809/focus=23815][mailing list]].

To transpose this 4x7 table

: #+TBLNAME: FOO
: | year | 2004 | 2005 | 2006 | 2007 | 2008 | 2009 |
: |------+------+------+------+------+------+------|
: | min  |  401 |  501 |  601 |  701 |  801 |  901 |
: | avg  |  402 |  502 |  602 |  702 |  802 |  902 |
: | max  |  403 |  503 |  603 |  703 |  803 |  903 |

start with a 7x4 table without any horizontal line (to have filled
also the column header) and yet empty:

: |   |   |   |   |
: |   |   |   |   |
: |   |   |   |   |
: |   |   |   |   |
: |   |   |   |   |
: |   |   |   |   |
: |   |   |   |   |

Then add the =TBLFM= below with the same formula repeated for each column.
After recalculation this will end up with the transposed copy:

: | year | min | avg | max |
: | 2004 | 401 | 402 | 403 |
: | 2005 | 501 | 502 | 503 |
: | 2006 | 601 | 602 | 603 |
: | 2007 | 701 | 702 | 703 |
: | 2008 | 801 | 802 | 803 |
: | 2009 | 901 | 902 | 903 |
: #+TBLFM: $1 = remote(FOO, @$#$@#) :: $2 = remote(FOO, @$#$@#) :: $3 = remote(FOO, @$#$@#) :: $4 = remote(FOO, @$#$@#)

The formulas simply exchange row and column numbers by taking
- the absolute remote row number =@$#= from the current column number =$#=
- the absolute remote column number =$@#= from the current row number =@#=

Possible field formulas from the remote table will have to be transferred
manually.  Since there are no row formulas yet there is no need to transfer
column formulas to row formulas or vice versa.

*** Dynamic variation of ranges

-- Michael Brand

In this example all columns next to =quote= are calculated from the column
=quote= and show the average change of the time series =quote[year]=
during the period of the preceding =1=, =2=, =3= or =4= years:

: | year | quote |   1 a |   2 a |   3 a |   4 a |
: |------+-------+-------+-------+-------+-------|
: | 2005 |    10 |       |       |       |       |
: | 2006 |    12 | 0.200 |       |       |       |
: | 2007 |    14 | 0.167 | 0.183 |       |       |
: | 2008 |    16 | 0.143 | 0.155 | 0.170 |       |
: | 2009 |    18 | 0.125 | 0.134 | 0.145 | 0.158 |
: #+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

The formula is the same for each column =$3= through =$6=.  This can easily
be seen with the great formula editor invoked by C-c ' on the
table. The important part of the formula without the field blanking is:

: ($2 / subscr(@-I$2..@+I$2, @# + 1 - $#)) ^ (1 / ($# - 2)) - 1

which is the Emacs Calc implementation of the equation

/AvgChange(i, a) = (quote[i] / quote[i - a]) ^ 1 / n - 1/

where /i/ is the current time and /a/ is the length of the preceding period.

* Org-mode and saveplace.el

Fix a problem with saveplace.el putting you back in a folded position:

#+begin_src emacs-lisp
(add-hook 'org-mode-hook
          (lambda ()
            (when (outline-invisible-p)
              (save-excursion
                (outline-previous-visible-heading 1)
                (org-show-subtree)))))
#+end_src
* Easy customization of TODO colors
  -- Ryan C. Thompson

  Here is some code I came up with some code to make it easier to
  customize the colors of various TODO keywords. As long as you just
  want a different color and nothing else, you can customize the
  variable org-todo-keyword-faces and use just a string color (i.e. a
  string of the color name) as the face, and then org-get-todo-face
  will convert the color to a face, inheriting everything else from
  the standard org-todo face.

  To demonstrate, I currently have org-todo-keyword-faces set to

#+BEGIN_SRC emacs-lisp
(("IN PROGRESS" . "dark orange")
 ("WAITING" . "red4")
 ("CANCELED" . "saddle brown"))
#+END_SRC emacs-lisp

  Here's the code, in a form you can put in your =.emacs=

#+BEGIN_SRC emacs-lisp
(eval-after-load 'org-faces
 '(progn
    (defcustom org-todo-keyword-faces nil
      "Faces for specific TODO keywords.
This is a list of cons cells, with TODO keywords in the car and
faces in the cdr.  The face can be a symbol, a color, or a
property list of attributes, like (:foreground \"blue\" :weight
bold :underline t)."
      :group 'org-faces
      :group 'org-todo
      :type '(repeat
              (cons
               (string :tag "Keyword")
               (choice color (sexp :tag "Face")))))))

(eval-after-load 'org
 '(progn
    (defun org-get-todo-face-from-color (color)
      "Returns a specification for a face that inherits from org-todo
 face and has the given color as foreground. Returns nil if
 color is nil."
      (when color
        `(:inherit org-warning :foreground ,color)))

    (defun org-get-todo-face (kwd)
      "Get the right face for a TODO keyword KWD.
If KWD is a number, get the corresponding match group."
      (if (numberp kwd) (setq kwd (match-string kwd)))
      (or (let ((face (cdr (assoc kwd org-todo-keyword-faces))))
            (if (stringp face)
                (org-get-todo-face-from-color face)
              face))
          (and (member kwd org-done-keywords) 'org-done)
          'org-todo))))
#+END_SRC emacs-lisp
* Changelog support for org headers
  -- James TD Smith

  Put the following in your =.emacs=, and =C-x 4 a= and other functions which
  use =add-log-current-defun= like =magit-add-log= will pick up the nearest org
  headline as the "current function" if you add a changelog entry from an org
  buffer.

  #+BEGIN_SRC emacs-lisp
    (defun org-log-current-defun ()
      (save-excursion
        (org-back-to-heading)
        (if (looking-at org-complex-heading-regexp)
            (match-string 4))))

    (add-hook 'org-mode-hook
              (lambda ()
                (make-variable-buffer-local 'add-log-current-defun-function)
                (setq add-log-current-defun-function 'org-log-current-defun)))
  #+END_SRC

* Using ido-completing-read to find attachments
  -- Matt Lundin

Org-attach is great for quickly linking files to a project. But if you
use org-attach extensively you might find yourself wanting to browse
all the files you've attached to org headlines. This is not easy to do
manually, since the directories containing the files are not human
readable (i.e., they are based on automatically generated ids). Here's
some code to browse those files using ido (obviously, you need to be
using ido):

#+begin_src emacs-lisp
  (load-library "find-lisp")

  ;; Adapted from http://www.emacswiki.org/emacs/RecentFiles

  (defun my-ido-find-org-attach ()
    "Find files in org-attachment directory"
    (interactive)
    (let* ((enable-recursive-minibuffers t)
           (files (find-lisp-find-files org-attach-directory "."))
           (file-assoc-list
            (mapcar (lambda (x)
                      (cons (file-name-nondirectory x)
                            x))
                    files))
           (filename-list
            (remove-duplicates (mapcar #'car file-assoc-list)
                               :test #'string=))
           (filename (ido-completing-read "Org attachments: " filename-list nil t))
           (longname (cdr (assoc filename file-assoc-list))))
      (ido-set-current-directory
       (if (file-directory-p longname)
           longname
         (file-name-directory longname)))
      (setq ido-exit 'refresh
            ido-text-init ido-text
            ido-rotate-temp t)
      (exit-minibuffer)))

  (add-hook 'ido-setup-hook 'ido-my-keys)

  (defun ido-my-keys ()
    "Add my keybindings for ido."
    (define-key ido-completion-map (kbd "C-;") 'my-ido-find-org-attach)
    )
#+end_src

To browse your org attachments using ido fuzzy matching and/or the
completion buffer, invoke ido-find-file as usual (=C-x C-f=) and then
press =C-;=.

* Remove redundant tags of headlines
  -- David Maus

A small function that processes all headlines in current buffer and
removes tags that are local to a headline and inherited by a parent
headline or the #+FILETAGS: statement.

#+BEGIN_SRC emacs-lisp
  (defun dmj/org-remove-redundant-tags ()
    "Remove redundant tags of headlines in current buffer.

  A tag is considered redundant if it is local to a headline and
  inherited by a parent headline."
    (interactive)
    (when (eq major-mode 'org-mode)
      (save-excursion
        (org-map-entries
         '(lambda ()
            (let ((alltags (split-string (or (org-entry-get (point) "ALLTAGS") "") ":"))
                  local inherited tag)
              (dolist (tag alltags)
                (if (get-text-property 0 'inherited tag)
                    (push tag inherited) (push tag local)))
              (dolist (tag local)
                (if (member tag inherited) (org-toggle-tag tag 'off)))))
         t nil))))
#+END_SRC

* Different org-cycle-level behavior
  -- Ryan Thompson

In recent org versions, when your point (cursor) is at the end of an
empty header line (like after you first created the header), the TAB
key (=org-cycle=) has a special behavior: it cycles the headline through
all possible levels. However, I did not like the way it determined
"all possible levels," so I rewrote the whole function, along with a
couple of supporting functions.

The original function's definition of "all possible levels" was "every
level from 1 to one more than the initial level of the current
headline before you started cycling." My new definition is "every
level from 1 to one more than the previous headline's level." So, if
you have a headline at level 4 and you use ALT+RET to make a new
headline below it, it will cycle between levels 1 and 5, inclusive.

The main advantage of my custom =org-cycle-level= function is that it
is stateless: the next level in the cycle is determined entirely by
the contents of the buffer, and not what command you executed last.
This makes it more predictable, I hope.

#+BEGIN_SRC emacs-lisp
(require 'cl)

(defun org-point-at-end-of-empty-headline ()
  "If point is at the end of an empty headline, return t, else nil."
  (and (looking-at "[ \t]*$")
       (save-excursion
         (beginning-of-line 1)
         (looking-at (concat "^\\(\\*+\\)[ \t]+\\(" org-todo-regexp "\\)?[ \t]*")))))

(defun org-level-increment ()
  "Return the number of stars that will be added or removed at a
time to headlines when structure editing, based on the value of
`org-odd-levels-only'."
  (if org-odd-levels-only 2 1))

(defvar org-previous-line-level-cached nil)

(defun org-recalculate-previous-line-level ()
  "Same as `org-get-previous-line-level', but does not use cached
value. It does *set* the cached value, though."
  (set 'org-previous-line-level-cached
       (let ((current-level (org-current-level))
             (prev-level (when (> (line-number-at-pos) 1)
                           (save-excursion
                             (previous-line)
                             (org-current-level)))))
         (cond ((null current-level) nil) ; Before first headline
               ((null prev-level) 0)      ; At first headline
               (prev-level)))))

(defun org-get-previous-line-level ()
  "Return the outline depth of the last headline before the
current line. Returns 0 for the first headline in the buffer, and
nil if before the first headline."
  ;; This calculation is quite expensive, with all the regex searching
  ;; and stuff. Since org-cycle-level won't change lines, we can reuse
  ;; the last value of this command.
  (or (and (eq last-command 'org-cycle-level)
           org-previous-line-level-cached)
      (org-recalculate-previous-line-level)))

(defun org-cycle-level ()
  (interactive)
  (let ((org-adapt-indentation nil))
    (when (org-point-at-end-of-empty-headline)
      (setq this-command 'org-cycle-level) ;Only needed for caching
      (let ((cur-level (org-current-level))
            (prev-level (org-get-previous-line-level)))
        (cond
         ;; If first headline in file, promote to top-level.
         ((= prev-level 0)
          (loop repeat (/ (- cur-level 1) (org-level-increment))
                do (org-do-promote)))
         ;; If same level as prev, demote one.
         ((= prev-level cur-level)
          (org-do-demote))
         ;; If parent is top-level, promote to top level if not already.
         ((= prev-level 1)
          (loop repeat (/ (- cur-level 1) (org-level-increment))
                do (org-do-promote)))
         ;; If top-level, return to prev-level.
         ((= cur-level 1)
          (loop repeat (/ (- prev-level 1) (org-level-increment))
                do (org-do-demote)))
         ;; If less than prev-level, promote one.
         ((< cur-level prev-level)
          (org-do-promote))
         ;; If deeper than prev-level, promote until higher than
         ;; prev-level.
         ((> cur-level prev-level)
          (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
                do (org-do-promote))))
        t))))
#+END_SRC

* Set org-agenda-files by filetag
  - Matt Lundin

It is often helpful to limit yourself to a subset of your agenda
files. For instance, at work, you might want to see only files related
to work (e.g., bugs, clientA, projectxyz, etc.). The FAQ has helpful
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
commands]]. These solutions, however, require reapplying a filter each
time you call the agenda or writing several new custom agenda commands
for each context. Another solution is to use directories for different
types of tasks and to change your agenda files with a function that
sets org-agenda-files to the appropriate directory. But this relies on
hard and static boundaries between files.

The following functions allow for a more dynamic approach to selecting
a subset of files based on filetags:

#+begin_src emacs-lisp
(defun my-org-agenda-files-by-filetag (&optional tag)
  "Limit org agenda files only to those containing filetag."
  (interactive)
  (let* ((tagslist (my-org-get-all-filetags))
         (ftag (or tag 
                   (completing-read "Tag: " 
                                    (mapcar 'car tagslist)))))
    (setq org-agenda-files (cdr (assoc ftag tagslist)))))

(defun my-org-get-all-filetags ()
  "Get list of filetags from all default org-files."
  (let ((files 
         (my-org-list-files 
          my-org-agenda-directories my-org-agenda-extensions))
        (tagslist nil)
        x)
    (save-window-excursion
      (while (setq x (pop files))
        (set-buffer (find-file-noselect x))
        (mapc
         (lambda (y)
           (let ((tagfiles (assoc y tagslist)))
             (if tagfiles
                 (setcdr tagfiles (cons x (cdr tagfiles)))
               (add-to-list 'tagslist (list y x)))))
         (my-org-get-filetags)))
      tagslist)))

(defun my-org-get-filetags ()
  "Get list of filetags for current buffer"
  (let ((ftags org-file-tags)
        x)
    (mapcar 
     (lambda (x)
       (org-substring-no-properties x))
     ftags)))
#+end_src

Calling my-org-agenda-files-by-filetag results in a prompt with all
filetags in your "normal" agenda files. When you select a tag,
org-agenda-files will be set only to those files containing that
filetag.

This functionality relies on a few other functions that abstract the
process of setting org-agenda-files:

#+begin_src emacs-lisp
  (defun my-org-list-files (dirs ext)
    "Function to create list of org files in multiple subdirectories.
  This can be called to generate a list of files for
  org-agenda-files or org-refile-targets.
  
  DIRS is a list of directories.
  
  EXT is a list of the extensions of files to be included."
    (let ((dirs (if (listp dirs)
                    dirs
                  (list dirs)))
          (ext (if (listp ext)
                   ext
                 (list ext)))
          files)
      (mapc 
       (lambda (x)
         (mapc 
          (lambda (y)
            (setq files 
                  (append files 
                          (file-expand-wildcards 
                           (concat (file-name-as-directory x) "*" y)))))
          ext))
       dirs)
      (mapc
       (lambda (x)
         (when (or (string-match "/.#" x)
                   (string-match "#$" x))
           (setq files (delete x files))))
       files)
      files))
  
  (defvar my-org-agenda-directories '("~/org/")
    "List of directories containing org files.")
  (defvar my-org-agenda-extensions '(".org")
    "List of extensions of agenda files")
  
  (setq my-org-agenda-directories '("~/org/"))
  (setq my-org-agenda-extensions '(".org"))
  
  (defun my-org-set-agenda-files ()
    (interactive)
    (setq org-agenda-files (my-org-list-files 
                            my-org-agenda-directories
                            my-org-agenda-extensions)))
  
  (my-org-set-agenda-files)
#+end_src

The code above will set your "default" agenda files to all files
ending in ".org" in the directory "~/org/". You can change these values
by setting the variables my-org-agenda-extensions and
my-org-agenda-directories. The function my-org-agenda-files-by-filetag
uses these two variables to determine which files to search for
filetags (i.e., the larger set from which the subset will be drawn).

You can also easily use my-org-list-files to "mix and match"
directories and extensions to generate different lists of agenda
files.

* Speed Commands
  Speed commands are described [[http://orgmode.org/manual/Speed-keys.html#Speed-keys][here]] in the manual. Add your own speed
  commands here.
** Show next/prev heading tidily
   - Dan Davison
     These close the current heading and open the next/previous heading.
#+begin_src emacs-lisp
(defun ded/org-show-next-heading-tidily ()
  "Show next entry, keeping other entries closed."
  (if (save-excursion (end-of-line) (outline-invisible-p))
      (progn (org-show-entry) (show-children))
    (outline-next-heading)
    (unless (and (bolp) (org-on-heading-p))
      (org-up-heading-safe)
      (hide-subtree)
      (error "Boundary reached"))
    (org-overview)
    (org-reveal t)
    (org-show-entry)
    (show-children)))

(defun ded/org-show-previous-heading-tidily ()
  "Show previous entry, keeping other entries closed."
  (let ((pos (point)))
    (outline-previous-heading)
    (unless (and (< (point) pos) (bolp) (org-on-heading-p))
      (goto-char pos)
      (hide-subtree)
      (error "Boundary reached"))
    (org-overview)
    (org-reveal t)
    (org-show-entry)
    (show-children)))

(setq org-use-speed-commands t)
(add-to-list 'org-speed-commands-user
             '("n" ded/org-show-next-heading-tidily))
(add-to-list 'org-speed-commands-user 
             '("p" ded/org-show-previous-heading-tidily))
#+end_src
* Use idle timer for automatic agenda views

From John Wiegley's mailing list post (March 18, 2010):

#+begin_quote
I have the following snippet in my .emacs file, which I find very
useful. Basically what it does is that if I don't touch my Emacs for 5
minutes, it displays the current agenda. This keeps my tasks "always
in mind" whenever I come back to Emacs after doing something else,
whereas before I had a tendency to forget that it was there.
#+end_quote  

  - [[http://mid.gmane.org/55590EA7-C744-44E5-909F-755F0BBE452D@gmail.com][John Wiegley: Displaying your Org agenda after idle time]]

#+begin_src emacs-lisp
  (defun jump-to-org-agenda ()
    (interactive)
    (let ((buf (get-buffer "*Org Agenda*"))
          wind)
      (if buf
          (if (setq wind (get-buffer-window buf))
              (select-window wind)
            (if (called-interactively-p)
                (progn
                  (select-window (display-buffer buf t t))
                  (org-fit-window-to-buffer)
                  ;; (org-agenda-redo)
                  )
              (with-selected-window (display-buffer buf)
                (org-fit-window-to-buffer)
                ;; (org-agenda-redo)
                )))
        (call-interactively 'org-agenda-list)))
    ;;(let ((buf (get-buffer "*Calendar*")))
    ;;  (unless (get-buffer-window buf)
    ;;    (org-agenda-goto-calendar)))
    )
  
  (run-with-idle-timer 300 t 'jump-to-org-agenda)
#+end_src

* Send html messages and attachments with Wanderlust
** Org-mime
*note*: [[file:org-contrib/org-mime.org][Org-mime]] has recently been added to the contrib directory of
 Org-mode implementing this functionality for both Wanderlust and
 Gnus.

** non Org-mime approach
These two hacks below add the capability of using Org to send out html
via email.  Both focus on Wanderlust but could be easily adopted for
Gnus, I think. -- David Maus

*** Send HTML message

Putting the code below in your .emacs adds following four functions:

   - dmj/wl-send-html-message

     Function that does the job: Convert everything between "--text
     follows this line--" and first mime entity (read: attachment) or
     end of buffer into html markup using `org-export-region-as-html'
     and replaces original body with a multipart MIME entity with the
     plain text version of body and the html markup version.  Thus a
     recipient that prefers html messages can see the html markup,
     recipients that prefer or depend on plain text can see the plain
     text.

     Cannot be called interactively: It is hooked into SEMI's
     `mime-edit-translate-hook' if message should be HTML message.

   - dmj/wl-send-html-message-draft-init

     Cannot be called interactively: It is hooked into WL's
     `wl-mail-setup-hook' and provides a buffer local variable to
     toggle.

   - dmj/wl-send-html-message-draft-maybe

     Cannot be called interactively: It is hooked into WL's
     `wl-draft-send-hook' and hooks `dmj/wl-send-html-message' into
     `mime-edit-translate-hook' depending on whether HTML message is
     toggled on or off

   - dmj/wl-send-html-message-toggle

     Toggles sending of HTML message.  If toggled on, the letters
     "HTML" appear in the mode line.

     Call it interactively!  Or bind it to a key in `wl-draft-mode'.

If you have to send HTML messages regularly you can set a global
variable `dmj/wl-send-html-message-toggled-p' to the string "HTML" to
toggle on sending HTML message by default.

The image [[http://s11.directupload.net/file/u/15851/48ru5wl3.png][here]] shows an example of how the HTML message looks like in
Google's web front end.  As you can see you have the whole markup of
Org at your service: *bold*, /italics/, tables, lists...

So even if you feel uncomfortable with sending HTML messages at least
you send HTML that looks quite good.

#+begin_src emacs-lisp
  (defun dmj/wl-send-html-message ()
    "Send message as html message.
  Convert body of message to html using
    `org-export-region-as-html'."
    (require 'org)
    (save-excursion
      (let (beg end html text)
        (goto-char (point-min))
        (re-search-forward "^--text follows this line--$")
        ;; move to beginning of next line
        (beginning-of-line 2)
        (setq beg (point))
        (if (not (re-search-forward "^--\\[\\[" nil t))
            (setq end (point-max))
          ;; line up
          (end-of-line 0)
          (setq end (point)))
        ;; grab body
        (setq text (buffer-substring-no-properties beg end))
        ;; convert to html
        (with-temp-buffer
          (org-mode)
          (insert text)
          ;; handle signature
          (when (re-search-backward "^-- \n" nil t)
            ;; preserve link breaks in signature
            (insert "\n#+BEGIN_VERSE\n")
            (goto-char (point-max))
            (insert "\n#+END_VERSE\n")
            ;; grab html
            (setq html (org-export-region-as-html
                        (point-min) (point-max) t 'string))))
        (delete-region beg end)
        (insert
         (concat
          "--" "<<alternative>>-{\n"
          "--" "[[text/plain]]\n" text
          "--" "[[text/html]]\n"  html
          "--" "}-<<alternative>>\n")))))
  
  (defun dmj/wl-send-html-message-toggle ()
    "Toggle sending of html message."
    (interactive)
    (setq dmj/wl-send-html-message-toggled-p
          (if dmj/wl-send-html-message-toggled-p
              nil "HTML"))
    (message "Sending html message toggled %s"
             (if dmj/wl-send-html-message-toggled-p
                 "on" "off")))
  
  (defun dmj/wl-send-html-message-draft-init ()
    "Create buffer local settings for maybe sending html message."
    (unless (boundp 'dmj/wl-send-html-message-toggled-p)
      (setq dmj/wl-send-html-message-toggled-p nil))
    (make-variable-buffer-local 'dmj/wl-send-html-message-toggled-p)
    (add-to-list 'global-mode-string
                 '(:eval (if (eq major-mode 'wl-draft-mode)
                             dmj/wl-send-html-message-toggled-p))))
  
  (defun dmj/wl-send-html-message-maybe ()
    "Maybe send this message as html message.
  
  If buffer local variable `dmj/wl-send-html-message-toggled-p' is
  non-nil, add `dmj/wl-send-html-message' to
  `mime-edit-translate-hook'."
    (if dmj/wl-send-html-message-toggled-p
        (add-hook 'mime-edit-translate-hook 'dmj/wl-send-html-message)
      (remove-hook 'mime-edit-translate-hook 'dmj/wl-send-html-message)))
  
  (add-hook 'wl-draft-reedit-hook 'dmj/wl-send-html-message-draft-init)
  (add-hook 'wl-mail-setup-hook 'dmj/wl-send-html-message-draft-init)
  (add-hook 'wl-draft-send-hook 'dmj/wl-send-html-message-maybe)
#+end_src

*** Attach HTML of region or subtree

Instead of sending a complete HTML message you might only send parts
of an Org file as HTML for the poor souls who are plagued with
non-proportional fonts in their mail program that messes up pretty
ASCII tables.

This short function does the trick: It exports region or subtree to
HTML, prefixes it with a MIME entity delimiter and pushes to killring
and clipboard.  If a region is active, it uses the region, the
complete subtree otherwise.

#+begin_src emacs-lisp
  (defun dmj/org-export-region-as-html-attachment (beg end arg)
    "Export region between BEG and END as html attachment.
  If BEG and END are not set, use current subtree.  Region or
  subtree is exported to html without header and footer, prefixed
  with a mime entity string and pushed to clipboard and killring.
  When called with prefix, mime entity is not marked as
  attachment."
    (interactive "r\nP")
    (save-excursion
      (let* ((beg (if (region-active-p) (region-beginning)
                    (progn
                      (org-back-to-heading)
                      (point))))
             (end (if (region-active-p) (region-end)
                    (progn
                      (org-end-of-subtree)
                      (point))))
             (html (concat "--[[text/html"
                           (if arg "" "\nContent-Disposition: attachment")
                           "]]\n"
                           (org-export-region-as-html beg end t 'string))))
        (when (fboundp 'x-set-selection)
          (ignore-errors (x-set-selection 'PRIMARY html))
          (ignore-errors (x-set-selection 'CLIPBOARD html)))
        (message "html export done, pushed to kill ring and clipboard"))))
#+end_src

*** Adopting for Gnus

The whole magic lies in the special strings that mark a HTML
attachment.  So you might just have to find out what these special
strings are in message-mode and modify the functions accordingly.