diff options
| author | Luke Shumaker <LukeShu@sbcglobal.net> | 2011-04-13 23:20:15 -0400 |
|---|---|---|
| committer | Luke Shumaker <LukeShu@sbcglobal.net> | 2011-04-13 23:20:15 -0400 |
| commit | f7464fdd2e33e5dc6c159a4adc8f53902e6d4511 (patch) | |
| tree | b1d65db982af54cc2088de3228174c4ea710c2f4 /.emacs.d/org-7.4/contrib | |
Initial commit of Luke Shumaker's "dot-files".
Diffstat (limited to '.emacs.d/org-7.4/contrib')
58 files changed, 15025 insertions, 0 deletions
diff --git a/.emacs.d/org-7.4/contrib/.DS_Store b/.emacs.d/org-7.4/contrib/.DS_Store Binary files differnew file mode 100644 index 0000000..dc5f85a --- /dev/null +++ b/.emacs.d/org-7.4/contrib/.DS_Store diff --git a/.emacs.d/org-7.4/contrib/README b/.emacs.d/org-7.4/contrib/README new file mode 100644 index 0000000..6a15821 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/README @@ -0,0 +1,60 @@ +This directory contains add-ons to Org-mode. + +These contributions are not part of GNU Emacs or of the official Org-mode +package. But the git repository for Org-mode is glad to provide useful way +to distribute and develop them as long as they are distributed under a free +software license. + +Please put your contribution in one of these three directories: + +LISP (emacs-lisp code) +====================== +htmlize.el --- Convert buffer text and decorations to HTML +org2rem.el --- Convert org appointments into reminders +org-annotate-file.el --- Annotate a file with org syntax +org-bookmark.el --- Links to bookmarks +org-checklist.el --- org functions for checklist handling +org-choose.el --- Use TODO keywords to mark decision states +org-collector.el --- Collect properties into tables +org-contribdir.el --- Dummy file to mark the org contrib Lisp directory +org-depend.el --- TODO dependencies for Org-mode +org-drill.el --- Self-testing with org-learn +org-depend.el --- TODO dependencies for Org-mode +org-elisp-symbol.el --- Org links to emacs-lisp symbols +org-eval.el --- The <lisp> tag, adapted from Muse +org-eval-light.el --- Evaluate in-buffer code on demand +org-exp-bibtex.el --- Export citations to LaTeX and HTML +org-expiry.el --- Expiry mechanism for Org entries +org-export-generic.el --- Export framework for configurable backends +org-git-link.el --- Provide org links to specific file version +org-interactive-query.el --- Interactive modification of tags query +org-invoice.el --- Help manage client invoices in OrgMode +org-jira.el --- Add a jira:ticket protocol to Org +org-learn.el --- SuperMemo's incremental learning algorithm +org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary +org-mac-link-grabber.el --- Grab links and URLs from various Mac applications +org-mairix.el --- Hook mairix search into Org for different MUAs +org-man.el --- Support for links to manpages in Org-mode +org-mime.el --- org html export for text/html MIME emails +org-mtags.el --- Support for some Muse-like tags in Org-mode +org-panel.el --- Simple routines for us with bad memory +org-registry.el --- A registry for Org links +org-screen.el --- Visit screen sessions through Org-mode links +org-secretary.el --- Team management with org-mode +org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs +orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions +org-toc.el --- Table of contents for Org-mode buffer +org-track.el --- Keep up with Org development +org-velocity.el --- something like Notational Velocity for Org +org-wikinodes --- CamelCase wiki-like links for Org + + +PACKAGES +======== + +SCRIPTS (shell, bash, etc.) +=========================== + +dir2org.zsh --- Org compatible fs structure output +org2hpda --- Generate hipster pda style printouts from Org-mode +ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL diff --git a/.emacs.d/org-7.4/contrib/babel/langs/ob-oz.el b/.emacs.d/org-7.4/contrib/babel/langs/ob-oz.el new file mode 100644 index 0000000..e1e6e35 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/babel/langs/ob-oz.el @@ -0,0 +1,306 @@ +;;; ob-oz.el --- org-babel functions for Oz evaluation + +;; Copyright (C) 2009 Torsten Anders and Eric Schulte + +;; Author: Torsten Anders and Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 0.01 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Org-Babel support for evaluating Oz source code. +;; +;; Oz code is always send to the Oz Programming Environment (OPI), the +;; Emacs mode and compiler interface for Oz programs. Therefore, only +;; session mode is supported. In practice, non-session code blocks are +;; handled equally well by the session mode. However, only a single +;; session is supported. Consequently, the :session header argument is +;; ignored. +;; +;; The Org-babel header argument :results is interpreted as +;; follows. :results output requires the respective code block to be +;; an Oz statement and :results value requires an Oz +;; expression. Currently, results are only supported for expressions +;; (i.e. the result of :results output is always nil). +;; +;; Expression evaluation happens synchronously. Therefore there is an +;; additional header argument :wait-time <number>, which specifies the +;; maximum time to wait for the result of a given expression. nil +;; means to wait as long as it takes to get a result (potentially wait +;; forever). +;; +;; NOTE: Currently the copyright of this file may not be in a state to +;; permit inclusion as core software into Emacs or Org-mode. + +;;; Requirements: + +;; - Mozart Programming System, the implementation of the Oz +;; programming language (http://www.mozart-oz.org/), which includes +;; the major mode mozart for editing Oz programs. +;; +;; - StartOzServer.oz which is located in the contrib/scripts +;; directory of the Org-mode repository + +;;; TODO: + +;; - Decide: set communication to \\switch -threadedqueries? +;; +;; - Only start Oz compiler when required, e.g., load Org-babel only when needed? +;; +;; - Avoid synchronous evaluation to avoid blocking Emacs (complex +;; Strasheela programs can take long to find a result..). In order +;; to cleanly map code blocks to their associated results (which can +;; arrive then in any order) I could use IDs +;; (e.g. integers). However, how do I do concurrency in Emacs Lisp, +;; and how can I define org-babel-execute:oz concurrently. +;; +;; - Expressions are rarely used in Oz at the top-level, and using +;; them in documentation and Literate Programs will cause +;; confusion. Idea: hide expression from reader and instead show +;; them statement (e.g., MIDI output statement) and then include +;; result in Org file. Implementation: for expressions (:results +;; value) support an additional header argument that takes arbitrary +;; Oz code. This code is not seen by the reader, but will be used +;; for the actual expression at the end. Alternative: feed all +;; relevant code as statement (:results output), then add expression +;; as extra code block which outputs, e.g., file name (so the file +;; name must be accessible by global var), but the code of this +;; extra codeblock is not seen. Hm, in that case it might be even +;; more easy to manually add this link to the Org file. +;; + + +(require 'ob) +;;; major mode for editing Oz programs +(require 'mozart) + +;; +;; Interface to communicate with Oz. +;; (1) For statements without any results: oz-send-string +;; (2) For expressions with a single result: oz-send-string-expression +;; (defined in org-babel-oz-ResultsValue.el) +;; + +;; oz-send-string-expression implements an additional very direct +;; communication between Org-babel and the Oz compiler. Communication +;; with the Oz server works already without this code via the function +;; oz-send-string from mozart.el.in, but this function does not get +;; back any results from Oz to Emacs. The following code creates a +;; socket for sending code to the OPI compiler and results are +;; returned by the same socket. On the Oz side, a socket is opened and +;; conected to the compiler of the OPI (via oz-send-string). On the +;; Emacs side, a connection to this socket is created for feeding code +;; and receiving results. This additional communication channel to the +;; OPI compiler ensures that results are returned cleanly (e.g., only +;; the result of the sent code is returned, no parsing or any +;; processing of *Oz Emulator* is required). +;; +;; There is no buffer, nor sentinel involved. Oz code is send +;; directly, and results from Oz are send back, but Emacs Lisp +;; requires a filter function for processing results. + +(defvar org-babel-oz-server-dir + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../../.." + (file-name-directory (or load-file-name buffer-file-name)))))) + "Path to the contrib/scripts directory in which +StartOzServer.oz is located.") + +(defvar org-babel-oz-port 6001 + "Port for communicating with Oz compiler.") +(defvar org-babel-oz-OPI-socket nil + "Socket for communicating with OPI.") + +(defvar org-babel-oz-collected-result nil + "Aux var to hand result from org-babel-oz-filter to oz-send-string-expression.") +(defun org-babel-oz-filter (proc string) + "Processes output from socket org-babel-oz-OPI-socket." +;; (setq org-babel-oz-collected-results (cons string org-babel-oz-collected-results)) + (setq org-babel-oz-collected-result string) + ) + + +(defun org-babel-oz-create-socket () + (message "Create OPI socket for evaluating expressions") + ;; Start Oz directly + (run-oz) + ;; Create socket on Oz side (after Oz was started). + (oz-send-string (concat "\\insert '" org-babel-oz-server-dir "StartOzServer.oz'")) + ;; Wait until socket is created before connecting to it. + ;; Quick hack: wait 3 sec + ;; + ;; extending time to 30 secs does not help when starting Emacs for + ;; the first time (and computer does nothing else) + (sit-for 3) + ;; connect to OPI socket + (setq org-babel-oz-OPI-socket + ;; Creates a socket. I/O interface of Emacs sockets as for processes. + (open-network-stream "*Org-babel-OPI-socket*" nil "localhost" org-babel-oz-port)) + ;; install filter + (set-process-filter org-babel-oz-OPI-socket #'org-babel-oz-filter) +) + +;; communication with org-babel-oz-OPI-socket is asynchronous, but +;; oz-send-string-expression turns is into synchronous... +(defun oz-send-string-expression (string &optional wait-time) + "Similar to oz-send-string, oz-send-string-expression sends a string to the OPI compiler. However, string must be expression and this function returns the result of the expression (as string). oz-send-string-expression is synchronous, wait-time allows to specify a maximum wait time. After wait-time is over with no result, the function returns nil." + (if (not org-babel-oz-OPI-socket) + (org-babel-oz-create-socket)) + (let ((polling-delay 0.1) + result) + (process-send-string org-babel-oz-OPI-socket string) + ;; wait for result + (if wait-time + (let ((waited 0)) + (unwind-protect + (progn + (while + ;; stop loop if org-babel-oz-collected-result \= nil or waiting time is over + (not (or (not (equal org-babel-oz-collected-result nil)) + (> waited wait-time))) + (progn + (sit-for polling-delay) +;; (message "org-babel-oz: next polling iteration") + (setq waited (+ waited polling-delay)))) +;; (message "org-babel-oz: waiting over, got result or waiting timed out") +;; (message (format "wait-time: %s, waited: %s" wait-time waited)) + (setq result org-babel-oz-collected-result) + (setq org-babel-oz-collected-result nil)))) + (unwind-protect + (progn + (while (equal org-babel-oz-collected-result nil) + (sit-for polling-delay)) + (setq result org-babel-oz-collected-result) + (setq org-babel-oz-collected-result nil)))) + result)) + +(defun org-babel-expand-body:oz (body params &optional processed-params) + (let ((vars (second (or processed-params (org-babel-process-params params)))))) + (if vars + ;; only add var declarations if any variables are there + (concat + ;; prepend code to define all arguments passed to the code block + "local\n" + (mapconcat + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-oz-var-to-oz (cdr pair)))) + vars "\n") "\n" + "in\n" + body + "end\n") + body)) + +(defun org-babel-execute:oz (body params) + "Execute a block of Oz code with org-babel. This function is +called by `org-babel-execute-src-block' via multiple-value-bind." + (let* ((processed-params (org-babel-process-params params)) +;; (session (org-babel-ruby-initiate-session (first processed-params))) + (vars (second processed-params)) +;; (result-params (third processed-params)) + (result-type (fourth processed-params)) + (full-body (org-babel-expand-body:oz body params processed-params)) + (wait-time (plist-get params :wait-time)) + ;; set the session if the session variable is non-nil +;; (session-buffer (org-babel-oz-initiate-session session)) +;; (session (org-babel-prep-session:oz session params)) + ) + ;; actually execute the source-code block + (org-babel-reassemble-table + (case result-type + (output + (progn + (message "Org-babel: executing Oz statement") + (oz-send-string full-body))) + (value + (progn + (message "Org-babel: executing Oz expression") + (oz-send-string-expression full-body (if wait-time + wait-time + 1))))) + (org-babel-pick-name (nth 4 processed-params) (cdr (assoc :colnames params))) + (org-babel-pick-name (nth 5 processed-params) (cdr (assoc :rownames params)))))) + +;; This function should be used to assign any variables in params in +;; the context of the session environment. +(defun org-babel-prep-session:oz (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "org-babel-prep-session:oz unimplemented")) +;; TODO: testing... (copied from org-babel-haskell.el) +;; (defun org-babel-prep-session:oz (session params) +;; "Prepare SESSION according to the header arguments specified in PARAMS." +;; (save-window-excursion +;; (org-babel-oz-initiate-session session) +;; (let* ((vars (org-babel-ref-variables params)) +;; (var-lines (mapconcat ;; define any variables +;; (lambda (pair) +;; (format "%s=%s" +;; (car pair) +;; (org-babel-ruby-var-to-ruby (cdr pair)))) +;; vars "\n")) +;; (vars-file (concat (make-temp-file "org-babel-oz-vars") ".oz"))) +;; (when vars +;; (with-temp-buffer +;; (insert var-lines) (write-file vars-file) +;; (oz-mode) +;; ;; (inferior-oz-load-file) ; ?? +;; )) +;; (current-buffer)))) +;; + + +;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml) +;; +;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or has no process +;; UNUSED DEF +(defun org-babel-oz-initiate-session (&optional session params) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session "none") + ;; TODO: make it possible to have multiple sessions + (save-window-excursion + ;; (run-oz) + (get-buffer oz-compiler-buffer)))) + +(defun org-babel-oz-var-to-oz (var) + "Convert an elisp var into a string of Oz source code +specifying a var of the same value." + (if (listp var) +;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]") + (eval var) + (format "%s" var) ; don't preserve string quotes. +;; (format "%s" var) + )) + +;; TODO: +(defun org-babel-oz-table-or-string (results) + "If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (error "org-babel-oz-table-or-string unimplemented")) + + +(provide 'ob-oz) +;;; org-babel-oz.el ends here diff --git a/.emacs.d/org-7.4/contrib/babel/library-of-babel.org b/.emacs.d/org-7.4/contrib/babel/library-of-babel.org new file mode 100644 index 0000000..abc15a9 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/babel/library-of-babel.org @@ -0,0 +1,370 @@ +#+title: The Library of Babel +#+author: Org-mode People +#+STARTUP: odd hideblocks + +* Introduction + The Library of Babel is an extensible collection of ready-made and + easily-shortcut-callable source-code blocks for handling common + tasks. Org-babel comes pre-populated with the source-code blocks + located in this file. It is possible to add source-code blocks from + any org-mode file to the library by calling =(org-babel-lob-ingest + "path/to/file.org")=. + + This file is included in worg mainly less for viewing through the + web interface, and more for contribution through the worg git + repository. If you have code snippets that you think others may + find useful please add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to + worg. + + The raw Org-mode text of this file can be downloaded at + [[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]] + +* Simple +A collection of simple utility functions + +#+srcname: echo +#+begin_src emacs-lisp :var input="echo'd" + input +#+end_src + +* File I/O +** reading and writing files +Read the contents of the file at =file=. The =:results vector= and +=:results scalar= header arguments can be used to read the contents of +file as either a table or a string. +#+srcname: read +#+begin_src emacs-lisp :var file="" :var format="" + (if (string= format "csv") + (with-temp-buffer + (org-table-import (expand-file-name file) nil) + (org-table-to-lisp)) + (with-temp-buffer + (insert-file-contents (expand-file-name file)) + (buffer-string))) +#+end_src + +Write =data= to a file at =file=. If =data= is a list, then write it +as a table in traditional Org-mode table syntax. +#+srcname: write +#+begin_src emacs-lisp :var data="" :var file="" :var ext='() + (flet ((echo (r) (if (stringp r) r (format "%S" r)))) + (with-temp-file file + (case (and (listp data) + (or ext (intern (file-name-extension file)))) + ('tsv (insert (orgtbl-to-tsv data '(:fmt echo)))) + ('csv (insert (orgtbl-to-csv data '(:fmt echo)))) + (t (org-babel-insert-result data))))) + nil +#+end_src + +** remote files +**** json +Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects. +#+srcname: json +#+begin_src emacs-lisp :var file='() :var url='() + (require 'json) + (cond + (file + (with-temp-filebuffer file + (goto-char (point-min)) + (json-read))) + (url + (require 'w3m) + (with-temp-buffer + (w3m-retrieve url) + (goto-char (point-min)) + (json-read)))) +#+end_src + +**** Google docs +The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line +tool. This tool provides functionality for accessing Google services +from the command line, and the following code blocks use /googlecl/ +for reading from and writing to Google docs with Org-mode code blocks. + +****** read a document from Google docs +The =google= command seems to be throwing "Moved Temporarily" errors +when trying to download textual documents, but this is working fine +for spreadsheets. +#+source: gdoc-read +#+begin_src emacs-lisp :var title="example" :var format="csv" + (let* ((file (concat title "." format)) + (cmd (format "google docs get --format %S --title %S" format title))) + (message cmd) (message (shell-command-to-string cmd)) + (prog1 (if (string= format "csv") + (with-temp-buffer + (org-table-import (shell-quote-argument file) '(4)) + (org-table-to-lisp)) + (with-temp-buffer + (insert-file-contents (shell-quote-argument file)) + (buffer-string))) + (delete-file file))) +#+end_src + +For example, a line like the following can be used to read the +contents of a spreadsheet named =num-cells= into a table. +: #+call: gdoc-read(title="num-cells"") + +A line like the following can be used to read the contents of a +document as a string. +: #+call: gdoc-read(title="loremi", :format "txt") + +****** write a document to a Google docs +Write =data= to a google document named =title=. If =data= is tabular +it will be saved to a spreadsheet, otherwise it will be saved as a +normal document. +#+source: gdoc-write +#+begin_src emacs-lisp :var title="babel-upload" :var data=fibs(n=10) :results silent + (let* ((format (if (listp data) "csv" "txt")) + (tmp-file (make-temp-file "org-babel-google-doc" nil (concat "." format))) + (cmd (format "google docs upload --title %S %S" title tmp-file))) + (with-temp-file tmp-file + (insert + (if (listp data) + (orgtbl-to-csv + data '(:fmt (lambda (el) (if (stringp el) el (format "%S" el))))) + (if (stringp data) data (format "%S" data))))) + (message cmd) + (prog1 (shell-command-to-string cmd) (delete-file tmp-file))) +#+end_src + +example usage +: #+source: fibs +: #+begin_src emacs-lisp :var n=8 +: (flet ((fib (m) (if (< m 2) 1 (+ (fib (- m 1)) (fib (- m 2)))))) +: (mapcar (lambda (el) (list el (fib el))) (number-sequence 0 (- n 1)))) +: #+end_src +: +: #+call: gdoc-write(title="fibs", data=fibs(n=10)) + +* Plotting code + +** R + Plot column 2 (y axis) against column 1 (x axis). Columns 3 and beyond, if present, are ignored. + +#+srcname: R-plot(data=R-plot-example-data) +#+begin_src R +plot(data) +#+end_src + +#+tblname: R-plot-example-data +| 1 | 2 | +| 2 | 4 | +| 3 | 9 | +| 4 | 16 | +| 5 | 25 | + +#+lob: R-plot(data=R-plot-example-data) + +#+resname: R-plot(data=R-plot-example-data) +: nil + +** Gnuplot + +* Org reference +** headline references +#+source: headline +#+begin_src emacs-lisp :var headline=top :var file='() + (save-excursion + (when file (get-file-buffer file)) + (org-open-link-from-string (org-make-link-string headline)) + (save-restriction + (org-narrow-to-subtree) + (buffer-string))) +#+end_src + +#+call: headline(headline="headline references") + +* Tables +** LaTeX Table export +*** booktabs +This block can be used to wrap a table in the latex =booktabs= +environment, it takes the following arguments -- all but the first two +are optional. +| arg | description | +|-------+--------------------------------------------| +| table | a reference to the table | +| align | optional alignment string | +| env | optional environment, default to "tabular" | +| width | optional width specification string | + +#+srcname: booktabs +#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var align='() :var env="tabular" :var width='() :noweb yes :results latex + (flet ((to-tab (tab) + (orgtbl-to-generic + (mapcar (lambda (lis) + (if (listp lis) + (mapcar (lambda (el) + (if (stringp el) + el + (format "%S" el))) lis) + lis)) tab) + (list :lend " \\\\" :sep " & " :hline "\\hline")))) + (org-fill-template + " + \\begin{%env}%width%align + \\toprule + %table + \\bottomrule + \\end{%env}\n" + (list + (cons "env" (or env "table")) + (cons "width" (if width (format "{%s}" width) "")) + (cons "align" (if align (format "{%s}" align) "")) + (cons "table" + ;; only use \midrule if it looks like there are column headers + (if (equal 'hline (second table)) + (concat (to-tab (list (first table))) + "\n\\midrule\n" + (to-tab (cddr table))) + (to-tab table)))))) +#+end_src + +*** longtable +This block can be used to wrap a table in the latex =longtable= +environment, it takes the following arguments -- all but the first two +are optional. +| arg | description | +|-----------+-------------------------------------------------------------| +| table | a reference to the table | +| align | optional alignment string | +| width | optional width specification string | +| hline | the string to use as hline separator, defaults to "\\hline" | +| head | optional "head" string | +| firsthead | optional "firsthead" string | +| foot | optional "foot" string | +| lastfoot | optional "lastfoot" string | + +#+srcname: longtable +#+begin_src emacs-lisp :var table='((:table)) :var align='() :var width='() :var hline="\\hline" :var firsthead='() :var head='() :var foot='() :var lastfoot='() :noweb yes :results latex + (org-fill-template + " + \\begin{longtable}%width%align + %firsthead + %head + %foot + %lastfoot + + %table + \\end{longtable}\n" + (list + (cons "width" (if width (format "{%s}" width) "")) + (cons "align" (if align (format "{%s}" align) "")) + (cons "firsthead" (if firsthead (concat firsthead "\n\\endfirsthead\n") "")) + (cons "head" (if head (concat head "\n\\endhead\n") "")) + (cons "foot" (if foot (concat foot "\n\\endfoot\n") "")) + (cons "lastfoot" (if lastfoot (concat lastfoot "\n\\endlastfoot\n") "")) + (cons "table" (orgtbl-to-generic + (mapcar (lambda (lis) + (if (listp lis) + (mapcar (lambda (el) + (if (stringp el) + el + (format "%S" el))) lis) + lis)) table) + (list :lend " \\\\" :sep " & " :hline hline))))) +#+end_src + +** Elegant lisp for transposing a matrix. + +#+tblname: transpose-example +| 1 | 2 | 3 | +| 4 | 5 | 6 | + +#+srcname: transpose +#+begin_src emacs-lisp :var table=transpose-example + (apply #'mapcar* #'list table) +#+end_src + +#+resname: +| 1 | 4 | +| 2 | 5 | +| 3 | 6 | + +* Misc +#+srcname: python-identity(a=1) +#+begin_src python +a +#+end_src +#+srcname: python-add(a=1, b=2) +#+begin_src python +a + b +#+end_src +* GANTT Charts + +The =elispgantt= source block was sent to the mailing list by Eric +Fraga. It was modified slightly by Tom Dye. + +#+source: elispgantt +#+begin_src emacs-lisp :var table=gantttest + (let ((dates "") + (entries (nthcdr 2 table)) + (milestones "") + (nmilestones 0) + (ntasks 0) + (projecttime 0) + (tasks "") + (xlength 1)) + (message "Initial: %s\n" table) + (message "Entries: %s\n" entries) + (while entries + (let ((entry (first entries))) + (if (listp entry) + (let ((id (first entry)) + (type (nth 1 entry)) + (label (nth 2 entry)) + (task (nth 3 entry)) + (dependencies (nth 4 entry)) + (start (nth 5 entry)) + (duration (nth 6 entry)) + (end (nth 7 entry)) + (alignment (nth 8 entry))) + (if (> start projecttime) (setq projecttime start)) + (if (string= type "task") + (let ((end (+ start duration)) + (textposition (+ start (/ duration 2))) + (flush "")) + (if (string= alignment "left") + (progn + (setq textposition start) + (setq flush "[left]")) + (if (string= alignment "right") + (progn + (setq textposition end) + (setq flush "[right]")))) + (setq tasks + (format "%s \\gantttask{%s}{%s}{%d}{%d}{%d}{%s}\n" + tasks label task start end textposition flush)) + (setq ntasks (+ 1 ntasks)) + (if (> end projecttime) + (setq projecttime end))) + (if (string= type "milestone") + (progn + (setq milestones + (format + "%s \\ganttmilestone{$\\begin{array}{c}\\mbox{%s}\\\\ \\mbox{%s}\\end{array}$}{%d}\n" + milestones label task start)) + (setq nmilestones (+ 1 nmilestones))) + (if (string= type "date") + (setq dates (format "%s \\ganttdateline{%s}{%d}\n" + dates label start)) + (message "Ignoring entry with type %s\n" type))))) + (message "Ignoring non-list entry %s\n" entry)) ; end if list entry + (setq entries (cdr entries)))) ; end while entries left + (format "\\pgfdeclarelayer{background} + \\pgfdeclarelayer{foreground} + \\pgfsetlayers{background,foreground} + \\renewcommand{\\ganttprojecttime}{%d} + \\renewcommand{\\ganttntasks}{%d} + \\noindent + \\begin{tikzpicture}[y=-0.75cm,x=0.75\\textwidth] + \\begin{pgfonlayer}{background} + \\draw[very thin, red!10!white] (0,1+\\ganttntasks) grid [ystep=0.75cm,xstep=1/\\ganttprojecttime] (1,0); + \\draw[\\ganttdatelinecolour] (0,0) -- (1,0); + \\draw[\\ganttdatelinecolour] (0,1+\\ganttntasks) -- (1,1+\\ganttntasks); + \\end{pgfonlayer} + %s + %s + %s + \\end{tikzpicture}" projecttime ntasks tasks milestones dates)) +#+end_src diff --git a/.emacs.d/org-7.4/contrib/lisp/.DS_Store b/.emacs.d/org-7.4/contrib/lisp/.DS_Store Binary files differnew file mode 100644 index 0000000..5008ddf --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/.DS_Store diff --git a/.emacs.d/org-7.4/contrib/lisp/htmlize.el b/.emacs.d/org-7.4/contrib/lisp/htmlize.el new file mode 100644 index 0000000..5f4cb5b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/htmlize.el @@ -0,0 +1,1769 @@ +;; htmlize.el -- Convert buffer text and decorations to HTML. + +;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005,2006,2009 Hrvoje Niksic + +;; Author: Hrvoje Niksic <hniksic@xemacs.org> +;; Keywords: hypermedia, extensions + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This package converts the buffer text and the associated +;; decorations to HTML. Mail to <hniksic@xemacs.org> to discuss +;; features and additions. All suggestions are more than welcome. + +;; To use this, just switch to the buffer you want HTML-ized and type +;; `M-x htmlize-buffer'. You will be switched to a new buffer that +;; contains the resulting HTML code. You can edit and inspect this +;; buffer, or you can just save it with C-x C-w. `M-x htmlize-file' +;; will find a file, fontify it, and save the HTML version in +;; FILE.html, without any additional intervention. `M-x +;; htmlize-many-files' allows you to htmlize any number of files in +;; the same manner. `M-x htmlize-many-files-dired' does the same for +;; files marked in a dired buffer. + +;; htmlize supports three types of HTML output, selected by setting +;; `htmlize-output-type': `css', `inline-css', and `font'. In `css' +;; mode, htmlize uses cascading style sheets to specify colors; it +;; generates classes that correspond to Emacs faces and uses <span +;; class=FACE>...</span> to color parts of text. In this mode, the +;; produced HTML is valid under the 4.01 strict DTD, as confirmed by +;; the W3C validator. `inline-css' is like `css', except the CSS is +;; put directly in the STYLE attribute of the SPAN element, making it +;; possible to paste the generated HTML to other documents. In `font' +;; mode, htmlize uses <font color="...">...</font> to colorize HTML, +;; which is not standard-compliant, but works better in older +;; browsers. `css' mode is the default. + +;; You can also use htmlize from your Emacs Lisp code. When called +;; non-interactively, `htmlize-buffer' and `htmlize-region' will +;; return the resulting HTML buffer, but will not change current +;; buffer or move the point. + +;; I tried to make the package elisp-compatible with multiple Emacsen, +;; specifically aiming for XEmacs 19.14+ and GNU Emacs 19.34+. Please +;; let me know if it doesn't work on some of those, and I'll try to +;; fix it. I relied heavily on the presence of CL extensions, +;; especially for cross-emacs compatibility; please don't try to +;; remove that particular dependency. When byte-compiling under GNU +;; Emacs, you're likely to get some warnings; just ignore them. + +;; The latest version should be available at: +;; +;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el> +;; +;; You can find a sample of htmlize's output (possibly generated with +;; an older version) at: +;; +;; <http://fly.srk.fer.hr/~hniksic/emacs/htmlize.el.html> + +;; Thanks go to the multitudes of people who have sent reports and +;; contributed comments, suggestions, and fixes. They include Ron +;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri +;; Linkov, Maciek Pasternacki, and many others. + +;; User quotes: "You sir, are a sick, sick, _sick_ person. :)" +;; -- Bill Perry, author of Emacs/W3 + + +;;; Code: + +(require 'cl) +(eval-when-compile + (if (string-match "XEmacs" emacs-version) + (byte-compiler-options + (warnings (- unresolved)))) + (defvar font-lock-auto-fontify) + (defvar font-lock-support-mode) + (defvar global-font-lock-mode) + (when (and (eq emacs-major-version 19) + (not (string-match "XEmacs" emacs-version))) + ;; Older versions of GNU Emacs fail to autoload cl-extra even when + ;; `cl' is loaded. + (load "cl-extra"))) + +(defconst htmlize-version "1.36") + +;; Incantations to make custom stuff work without customize, e.g. on +;; XEmacs 19.14 or GNU Emacs 19.34. +(eval-and-compile + (condition-case () + (require 'custom) + (error nil)) + (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) + nil ; we've got what we needed + ;; No custom or obsolete custom, define surrogates. Define all + ;; three macros, so we don't hose another library that expects + ;; e.g. `defface' to work after (fboundp 'defcustom) succeeds. + (defmacro defgroup (&rest ignored) nil) + (defmacro defcustom (var value doc &rest ignored) + `(defvar ,var ,value ,doc)) + (defmacro defface (face value doc &rest stuff) + `(make-face ,face)))) + +(defgroup htmlize nil + "Convert buffer text and faces to HTML." + :group 'hypermedia) + +(defcustom htmlize-head-tags "" + "*Additional tags to insert within HEAD of the generated document." + :type 'string + :group 'htmlize) + +(defcustom htmlize-output-type 'css + "*Output type of generated HTML, one of `css', `inline-css', or `font'. +When set to `css' (the default), htmlize will generate a style sheet +with description of faces, and use it in the HTML document, specifying +the faces in the actual text with <span class=\"FACE\">. + +When set to `inline-css', the style will be generated as above, but +placed directly in the STYLE attribute of the span ELEMENT: <span +style=\"STYLE\">. This makes it easier to paste the resulting HTML to +other documents. + +When set to `font', the properties will be set using layout tags +<font>, <b>, <i>, <u>, and <strike>. + +`css' output is normally preferred, but `font' is still useful for +supporting old, pre-CSS browsers, and both `inline-css' and `font' for +easier embedding of colorized text in foreign HTML documents (no style +sheet to carry around)." + :type '(choice (const css) (const inline-css) (const font)) + :group 'htmlize) + +(defcustom htmlize-generate-hyperlinks t + "*Non-nil means generate the hyperlinks for URLs and mail addresses. +This is on by default; set it to nil if you don't want htmlize to +insert hyperlinks in the resulting HTML. (In which case you can still +do your own hyperlinkification from htmlize-after-hook.)" + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-hyperlink-style " + a { + color: inherit; + background-color: inherit; + font: inherit; + text-decoration: inherit; + } + a:hover { + text-decoration: underline; + } +" + "*The CSS style used for hyperlinks when in CSS mode." + :type 'string + :group 'htmlize) + +(defcustom htmlize-replace-form-feeds t + "*Non-nil means replace form feeds in source code with HTML separators. +Form feeds are the ^L characters at line beginnings that are sometimes +used to separate sections of source code. If this variable is set to +`t', form feed characters are replaced with the <hr> separator. If this +is a string, it specifies the replacement to use. Note that <pre> is +temporarily closed before the separator is inserted, so the default +replacement is effectively \"</pre><hr /><pre>\". If you specify +another replacement, don't forget to close and reopen the <pre> if you +want the output to remain valid HTML. + +If you need more elaborate processing, set this to nil and use +htmlize-after-hook." + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-html-charset nil + "*The charset declared by the resulting HTML documents. +When non-nil, causes htmlize to insert the following in the HEAD section +of the generated HTML: + + <meta http-equiv=\"Content-Type\" content=\"text/html; charset=CHARSET\"> + +where CHARSET is the value you've set for htmlize-html-charset. Valid +charsets are defined by MIME and include strings like \"iso-8859-1\", +\"iso-8859-15\", \"utf-8\", etc. + +If you are using non-Latin-1 charsets, you might need to set this for +your documents to render correctly. Also, the W3C validator requires +submitted HTML documents to declare a charset. So if you care about +validation, you can use this to prevent the validator from bitching. + +Needless to say, if you set this, you should actually make sure that +the buffer is in the encoding you're claiming it is in. (Under Mule +that is done by ensuring the correct \"file coding system\" for the +buffer.) If you don't understand what that means, this option is +probably not for you." + :type '(choice (const :tag "Unset" nil) + string) + :group 'htmlize) + +(defcustom htmlize-convert-nonascii-to-entities (featurep 'mule) + "*Whether non-ASCII characters should be converted to HTML entities. + +When this is non-nil, characters with codes in the 128-255 range will be +considered Latin 1 and rewritten as \"&#CODE;\". Characters with codes +above 255 will be converted to \"&#UCS;\", where UCS denotes the Unicode +code point of the character. If the code point cannot be determined, +the character will be copied unchanged, as would be the case if the +option were nil. + +When the option is nil, the non-ASCII characters are copied to HTML +without modification. In that case, the web server and/or the browser +must be set to understand the encoding that was used when saving the +buffer. (You might also want to specify it by setting +`htmlize-html-charset'.) + +Note that in an HTML entity \"&#CODE;\", CODE is always a UCS code point, +which has nothing to do with the charset the page is in. For example, +\"©\" *always* refers to the copyright symbol, regardless of charset +specified by the META tag or the charset sent by the HTTP server. In +other words, \"©\" is exactly equivalent to \"©\". + +By default, entity conversion is turned on for Mule-enabled Emacsen and +turned off otherwise. This is because Mule knows the charset of +non-ASCII characters in the buffer. A non-Mule Emacs cannot tell +whether a character with code 0xA9 represents Latin 1 copyright symbol, +Latin 2 \"S with caron\", or something else altogether. Setting this to +t without Mule means asserting that 128-255 characters always mean Latin +1. + +For most people htmlize will work fine with this option left at the +default setting; don't change it unless you know what you're doing." + :type 'sexp + :group 'htmlize) + +(defcustom htmlize-ignore-face-size 'absolute + "*Whether face size should be ignored when generating HTML. +If this is nil, face sizes are used. If set to t, sizes are ignored +If set to `absolute', only absolute size specifications are ignored. +Please note that font sizes only work with CSS-based output types." + :type '(choice (const :tag "Don't ignore" nil) + (const :tag "Ignore all" t) + (const :tag "Ignore absolute" absolute)) + :group 'htmlize) + +(defcustom htmlize-css-name-prefix "" + "*The prefix used for CSS names. +The CSS names that htmlize generates from face names are often too +generic for CSS files; for example, `font-lock-type-face' is transformed +to `type'. Use this variable to add a prefix to the generated names. +The string \"htmlize-\" is an example of a reasonable prefix." + :type 'string + :group 'htmlize) + +(defcustom htmlize-use-rgb-txt t + "*Whether `rgb.txt' should be used to convert color names to RGB. + +This conversion means determining, for instance, that the color +\"IndianRed\" corresponds to the (205, 92, 92) RGB triple. `rgb.txt' +is the X color database that maps hundreds of color names to such RGB +triples. When this variable is non-nil, `htmlize' uses `rgb.txt' to +look up color names. + +If this variable is nil, htmlize queries Emacs for RGB components of +colors using `color-instance-rgb-components' and `x-color-values'. +This can yield incorrect results on non-true-color displays. + +If the `rgb.txt' file is not found (which will be the case if you're +running Emacs on non-X11 systems), this option is ignored." + :type 'boolean + :group 'htmlize) + +(defcustom htmlize-html-major-mode nil + "The mode the newly created HTML buffer will be put in. +Set this to nil if you prefer the default (fundamental) mode." + :type '(radio (const :tag "No mode (fundamental)" nil) + (function-item html-mode) + (function :tag "User-defined major mode")) + :group 'htmlize) + +(defvar htmlize-before-hook nil + "Hook run before htmlizing a buffer. +The hook functions are run in the source buffer (not the resulting HTML +buffer).") + +(defvar htmlize-after-hook nil + "Hook run after htmlizing a buffer. +Unlike `htmlize-before-hook', these functions are run in the generated +HTML buffer. You may use them to modify the outlook of the final HTML +output.") + +(defvar htmlize-file-hook nil + "Hook run by `htmlize-file' after htmlizing a file, but before saving it.") + +(defvar htmlize-buffer-places) + +;;; Some cross-Emacs compatibility. + +;; I try to conditionalize on features rather than Emacs version, but +;; in some cases checking against the version *is* necessary. +(defconst htmlize-running-xemacs (string-match "XEmacs" emacs-version)) + +(eval-and-compile + ;; save-current-buffer, with-current-buffer, and with-temp-buffer + ;; are not available in 19.34 and in older XEmacsen. Strictly + ;; speaking, we should stick to our own namespace and define and use + ;; htmlize-save-current-buffer, etc. But non-standard special forms + ;; are a pain because they're not properly fontified or indented and + ;; because they look weird and ugly. So I'll just go ahead and + ;; define the real ones if they're not available. If someone + ;; convinces me that this breaks something, I'll switch to the + ;; "htmlize-" namespace. + (unless (fboundp 'save-current-buffer) + (defmacro save-current-buffer (&rest forms) + `(let ((__scb_current (current-buffer))) + (unwind-protect + (progn ,@forms) + (set-buffer __scb_current))))) + (unless (fboundp 'with-current-buffer) + (defmacro with-current-buffer (buffer &rest forms) + `(save-current-buffer (set-buffer ,buffer) ,@forms))) + (unless (fboundp 'with-temp-buffer) + (defmacro with-temp-buffer (&rest forms) + (let ((temp-buffer (gensym "tb-"))) + `(let ((,temp-buffer + (get-buffer-create (generate-new-buffer-name " *temp*")))) + (unwind-protect + (with-current-buffer ,temp-buffer + ,@forms) + (and (buffer-live-p ,temp-buffer) + (kill-buffer ,temp-buffer)))))))) + +;; We need a function that efficiently finds the next change of a +;; property (usually `face'), preferably regardless of whether the +;; change occurred because of a text property or an extent/overlay. +;; As it turns out, it is not easy to do that compatibly. +;; +;; Under XEmacs, `next-single-property-change' does that. Under GNU +;; Emacs beginning with version 21, `next-single-char-property-change' +;; is available and does the same. GNU Emacs 20 had +;; `next-char-property-change', which we can use. GNU Emacs 19 didn't +;; provide any means for simultaneously examining overlays and text +;; properties, so when using Emacs 19.34, we punt and fall back to +;; `next-single-property-change', thus ignoring overlays altogether. + +(cond + (htmlize-running-xemacs + ;; XEmacs: good. + (defun htmlize-next-change (pos prop &optional limit) + (next-single-property-change pos prop nil (or limit (point-max))))) + ((fboundp 'next-single-char-property-change) + ;; GNU Emacs 21: good. + (defun htmlize-next-change (pos prop &optional limit) + (next-single-char-property-change pos prop nil limit))) + ((fboundp 'next-char-property-change) + ;; GNU Emacs 20: bad, but fixable. + (defun htmlize-next-change (pos prop &optional limit) + (let ((done nil) + (current-value (get-char-property pos prop)) + newpos next-value) + ;; Loop over positions returned by next-char-property-change + ;; until the value of PROP changes or we've hit EOB. + (while (not done) + (setq newpos (next-char-property-change pos limit) + next-value (get-char-property newpos prop)) + (cond ((eq newpos pos) + ;; Possibly at EOB? Whatever, just don't infloop. + (setq done t)) + ((eq next-value current-value) + ;; PROP hasn't changed -- keep looping. + ) + (t + (setq done t))) + (setq pos newpos)) + pos))) + (t + ;; GNU Emacs 19.34: hopeless, cannot properly support overlays. + (defun htmlize-next-change (pos prop &optional limit) + (unless limit + (setq limit (point-max))) + (let ((res (next-single-property-change pos prop))) + (if (or (null res) + (> res limit)) + limit + res))))) + +;;; Transformation of buffer text: HTML escapes, untabification, etc. + +(defvar htmlize-basic-character-table + ;; Map characters in the 0-127 range to either one-character strings + ;; or to numeric entities. + (let ((table (make-vector 128 ?\0))) + ;; Map characters in the 32-126 range to themselves, others to + ;; &#CODE entities; + (dotimes (i 128) + (setf (aref table i) (if (and (>= i 32) (<= i 126)) + (char-to-string i) + (format "&#%d;" i)))) + ;; Set exceptions manually. + (setf + ;; Don't escape newline, carriage return, and TAB. + (aref table ?\n) "\n" + (aref table ?\r) "\r" + (aref table ?\t) "\t" + ;; Escape &, <, and >. + (aref table ?&) "&" + (aref table ?<) "<" + (aref table ?>) ">" + ;; Not escaping '"' buys us a measurable speedup. It's only + ;; necessary to quote it for strings used in attribute values, + ;; which htmlize doesn't do. + ;(aref table ?\") """ + ) + table)) + +;; A cache of HTML representation of non-ASCII characters. Depending +;; on availability of `encode-char' and the setting of +;; `htmlize-convert-nonascii-to-entities', this maps non-ASCII +;; characters to either "&#<code>;" or "<char>" (mapconcat's mapper +;; must always return strings). It's only filled as characters are +;; encountered, so that in a buffer with e.g. French text, it will +;; only ever contain French accented characters as keys. It's cleared +;; on each entry to htmlize-buffer-1 to allow modifications of +;; `htmlize-convert-nonascii-to-entities' to take effect. +(defvar htmlize-extended-character-cache (make-hash-table :test 'eq)) + +(defun htmlize-protect-string (string) + "HTML-protect string, escaping HTML metacharacters and I18N chars." + ;; Only protecting strings that actually contain unsafe or non-ASCII + ;; chars removes a lot of unnecessary funcalls and consing. + (if (not (string-match "[^\r\n\t -%'-;=?-~]" string)) + string + (mapconcat (lambda (char) + (cond + ((< char 128) + ;; ASCII: use htmlize-basic-character-table. + (aref htmlize-basic-character-table char)) + ((gethash char htmlize-extended-character-cache) + ;; We've already seen this char; return the cached + ;; string. + ) + ((not htmlize-convert-nonascii-to-entities) + ;; If conversion to entities is not desired, always + ;; copy the char literally. + (setf (gethash char htmlize-extended-character-cache) + (char-to-string char))) + ((< char 256) + ;; Latin 1: no need to call encode-char. + (setf (gethash char htmlize-extended-character-cache) + (format "&#%d;" char))) + ((and (fboundp 'encode-char) + ;; Must check if encode-char works for CHAR; + ;; it fails for Arabic and possibly elsewhere. + (encode-char char 'ucs)) + (setf (gethash char htmlize-extended-character-cache) + (format "&#%d;" (encode-char char 'ucs)))) + (t + ;; encode-char doesn't work for this char. Copy it + ;; unchanged and hope for the best. + (setf (gethash char htmlize-extended-character-cache) + (char-to-string char))))) + string ""))) + +(defconst htmlize-ellipsis "...") +(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis) + +(defun htmlize-buffer-substring-no-invisible (beg end) + ;; Like buffer-substring-no-properties, but don't copy invisible + ;; parts of the region. Where buffer-substring-no-properties + ;; mandates an ellipsis to be shown, htmlize-ellipsis is inserted. + (let ((pos beg) + visible-list invisible show next-change) + ;; Iterate over the changes in the `invisible' property and filter + ;; out the portions where it's non-nil, i.e. where the text is + ;; invisible. + (while (< pos end) + (setq invisible (get-char-property pos 'invisible) + next-change (htmlize-next-change pos 'invisible end)) + (if (not (listp buffer-invisibility-spec)) + ;; If buffer-invisibility-spec is not a list, then all + ;; characters with non-nil `invisible' property are visible. + (setq show (not invisible)) + ;; Otherwise, the value of a non-nil `invisible' property can be: + ;; 1. a symbol -- make the text invisible if it matches + ;; buffer-invisibility-spec. + ;; 2. a list of symbols -- make the text invisible if + ;; any symbol in the list matches + ;; buffer-invisibility-spec. + ;; If the match of buffer-invisibility-spec has a non-nil + ;; CDR, replace the invisible text with an ellipsis. + (let (match) + (if (symbolp invisible) + (setq match (member* invisible buffer-invisibility-spec + :key (lambda (i) + (if (symbolp i) i (car i))))) + (setq match (block nil + (dolist (elem invisible) + (let ((m (member* + elem buffer-invisibility-spec + :key (lambda (i) + (if (symbolp i) i (car i)))))) + (when m (return m)))) + nil))) + (setq show (cond ((null match) t) + ((and (cdr-safe (car match)) + ;; Conflate successive ellipses. + (not (eq show htmlize-ellipsis))) + htmlize-ellipsis) + (t nil))))) + (cond ((eq show t) + (push (buffer-substring-no-properties pos next-change) visible-list)) + ((stringp show) + (push show visible-list))) + (setq pos next-change)) + (if (= (length visible-list) 1) + ;; If VISIBLE-LIST consists of only one element, return it + ;; without concatenation. This avoids additional consing in + ;; regions without any invisible text. + (car visible-list) + (apply #'concat (nreverse visible-list))))) + +(defun htmlize-trim-ellipsis (text) + ;; Remove htmlize-ellipses ("...") from the beginning of TEXT if it + ;; starts with it. It checks for the special property of the + ;; ellipsis so it doesn't work on ordinary text that begins with + ;; "...". + (if (get-text-property 0 'htmlize-ellipsis text) + (substring text (length htmlize-ellipsis)) + text)) + +(defconst htmlize-tab-spaces + ;; A table of strings with spaces. (aref htmlize-tab-spaces 5) is + ;; like (make-string 5 ?\ ), except it doesn't cons. + (let ((v (make-vector 32 nil))) + (dotimes (i (length v)) + (setf (aref v i) (make-string i ?\ ))) + v)) + +(defun htmlize-untabify (text start-column) + "Untabify TEXT, assuming it starts at START-COLUMN." + (let ((column start-column) + (last-match 0) + (chunk-start 0) + chunks match-pos tab-size) + (while (string-match "[\t\n]" text last-match) + (setq match-pos (match-beginning 0)) + (cond ((eq (aref text match-pos) ?\t) + ;; Encountered a tab: create a chunk of text followed by + ;; the expanded tab. + (push (substring text chunk-start match-pos) chunks) + ;; Increase COLUMN by the length of the text we've + ;; skipped since last tab or newline. (Encountering + ;; newline resets it.) + (incf column (- match-pos last-match)) + ;; Calculate tab size based on tab-width and COLUMN. + (setq tab-size (- tab-width (% column tab-width))) + ;; Expand the tab. + (push (aref htmlize-tab-spaces tab-size) chunks) + (incf column tab-size) + (setq chunk-start (1+ match-pos))) + (t + ;; Reset COLUMN at beginning of line. + (setq column 0))) + (setq last-match (1+ match-pos))) + ;; If no chunks have been allocated, it means there have been no + ;; tabs to expand. Return TEXT unmodified. + (if (null chunks) + text + (when (< chunk-start (length text)) + ;; Push the remaining chunk. + (push (substring text chunk-start) chunks)) + ;; Generate the output from the available chunks. + (apply #'concat (nreverse chunks))))) + +(defun htmlize-despam-address (string) + "Replace every occurrence of '@' in STRING with @. +`htmlize-make-hyperlinks' uses this to spam-protect mailto links +without modifying their meaning." + ;; Suggested by Ville Skytta. + (while (string-match "@" string) + (setq string (replace-match "@" nil t string))) + string) + +(defun htmlize-make-hyperlinks () + "Make hyperlinks in HTML." + ;; Function originally submitted by Ville Skytta. Rewritten by + ;; Hrvoje Niksic, then modified by Ville Skytta and Hrvoje Niksic. + (goto-char (point-min)) + (while (re-search-forward + "<\\(\\(mailto:\\)?\\([-=+_.a-zA-Z0-9]+@[-_.a-zA-Z0-9]+\\)\\)>" + nil t) + (let ((address (match-string 3)) + (link-text (match-string 1))) + (delete-region (match-beginning 0) (match-end 0)) + (insert "<<a href=\"mailto:" + (htmlize-despam-address address) + "\">" + (htmlize-despam-address link-text) + "</a>>"))) + (goto-char (point-min)) + (while (re-search-forward "<\\(\\(URL:\\)?\\([a-zA-Z]+://[^;]+\\)\\)>" + nil t) + (let ((url (match-string 3)) + (link-text (match-string 1))) + (delete-region (match-beginning 0) (match-end 0)) + (insert "<<a href=\"" url "\">" link-text "</a>>")))) + +;; Tests for htmlize-make-hyperlinks: + +;; <mailto:hniksic@xemacs.org> +;; <http://fly.srk.fer.hr> +;; <URL:http://www.xemacs.org> +;; <http://www.mail-archive.com/bbdb-info@xemacs.org/> +;; <hniksic@xemacs.org> +;; <xalan-dev-sc.10148567319.hacuhiucknfgmpfnjcpg-john=doe.com@xml.apache.org> + +(defun htmlize-defang-local-variables () + ;; Juri Linkov reports that an HTML-ized "Local variables" can lead + ;; visiting the HTML to fail with "Local variables list is not + ;; properly terminated". He suggested changing the phrase to + ;; syntactically equivalent HTML that Emacs doesn't recognize. + (goto-char (point-min)) + (while (search-forward "Local Variables:" nil t) + (replace-match "Local Variables:" nil t))) + + +;;; Color handling. + +(if (fboundp 'locate-file) + (defalias 'htmlize-locate-file 'locate-file) + (defun htmlize-locate-file (file path) + (dolist (dir path nil) + (when (file-exists-p (expand-file-name file dir)) + (return (expand-file-name file dir)))))) + +(defvar htmlize-x-library-search-path + '("/usr/X11R6/lib/X11/" + "/usr/X11R5/lib/X11/" + "/usr/lib/X11R6/X11/" + "/usr/lib/X11R5/X11/" + "/usr/local/X11R6/lib/X11/" + "/usr/local/X11R5/lib/X11/" + "/usr/local/lib/X11R6/X11/" + "/usr/local/lib/X11R5/X11/" + "/usr/X11/lib/X11/" + "/usr/lib/X11/" + "/usr/local/lib/X11/" + "/usr/X386/lib/X11/" + "/usr/x386/lib/X11/" + "/usr/XFree86/lib/X11/" + "/usr/unsupported/lib/X11/" + "/usr/athena/lib/X11/" + "/usr/local/x11r5/lib/X11/" + "/usr/lpp/Xamples/lib/X11/" + "/usr/openwin/lib/X11/" + "/usr/openwin/share/lib/X11/")) + +(defun htmlize-get-color-rgb-hash (&optional rgb-file) + "Return a hash table mapping X color names to RGB values. +The keys in the hash table are X11 color names, and the values are the +#rrggbb RGB specifications, extracted from `rgb.txt'. + +If RGB-FILE is nil, the function will try hard to find a suitable file +in the system directories. + +If no rgb.txt file is found, return nil." + (let ((rgb-file (or rgb-file (htmlize-locate-file + "rgb.txt" + htmlize-x-library-search-path))) + (hash nil)) + (when rgb-file + (with-temp-buffer + (insert-file-contents rgb-file) + (setq hash (make-hash-table :test 'equal)) + (while (not (eobp)) + (cond ((looking-at "^\\s-*\\([!#]\\|$\\)") + ;; Skip comments and empty lines. + ) + ((looking-at + "[ \t]*\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(.*\\)") + (setf (gethash (downcase (match-string 4)) hash) + (format "#%02x%02x%02x" + (string-to-number (match-string 1)) + (string-to-number (match-string 2)) + (string-to-number (match-string 3))))) + (t + (error + "Unrecognized line in %s: %s" + rgb-file + (buffer-substring (point) (progn (end-of-line) (point)))))) + (forward-line 1)))) + hash)) + +;; Compile the RGB map when loaded. On systems where rgb.txt is +;; missing, the value of the variable will be nil, and rgb.txt will +;; not be used. +(defvar htmlize-color-rgb-hash (htmlize-get-color-rgb-hash)) + +;;; Face handling. + +(defun htmlize-face-specifies-property (face prop) + ;; Return t if face specifies PROP, as opposed to it being inherited + ;; from the default face. The problem with e.g. + ;; `face-foreground-instance' is that it returns an instance for + ;; EVERY face because every face inherits from the default face. + ;; However, we'd like htmlize-face-{fore,back}ground to return nil + ;; when called with a face that doesn't specify its own foreground + ;; or background. + (or (eq face 'default) + (assq 'global (specifier-spec-list (face-property face prop))))) + +(defun htmlize-face-color-internal (face fg) + ;; Used only under GNU Emacs. Return the color of FACE, but don't + ;; return "unspecified-fg" or "unspecified-bg". If the face is + ;; `default' and the color is unspecified, look up the color in + ;; frame parameters. + (let* ((function (if fg #'face-foreground #'face-background)) + color) + (if (>= emacs-major-version 22) + ;; For GNU Emacs 22+ set INHERIT to get the inherited values. + (setq color (funcall function face nil t)) + (setq color (funcall function face)) + ;; For GNU Emacs 21 (which has `face-attribute'): if the color + ;; is nil, recursively check for the face's parent. + (when (and (null color) + (fboundp 'face-attribute) + (face-attribute face :inherit) + (not (eq (face-attribute face :inherit) 'unspecified))) + (setq color (htmlize-face-color-internal + (face-attribute face :inherit) fg)))) + (when (and (eq face 'default) (null color)) + (setq color (cdr (assq (if fg 'foreground-color 'background-color) + (frame-parameters))))) + (when (or (eq color 'unspecified) + (equal color "unspecified-fg") + (equal color "unspecified-bg")) + (setq color nil)) + (when (and (eq face 'default) + (null color)) + ;; Assuming black on white doesn't seem right, but I can't think + ;; of anything better to do. + (setq color (if fg "black" "white"))) + color)) + +(defun htmlize-face-foreground (face) + ;; Return the name of the foreground color of FACE. If FACE does + ;; not specify a foreground color, return nil. + (cond (htmlize-running-xemacs + ;; XEmacs. + (and (htmlize-face-specifies-property face 'foreground) + (color-instance-name (face-foreground-instance face)))) + (t + ;; GNU Emacs. + (htmlize-face-color-internal face t)))) + +(defun htmlize-face-background (face) + ;; Return the name of the background color of FACE. If FACE does + ;; not specify a background color, return nil. + (cond (htmlize-running-xemacs + ;; XEmacs. + (and (htmlize-face-specifies-property face 'background) + (color-instance-name (face-background-instance face)))) + (t + ;; GNU Emacs. + (htmlize-face-color-internal face nil)))) + +;; Convert COLOR to the #RRGGBB string. If COLOR is already in that +;; format, it's left unchanged. + +(defun htmlize-color-to-rgb (color) + (let ((rgb-string nil)) + (cond ((null color) + ;; Ignore nil COLOR because it means that the face is not + ;; specifying any color. Hence (htmlize-color-to-rgb nil) + ;; returns nil. + ) + ((string-match "\\`#" color) + ;; The color is already in #rrggbb format. + (setq rgb-string color)) + ((and htmlize-use-rgb-txt + htmlize-color-rgb-hash) + ;; Use of rgb.txt is requested, and it's available on the + ;; system. Use it. + (setq rgb-string (gethash (downcase color) htmlize-color-rgb-hash))) + (t + ;; We're getting the RGB components from Emacs. + (let ((rgb + ;; Here I cannot conditionalize on (fboundp ...) + ;; because ps-print under some versions of GNU Emacs + ;; defines its own dummy version of + ;; `color-instance-rgb-components'. + (if htmlize-running-xemacs + (mapcar (lambda (arg) + (/ arg 256)) + (color-instance-rgb-components + (make-color-instance color))) + (mapcar (lambda (arg) + (/ arg 256)) + (x-color-values color))))) + (when rgb + (setq rgb-string (apply #'format "#%02x%02x%02x" rgb)))))) + ;; If RGB-STRING is still nil, it means the color cannot be found, + ;; for whatever reason. In that case just punt and return COLOR. + ;; Most browsers support a decent set of color names anyway. + (or rgb-string color))) + +;; We store the face properties we care about into an +;; `htmlize-fstruct' type. That way we only have to analyze face +;; properties, which can be time consuming, once per each face. The +;; mapping between Emacs faces and htmlize-fstructs is established by +;; htmlize-make-face-map. The name "fstruct" refers to variables of +;; type `htmlize-fstruct', while the term "face" is reserved for Emacs +;; faces. + +(defstruct htmlize-fstruct + foreground ; foreground color, #rrggbb + background ; background color, #rrggbb + size ; size + boldp ; whether face is bold + italicp ; whether face is italic + underlinep ; whether face is underlined + overlinep ; whether face is overlined + strikep ; whether face is struck through + css-name ; CSS name of face + ) + +(defun htmlize-face-emacs21-attr (fstruct attr value) + ;; For ATTR and VALUE, set the equivalent value in FSTRUCT. + (case attr + (:foreground + (setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value))) + (:background + (setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value))) + (:height + (setf (htmlize-fstruct-size fstruct) value)) + (:weight + (when (string-match (symbol-name value) "bold") + (setf (htmlize-fstruct-boldp fstruct) t))) + (:slant + (setf (htmlize-fstruct-italicp fstruct) (or (eq value 'italic) + (eq value 'oblique)))) + (:bold + (setf (htmlize-fstruct-boldp fstruct) value)) + (:italic + (setf (htmlize-fstruct-italicp fstruct) value)) + (:underline + (setf (htmlize-fstruct-underlinep fstruct) value)) + (:overline + (setf (htmlize-fstruct-overlinep fstruct) value)) + (:strike-through + (setf (htmlize-fstruct-strikep fstruct) value)))) + +(defun htmlize-face-size (face) + ;; The size (height) of FACE, taking inheritance into account. + ;; Only works in Emacs 21 and later. + (let ((size-list + (loop + for f = face then (ignore-errors (face-attribute f :inherit)) ;????? + until (or (not f) (eq f 'unspecified)) + for h = (ignore-errors (face-attribute f :height)) ;??????? + collect (if (eq h 'unspecified) nil h)))) + (reduce 'htmlize-merge-size (cons nil size-list)))) + +(defun htmlize-face-to-fstruct (face) + "Convert Emacs face FACE to fstruct." + (let ((fstruct (make-htmlize-fstruct + :foreground (htmlize-color-to-rgb + (htmlize-face-foreground face)) + :background (htmlize-color-to-rgb + (htmlize-face-background face))))) + (cond (htmlize-running-xemacs + ;; XEmacs doesn't provide a way to detect whether a face is + ;; bold or italic, so we need to examine the font instance. + ;; #### This probably doesn't work under MS Windows and/or + ;; GTK devices. I'll need help with those. + (let* ((font-instance (face-font-instance face)) + (props (font-instance-properties font-instance))) + (when (equalp (cdr (assq 'WEIGHT_NAME props)) "bold") + (setf (htmlize-fstruct-boldp fstruct) t)) + (when (or (equalp (cdr (assq 'SLANT props)) "i") + (equalp (cdr (assq 'SLANT props)) "o")) + (setf (htmlize-fstruct-italicp fstruct) t)) + (setf (htmlize-fstruct-strikep fstruct) + (face-strikethru-p face)) + (setf (htmlize-fstruct-underlinep fstruct) + (face-underline-p face)))) + ((fboundp 'face-attribute) + ;; GNU Emacs 21 and further. + (dolist (attr '(:weight :slant :underline :overline :strike-through)) + (let ((value (if (>= emacs-major-version 22) + ;; Use the INHERIT arg in GNU Emacs 22. + (face-attribute face attr nil t) + ;; Otherwise, fake it. + (let ((face face)) + (while (and (eq (face-attribute face attr) + 'unspecified) + (not (eq (face-attribute face :inherit) + 'unspecified))) + (setq face (face-attribute face :inherit))) + (face-attribute face attr))))) + (when (and value (not (eq value 'unspecified))) + (htmlize-face-emacs21-attr fstruct attr value)))) + (let ((size (htmlize-face-size face))) + (unless (eql size 1.0) ; ignore non-spec + (setf (htmlize-fstruct-size fstruct) size)))) + (t + ;; Older GNU Emacs. Some of these functions are only + ;; available under Emacs 20+, hence the guards. + (when (fboundp 'face-bold-p) + (setf (htmlize-fstruct-boldp fstruct) (face-bold-p face))) + (when (fboundp 'face-italic-p) + (setf (htmlize-fstruct-italicp fstruct) (face-italic-p face))) + (setf (htmlize-fstruct-underlinep fstruct) + (face-underline-p face)))) + ;; Generate the css-name property. Emacs places no restrictions + ;; on the names of symbols that represent faces -- any characters + ;; may be in the name, even ^@. We try hard to beat the face name + ;; into shape, both esthetically and according to CSS1 specs. + (setf (htmlize-fstruct-css-name fstruct) + (let ((name (downcase (symbol-name face)))) + (when (string-match "\\`font-lock-" name) + ;; Change font-lock-FOO-face to FOO. + (setq name (replace-match "" t t name))) + (when (string-match "-face\\'" name) + ;; Drop the redundant "-face" suffix. + (setq name (replace-match "" t t name))) + (while (string-match "[^-a-zA-Z0-9]" name) + ;; Drop the non-alphanumerics. + (setq name (replace-match "X" t t name))) + (when (string-match "\\`[-0-9]" name) + ;; CSS identifiers may not start with a digit. + (setq name (concat "X" name))) + ;; After these transformations, the face could come + ;; out empty. + (when (equal name "") + (setq name "face")) + ;; Apply the prefix. + (setq name (concat htmlize-css-name-prefix name)) + name)) + fstruct)) + +(defmacro htmlize-copy-attr-if-set (attr-list dest source) + ;; Expand the code of the type + ;; (and (htmlize-fstruct-ATTR source) + ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source))) + ;; for the given list of boolean attributes. + (cons 'progn + (loop for attr in attr-list + for attr-sym = (intern (format "htmlize-fstruct-%s" attr)) + collect `(and (,attr-sym ,source) + (setf (,attr-sym ,dest) (,attr-sym ,source)))))) + +(defun htmlize-merge-size (merged next) + ;; Calculate the size of the merge of MERGED and NEXT. + (cond ((null merged) next) + ((integerp next) next) + ((null next) merged) + ((floatp merged) (* merged next)) + ((integerp merged) (round (* merged next))))) + +(defun htmlize-merge-two-faces (merged next) + (htmlize-copy-attr-if-set + (foreground background boldp italicp underlinep overlinep strikep) + merged next) + (setf (htmlize-fstruct-size merged) + (htmlize-merge-size (htmlize-fstruct-size merged) + (htmlize-fstruct-size next))) + merged) + +(defun htmlize-merge-faces (fstruct-list) + (cond ((null fstruct-list) + ;; Nothing to do, return a dummy face. + (make-htmlize-fstruct)) + ((null (cdr fstruct-list)) + ;; Optimize for the common case of a single face, simply + ;; return it. + (car fstruct-list)) + (t + (reduce #'htmlize-merge-two-faces + (cons (make-htmlize-fstruct) fstruct-list))))) + +;; GNU Emacs 20+ supports attribute lists in `face' properties. For +;; example, you can use `(:foreground "red" :weight bold)' as an +;; overlay's "face", or you can even use a list of such lists, etc. +;; We call those "attrlists". +;; +;; htmlize supports attrlist by converting them to fstructs, the same +;; as with regular faces. + +(defun htmlize-attrlist-to-fstruct (attrlist) + ;; Like htmlize-face-to-fstruct, but accepts an ATTRLIST as input. + (let ((fstruct (make-htmlize-fstruct))) + (cond ((eq (car attrlist) 'foreground-color) + ;; ATTRLIST is (foreground-color . COLOR) + (setf (htmlize-fstruct-foreground fstruct) + (htmlize-color-to-rgb (cdr attrlist)))) + ((eq (car attrlist) 'background-color) + ;; ATTRLIST is (background-color . COLOR) + (setf (htmlize-fstruct-background fstruct) + (htmlize-color-to-rgb (cdr attrlist)))) + (t + ;; ATTRLIST is a plist. + (while attrlist + (let ((attr (pop attrlist)) + (value (pop attrlist))) + (when (and value (not (eq value 'unspecified))) + (htmlize-face-emacs21-attr fstruct attr value)))))) + (setf (htmlize-fstruct-css-name fstruct) "ATTRLIST") + fstruct)) + +(defun htmlize-face-list-p (face-prop) + "Return non-nil if FACE-PROP is a list of faces, nil otherwise." + ;; If not for attrlists, this would return (listp face-prop). This + ;; way we have to be more careful because attrlist is also a list! + (cond + ((eq face-prop nil) + ;; FACE-PROP being nil means empty list (no face), so return t. + t) + ((symbolp face-prop) + ;; A symbol other than nil means that it's only one face, so return + ;; nil. + nil) + ((not (consp face-prop)) + ;; Huh? Not a symbol or cons -- treat it as a single element. + nil) + (t + ;; We know that FACE-PROP is a cons: check whether it looks like an + ;; ATTRLIST. + (let* ((car (car face-prop)) + (attrlist-p (and (symbolp car) + (or (eq car 'foreground-color) + (eq car 'background-color) + (eq (aref (symbol-name car) 0) ?:))))) + ;; If FACE-PROP is not an ATTRLIST, it means it's a list of + ;; faces. + (not attrlist-p))))) + +(defun htmlize-make-face-map (faces) + ;; Return a hash table mapping Emacs faces to htmlize's fstructs. + ;; The keys are either face symbols or attrlists, so the test + ;; function must be `equal'. + (let ((face-map (make-hash-table :test 'equal)) + css-names) + (dolist (face faces) + (unless (gethash face face-map) + ;; Haven't seen FACE yet; convert it to an fstruct and cache + ;; it. + (let ((fstruct (if (symbolp face) + (htmlize-face-to-fstruct face) + (htmlize-attrlist-to-fstruct face)))) + (setf (gethash face face-map) fstruct) + (let* ((css-name (htmlize-fstruct-css-name fstruct)) + (new-name css-name) + (i 0)) + ;; Uniquify the face's css-name by using NAME-1, NAME-2, + ;; etc. + (while (member new-name css-names) + (setq new-name (format "%s-%s" css-name (incf i)))) + (unless (equal new-name css-name) + (setf (htmlize-fstruct-css-name fstruct) new-name)) + (push new-name css-names))))) + face-map)) + +(defun htmlize-unstringify-face (face) + "If FACE is a string, return it interned, otherwise return it unchanged." + (if (stringp face) + (intern face) + face)) + +(defun htmlize-faces-in-buffer () + "Return a list of faces used in the current buffer. +Under XEmacs, this returns the set of faces specified by the extents +with the `face' property. (This covers text properties as well.) Under +GNU Emacs, it returns the set of faces specified by the `face' text +property and by buffer overlays that specify `face'." + (let (faces) + ;; Testing for (fboundp 'map-extents) doesn't work because W3 + ;; defines `map-extents' under FSF. + (if htmlize-running-xemacs + (let (face-prop) + (map-extents (lambda (extent ignored) + (setq face-prop (extent-face extent) + ;; FACE-PROP can be a face or a list of + ;; faces. + faces (if (listp face-prop) + (union face-prop faces) + (adjoin face-prop faces))) + nil) + nil + ;; Specify endpoints explicitly to respect + ;; narrowing. + (point-min) (point-max) nil nil 'face)) + ;; FSF Emacs code. + ;; Faces used by text properties. + (let ((pos (point-min)) face-prop next) + (while (< pos (point-max)) + (setq face-prop (get-text-property pos 'face) + next (or (next-single-property-change pos 'face) (point-max))) + ;; FACE-PROP can be a face/attrlist or a list thereof. + (setq faces (if (htmlize-face-list-p face-prop) + (nunion (mapcar #'htmlize-unstringify-face face-prop) + faces :test 'equal) + (adjoin (htmlize-unstringify-face face-prop) + faces :test 'equal))) + (setq pos next))) + ;; Faces used by overlays. + (dolist (overlay (overlays-in (point-min) (point-max))) + (let ((face-prop (overlay-get overlay 'face))) + ;; FACE-PROP can be a face/attrlist or a list thereof. + (setq faces (if (htmlize-face-list-p face-prop) + (nunion (mapcar #'htmlize-unstringify-face face-prop) + faces :test 'equal) + (adjoin (htmlize-unstringify-face face-prop) + faces :test 'equal)))))) + faces)) + +;; htmlize-faces-at-point returns the faces in use at point. The +;; faces are sorted by increasing priority, i.e. the last face takes +;; precedence. +;; +;; Under XEmacs, this returns all the faces in all the extents at +;; point. Under GNU Emacs, this returns all the faces in the `face' +;; property and all the faces in the overlays at point. + +(cond (htmlize-running-xemacs + (defun htmlize-faces-at-point () + (let (extent extent-list face-list face-prop) + (while (setq extent (extent-at (point) nil 'face extent)) + (push extent extent-list)) + ;; extent-list is in reverse display order, meaning that + ;; smallest ones come last. That is the order we want, + ;; except it can be overridden by the `priority' property. + (setq extent-list (stable-sort extent-list #'< + :key #'extent-priority)) + (dolist (extent extent-list) + (setq face-prop (extent-face extent)) + ;; extent's face-list is in reverse order from what we + ;; want, but the `nreverse' below will take care of it. + (setq face-list (if (listp face-prop) + (append face-prop face-list) + (cons face-prop face-list)))) + (nreverse face-list)))) + (t + (defun htmlize-faces-at-point () + (let (all-faces) + ;; Faces from text properties. + (let ((face-prop (get-text-property (point) 'face))) + (setq all-faces (if (htmlize-face-list-p face-prop) + (nreverse (mapcar #'htmlize-unstringify-face + face-prop)) + (list (htmlize-unstringify-face face-prop))))) + ;; Faces from overlays. + (let ((overlays + ;; Collect overlays at point that specify `face'. + (delete-if-not (lambda (o) + (overlay-get o 'face)) + (overlays-at (point)))) + list face-prop) + ;; Sort the overlays so the smaller (more specific) ones + ;; come later. The number of overlays at each one + ;; position should be very small, so the sort shouldn't + ;; slow things down. + (setq overlays (sort* overlays + ;; Sort by ascending... + #'< + ;; ...overlay size. + :key (lambda (o) + (- (overlay-end o) + (overlay-start o))))) + ;; Overlay priorities, if present, override the above + ;; established order. Larger overlay priority takes + ;; precedence and therefore comes later in the list. + (setq overlays (stable-sort + overlays + ;; Reorder (stably) by acending... + #'< + ;; ...overlay priority. + :key (lambda (o) + (or (overlay-get o 'priority) 0)))) + (dolist (overlay overlays) + (setq face-prop (overlay-get overlay 'face)) + (setq list (if (htmlize-face-list-p face-prop) + (nconc (nreverse (mapcar + #'htmlize-unstringify-face + face-prop)) + list) + (cons (htmlize-unstringify-face face-prop) list)))) + ;; Under "Merging Faces" the manual explicitly states + ;; that faces specified by overlays take precedence over + ;; faces specified by text properties. + (setq all-faces (nconc all-faces list))) + all-faces)))) + +;; htmlize supports generating HTML in two several fundamentally +;; different ways, one with the use of CSS and nested <span> tags, and +;; the other with the use of the old <font> tags. Rather than adding +;; a bunch of ifs to many places, we take a semi-OO approach. +;; `htmlize-buffer-1' calls a number of "methods", which indirect to +;; the functions that depend on `htmlize-output-type'. The currently +;; used methods are `doctype', `insert-head', `body-tag', and +;; `insert-text'. Not all output types define all methods. +;; +;; Methods are called either with (htmlize-method METHOD ARGS...) +;; special form, or by accessing the function with +;; (htmlize-method-function 'METHOD) and calling (funcall FUNCTION). +;; The latter form is useful in tight loops because `htmlize-method' +;; conses. +;; +;; Currently defined output types are `css' and `font'. + +(defmacro htmlize-method (method &rest args) + ;; Expand to (htmlize-TYPE-METHOD ...ARGS...). TYPE is the value of + ;; `htmlize-output-type' at run time. + `(funcall (htmlize-method-function ',method) ,@args)) + +(defun htmlize-method-function (method) + ;; Return METHOD's function definition for the current output type. + ;; The returned object can be safely funcalled. + (let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method)))) + (indirect-function (if (fboundp sym) + sym + (let ((default (intern (concat "htmlize-default-" + (symbol-name method))))) + (if (fboundp default) + default + 'ignore)))))) + +(defvar htmlize-memoization-table (make-hash-table :test 'equal)) + +(defmacro htmlize-memoize (key generator) + "Return the value of GENERATOR, memoized as KEY. +That means that GENERATOR will be evaluated and returned the first time +it's called with the same value of KEY. All other times, the cached +\(memoized) value will be returned." + (let ((value (gensym))) + `(let ((,value (gethash ,key htmlize-memoization-table))) + (unless ,value + (setq ,value ,generator) + (setf (gethash ,key htmlize-memoization-table) ,value)) + ,value))) + +;;; Default methods. + +(defun htmlize-default-doctype () + nil ; no doc-string + ;; According to DTDs published by the W3C, it is illegal to embed + ;; <font> in <pre>. This makes sense in general, but is bad for + ;; htmlize's intended usage of <font> to specify the document color. + + ;; To make generated HTML legal, htmlize's `font' mode used to + ;; specify the SGML declaration of "HTML Pro" DTD here. HTML Pro + ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed + ;; DTD that would encompass all the incompatible HTML extensions + ;; procured by Netscape, MSIE, and other players in the field. + ;; Apparently the project got abandoned, the last available version + ;; being "Draft 0 Revision 11" from January 1997, as documented at + ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>. + + ;; Since by now HTML Pro is remembered by none but the most die-hard + ;; early-web-days nostalgics and used by not even them, there is no + ;; use in specifying it. So we return the standard HTML 4.0 + ;; declaration, which makes generated HTML technically illegal. If + ;; you have a problem with that, use the `css' engine designed to + ;; create fully conforming HTML. + + "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">" + + ;; Now-abandoned HTML Pro declaration. + ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">" + ) + +(defun htmlize-default-body-tag (face-map) + nil ; no doc-string + "<body>") + +;;; CSS based output support. + +;; Internal function; not a method. +(defun htmlize-css-specs (fstruct) + (let (result) + (when (htmlize-fstruct-foreground fstruct) + (push (format "color: %s;" (htmlize-fstruct-foreground fstruct)) + result)) + (when (htmlize-fstruct-background fstruct) + (push (format "background-color: %s;" + (htmlize-fstruct-background fstruct)) + result)) + (let ((size (htmlize-fstruct-size fstruct))) + (when (and size (not (eq htmlize-ignore-face-size t))) + (cond ((floatp size) + (push (format "font-size: %d%%;" (* 100 size)) result)) + ((not (eq htmlize-ignore-face-size 'absolute)) + (push (format "font-size: %spt;" (/ size 10.0)) result))))) + (when (htmlize-fstruct-boldp fstruct) + (push "font-weight: bold;" result)) + (when (htmlize-fstruct-italicp fstruct) + (push "font-style: italic;" result)) + (when (htmlize-fstruct-underlinep fstruct) + (push "text-decoration: underline;" result)) + (when (htmlize-fstruct-overlinep fstruct) + (push "text-decoration: overline;" result)) + (when (htmlize-fstruct-strikep fstruct) + (push "text-decoration: line-through;" result)) + (nreverse result))) + +(defun htmlize-css-insert-head (buffer-faces face-map) + (insert " <style type=\"text/css\">\n <!--\n") + (insert " body {\n " + (mapconcat #'identity + (htmlize-css-specs (gethash 'default face-map)) + "\n ") + "\n }\n") + (dolist (face (sort* (copy-list buffer-faces) #'string-lessp + :key (lambda (f) + (htmlize-fstruct-css-name (gethash f face-map))))) + (let* ((fstruct (gethash face face-map)) + (cleaned-up-face-name + (let ((s + ;; Use `prin1-to-string' rather than `symbol-name' + ;; to get the face name because the "face" can also + ;; be an attrlist, which is not a symbol. + (prin1-to-string face))) + ;; If the name contains `--' or `*/', remove them. + (while (string-match "--" s) + (setq s (replace-match "-" t t s))) + (while (string-match "\\*/" s) + (setq s (replace-match "XX" t t s))) + s)) + (specs (htmlize-css-specs fstruct))) + (insert " ." (htmlize-fstruct-css-name fstruct)) + (if (null specs) + (insert " {") + (insert " {\n /* " cleaned-up-face-name " */\n " + (mapconcat #'identity specs "\n "))) + (insert "\n }\n"))) + (insert htmlize-hyperlink-style + " -->\n </style>\n")) + +(defun htmlize-css-insert-text (text fstruct-list buffer) + ;; Insert TEXT colored with FACES into BUFFER. In CSS mode, this is + ;; easy: just nest the text in one <span class=...> tag for each + ;; face in FSTRUCT-LIST. + (dolist (fstruct fstruct-list) + (princ "<span class=\"" buffer) + (princ (htmlize-fstruct-css-name fstruct) buffer) + (princ "\">" buffer)) + (princ text buffer) + (dolist (fstruct fstruct-list) + (ignore fstruct) ; shut up the byte-compiler + (princ "</span>" buffer))) + +;; `inline-css' output support. + +(defun htmlize-inline-css-body-tag (face-map) + (format "<body style=\"%s\">" + (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map)) + " "))) + +(defun htmlize-inline-css-insert-text (text fstruct-list buffer) + (let* ((merged (htmlize-merge-faces fstruct-list)) + (style (htmlize-memoize + merged + (let ((specs (htmlize-css-specs merged))) + (and specs + (mapconcat #'identity (htmlize-css-specs merged) " ")))))) + (when style + (princ "<span style=\"" buffer) + (princ style buffer) + (princ "\">" buffer)) + (princ text buffer) + (when style + (princ "</span>" buffer)))) + +;;; `font' tag based output support. + +(defun htmlize-font-body-tag (face-map) + (let ((fstruct (gethash 'default face-map))) + (format "<body text=\"%s\" bgcolor=\"%s\">" + (htmlize-fstruct-foreground fstruct) + (htmlize-fstruct-background fstruct)))) + +(defun htmlize-font-insert-text (text fstruct-list buffer) + ;; In `font' mode, we use the traditional HTML means of altering + ;; presentation: <font> tag for colors, <b> for bold, <u> for + ;; underline, and <strike> for strike-through. + (let* ((merged (htmlize-merge-faces fstruct-list)) + (markup (htmlize-memoize + merged + (cons (concat + (and (htmlize-fstruct-foreground merged) + (format "<font color=\"%s\">" (htmlize-fstruct-foreground merged))) + (and (htmlize-fstruct-boldp merged) "<b>") + (and (htmlize-fstruct-italicp merged) "<i>") + (and (htmlize-fstruct-underlinep merged) "<u>") + (and (htmlize-fstruct-strikep merged) "<strike>")) + (concat + (and (htmlize-fstruct-strikep merged) "</strike>") + (and (htmlize-fstruct-underlinep merged) "</u>") + (and (htmlize-fstruct-italicp merged) "</i>") + (and (htmlize-fstruct-boldp merged) "</b>") + (and (htmlize-fstruct-foreground merged) "</font>")))))) + (princ (car markup) buffer) + (princ text buffer) + (princ (cdr markup) buffer))) + +(defun htmlize-buffer-1 () + ;; Internal function; don't call it from outside this file. Htmlize + ;; current buffer, writing the resulting HTML to a new buffer, and + ;; return it. Unlike htmlize-buffer, this doesn't change current + ;; buffer or use switch-to-buffer. + (save-excursion + ;; Protect against the hook changing the current buffer. + (save-excursion + (run-hooks 'htmlize-before-hook)) + ;; Convince font-lock support modes to fontify the entire buffer + ;; in advance. + (htmlize-ensure-fontified) + (clrhash htmlize-extended-character-cache) + (clrhash htmlize-memoization-table) + (let* ((buffer-faces (htmlize-faces-in-buffer)) + (face-map (htmlize-make-face-map (adjoin 'default buffer-faces))) + ;; Generate the new buffer. It's important that it inherits + ;; default-directory from the current buffer. + (htmlbuf (generate-new-buffer (if (buffer-file-name) + (htmlize-make-file-name + (file-name-nondirectory + (buffer-file-name))) + "*html*"))) + ;; Having a dummy value in the plist allows writing simply + ;; (plist-put places foo bar). + (places '(nil nil)) + (title (if (buffer-file-name) + (file-name-nondirectory (buffer-file-name)) + (buffer-name)))) + ;; Initialize HTMLBUF and insert the HTML prolog. + (with-current-buffer htmlbuf + (buffer-disable-undo) + (insert (htmlize-method doctype) ?\n + (format "<!-- Created by htmlize-%s in %s mode. -->\n" + htmlize-version htmlize-output-type) + "<html>\n ") + (plist-put places 'head-start (point-marker)) + (insert "<head>\n" + " <title>" (htmlize-protect-string title) "</title>\n" + (if htmlize-html-charset + (format (concat " <meta http-equiv=\"Content-Type\" " + "content=\"text/html; charset=%s\">\n") + htmlize-html-charset) + "") + htmlize-head-tags) + (htmlize-method insert-head buffer-faces face-map) + (insert " </head>") + (plist-put places 'head-end (point-marker)) + (insert "\n ") + (plist-put places 'body-start (point-marker)) + (insert (htmlize-method body-tag face-map) + "\n ") + (plist-put places 'content-start (point-marker)) + (insert "<pre>\n")) + (let ((insert-text-method + ;; Get the inserter method, so we can funcall it inside + ;; the loop. Not calling `htmlize-method' in the loop + ;; body yields a measurable speed increase. + (htmlize-method-function 'insert-text)) + ;; Declare variables used in loop body outside the loop + ;; because it's faster to establish `let' bindings only + ;; once. + next-change text face-list fstruct-list trailing-ellipsis) + ;; This loop traverses and reads the source buffer, appending + ;; the resulting HTML to HTMLBUF with `princ'. This method is + ;; fast because: 1) it doesn't require examining the text + ;; properties char by char (htmlize-next-change is used to + ;; move between runs with the same face), and 2) it doesn't + ;; require buffer switches, which are slow in Emacs. + (goto-char (point-min)) + (while (not (eobp)) + (setq next-change (htmlize-next-change (point) 'face)) + ;; Get faces in use between (point) and NEXT-CHANGE, and + ;; convert them to fstructs. + (setq face-list (htmlize-faces-at-point) + fstruct-list (delq nil (mapcar (lambda (f) + (gethash f face-map)) + face-list))) + ;; Extract buffer text, sans the invisible parts. Then + ;; untabify it and escape the HTML metacharacters. + (setq text (htmlize-buffer-substring-no-invisible + (point) next-change)) + (when trailing-ellipsis + (setq text (htmlize-trim-ellipsis text))) + ;; If TEXT ends up empty, don't change trailing-ellipsis. + (when (> (length text) 0) + (setq trailing-ellipsis + (get-text-property (1- (length text)) + 'htmlize-ellipsis text))) + (setq text (htmlize-untabify text (current-column))) + (setq text (htmlize-protect-string text)) + ;; Don't bother writing anything if there's no text (this + ;; happens in invisible regions). + (when (> (length text) 0) + ;; Insert the text, along with the necessary markup to + ;; represent faces in FSTRUCT-LIST. + (funcall insert-text-method text fstruct-list htmlbuf)) + (goto-char next-change))) + + ;; Insert the epilog and post-process the buffer. + (with-current-buffer htmlbuf + (insert "</pre>") + (plist-put places 'content-end (point-marker)) + (insert "\n </body>") + (plist-put places 'body-end (point-marker)) + (insert "\n</html>\n") + (when htmlize-generate-hyperlinks + (htmlize-make-hyperlinks)) + (htmlize-defang-local-variables) + (when htmlize-replace-form-feeds + ;; Change each "\n^L" to "<hr />". + (goto-char (point-min)) + (let ((source + ;; ^L has already been escaped, so search for that. + (htmlize-protect-string "\n\^L")) + (replacement + (if (stringp htmlize-replace-form-feeds) + htmlize-replace-form-feeds + "</pre><hr /><pre>"))) + (while (search-forward source nil t) + (replace-match replacement t t)))) + (goto-char (point-min)) + (when htmlize-html-major-mode + ;; What sucks about this is that the minor modes, most notably + ;; font-lock-mode, won't be initialized. Oh well. + (funcall htmlize-html-major-mode)) + (set (make-local-variable 'htmlize-buffer-places) places) + (run-hooks 'htmlize-after-hook) + (buffer-enable-undo)) + htmlbuf))) + +;; Utility functions. + +(defmacro htmlize-with-fontify-message (&rest body) + ;; When forcing fontification of large buffers in + ;; htmlize-ensure-fontified, inform the user that he is waiting for + ;; font-lock, not for htmlize to finish. + `(progn + (if (> (buffer-size) 65536) + (message "Forcing fontification of %s..." + (buffer-name (current-buffer)))) + ,@body + (if (> (buffer-size) 65536) + (message "Forcing fontification of %s...done" + (buffer-name (current-buffer)))))) + +(defun htmlize-ensure-fontified () + ;; If font-lock is being used, ensure that the "support" modes + ;; actually fontify the buffer. If font-lock is not in use, we + ;; don't care because, except in htmlize-file, we don't force + ;; font-lock on the user. + (when (and (boundp 'font-lock-mode) + font-lock-mode) + ;; In part taken from ps-print-ensure-fontified in GNU Emacs 21. + (cond + ((and (boundp 'jit-lock-mode) + (symbol-value 'jit-lock-mode)) + (htmlize-with-fontify-message + (jit-lock-fontify-now (point-min) (point-max)))) + ((and (boundp 'lazy-lock-mode) + (symbol-value 'lazy-lock-mode)) + (htmlize-with-fontify-message + (lazy-lock-fontify-region (point-min) (point-max)))) + ((and (boundp 'lazy-shot-mode) + (symbol-value 'lazy-shot-mode)) + (htmlize-with-fontify-message + ;; lazy-shot is amazing in that it must *refontify* the region, + ;; even if the whole buffer has already been fontified. <sigh> + (lazy-shot-fontify-region (point-min) (point-max)))) + ;; There's also fast-lock, but we don't need to handle specially, + ;; I think. fast-lock doesn't really defer fontification, it + ;; just saves it to an external cache so it's not done twice. + ))) + + +;;;###autoload +(defun htmlize-buffer (&optional buffer) + "Convert BUFFER to HTML, preserving colors and decorations. + +The generated HTML is available in a new buffer, which is returned. +When invoked interactively, the new buffer is selected in the current +window. The title of the generated document will be set to the buffer's +file name or, if that's not available, to the buffer's name. + +Note that htmlize doesn't fontify your buffers, it only uses the +decorations that are already present. If you don't set up font-lock or +something else to fontify your buffers, the resulting HTML will be +plain. Likewise, if you don't like the choice of colors, fix the mode +that created them, or simply alter the faces it uses." + (interactive) + (let ((htmlbuf (with-current-buffer (or buffer (current-buffer)) + (htmlize-buffer-1)))) + (when (interactive-p) + (switch-to-buffer htmlbuf)) + htmlbuf)) + +;;;###autoload +(defun htmlize-region (beg end) + "Convert the region to HTML, preserving colors and decorations. +See `htmlize-buffer' for details." + (interactive "r") + ;; Don't let zmacs region highlighting end up in HTML. + (when (fboundp 'zmacs-deactivate-region) + (zmacs-deactivate-region)) + (let ((htmlbuf (save-restriction + (narrow-to-region beg end) + (htmlize-buffer-1)))) + (when (interactive-p) + (switch-to-buffer htmlbuf)) + htmlbuf)) + +(defun htmlize-region-for-paste (beg end) + "Htmlize the region and return just the HTML as a string. +This forces the `inline-css' style and only returns the HTML body, +but without the BODY tag. This should make it useful for inserting +the text to another HTML buffer." + (let* ((htmlize-output-type 'inline-css) + (htmlbuf (htmlize-region beg end))) + (unwind-protect + (with-current-buffer htmlbuf + (buffer-substring (plist-get htmlize-buffer-places 'content-start) + (plist-get htmlize-buffer-places 'content-end))) + (kill-buffer htmlbuf)))) + +(defun htmlize-make-file-name (file) + "Make an HTML file name from FILE. + +In its default implementation, this simply appends `.html' to FILE. +This function is called by htmlize to create the buffer file name, and +by `htmlize-file' to create the target file name. + +More elaborate transformations are conceivable, such as changing FILE's +extension to `.html' (\"file.c\" -> \"file.html\"). If you want them, +overload this function to do it and htmlize will comply." + (concat file ".html")) + +;; Older implementation of htmlize-make-file-name that changes FILE's +;; extension to ".html". +;(defun htmlize-make-file-name (file) +; (let ((extension (file-name-extension file)) +; (sans-extension (file-name-sans-extension file))) +; (if (or (equal extension "html") +; (equal extension "htm") +; (equal sans-extension "")) +; (concat file ".html") +; (concat sans-extension ".html")))) + +;;;###autoload +(defun htmlize-file (file &optional target) + "Load FILE, fontify it, convert it to HTML, and save the result. + +Contents of FILE are inserted into a temporary buffer, whose major mode +is set with `normal-mode' as appropriate for the file type. The buffer +is subsequently fontified with `font-lock' and converted to HTML. Note +that, unlike `htmlize-buffer', this function explicitly turns on +font-lock. If a form of highlighting other than font-lock is desired, +please use `htmlize-buffer' directly on buffers so highlighted. + +Buffers currently visiting FILE are unaffected by this function. The +function does not change current buffer or move the point. + +If TARGET is specified and names a directory, the resulting file will be +saved there instead of to FILE's directory. If TARGET is specified and +does not name a directory, it will be used as output file name." + (interactive (list (read-file-name + "HTML-ize file: " + nil nil nil (and (buffer-file-name) + (file-name-nondirectory + (buffer-file-name)))))) + (let ((output-file (if (and target (not (file-directory-p target))) + target + (expand-file-name + (htmlize-make-file-name (file-name-nondirectory file)) + (or target (file-name-directory file))))) + ;; Try to prevent `find-file-noselect' from triggering + ;; font-lock because we'll fontify explicitly below. + (font-lock-mode nil) + (font-lock-auto-fontify nil) + (global-font-lock-mode nil) + ;; Ignore the size limit for the purposes of htmlization. + (font-lock-maximum-size nil) + ;; Disable font-lock support modes. This will only work in + ;; more recent Emacs versions, so htmlize-buffer-1 still needs + ;; to call htmlize-ensure-fontified. + (font-lock-support-mode nil)) + (with-temp-buffer + ;; Insert FILE into the temporary buffer. + (insert-file-contents file) + ;; Set the file name so normal-mode and htmlize-buffer-1 pick it + ;; up. Restore it afterwards so with-temp-buffer's kill-buffer + ;; doesn't complain about killing a modified buffer. + (let ((buffer-file-name file)) + ;; Set the major mode for the sake of font-lock. + (normal-mode) + (font-lock-mode 1) + (unless font-lock-mode + ;; In GNU Emacs (font-lock-mode 1) doesn't force font-lock, + ;; contrary to the documentation. This seems to work. + (font-lock-fontify-buffer)) + ;; htmlize the buffer and save the HTML. + (with-current-buffer (htmlize-buffer-1) + (unwind-protect + (progn + (run-hooks 'htmlize-file-hook) + (write-region (point-min) (point-max) output-file)) + (kill-buffer (current-buffer))))))) + ;; I haven't decided on a useful return value yet, so just return + ;; nil. + nil) + +;;;###autoload +(defun htmlize-many-files (files &optional target-directory) + "Convert FILES to HTML and save the corresponding HTML versions. + +FILES should be a list of file names to convert. This function calls +`htmlize-file' on each file; see that function for details. When +invoked interactively, you are prompted for a list of files to convert, +terminated with RET. + +If TARGET-DIRECTORY is specified, the HTML files will be saved to that +directory. Normally, each HTML file is saved to the directory of the +corresponding source file." + (interactive + (list + (let (list file) + ;; Use empty string as DEFAULT because setting DEFAULT to nil + ;; defaults to the directory name, which is not what we want. + (while (not (equal (setq file (read-file-name + "HTML-ize file (RET to finish): " + (and list (file-name-directory + (car list))) + "" t)) + "")) + (push file list)) + (nreverse list)))) + ;; Verify that TARGET-DIRECTORY is indeed a directory. If it's a + ;; file, htmlize-file will use it as target, and that doesn't make + ;; sense. + (and target-directory + (not (file-directory-p target-directory)) + (error "target-directory must name a directory: %s" target-directory)) + (dolist (file files) + (htmlize-file file target-directory))) + +;;;###autoload +(defun htmlize-many-files-dired (arg &optional target-directory) + "HTMLize dired-marked files." + (interactive "P") + (htmlize-many-files (dired-get-marked-files nil arg) target-directory)) + +(provide 'htmlize) + +;;; htmlize.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el b/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el new file mode 100644 index 0000000..9ea9015 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-annotate-file.el @@ -0,0 +1,130 @@ +;;; org-annotate-file.el --- Annotate a file with org syntax + +;; Copyright (C) 2008 Philip Jackson + +;; Author: Philip Jackson <phil@shellarchive.co.uk> +;; Version: 0.2 + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This is yet another implementation to allow the annotation of a +;; file without modification of the file itself. The annotation is in +;; org syntax so you can use all of the org features you are used to. + +;; To use you might put the following in your .emacs: +;; +;; (require 'org-annotate-file) +;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example +;; +;; To change the location of the annotation file: +;; +;; (setq org-annotate-file-storage-file "~/annotated.org") +;; +;; Then when you visit any file and hit C-c C-l you will find yourself +;; in an org buffer on a headline which links to the file you were +;; visiting, e.g: + +;; * ~/org-annotate-file.el + +;; Under here you can put anything you like, save the file +;; and next time you hit C-c C-l you will hit those notes again. +;; +;; To put a subheading with a text search for the current line set +;; `org-annotate-file-add-search` to non-nil value. Then when you hit +;; C-c C-l (on the above line for example) you will get: + +;; * ~/org-annotate-file.el +;; ** `org-annotate-file-add-search` to non-nil value. Then whe... + +;; Note that both of the above will be links. + +(require 'org) + +(defvar org-annotate-file-storage-file "~/.org-annotate-file.org" + "File in which to keep annotations.") + +(defvar org-annotate-file-add-search nil + "If non-nil then add a link as a second level to the actual +location in the file") + +(defvar org-annotate-file-always-open t + "non-nil means always expand the full tree when you visit +`org-annotate-file-storage-file'.") + +(defun org-annotate-file-elipsify-desc (string &optional after) + "Strip starting and ending whitespace and replace any chars +that appear after the value in `after' with '...'" + (let* ((after (number-to-string (or after 30))) + (replace-map (list (cons "^[ \t]*" "") + (cons "[ \t]*$" "") + (cons (concat "^\\(.\\{" after + "\\}\\).*") "\\1...")))) + (mapc (lambda (x) + (when (string-match (car x) string) + (setq string (replace-match (cdr x) nil nil string)))) + replace-map) + string)) + +(defun org-annotate-file () + "Put a section for the current file into your annotation file" + (interactive) + (unless (buffer-file-name) + (error "This buffer has no associated file.")) + (org-annotate-file-show-section)) + +(defun org-annotate-file-show-section (&optional buffer) + "Visit the buffer named `org-annotate-file-storage-file' and +show the relevant section" + (let* ((filename (abbreviate-file-name (or buffer (buffer-file-name)))) + (line (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + (link (org-make-link-string (concat "file:" filename) filename)) + (search-link (org-make-link-string + (concat "file:" filename "::" line) + (org-annotate-file-elipsify-desc line)))) + (with-current-buffer (find-file org-annotate-file-storage-file) + (unless (org-mode-p) + (org-mode)) + (goto-char (point-min)) + (widen) + (when org-annotate-file-always-open + (show-all)) + (unless (search-forward-regexp + (concat "^* " (regexp-quote link)) nil t) + (org-annotate-file-add-upper-level link)) + (beginning-of-line) + (org-narrow-to-subtree) + ;; deal with a '::' search if need be + (when org-annotate-file-add-search + (unless (search-forward-regexp + (concat "^** " (regexp-quote search-link)) nil t) + (org-annotate-file-add-second-level search-link)))))) + +(defun org-annotate-file-add-upper-level (link) + (goto-char (point-min)) + (call-interactively 'org-insert-heading) + (insert link)) + +(defun org-annotate-file-add-second-level (link) + (goto-char (point-at-eol)) + (call-interactively 'org-insert-subheading) + (insert link)) + +(provide 'org-annotate-file) +;;; org-annotate-file.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el b/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el new file mode 100644 index 0000000..06d2c60 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-bookmark.el @@ -0,0 +1,88 @@ +;;; org-bookmark.el - Support for links to bookmark +;; Copyright (C) 2008 Free Software Foundation, Inc. +;; +;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp> +;; Version: 1.0 +;; Keywords: outlines, hypermedia, calendar, wp +;; +;; This file is not part of GNU Emacs. +;; +;; Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'org) +(require 'bookmark) + +(defgroup org-bookmark nil + "Options concerning the bookmark link." + :tag "Org Startup" + :group 'org-link) + +(defcustom org-bookmark-in-dired nil + "Use org-bookmark in dired." + :group 'org-bookmark + :type 'boolean) + +(defcustom org-bookmark-when-visiting-a-file nil + "Use org-bookmark in any buffer visiting a file." + :group 'org-bookmark + :type 'boolean) + +(defcustom org-bookmark-use-first-bookmark nil + "If several bookmarks links to the buffer, take the first one. +Otherwise prompt the user for the right bookmark to use." + :group 'org-bookmark + :type 'boolean) + +(org-add-link-type "bookmark" 'org-bookmark-open) +(add-hook 'org-store-link-functions 'org-bookmark-store-link) + +(defun org-bookmark-open (bookmark) + "Visit the bookmark BOOKMARK." + (bookmark-jump bookmark)) + +(defun org-bookmark-store-link () + "Store a link to the current line's bookmark in bookmark list." + (let (file bookmark bmks) + (cond ((and org-bookmark-in-dired + (eq major-mode 'dired-mode)) + (setq file (abbreviate-file-name (dired-get-filename)))) + ((and org-bookmark-when-visiting-a-file + (buffer-file-name (buffer-base-buffer))) + (setq file (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))) + (if (not file) + (when (eq major-mode 'bookmark-bmenu-mode) + (setq bookmark (bookmark-bmenu-bookmark))) + (when (and (setq bmks + (mapcar (lambda (name) + (if (equal file + (abbreviate-file-name + (bookmark-location name))) + name)) + (bookmark-all-names))) + (setq bmks (delete nil bmks))) + (setq bookmark + (if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark) + (car bmks) + (completing-read "Bookmark: " bmks nil t nil nil (car bmks)))))) + (if bookmark + (org-store-link-props :link (org-make-link "bookmark:" bookmark) + :description bookmark)))) + +(provide 'org-bookmark) + +;;; org-bookmark.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-checklist.el b/.emacs.d/org-7.4/contrib/lisp/org-checklist.el new file mode 100644 index 0000000..50df757 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-checklist.el @@ -0,0 +1,143 @@ +;;; org-checklist.el --- org functions for checklist handling + +;; Copyright (C) 2008 James TD Smith + +;; Author: James TD Smith (@ ahktenzero (. mohorovi cc)) +;; Version: 1.0 +;; Keywords: org, checklists +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This file provides some functions for handing repeated tasks which involve +;; checking off a list of items. By setting the RESET_CHECK_BOXES property in an +;; item, when the TODO state is set to done all checkboxes under that item are +;; cleared. If the LIST_EXPORT_BASENAME property is set, a file will be created +;; using the value of that property plus a timestamp, containing all the items +;; in the list which are not checked. Additionally the user will be prompted to +;; print the list. +;; +;; I use this for to keep track of stores of various things (food stores, +;; components etc) which I check periodically and use the exported list of items +;; which are not present as a shopping list. +;; +;;; Usage: +;; (require 'org-checklist) +;; +;; Set the RESET_CHECK_BOXES and LIST_EXPORT_BASENAME properties in items as +;; needed. +;; +;;; Code: +(require 'org) +(load "a2ps-print" 'no-error) + +(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons "LIST_EXPORT_BASENAME" org-default-properties))) + +(defgroup org-checklist nil + "Extended checklist handling for org" + :tag "Org-checklist" + :group 'org) + +(defcustom org-checklist-export-time-format "%Y%m%d%H%M" + "The format of timestamp appended to LIST_EXPORT_BASENAME to + make the name of the export file." + :link '(function-link format-time-string) + :group 'org-checklist + :type 'string) + +(defcustom org-checklist-export-function 'org-export-as-ascii + "function used to prepare the export file for printing" + :group 'org-checklist + :type '(radio (function-item :tag "ascii text" org-export-as-ascii) + (function-item :tag "HTML" org-export-as-html) + (function-item :tag "LaTeX" :value org-export-as-latex) + (function-item :tag "XOXO" :value org-export-as-xoxo))) + +(defcustom org-checklist-export-params nil + "options for the export function file for printing" + :group 'org-checklist + :type '(repeat string)) + +(defcustom org-checklist-a2ps-params nil + "options for a2ps for printing" + :group 'org-checklist + :type '(repeat string)) + +(defun org-reset-checkbox-state-maybe () + "Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set" + (interactive "*") + (if (org-entry-get (point) "RESET_CHECK_BOXES") + (org-reset-checkbox-state-subtree))) + + +(defun org-make-checklist-export () + "Produce a checklist containing all unchecked items from a list +of checkbox items" + (interactive "*") + (if (org-entry-get (point) "LIST_EXPORT_BASENAME") + (let* ((export-file (concat (org-entry-get (point) "LIST_EXPORT_BASENAME" nil) + "-" (format-time-string + org-checklist-export-time-format) + ".org")) + (print (case (org-entry-get (point) "PRINT_EXPORT" nil) + (("" "nil" nil) nil) + (t t) + (nil (y-or-n-p "Print list? ")))) + exported-lines + (title "Checklist export")) + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-update-checkbox-count-maybe) + (org-show-subtree) + (goto-char (point-min)) + (when (looking-at org-complex-heading-regexp) + (setq title (match-string 4))) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (and (org-at-item-checkbox-p) + (or (string= (match-string 0) "[ ]") + (string= (match-string 0) "[-]"))) + (add-to-list 'exported-lines (thing-at-point 'line) t)) + (beginning-of-line 2))) + (set-buffer (get-buffer-create export-file)) + (org-insert-heading) + (insert (or title export-file) "\n") + (dolist (entry exported-lines) (insert entry)) + (org-update-checkbox-count-maybe) + (write-file export-file) + (if (print) + (progn (funcall org-checklist-export-function + org-checklist-export-params) + (let* ((current-a2ps-switches a2ps-switches) + (a2ps-switches (append current-a2ps-switches + org-checklist-a2ps-params))) + (a2ps-buffer))))))))) + +(defun org-checklist () + (when (member state org-done-keywords) + (org-make-checklist-export) + (org-reset-checkbox-state-maybe))) + +(add-hook 'org-after-todo-state-change-hook 'org-checklist) + +(provide 'org-checklist) + +;;; org-checklist.el ends here + + + diff --git a/.emacs.d/org-7.4/contrib/lisp/org-choose.el b/.emacs.d/org-7.4/contrib/lisp/org-choose.el new file mode 100644 index 0000000..6f7f120 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-choose.el @@ -0,0 +1,539 @@ +;;;_ org-choose.el --- decision management for org-mode + +;;;_. Headers +;;;_ , License +;; Copyright (C) 2009 Tom Breton (Tehom) + +;; Author: Tom Breton (Tehom) +;; Keywords: outlines, convenience + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;;_ , Commentary: + +; This is code to support decision management. It lets you treat a +; group of sibling items in org-mode as alternatives in a decision. + +; There are no user commands in this file. You use it by: +; * Loading it (manually or by M-x customize-apropos org-modules) + +;; * Setting up at least one set of TODO keywords with the +;; interpretation "choose" by either: + +;; * Using the file directive #+CHOOSE_TODO: + +;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES" + +;; * Or by M-x customize-apropos org-todo-keywords + +;; * Operating on single items with the TODO commands. + +;; * Use C-S-right to change the keyword set. Use this to change to +;; the "choose" keyword set that you just defined. + +;; * Use S-right to advance the TODO mark to the next setting. + +;; For "choose", that means you like this alternative more than +;; before. Other alternatives will be automatically demoted to +;; keep your settings consistent. + +;; * Use S-left to demote TODO to the previous setting. + +;; For "choose", that means you don't like this alternative as much +;; as before. Other alternatives will be automatically promoted, +;; if this item was all that was keeping them down. + +;; * All the other TODO commands are available and behave essentially +;; the normal way. + + +;;;_ , Requires + +(require 'org) +;(eval-when-compile +; (require 'cl)) +(require 'cl) + +;;;_. Body +;;;_ , The variables + +(defstruct (org-choose-mark-data. (:type list)) + "The format of an entry in org-choose-mark-data. +Indexes are 0-based or `nil'. +" + keyword + bot-lower-range + top-upper-range + range-length + static-default + all-keywords) + +(defvar org-choose-mark-data + () + "Alist of information for choose marks. + +Each entry is an `org-choose-mark-data.'" ) +(make-variable-buffer-local 'org-choose-mark-data) +;;;_ , For setup +;;;_ . org-choose-filter-one + +(defun org-choose-filter-one (i) + "Return a list of + * a canonized version of the string + * optionally one symbol" + + (if + (not + (string-match "(.*)" i)) + (list i i) + (let* + ( + (end-text (match-beginning 0)) + (vanilla-text (substring i 0 end-text)) + ;;Get the parenthesized part. + (match (match-string 0 i)) + ;;Remove the parentheses. + (args (substring match 1 -1)) + ;;Split it + (arglist + (let + ((arglist-x (org-split-string args ","))) + ;;When string starts with "," `split-string' doesn't + ;;make a first arg, so in that case make one + ;;manually. + (if + (string-match "^," args) + (cons nil arglist-x) + arglist-x))) + (decision-arg (second arglist)) + (type + (cond + ((string= decision-arg "0") + 'default-mark) + ((string= decision-arg "+") + 'top-upper-range) + ((string= decision-arg "-") + 'bot-lower-range) + (t nil))) + (vanilla-arg (first arglist)) + (vanilla-mark + (if vanilla-arg + (concat vanilla-text "("vanilla-arg")") + vanilla-text))) + (if type + (list vanilla-text vanilla-mark type) + (list vanilla-text vanilla-mark))))) + +;;;_ . org-choose-setup-vars +(defun org-choose-setup-vars (bot-lower-range top-upper-range + static-default num-items all-mark-texts) + "Add to org-choose-mark-data according to arguments" + + (let* + ( + (tail + ;;If there's no bot-lower-range or no default, we don't + ;;have ranges. + (cdr + (if (and static-default bot-lower-range) + (let* + ( + ;;If there's no top-upper-range, use the last + ;;item. + (top-upper-range + (or top-upper-range (1- num-items))) + (lower-range-length + (1+ (- static-default bot-lower-range))) + (upper-range-length + (- top-upper-range static-default)) + (range-length + (min upper-range-length lower-range-length))) + + + (make-org-choose-mark-data. + :keyword nil + :bot-lower-range bot-lower-range + :top-upper-range top-upper-range + :range-length range-length + :static-default static-default + :all-keywords all-mark-texts)) + + (make-org-choose-mark-data. + :keyword nil + :bot-lower-range nil + :top-upper-range nil + :range-length nil + :static-default (or static-default 0) + :all-keywords all-mark-texts))))) + + (dolist (text all-mark-texts) + (pushnew (cons text tail) + org-choose-mark-data + :test + #'(lambda (a b) + (equal (car a) (car b))))))) + + + + +;;;_ . org-choose-filter-tail +(defun org-choose-filter-tail (raw) + "Return a translation of RAW to vanilla and set appropriate +buffer-local variables. + +RAW is a list of strings representing the input text of a choose +interpretation." + (let + ((vanilla-list nil) + (all-mark-texts nil) + (index 0) + bot-lower-range top-upper-range range-length static-default) + (dolist (i raw) + (destructuring-bind + (vanilla-text vanilla-mark &optional type) + (org-choose-filter-one i) + (cond + ((eq type 'bot-lower-range) + (setq bot-lower-range index)) + ((eq type 'top-upper-range) + (setq top-upper-range index)) + ((eq type 'default-mark) + (setq static-default index))) + (incf index) + (push vanilla-text all-mark-texts) + (push vanilla-mark vanilla-list))) + + (org-choose-setup-vars bot-lower-range top-upper-range + static-default index (reverse all-mark-texts)) + (nreverse vanilla-list))) + +;;;_ . org-choose-setup-filter + +(defun org-choose-setup-filter (raw) + "A setup filter for choose interpretations." + (when (eq (car raw) 'choose) + (cons + 'choose + (org-choose-filter-tail (cdr raw))))) + +;;;_ . org-choose-conform-after-promotion +(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix) + "Conform the current item after another item was promoted" + + (unless + ;;Skip the entry that triggered this by skipping any entry with + ;;the same starting position. plist uses the start of the + ;;header line as the position, but map no longer does, so we + ;;have to go back to the heading. + (= + (save-excursion + (org-back-to-heading) + (point)) + entry-pos) + (let + ((ix + (org-choose-get-entry-index keywords))) + ;;If the index of the entry exceeds the highest allowable + ;;index, change it to that. + (when (and ix + (> ix highest-ok-ix)) + (org-todo + (nth highest-ok-ix keywords)))))) +;;;_ . org-choose-conform-after-demotion +(defun org-choose-conform-after-demotion (entry-pos keywords + raise-to-ix + old-highest-ok-ix) + "Conform the current item after another item was demoted." + + (unless + ;;Skip the entry that triggered this. + (= + (save-excursion + (org-back-to-heading) + (point)) + entry-pos) + (let + ((ix + (org-choose-get-entry-index keywords))) + ;;If the index of the entry was at or above the old allowable + ;;position, change it to the new mirror position if there is + ;;one. + (when (and + ix + raise-to-ix + (>= ix old-highest-ok-ix)) + (org-todo + (nth raise-to-ix keywords)))))) + +;;;_ , org-choose-keep-sensible (the org-trigger-hook function) +(defun org-choose-keep-sensible (change-plist) + "Bring the other items back into a sensible state after an item's +setting was changed." + (let* + ( (from (plist-get change-plist :from)) + (to (plist-get change-plist :to)) + (entry-pos + (set-marker + (make-marker) + (plist-get change-plist :position))) + (kwd-data + (assoc to org-todo-kwd-alist))) + (when + (eq (nth 1 kwd-data) 'choose) + (let* + ( + (data + (assoc to org-choose-mark-data)) + (keywords + (org-choose-mark-data.-all-keywords data)) + (old-index + (org-choose-get-index-in-keywords + from + keywords)) + (new-index + (org-choose-get-index-in-keywords + to + keywords)) + (highest-ok-ix + (org-choose-highest-other-ok + new-index + data)) + (funcdata + (cond + ;;The entry doesn't participate in conformance, + ;;so give `nil' which does nothing. + ((not highest-ok-ix) nil) + ;;The entry was created or promoted + ((or + (not old-index) + (> new-index old-index)) + (list + #'org-choose-conform-after-promotion + entry-pos keywords + highest-ok-ix)) + (t ;;Otherwise the entry was demoted. + (let + ( + (raise-to-ix + (min + highest-ok-ix + (org-choose-mark-data.-static-default + data))) + (old-highest-ok-ix + (org-choose-highest-other-ok + old-index + data))) + + (list + #'org-choose-conform-after-demotion + entry-pos + keywords + raise-to-ix + old-highest-ok-ix)))))) + + (if funcdata + ;;The funny-looking names are to make variable capture + ;;unlikely. (Poor-man's lexical bindings). + (destructuring-bind (func-d473 . args-46k) funcdata + (let + ((map-over-entries + (org-choose-get-fn-map-group)) + ;;We may call `org-todo', so let various hooks + ;;`nil' so we don't cause loops. + org-after-todo-state-change-hook + org-trigger-hook + org-blocker-hook + org-todo-get-default-hook + ;;Also let this alist `nil' so we don't log + ;;secondary transitions. + org-todo-log-states) + ;;Map over group + (funcall map-over-entries + #'(lambda () + (apply func-d473 args-46k)))))))) + + ;;Remove the marker + (set-marker entry-pos nil))) + + + +;;;_ , Getting the default mark +;;;_ . org-choose-get-index-in-keywords +(defun org-choose-get-index-in-keywords (ix all-keywords) + "Return the index of the current entry." + + (if ix + (position ix all-keywords + :test #'equal))) + +;;;_ . org-choose-get-entry-index +(defun org-choose-get-entry-index (all-keywords) + "Return index of current entry." + + (let* + ((state (org-entry-get (point) "TODO"))) + (org-choose-get-index-in-keywords state all-keywords))) + +;;;_ . org-choose-get-fn-map-group + +(defun org-choose-get-fn-map-group () + "Return a function to map over the group" + + #'(lambda (fn) + (require 'org-agenda) ;; `org-map-entries' seems to need it. + (save-excursion + (unless (org-up-heading-safe) + (error "Choosing is only supported between siblings in a tree, not on top level")) + (let + ((level (org-reduced-level (org-outline-level)))) + (save-restriction + (org-map-entries + fn + (format "LEVEL=%d" level) + 'tree)))))) + +;;;_ . org-choose-get-highest-mark-index + +(defun org-choose-get-highest-mark-index (keywords) + "Get the index of the highest current mark in the group. +If there is none, return 0" + + (let* + ( + ;;Func maps over applicable entries. + (map-over-entries + (org-choose-get-fn-map-group)) + + (indexes-list + (remove nil + (funcall map-over-entries + #'(lambda () + (org-choose-get-entry-index keywords)))))) + (if + indexes-list + (apply #'max indexes-list) + 0))) + + +;;;_ . org-choose-highest-ok + +(defun org-choose-highest-other-ok (ix data) + "Return the highest index that any choose mark can sensibly have, +given that another mark has index IX. +DATA must be a `org-choose-mark-data.'." + + (let + ( + (bot-lower-range + (org-choose-mark-data.-bot-lower-range data)) + (top-upper-range + (org-choose-mark-data.-top-upper-range data)) + (range-length + (org-choose-mark-data.-range-length data))) + (when (and ix bot-lower-range) + (let* + ((delta + (- top-upper-range ix))) + (unless + (< range-length delta) + (+ bot-lower-range delta)))))) + +;;;_ . org-choose-get-default-mark-index + +(defun org-choose-get-default-mark-index (data) + "Return the index of the default mark in a choose interpretation. + +DATA must be a `org-choose-mark-data.'." + + + (or + (let + ((highest-mark-index + (org-choose-get-highest-mark-index + (org-choose-mark-data.-all-keywords data)))) + (org-choose-highest-other-ok + highest-mark-index data)) + (org-choose-mark-data.-static-default data))) + + + +;;;_ . org-choose-get-mark-N +(defun org-choose-get-mark-N (n data) + "Get the text of the nth mark in a choose interpretation." + + (let* + ((l (org-choose-mark-data.-all-keywords data))) + (nth n l))) + +;;;_ . org-choose-get-default-mark + +(defun org-choose-get-default-mark (new-mark old-mark) + "Get the default mark IFF in a choose interpretation. +NEW-MARK and OLD-MARK are the text of the new and old marks." + + (let* + ( + (old-kwd-data + (assoc old-mark org-todo-kwd-alist)) + (new-kwd-data + (assoc new-mark org-todo-kwd-alist)) + (becomes-choose + (and + (or + (not old-kwd-data) + (not + (eq (nth 1 old-kwd-data) 'choose))) + (eq (nth 1 new-kwd-data) 'choose)))) + (when + becomes-choose + (let + ((new-mark-data + (assoc new-mark org-choose-mark-data))) + (if + new-mark + (org-choose-get-mark-N + (org-choose-get-default-mark-index + new-mark-data) + new-mark-data) + (error "Somehow got an unrecognizable mark")))))) + +;;;_ , Setting it all up + +(eval-after-load "org" + '(progn + (add-to-list 'org-todo-setup-filter-hook + #'org-choose-setup-filter) + (add-to-list 'org-todo-get-default-hook + #'org-choose-get-default-mark) + (add-to-list 'org-trigger-hook + #'org-choose-keep-sensible) + (add-to-list 'org-todo-interpretation-widgets + '(:tag "Choose (to record decisions)" choose) + 'append) + )) + + +;;;_. Footers +;;;_ , Provides + +(provide 'org-choose) + +;;;_ * Local emacs vars. +;;;_ + Local variables: +;;;_ + End: + +;;;_ , End +;;; org-choose.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-collector.el b/.emacs.d/org-7.4/contrib/lisp/org-collector.el new file mode 100644 index 0000000..1d4f042 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-collector.el @@ -0,0 +1,235 @@ +;;; org-collector --- collect properties into tables + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Eric Schulte <schulte dot eric at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp, experimentation, +;; organization, properties +;; Homepage: http://orgmode.org +;; Version: 0.01 + +;; This file is not yet part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Pass in an alist of columns, each column can be either a single +;; property or a function which takes column names as arguments. +;; +;; For example the following propview block would collect the value of +;; the 'amount' property from each header in the current buffer +;; +;; #+BEGIN: propview :cols (ITEM amount) +;; | "ITEM" | "amount" | +;; |---------------------+----------| +;; | "December Spending" | 0 | +;; | "Grocery Store" | 56.77 | +;; | "Athletic club" | 75.0 | +;; | "Restaurant" | 30.67 | +;; | "January Spending" | 0 | +;; | "Athletic club" | 75.0 | +;; | "Restaurant" | 50.00 | +;; |---------------------+----------| +;; | | | +;; #+END: +;; +;; This slightly more selective propview block will limit those +;; headers included to those in the subtree with the id 'december' +;; in which the spendtype property is equal to "food" +;; +;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount) +;; | "ITEM" | "amount" | +;; |-----------------+----------| +;; | "Grocery Store" | 56.77 | +;; | "Restaurant" | 30.67 | +;; |-----------------+----------| +;; | | | +;; #+END: +;; +;; Org Collector allows arbitrary processing of the property values +;; through elisp in the cols: property. This allows for both simple +;; computations as in the following example +;; +;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d)) +;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" | "(+ f d)" | +;; |--------+-----+-----+-------------------------+--------------------------+-----------| +;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 | 35 | +;; | "run2" | 2 | 34 | :na | :na | 36 | +;; | "run3" | 2 | 35 | :na | :na | 37 | +;; | "run4" | 2 | 36 | :na | :na | 38 | +;; | | | | | | | +;; #+END: +;; +;; or more complex computations as in the following example taken from +;; an org file where each header in "results" subtree contained a +;; property "sorted_hits" which was passed through the +;; "average-precision" elisp function +;; +;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits)) +;; | "ITEM" | "(average-precision sorted_hits)" | +;; |-----------+-----------------------------------| +;; | run (80) | 0.105092 | +;; | run (70) | 0.108142 | +;; | run (10) | 0.111348 | +;; | run (60) | 0.113593 | +;; | run (50) | 0.116446 | +;; | run (100) | 0.118863 | +;; #+END: +;; + +;;; Code: +(require 'org) +(require 'org-table) + +(defvar org-propview-default-value 0 + "Default value to insert into the propview table when the no +value is calculated either through lack of required variables for +a column, or through the generation of an error.") + +(defun and-rest (list) + (if (listp list) + (if (> (length list) 1) + (and (car list) (and-rest (cdr list))) + (car list)) + list)) + +(put 'org-collector-error + 'error-conditions + '(error column-prop-error org-collector-error)) + +(defun org-read-prop (prop) + "Convert the string property PROP to a number if appropriate. +If prop looks like a list (meaning it starts with a '(') then +read it as lisp expression, otherwise return it unmodified as a +string. + +Results of calling: +\(org-read-prop \"12\") -> 12 +\(org-read-prop \"(1 2 3)\") -> (1 2 3) +\(org-read-prop \"+0\") -> 0 +\(org-read-prop \"aaa\") -> \"aaa\"" + (if (and (stringp prop) (not (equal prop ""))) + (let ((out (string-to-number prop))) + (if (equal out 0) + (cond + ((or + (equal "(" (substring prop 0 1)) + (equal "'" (substring prop 0 1))) + + (condition-case nil + (read prop) + (error prop))) + ((string-match "^\\(+0\\|-0\\|0\\)$" prop) + 0) + (t + (set-text-properties 0 (length prop) nil prop) + prop)) + out)) + prop)) + +(defun org-dblock-write:propview (params) + "collect the column specification from the #+cols line +preceeding the dblock, then update the contents of the dblock." + (interactive) + (condition-case er + (let ((cols (plist-get params :cols)) + (conds (plist-get params :conds)) + (match (plist-get params :match)) + (scope (plist-get params :scope)) + (content-lines (org-split-string (plist-get params :content) "\n")) + id table line pos) + (save-excursion + (when (setq id (plist-get params :id)) + (cond ((not id) nil) + ((eq id 'global) (goto-char (point-min))) + ((eq id 'local) nil) + ((setq idpos (org-find-entry-with-id id)) + (goto-char idpos)) + (t (error "Cannot find entry with :ID: %s" id)))) + (org-narrow-to-subtree) + (setq table (org-propview-to-table (org-propview-collect cols conds match scope))) + (widen)) + (setq pos (point)) + (when content-lines + (while (string-match "^#" (car content-lines)) + (insert (pop content-lines) "\n"))) + (insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1) + (message (format "point-%d" pos)) + (while (setq line (pop content-lines)) + (when (string-match "^#" line) + (insert "\n" line))) + (goto-char pos) + (org-table-recalculate 'all)) + (org-collector-error (widen) (error "%s" er)) + (error (widen) (error "%s" er)))) + +(defun org-propview-eval-w-props (props body) + "evaluate the BODY-FORMS binding the variables using the +variables and values specified in props" + (condition-case nil ;; catch any errors + (eval `(let ,(mapcar + (lambda (pair) (list (intern (car pair)) (cdr pair))) + props) + ,body)) + (error nil))) + +(defun org-propview-collect (cols &optional conds match scope) + (interactive) + ;; collect the properties from every header + (let* ((header-props + (let ((org-trust-scanner-tags t)) + (org-map-entries (quote (cons (cons "ITEM" (org-get-heading t)) + (org-entry-properties))) + match scope))) + ;; read property values + (header-props (mapcar (lambda (props) + (mapcar (lambda (pair) (cons (car pair) (org-read-prop (cdr pair)))) + props)) + header-props)) + ;; collect all property names + (prop-names (mapcar 'intern (delete-dups + (apply 'append (mapcar (lambda (header) + (mapcar 'car header)) + header-props)))))) + (append + (list + (mapcar (lambda (el) (format "%S" el)) cols) ;; output headers + 'hline) ;; ------------------------------------------------ + (mapcar ;; calculate the value of the column for each header + (lambda (props) (mapcar (lambda (col) (let ((result (org-propview-eval-w-props props col))) + (if result result org-propview-default-value))) + cols)) + (if conds + ;; eliminate the headers which don't satisfy the property + (delq nil + (mapcar + (lambda (props) + (if (and-rest (mapcar (lambda (col) (org-propview-eval-w-props props col)) conds)) + props)) + header-props)) + header-props))))) + +(defun org-propview-to-table (results) + ;; (message (format "cols:%S" cols)) + (orgtbl-to-orgtbl + (mapcar + (lambda (row) + (if (equal row 'hline) + 'hline + (mapcar (lambda (el) (format "%S" el)) row))) + (delq nil results)) '())) + +(provide 'org-collector) +;;; org-collector ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el b/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el new file mode 100644 index 0000000..92c50a0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-contribdir.el @@ -0,0 +1,38 @@ +;;; org-contribdir.el --- Mark the location of the contrib directory +;; Copyright (C) 2009 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 0.01 +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; + +;; The sole purpose of this file is to be located in the same place +;; as where the contributed Org files are located, typically in the +;; contrib/lisp directory of the Org-mode distribution. This is to +;; make sure that the command `org-reload' can reliably locate +;; contributed org files. + +(provide 'org-contribdir) + +;;; org-contribdir.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-depend.el b/.emacs.d/org-7.4/contrib/lisp/org-depend.el new file mode 100644 index 0000000..089a6a0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-depend.el @@ -0,0 +1,279 @@ +;;; org-depend.el --- TODO dependencies for Org-mode +;; Copyright (C) 2008 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 0.08 +;; +;; This file is not part of GNU Emacs. +;; +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part +;; of Org-mode. +;; +;; This is an example implementation of TODO dependencies in Org-mode. +;; It uses the new hooks in version 5.13 of Org-mode, +;; `org-trigger-hook' and `org-blocker-hook'. +;; +;; It implements the following: +;; +;; Triggering +;; ---------- +;; +;; 1) If an entry contains a TRIGGER property that contains the string +;; "chain-siblings(KEYWORD)", then switching that entry to DONE does +;; do the following: +;; - The sibling following this entry switched to todo-state KEYWORD. +;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)", +;; property, to make sure that, when *it* is DONE, the chain will +;; continue. +;; +;; 2) If an entry contains a TRIGGER property that contains the string +;; "chain-siblings-scheduled", then switching that entry to DONE does +;; the following actions, similarly to "chain-siblings(KEYWORD)": +;; - The sibling receives the same scheduled time as the entry +;; marked as DONE (or, in the case, in which there is no scheduled +;; time, the sibling does not get any either). +;; - The sibling also gets the same TRIGGER property +;; "chain-siblings-scheduled", so the chain can continue. +;; +;; 3) If the TRIGGER property contains any other words like +;; XYZ(KEYWORD), these are treated as entry id's with keywords. That +;; means Org-mode will search for an entry with the ID property XYZ +;; and switch that entry to KEYWORD as well. +;; +;; Blocking +;; -------- +;; +;; 1) If an entry contains a BLOCKER property that contains the word +;; "previous-sibling", the sibling above the current entry is +;; checked when you try to mark it DONE. If it is still in a TODO +;; state, the current state change is blocked. +;; +;; 2) If the BLOCKER property contains any other words, these are +;; treated as entry id's. That means Org-mode will search for an +;; entry with the ID property exactly equal to this word. If any +;; of these entries is not yet marked DONE, the current state change +;; will be blocked. +;; +;; 3) Whenever a state change is blocked, an org-mark is pushed, so that +;; you can find the offending entry with `C-c &'. +;; +;;; Example: +;; +;; When trying this example, make sure that the settings for TODO keywords +;; have been activated, i.e. include the following line and press C-c C-c +;; on the line before working with the example: +;; +;; #+TYP_TODO: TODO NEXT | DONE +;; +;; * TODO Win a million in Las Vegas +;; The "third" TODO (see above) cannot become a TODO without this money. +;; +;; :PROPERTIES: +;; :ID: I-cannot-do-it-without-money +;; :END: +;; +;; * Do this by doing a chain of TODO's +;; ** NEXT This is the first in this chain +;; :PROPERTIES: +;; :TRIGGER: chain-siblings(NEXT) +;; :END: +;; +;; ** This is the second in this chain +;; +;; ** This is the third in this chain +;; :PROPERTIES: +;; :BLOCKER: I-cannot-do-it-without-money +;; :END: +;; +;; ** This is the forth in this chain +;; When this is DONE, we will also trigger entry XYZ-is-my-id +;; :PROPERTIES: +;; :TRIGGER: XYZ-is-my-id(TODO) +;; :END: +;; +;; ** This is the fifth in this chain +;; +;; * Start writing report +;; :PROPERTIES: +;; :ID: XYZ-is-my-id +;; :END: +;; +;; + +(require 'org) + +(defcustom org-depend-tag-blocked t + "Whether to indicate blocked TODO items by a special tag." + :group 'org + :type 'boolean) + +(defmacro org-depend-act-on-sibling (trigger-val &rest rest) + "Perform a set of actions on the next sibling, if it exists, +copying the sibling spec TRIGGER-VAL to the next sibling." + `(catch 'exit + (save-excursion + (goto-char pos) + ;; find the sibling, exit if no more siblings + (condition-case nil + (outline-forward-same-level 1) + (error (throw 'exit t))) + ;; mark the sibling TODO + ,@rest + ;; make sure the sibling will continue the chain + (org-entry-add-to-multivalued-property + nil "TRIGGER" ,trigger-val)))) + +(defun org-depend-trigger-todo (change-plist) + "Trigger new TODO entries after the current is switched to DONE. +This does two different kinds of triggers: + +- If the current entry contains a TRIGGER property that contains + \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it + KEYWORD and also installs the \"chain-sibling\" trigger to continue + the chain. +- If the current entry contains a TRIGGER property that contains + \"chain-siblings-scheduled\", we go to the next sibling and copy + the scheduled time from the current task, also installing the property + in the sibling. +- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER + property is seen as an entry id. Org-mode finds the entry with the + corresponding ID property and switches it to the state TODO as well." + + ;; Get information from the plist + (let* ((type (plist-get change-plist :type)) + (pos (plist-get change-plist :position)) + (from (plist-get change-plist :from)) + (to (plist-get change-plist :to)) + (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger! + trigger triggers tr p1 kwd) + (catch 'return + (unless (eq type 'todo-state-change) + ;; We are only handling todo-state-change.... + (throw 'return t)) + (unless (and (member from org-not-done-keywords) + (member to org-done-keywords)) + ;; This is not a change from TODO to DONE, ignore it + (throw 'return t)) + + ;; OK, we just switched from a TODO state to a DONE state + ;; Lets see if this entry has a TRIGGER property. + ;; If yes, split it up on whitespace. + (setq trigger (org-entry-get pos "TRIGGER") + triggers (and trigger (org-split-string trigger "[ \t]+"))) + + ;; Go through all the triggers + (while (setq tr (pop triggers)) + (cond + ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr) + ;; This is a TODO chain of siblings + (setq kwd (match-string 1 tr)) + (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd) + (org-todo kwd))) + + ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr) + ;; This seems to be ENTRY_ID(KEYWORD) + (setq id (match-string 1 tr) + kwd (match-string 2 tr) + p1 (org-find-entry-with-id id)) + (when p1 + ;; there is an entry with this ID, mark it TODO + (save-excursion + (goto-char p1) + (org-todo kwd)))) + ((string-match "\\`chain-siblings-scheduled\\'" tr) + (let ((time (org-get-scheduled-time pos))) + (when time + (org-depend-act-on-sibling + "chain-siblings-scheduled" + (org-schedule nil time)))))))))) + +(defun org-depend-block-todo (change-plist) + "Block turning an entry into a TODO. +This checks for a BLOCKER property in an entry and checks +all the entries listed there. If any of them is not done, +block changing the current entry into a TODO entry. If the property contains +the word \"previous-sibling\", the sibling above the current entry is checked. +Any other words are treated as entry id's. If an entry exists with the +this ID property, that entry is also checked." + ;; Get information from the plist + (let* ((type (plist-get change-plist :type)) + (pos (plist-get change-plist :position)) + (from (plist-get change-plist :from)) + (to (plist-get change-plist :to)) + (org-log-done nil) ; IMPROTANT!: no logging during automatic trigger + blocker blockers bl p1 + (proceed-p + (catch 'return + ;; If this is not a todo state change, or if this entry is + ;; DONE, do not block + (when (or (not (eq type 'todo-state-change)) + (member from (cons 'done org-done-keywords)) + (member to (cons 'todo org-not-done-keywords)) + (not to)) + (throw 'return t)) + + ;; OK, the plan is to switch from nothing to TODO + ;; Lets see if we will allow it. Find the BLOCKER property + ;; and split it on whitespace. + (setq blocker (org-entry-get pos "BLOCKER") + blockers (and blocker (org-split-string blocker "[ \t]+"))) + + ;; go through all the blockers + (while (setq bl (pop blockers)) + (cond + ((equal bl "previous-sibling") + ;; the sibling is required to be DONE. + (catch 'ignore + (save-excursion + (goto-char pos) + ;; find the older sibling, exit if no more siblings + (condition-case nil + (outline-backward-same-level 1) + (error (throw 'ignore t))) + ;; Check if this entry is not yet done and block + (unless (org-entry-is-done-p) + ;; return nil, to indicate that we block the change! + (org-mark-ring-push) + (throw 'return nil))))) + + ((setq p1 (org-find-entry-with-id bl)) + ;; there is an entry with this ID, check it out + (save-excursion + (goto-char p1) + (unless (org-entry-is-done-p) + ;; return nil, to indicate that we block the change! + (org-mark-ring-push) + (throw 'return nil)))))) + t ; return t to indicate that we are not blocking + ))) + (when org-depend-tag-blocked + (org-toggle-tag "blocked" (if proceed-p 'off 'on))) + + proceed-p)) + +(add-hook 'org-trigger-hook 'org-depend-trigger-todo) +(add-hook 'org-blocker-hook 'org-depend-block-todo) + +(provide 'org-depend) + +;;; org-depend.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-drill.el b/.emacs.d/org-7.4/contrib/lisp/org-drill.el new file mode 100644 index 0000000..6b5ff06 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-drill.el @@ -0,0 +1,1144 @@ +;;; org-drill.el - Self-testing with org-learn +;;; +;;; Author: Paul Sexton <eeeickythump@gmail.com> +;;; Version: 1.4 +;;; Repository at http://bitbucket.org/eeeickythump/org-drill/ +;;; +;;; +;;; Synopsis +;;; ======== +;;; +;;; Uses the spaced repetition algorithm in `org-learn' to conduct interactive +;;; "drill sessions", where the material to be remembered is presented to the +;;; student in random order. The student rates his or her recall of each item, +;;; and this information is fed back to `org-learn' to schedule the item for +;;; later revision. +;;; +;;; Each drill session can be restricted to topics in the current buffer +;;; (default), one or several files, all agenda files, or a subtree. A single +;;; topic can also be drilled. +;;; +;;; Different "card types" can be defined, which present their information to +;;; the student in different ways. +;;; +;;; See the file README.org for more detailed documentation. + + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'hi-lock)) +(require 'org) +(require 'org-learn) + + +(defgroup org-drill nil + "Options concerning interactive drill sessions in Org mode (org-drill)." + :tag "Org-Drill" + :group 'org-link) + + + +(defcustom org-drill-question-tag + "drill" + "Tag which topics must possess in order to be identified as review topics +by `org-drill'." + :group 'org-drill + :type 'string) + + + +(defcustom org-drill-maximum-items-per-session + 30 + "Each drill session will present at most this many topics for review. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + + +(defcustom org-drill-maximum-duration + 20 + "Maximum duration of a drill session, in minutes. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + +(defcustom org-drill-failure-quality + 2 + "If the quality of recall for an item is this number or lower, +it is regarded as an unambiguous failure, and the repetition +interval for the card is reset to 0 days. By default this is +2. For Mnemosyne-like behaviour, set it to 1. Other values are +not really sensible." + :group 'org-drill + :type '(choice (const 2) (const 1))) + + +(defcustom org-drill-leech-failure-threshold + 15 + "If an item is forgotten more than this many times, it is tagged +as a 'leech' item." + :group 'org-drill + :type '(choice integer (const nil))) + + +(defcustom org-drill-leech-method + 'skip + "How should 'leech items' be handled during drill sessions? +Possible values: +- nil :: Leech items are treated the same as normal items. +- skip :: Leech items are not included in drill sessions. +- warn :: Leech items are still included in drill sessions, + but a warning message is printed when each leech item is + presented." + :group 'org-drill + :type '(choice (const 'warn) (const 'skip) (const nil))) + + +(defface org-drill-visible-cloze-face + '((t (:foreground "darkseagreen"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(defface org-drill-visible-cloze-hint-face + '((t (:foreground "dark slate blue"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(defcustom org-drill-use-visible-cloze-face-p + nil + "Use a special face to highlight cloze-deleted text in org mode +buffers?" + :group 'org-drill + :type 'boolean) + + +(defface org-drill-hidden-cloze-face + '((t (:foreground "deep sky blue" :background "blue"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(defcustom org-drill-new-count-color + "royal blue" + "Foreground colour used to display the count of remaining new items +during a drill session." + :group 'org-drill + :type 'color) + +(defcustom org-drill-mature-count-color + "green" + "Foreground colour used to display the count of remaining mature items +during a drill session. Mature items are due for review, but are not new." + :group 'org-drill + :type 'color) + +(defcustom org-drill-failed-count-color + "red" + "Foreground colour used to display the count of remaining failed items +during a drill session." + :group 'org-drill + :type 'color) + +(defcustom org-drill-done-count-color + "sienna" + "Foreground colour used to display the count of reviewed items +during a drill session." + :group 'org-drill + :type 'color) + + +(setplist 'org-drill-cloze-overlay-defaults + '(display "[...]" + face org-drill-hidden-cloze-face + window t)) + + +(defvar org-drill-cloze-regexp + ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)" + ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)" + ;; ver 3! "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)" + "\\(\\[[[:cntrl:][:graph:][:space:]]*?\\)\\(\\||.+?\\)\\(\\]\\)") + +(defvar org-drill-cloze-keywords + `((,org-drill-cloze-regexp + (1 'org-drill-visible-cloze-face nil) + (2 'org-drill-visible-cloze-hint-face t) + (3 'org-drill-visible-cloze-face nil) + ))) + + +(defcustom org-drill-card-type-alist + '((nil . org-drill-present-simple-card) + ("simple" . org-drill-present-simple-card) + ("twosided" . org-drill-present-two-sided-card) + ("multisided" . org-drill-present-multi-sided-card) + ("multicloze" . org-drill-present-multicloze) + ("spanish_verb" . org-drill-present-spanish-verb)) + "Alist associating card types with presentation functions. Each entry in the +alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string +or nil, and FUNCTION is a function which takes no arguments and returns a +boolean value." + :group 'org-drill + :type '(alist :key-type (choice string (const nil)) :value-type function)) + + +(defcustom org-drill-spaced-repetition-algorithm + 'sm5 + "Which SuperMemo spaced repetition algorithm to use for scheduling items. +Available choices are SM2 and SM5." + :group 'org-drill + :type '(choice (const 'sm2) (const 'sm5))) + +(defcustom org-drill-add-random-noise-to-intervals-p + nil + "If true, the number of days until an item's next repetition +will vary slightly from the interval calculated by the SM2 +algorithm. The variation is very small when the interval is +small, and scales up with the interval. The code for calculating +random noise is adapted from Mnemosyne." + :group 'org-drill + :type 'boolean) + +(defcustom org-drill-cram-hours + 12 + "When in cram mode, items are considered due for review if +they were reviewed at least this many hours ago." + :group 'org-drill + :type 'integer) + + +(defvar *org-drill-session-qualities* nil) +(defvar *org-drill-start-time* 0) +(defvar *org-drill-new-entries* nil) +(defvar *org-drill-mature-entries* nil) +(defvar *org-drill-failed-entries* nil) +(defvar *org-drill-again-entries* nil) +(defvar *org-drill-done-entries* nil) +(defvar *org-drill-cram-mode* nil + "Are we in 'cram mode', where all items are considered due +for review unless they were already reviewed in the recent past?") + + + +;;;; Utilities ================================================================ + + +(defun free-marker (m) + (set-marker m nil)) + + +(defmacro pop-random (place) + (let ((elt (gensym))) + `(if (null ,place) + nil + (let ((,elt (nth (random (length ,place)) ,place))) + (setq ,place (remove ,elt ,place)) + ,elt)))) + + +(defun shuffle-list (list) + "Randomly permute the elements of LIST (all permutations equally likely)." + ;; Adapted from 'shuffle-vector' in cookie1.el + (let ((i 0) + j + temp + (len (length list))) + (while (< i len) + (setq j (+ i (random (- len i)))) + (setq temp (nth i list)) + (setf (nth i list) (nth j list)) + (setf (nth j list) temp) + (setq i (1+ i)))) + list) + + +(defun time-to-inactive-org-timestamp (time) + (format-time-string + (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") + time)) + + + +(defmacro with-hidden-cloze-text (&rest body) + `(progn + (org-drill-hide-clozed-text) + (unwind-protect + (progn + ,@body) + (org-drill-unhide-clozed-text)))) + + +(defun org-drill-days-since-last-review () + "Nil means a last review date has not yet been stored for +the item. +Zero means it was reviewed today. +A positive number means it was reviewed that many days ago. +A negative number means the date of last review is in the future -- +this should never happen." + (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED"))) + (when datestr + (- (time-to-days (current-time)) + (time-to-days (apply 'encode-time + (org-parse-time-string datestr))))))) + + +(defun org-drill-hours-since-last-review () + "Like `org-drill-days-since-last-review', but return value is +in hours rather than days." + (let ((datestr (org-entry-get (point) "DRILL_LAST_REVIEWED"))) + (when datestr + (floor + (/ (- (time-to-seconds (current-time)) + (time-to-seconds (apply 'encode-time + (org-parse-time-string datestr)))) + (* 60 60)))))) + + +(defun org-drill-entry-p () + "Is the current entry a 'drill item'?" + (or (org-entry-get (point) "LEARN_DATA") + ;;(assoc "LEARN_DATA" (org-entry-properties nil)) + (member org-drill-question-tag (org-get-local-tags)))) + + +(defun org-part-of-drill-entry-p () + "Is the current entry either the main heading of a 'drill item', +or a subheading within a drill item?" + (or (org-drill-entry-p) + ;; Does this heading INHERIT the drill tag + (member org-drill-question-tag (org-get-tags-at)))) + + +(defun org-drill-goto-drill-entry-heading () + "Move the point to the heading which hold the :drill: tag for this +drill entry." + (unless (org-at-heading-p) + (org-back-to-heading)) + (unless (org-part-of-drill-entry-p) + (error "Point is not inside a drill entry")) + (while (not (org-drill-entry-p)) + (unless (org-up-heading-safe) + (error "Cannot find a parent heading that is marked as a drill entry")))) + + + +(defun org-drill-entry-leech-p () + "Is the current entry a 'leech item'?" + (and (org-drill-entry-p) + (member "leech" (org-get-local-tags)))) + + +(defun org-drill-entry-due-p () + (cond + (*org-drill-cram-mode* + (let ((hours (org-drill-hours-since-last-review))) + (and (org-drill-entry-p) + (or (null hours) + (>= hours org-drill-cram-hours))))) + (t + (let ((item-time (org-get-scheduled-time (point)))) + (and (org-drill-entry-p) + (or (not (eql 'skip org-drill-leech-method)) + (not (org-drill-entry-leech-p))) + (or (null item-time) + (not (minusp ; scheduled for today/in future + (- (time-to-days (current-time)) + (time-to-days item-time)))))))))) + + +(defun org-drill-entry-new-p () + (and (org-drill-entry-p) + (let ((item-time (org-get-scheduled-time (point)))) + (null item-time)))) + + + +(defun org-drill-entry-last-quality () + (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY"))) + (if quality + (string-to-number quality) + nil))) + + +;;; SM2 Algorithm ============================================================= + + +(defun determine-next-interval-sm2 (last-interval n ef quality of-matrix) + "Arguments: +- LAST-INTERVAL -- the number of days since the item was last reviewed. +- N -- the number of times the item has been successfully reviewed +- EF -- the 'easiness factor' +- QUALITY -- 0 to 5 +- OF-MATRIX -- a matrix of values, used by SM5 but not by SM2. + +Returns a list: (INTERVAL N EF OFMATRIX), where: +- INTERVAL is the number of days until the item should next be reviewed +- N is incremented by 1. +- EF is modified based on the recall quality for the item. +- OF-MATRIX is not modified." + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (if (<= quality org-drill-failure-quality) + ;; When an item is failed, its interval is reset to 0, + ;; but its EF is unchanged + (list -1 1 ef of-matrix) + ;; else: + (let* ((next-ef (modify-e-factor ef quality)) + (interval + (cond + ((<= n 1) 1) + ((= n 2) + (cond + (org-drill-add-random-noise-to-intervals-p + (case quality + (5 6) + (4 4) + (3 3) + (2 1) + (t -1))) + (t 6))) + (t (ceiling (* last-interval next-ef)))))) + (list (round + (if org-drill-add-random-noise-to-intervals-p + (+ last-interval (* (- interval last-interval) + (org-drill-random-dispersal-factor))) + interval)) + (1+ n) next-ef of-matrix)))) + + +;;; SM5 Algorithm ============================================================= + +;;; From http://www.supermemo.com/english/ol/sm5.htm +(defun org-drill-random-dispersal-factor () + (let ((a 0.047) + (b 0.092) + (p (- (random* 1.0) 0.5))) + (flet ((sign (n) + (cond ((zerop n) 0) + ((plusp n) 1) + (t -1)))) + (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p))))) + (sign p))) + 100)))) + + +(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix) + (let ((of (get-optimal-factor n ef of-matrix))) + (if (= 1 n) + of + (* of last-interval)))) + + +(defun determine-next-interval-sm5 (last-interval n ef quality of-matrix) + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (let ((next-ef (modify-e-factor ef quality)) + (interval nil)) + (setq of-matrix + (set-optimal-factor n next-ef of-matrix + (modify-of (get-optimal-factor n ef of-matrix) + quality org-learn-fraction)) + ef next-ef) + + (cond + ;; "Failed" -- reset repetitions to 0, + ((<= quality org-drill-failure-quality) + (list -1 1 ef of-matrix)) ; Not clear if OF matrix is supposed to be + ; preserved + ;; For a zero-based quality of 4 or 5, don't repeat + ((and (>= quality 4) + (not org-learn-always-reschedule)) + (list 0 (1+ n) ef of-matrix)) ; 0 interval = unschedule + (t + (setq interval (inter-repetition-interval-sm5 + last-interval n ef of-matrix)) + (if org-drill-add-random-noise-to-intervals-p + (setq interval (+ last-interval + (* (- interval last-interval) + (org-drill-random-dispersal-factor))))) + (list (round interval) (1+ n) ef of-matrix))))) + + +;;; Essentially copied from `org-learn.el', but modified to +;;; optionally call the SM2 function above. +(defun org-drill-smart-reschedule (quality) + (interactive "nHow well did you remember the information (on a scale of 0-5)? ") + (let* ((learn-str (org-entry-get (point) "LEARN_DATA")) + (learn-data (or (and learn-str + (read learn-str)) + (copy-list initial-repetition-state))) + closed-dates) + (setq learn-data + (case org-drill-spaced-repetition-algorithm + (sm5 (determine-next-interval-sm5 (nth 0 learn-data) + (nth 1 learn-data) + (nth 2 learn-data) + quality + (nth 3 learn-data))) + (sm2 (determine-next-interval-sm2 (nth 0 learn-data) + (nth 1 learn-data) + (nth 2 learn-data) + quality + (nth 3 learn-data))))) + (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data)) + (cond + ((= 0 (nth 0 learn-data)) + (org-schedule t)) + ((minusp (first learn-data)) + (org-schedule nil (current-time))) + (t + (org-schedule nil (time-add (current-time) + (days-to-time (nth 0 learn-data)))))))) + + +(defun org-drill-reschedule () + "Returns quality rating (0-5), or nil if the user quit." + (let ((ch nil)) + (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5))) + (setq ch (read-char-exclusive + (if (eq ch ??) + "0-2 Means you have forgotten the item. +3-5 Means you have remembered the item. + +0 - Completely forgot. +1 - Even after seeing the answer, it still took a bit to sink in. +2 - After seeing the answer, you remembered it. +3 - It took you awhile, but you finally remembered. +4 - After a little bit of thought you remembered. +5 - You remembered the item really easily. + +How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" + "How well did you do? (0-5, ?=help, e=edit, q=quit)"))) + (if (eql ch ?t) + (org-set-tags-command))) + (cond + ((and (>= ch ?0) (<= ch ?5)) + (let ((quality (- ch ?0)) + (failures (org-entry-get (point) "DRILL_FAILURE_COUNT"))) + (save-excursion + (org-drill-smart-reschedule quality)) + (push quality *org-drill-session-qualities*) + (cond + ((<= quality org-drill-failure-quality) + (when org-drill-leech-failure-threshold + (setq failures (if failures (string-to-number failures) 0)) + (org-set-property "DRILL_FAILURE_COUNT" + (format "%d" (1+ failures))) + (if (> (1+ failures) org-drill-leech-failure-threshold) + (org-toggle-tag "leech" 'on)))) + (t + (let ((scheduled-time (org-get-scheduled-time (point)))) + (when scheduled-time + (message "Next review in %d days" + (- (time-to-days scheduled-time) + (time-to-days (current-time)))) + (sit-for 0.5))))) + (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality)) + (org-set-property "DRILL_LAST_REVIEWED" + (time-to-inactive-org-timestamp (current-time))) + quality)) + ((= ch ?e) + 'edit) + (t + nil)))) + + +(defun org-drill-hide-all-subheadings-except (heading-list) + "Returns a list containing the position of each immediate subheading of +the current topic." + (let ((drill-entry-level (org-current-level)) + (drill-sections nil) + (drill-heading nil)) + (org-show-subtree) + (save-excursion + (org-map-entries + (lambda () + (when (= (org-current-level) (1+ drill-entry-level)) + (setq drill-heading (org-get-heading t)) + (unless (member drill-heading heading-list) + (hide-subtree)) + (push (point) drill-sections))) + "" 'tree)) + (reverse drill-sections))) + + + +(defun org-drill-presentation-prompt (&rest fmt-and-args) + (let* ((item-start-time (current-time)) + (ch nil) + (last-second 0) + (prompt + (if fmt-and-args + (apply 'format + (first fmt-and-args) + (rest fmt-and-args)) + (concat "Press key for answer, " + "e=edit, t=tags, s=skip, q=quit.")))) + (setq prompt + (format "%s %s %s %s %s" + (propertize + (number-to-string (length *org-drill-done-entries*)) + 'face `(:foreground ,org-drill-done-count-color) + 'help-echo "The number of items you have reviewed this session.") + (propertize + (number-to-string (+ (length *org-drill-again-entries*) + (length *org-drill-failed-entries*))) + 'face `(:foreground ,org-drill-failed-count-color) + 'help-echo (concat "The number of items that you failed, " + "and need to review again.")) + (propertize + (number-to-string (length *org-drill-mature-entries*)) + 'face `(:foreground ,org-drill-mature-count-color) + 'help-echo "The number of old items due for review.") + (propertize + (number-to-string (length *org-drill-new-entries*)) + 'face `(:foreground ,org-drill-new-count-color) + 'help-echo (concat "The number of new items that you " + "have never reviewed.")) + prompt)) + (if (and (eql 'warn org-drill-leech-method) + (org-drill-entry-leech-p)) + (setq prompt (concat + (propertize "!!! LEECH ITEM !!! +You seem to be having a lot of trouble memorising this item. +Consider reformulating the item to make it easier to remember.\n" + 'face '(:foreground "red")) + prompt))) + (while (memq ch '(nil ?t)) + (while (not (input-pending-p)) + (message (concat (format-time-string + "%M:%S " (time-subtract + (current-time) item-start-time)) + prompt)) + (sit-for 1)) + (setq ch (read-char-exclusive)) + (if (eql ch ?t) + (org-set-tags-command))) + (case ch + (?q nil) + (?e 'edit) + (?s 'skip) + (otherwise t)))) + + +(defun org-pos-in-regexp (pos regexp &optional nlines) + (save-excursion + (goto-char pos) + (org-in-regexp regexp nlines))) + + +(defun org-drill-hide-clozed-text () + (save-excursion + (while (re-search-forward org-drill-cloze-regexp nil t) + ;; Don't hide org links, partly because they might contain inline + ;; images which we want to keep visible + (unless (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1) + (org-drill-hide-matched-cloze-text))))) + + +(defun org-drill-hide-matched-cloze-text () + "Hide the current match with a 'cloze' visual overlay." + (let ((ovl (make-overlay (match-beginning 0) (match-end 0)))) + (overlay-put ovl 'category + 'org-drill-cloze-overlay-defaults) + (when (find ?| (match-string 0)) + (overlay-put ovl + 'display + (format "[...%s]" + (substring-no-properties + (match-string 0) + (1+ (position ?| (match-string 0))) + (1- (length (match-string 0))))))))) + + +(defun org-drill-unhide-clozed-text () + (save-excursion + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category)) + (delete-overlay ovl))))) + + + +;;; Presentation functions ==================================================== + +;; Each of these is called with point on topic heading. Each needs to show the +;; topic in the form of a 'question' or with some information 'hidden', as +;; appropriate for the card type. The user should then be prompted to press a +;; key. The function should then reveal either the 'answer' or the entire +;; topic, and should return t if the user chose to see the answer and rate their +;; recall, nil if they chose to quit. + +(defun org-drill-present-simple-card () + (with-hidden-cloze-text + (org-drill-hide-all-subheadings-except nil) + (org-display-inline-images t) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-show-subtree)))) + + +(defun org-drill-present-two-sided-card () + (with-hidden-cloze-text + (let ((drill-sections (org-drill-hide-all-subheadings-except nil))) + (when drill-sections + (save-excursion + (goto-char (nth (random (min 2 (length drill-sections))) + drill-sections)) + (org-show-subtree))) + (org-display-inline-images t) + (org-cycle-hide-drawers 'all) + (prog1 + (org-drill-presentation-prompt) + (org-show-subtree))))) + + + +(defun org-drill-present-multi-sided-card () + (with-hidden-cloze-text + (let ((drill-sections (org-drill-hide-all-subheadings-except nil))) + (when drill-sections + (save-excursion + (goto-char (nth (random (length drill-sections)) drill-sections)) + (org-show-subtree))) + (org-display-inline-images t) + (org-cycle-hide-drawers 'all) + (prog1 + (org-drill-presentation-prompt) + (org-show-subtree))))) + + +(defun org-drill-present-multicloze () + (let ((item-end nil) + (match-count 0) + (body-start (or (cdr (org-get-property-block)) + (point)))) + (org-drill-hide-all-subheadings-except nil) + (save-excursion + (outline-next-heading) + (setq item-end (point))) + (save-excursion + (goto-char body-start) + (while (re-search-forward org-drill-cloze-regexp item-end t) + (incf match-count))) + (when (plusp match-count) + (save-excursion + (goto-char body-start) + (re-search-forward org-drill-cloze-regexp + item-end t (1+ (random match-count))) + (org-drill-hide-matched-cloze-text))) + (org-display-inline-images t) + (org-cycle-hide-drawers 'all) + (prog1 (org-drill-presentation-prompt) + (org-show-subtree) + (org-drill-unhide-clozed-text)))) + + +(defun org-drill-present-spanish-verb () + (let ((prompt nil) + (reveal-headings nil)) + (with-hidden-cloze-text + (case (random 6) + (0 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (setq prompt + (concat "Translate this Spanish verb, and conjugate it " + "for the *present* tense.") + reveal-headings '("English" "Present Tense" "Notes"))) + (1 + (org-drill-hide-all-subheadings-except '("English")) + (setq prompt (concat "For the *present* tense, conjugate the " + "Spanish translation of this English verb.") + reveal-headings '("Infinitive" "Present Tense" "Notes"))) + (2 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (setq prompt (concat "Translate this Spanish verb, and " + "conjugate it for the *past* tense.") + reveal-headings '("English" "Past Tense" "Notes"))) + (3 + (org-drill-hide-all-subheadings-except '("English")) + (setq prompt (concat "For the *past* tense, conjugate the " + "Spanish translation of this English verb.") + reveal-headings '("Infinitive" "Past Tense" "Notes"))) + (4 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (setq prompt (concat "Translate this Spanish verb, and " + "conjugate it for the *future perfect* tense.") + reveal-headings '("English" "Future Perfect Tense" "Notes"))) + (5 + (org-drill-hide-all-subheadings-except '("English")) + (setq prompt (concat "For the *future perfect* tense, conjugate the " + "Spanish translation of this English verb.") + reveal-headings '("Infinitive" "Future Perfect Tense" "Notes")))) + (org-cycle-hide-drawers 'all) + (prog1 + (org-drill-presentation-prompt prompt) + (org-drill-hide-all-subheadings-except reveal-headings))))) + + + +(defun org-drill-entry () + "Present the current topic for interactive review, as in `org-drill'. +Review will occur regardless of whether the topic is due for review or whether +it meets the definition of a 'review topic' used by `org-drill'. + +Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol +EDIT if the user chose to exit the drill and edit the current item. + +See `org-drill' for more details." + (interactive) + (org-drill-goto-drill-entry-heading) + ;;(unless (org-part-of-drill-entry-p) + ;; (error "Point is not inside a drill entry")) + ;;(unless (org-at-heading-p) + ;; (org-back-to-heading)) + (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE")) + (cont nil)) + (save-restriction + (org-narrow-to-subtree) + (org-show-subtree) + (org-cycle-hide-drawers 'all) + + (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist)))) + (cond + (presentation-fn + (setq cont (funcall presentation-fn))) + (t + (error "Unknown card type: '%s'" card-type)))) + + (cond + ((not cont) + (message "Quit") + nil) + ((eql cont 'edit) + 'edit) + ((eql cont 'skip) + 'skip) + (t + (save-excursion + (org-drill-reschedule))))))) + + +;; (defun org-drill-entries (entries) +;; "Returns nil, t, or a list of markers representing entries that were +;; 'failed' and need to be presented again before the session ends." +;; (let ((again-entries nil)) +;; (setq *org-drill-done-entry-count* 0 +;; *org-drill-pending-entry-count* (length entries)) +;; (if (and org-drill-maximum-items-per-session +;; (> (length entries) +;; org-drill-maximum-items-per-session)) +;; (setq entries (subseq entries 0 +;; org-drill-maximum-items-per-session))) +;; (block org-drill-entries +;; (dolist (m entries) +;; (save-restriction +;; (switch-to-buffer (marker-buffer m)) +;; (goto-char (marker-position m)) +;; (setq result (org-drill-entry)) +;; (cond +;; ((null result) +;; (message "Quit") +;; (return-from org-drill-entries nil)) +;; ((eql result 'edit) +;; (setq end-pos (point-marker)) +;; (return-from org-drill-entries nil)) +;; (t +;; (cond +;; ((< result 3) +;; (push m again-entries)) +;; (t +;; (decf *org-drill-pending-entry-count*) +;; (incf *org-drill-done-entry-count*))) +;; (when (and org-drill-maximum-duration +;; (> (- (float-time (current-time)) *org-drill-start-time*) +;; (* org-drill-maximum-duration 60))) +;; (message "This drill session has reached its maximum duration.") +;; (return-from org-drill-entries nil)))))) +;; (or again-entries +;; t)))) + + +(defun org-drill-entries-pending-p () + (or *org-drill-again-entries* + (and (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p)) + (or *org-drill-new-entries* + *org-drill-failed-entries* + *org-drill-mature-entries* + *org-drill-again-entries*)))) + + +(defun org-drill-pending-entry-count () + (+ (length *org-drill-new-entries*) + (length *org-drill-failed-entries*) + (length *org-drill-mature-entries*) + (length *org-drill-again-entries*))) + + +(defun org-drill-maximum-duration-reached-p () + "Returns true if the current drill session has continued past its +maximum duration." + (and org-drill-maximum-duration + *org-drill-start-time* + (> (- (float-time (current-time)) *org-drill-start-time*) + (* org-drill-maximum-duration 60)))) + + +(defun org-drill-maximum-item-count-reached-p () + "Returns true if the current drill session has reached the +maximum number of items." + (and org-drill-maximum-items-per-session + (>= (length *org-drill-done-entries*) + org-drill-maximum-items-per-session))) + + +(defun org-drill-pop-next-pending-entry () + (cond + ;; First priority is items we failed in a prior session. + ((and *org-drill-failed-entries* + (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p))) + (pop-random *org-drill-failed-entries*)) + ;; Next priority is newly added items, and items which + ;; are not new and were not failed when they were last + ;; reviewed. + ((and (or *org-drill-new-entries* + *org-drill-mature-entries*) + (not (org-drill-maximum-item-count-reached-p)) + (not (org-drill-maximum-duration-reached-p))) + (if (< (random (+ (length *org-drill-new-entries*) + (length *org-drill-mature-entries*))) + (length *org-drill-new-entries*)) + (pop-random *org-drill-new-entries*) + ;; else + (pop-random *org-drill-mature-entries*))) + ;; After all the above are done, last priority is items + ;; that were failed earlier THIS SESSION. + (*org-drill-again-entries* + (pop-random *org-drill-again-entries*)) + (t + nil))) + + +(defun org-drill-entries () + "Returns nil, t, or a list of markers representing entries that were +'failed' and need to be presented again before the session ends." + (block org-drill-entries + (while (org-drill-entries-pending-p) + (setq m (org-drill-pop-next-pending-entry)) + (unless m + (error "Unexpectedly ran out of pending drill items")) + (save-excursion + (set-buffer (marker-buffer m)) + (goto-char m) + (setq result (org-drill-entry)) + (cond + ((null result) + (message "Quit") + (return-from org-drill-entries nil)) + ((eql result 'edit) + (setq end-pos (point-marker)) + (return-from org-drill-entries nil)) + ((eql result 'skip) + nil) ; skip this item + (t + (cond + ((<= result org-drill-failure-quality) + (push m *org-drill-again-entries*)) + (t + (push m *org-drill-done-entries*))))))))) + + + +(defun org-drill-final-report () + (read-char-exclusive + (format + "%d items reviewed +%d items awaiting review (%s, %s, %s) +Session duration %s + +Recall of reviewed items: + Excellent (5): %3d%% | Near miss (2): %3d%% + Good (4): %3d%% | Failure (1): %3d%% + Hard (3): %3d%% | Total failure (0): %3d%% + +Session finished. Press a key to continue..." + (length *org-drill-done-entries*) + (org-drill-pending-entry-count) + (propertize + (format "%d failed" + (+ (length *org-drill-failed-entries*) + (length *org-drill-again-entries*))) + 'face `(:foreground ,org-drill-failed-count-color)) + (propertize + (format "%d old" + (length *org-drill-mature-entries*)) + 'face `(:foreground ,org-drill-mature-count-color)) + (propertize + (format "%d new" + (length *org-drill-new-entries*)) + 'face `(:foreground ,org-drill-new-count-color)) + (format-seconds "%h:%.2m:%.2s" + (- (float-time (current-time)) *org-drill-start-time*)) + (round (* 100 (count 5 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 2 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 4 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 1 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 3 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 0 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + ))) + + + +(defun org-drill (&optional scope) + "Begin an interactive 'drill session'. The user is asked to +review a series of topics (headers). Each topic is initially +presented as a 'question', often with part of the topic content +hidden. The user attempts to recall the hidden information or +answer the question, then presses a key to reveal the answer. The +user then rates his or her recall or performance on that +topic. This rating information is used to reschedule the topic +for future review using the `org-learn' library. + +Org-drill proceeds by: + +- Finding all topics (headings) in SCOPE which have either been + used and rescheduled by org-learn before (i.e. the LEARN_DATA + property is set), or which have a tag that matches + `org-drill-question-tag'. + +- All matching topics which are either unscheduled, or are + scheduled for the current date or a date in the past, are + considered to be candidates for the drill session. + +- If `org-drill-maximum-items-per-session' is set, a random + subset of these topics is presented. Otherwise, all of the + eligible topics will be presented. + +SCOPE determines the scope in which to search for +questions. It is passed to `org-map-entries', and can be any of: + +nil The current buffer, respecting the restriction if any. + This is the default. +tree The subtree started with the entry at point +file The current buffer, without restriction +file-with-archives + The current buffer, and any archives associated with it +agenda All agenda files +agenda-with-archives + All agenda files with any archive files associated with them + (file1 file2 ...) + If this is a list, all files in the list will be scanned." + + (interactive) + (let ((entries nil) + (failed-entries nil) + (result nil) + (results nil) + (end-pos nil) + (cnt 0)) + (block org-drill + (setq *org-drill-done-entries* nil + *org-drill-new-entries* nil + *org-drill-mature-entries* nil + *org-drill-failed-entries* nil + *org-drill-again-entries* nil) + (setq *org-drill-session-qualities* nil) + (setq *org-drill-start-time* (float-time (current-time))) + (unwind-protect + (save-excursion + (let ((org-trust-scanner-tags t)) + (org-map-entries + (lambda () + (when (zerop (% (incf cnt) 50)) + (message "Processing drill items: %4d%s" + (+ (length *org-drill-new-entries*) + (length *org-drill-mature-entries*) + (length *org-drill-failed-entries*)) + (make-string (ceiling cnt 50) ?.))) + (when (org-drill-entry-due-p) + (cond + ((org-drill-entry-new-p) + (push (point-marker) *org-drill-new-entries*)) + ((and (org-drill-entry-last-quality) + (<= (org-drill-entry-last-quality) + org-drill-failure-quality)) + (push (point-marker) *org-drill-failed-entries*)) + (t + (push (point-marker) *org-drill-mature-entries*))))) + (concat "+" org-drill-question-tag) scope)) + ;; Failed first, then random mix of old + new + (setq entries (append (shuffle-list *org-drill-failed-entries*) + (shuffle-list (append *org-drill-mature-entries* + *org-drill-new-entries*)))) + (cond + ((and (null *org-drill-new-entries*) + (null *org-drill-failed-entries*) + (null *org-drill-mature-entries*)) + (message "I did not find any pending drill items.")) + (t + (org-drill-entries) + (message "Drill session finished!")))) + ;; (cond + ;; ((null entries) + ;; (message "I did not find any pending drill items.")) + ;; (t + ;; (let ((again t)) + ;; (while again + ;; (when (listp again) + ;; (setq entries (shuffle-list again))) + ;; (setq again (org-drill-entries entries)) + ;; (cond + ;; ((null again) + ;; (return-from org-drill nil)) + ;; ((eql t again) + ;; (setq again nil)))) + ;; (message "Drill session finished!") + ;; )))) + (progn + (dolist (m (append *org-drill-new-entries* + *org-drill-failed-entries* + *org-drill-again-entries* + *org-drill-mature-entries*)) + (free-marker m))))) + (cond + (end-pos + (switch-to-buffer (marker-buffer end-pos)) + (goto-char (marker-position end-pos)) + (message "Edit topic.")) + (t + (org-drill-final-report))))) + + +(defun org-drill-cram (&optional scope) + "Run an interactive drill session in 'cram mode'. In cram mode, +all drill items are considered to be due for review, unless they +have been reviewed within the last `org-drill-cram-hours' +hours." + (interactive) + (let ((*org-drill-cram-mode* t)) + (org-drill scope))) + + + +(add-hook 'org-mode-hook + (lambda () + (if org-drill-use-visible-cloze-face-p + (font-lock-add-keywords + 'org-mode + org-drill-cloze-keywords + t)))) + + + +(provide 'org-drill) diff --git a/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el b/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el new file mode 100644 index 0000000..b826467 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-elisp-symbol.el @@ -0,0 +1,159 @@ +;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols +;; +;; Copyright 2007, 2008, 2009 Bastien Guerry +;; +;; Author: bzg AT altern DOT org +;; Version: 0.2 +;; Keywords: org, remember, lisp +;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; +;; Org-mode already lets you store/insert links to emacs-lisp files, +;; just like any other file. This package lets you precisely link to +;; any emacs-lisp symbol and access useful information about the symbol. +;; +;; Here is the list of available properties when linking from a elisp-symbol: +;; +;; :name The symbol's name. +;; :stype The symbol's type (commandp, function, etc.) +;; :def The function used to set the symbol's value (defun, etc.) +;; :keys The keys associated with the command. +;; :args The arguments of the function. +;; :docstring The docstring of the symbol. +;; :doc The first line of the dostring. +;; :comment A comment line just above the sexp, if any. +;; :fixme A FIXME comment line just above the sexp, if any. +;; +;; Let's say we have a defun like this one: +;; +;; ;; FIXME update docstring +;; (defun org-export-latex-lists () +;; "Convert lists to LaTeX." +;; (goto-char (point-min)) +;; (while (re-search-forward org-export-latex-list-beginning-re nil t) +;; (beginning-of-line) +;; (insert (org-list-to-latex (org-list-parse-list t)) "\n"))) +;; +;; And a remember template like: +;; +;; (setq org-remember-templates +;; '((?s "* DEBUG `%:name' (%:args)\n\n%?\n\nFixme: %:fixme\n \ +;; Doc: \"%:doc\"\n\n%a"))) +;; +;; Then M-x `org-remember' on this sexp will produce this buffer: +;; +;; ===================================================================== +;; * DEBUG `org-export-latex-lists' () +;; +;; <== point +;; +;; Fixme: update the docstring +;; Doc: "Convert lists to LaTeX." +;; +;; [[file:~/path/file.el::defun%20my-func][Function: my-func]] +;; ===================================================================== +;; +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'org-elisp-symbol) + +;;; Code: + +(provide 'org-elisp-symbol) + +(require 'org) + +(org-add-link-type "elisp-symbol" 'org-elisp-symbol-open) +(add-hook 'org-store-link-functions 'org-elisp-symbol-store-link) + +(defun org-elisp-symbol-open (path) + "Visit the emacs-lisp elisp-symbol at PATH." + (let* ((search (when (string-match "::\\(.+\\)\\'" path) + (match-string 1 path))) + (path (substring path 0 (match-beginning 0)))) + (org-open-file path t nil search))) + +(defun org-elisp-symbol-store-link () + "Store a link to an emacs-lisp elisp-symbol." + (when (eq major-mode 'emacs-lisp-mode) + (save-excursion + (or (looking-at "^(") (beginning-of-defun)) + (looking-at "^(\\([a-z]+\\) \\([^)\n ]+\\) ?\n?[ \t]*\\(?:(\\(.*\\))\\)?") + (let* ((end (save-excursion + (save-match-data + (end-of-defun) (point)))) + (def (match-string 1)) + (name (match-string 2)) + (sym-name (intern-soft name)) + (stype (cond ((commandp sym-name) "Command") + ((functionp sym-name) "Function") + ((user-variable-p sym-name) "User variable") + ((eq def "defvar") "Variable") + ((eq def "defmacro") "Macro") + (t "Symbol"))) + (args (if (match-string 3) + (mapconcat (lambda (a) (unless (string-match "^&" a) a)) + (split-string (match-string 3)) " ") + "no arg")) + (docstring (cond ((functionp sym-name) + (or (documentation sym-name) + "[no documentation]")) + ((string-match "[Vv]ariable" stype) + (documentation-property sym-name + 'variable-documentation)) + (t "no documentation"))) + (doc (and (string-match "^\\([^\n]+\\)$" docstring) + (match-string 1 docstring))) + (fixme (save-excursion + (beginning-of-defun) (end-of-defun) + (if (re-search-forward "^;+ ?FIXME[ :]*\\(.*\\)$" end t) + (match-string 1) "nothing to fix"))) + (comment (save-excursion + (beginning-of-defun) (end-of-defun) + (if (re-search-forward "^;;+ ?\\(.*\\)$" end t) + (match-string 1) "no comment"))) + keys keys-desc link description) + (if (equal stype "Command") + (setq keys (where-is-internal sym-name) + keys-desc + (if keys (mapconcat 'key-description keys " ") "none"))) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" def " " name)) + (setq description (concat stype ": " name)) + (org-store-link-props + :type "elisp-symbol" + :link link + :description description + :def def + :name name + :stype stype + :args args + :keys keys-desc + :docstring docstring + :doc doc + :fixme fixme + :comment comment))))) + +(provide 'org-elisp-symbol) + + +;;;;########################################################################## +;;;; User Options, Variables +;;;;########################################################################## + + +;;; org-elisp-symbol.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el b/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el new file mode 100644 index 0000000..c571ea0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-eval-light.el @@ -0,0 +1,200 @@ +;;; org-eval-light.el --- Display result of evaluating code in various languages (light) + +;; Copyright (C) 2008 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org>, +;; Eric Schulte <schulte dot eric at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp, literate programming, +;; reproducible research +;; Homepage: http://orgmode.org +;; Version: 0.04 + +;; This file is not yet part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This file is based off of org-eval, with the following changes. +;; +;; 1) forms are only executed manually, (allowing for the execution of +;; an entire subtree of forms) +;; 2) use the org-mode style src blocks, rather than the muse style +;; <code></code> blocks +;; 3) forms are not replaced by their outputs, but rather the output +;; is placed in the buffer immediately following the src block +;; commented by `org-eval-light-make-region-example' (when +;; evaluated with a prefix argument no output is placed in the +;; buffer) +;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of +;; a source block it will call `org-eval-light-current-snippet' + +;;; Code: +(require 'org) + +(defgroup org-eval-light nil + "Options concerning including output from commands into the Org-mode buffer." + :tag "Org Eval" + :group 'org) + +(defvar org-eval-light-example-size-cutoff 10 + "The number of lines under which an example is considered +'small', and is exported with the '^:' syntax instead of in a +large example block") + +(defvar org-eval-light-regexp nil) + +(defun org-eval-light-set-interpreters (var value) + (set-default var value) + (setq org-eval-light-regexp + (concat "#\\+begin_src \\(" + (mapconcat 'regexp-quote value "\\|") + "\\)\\([^\000]+?\\)#\\+end_src"))) + +(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell") + "Interpreters allows for evaluation tags. +This is a list of program names (as strings) that can evaluate code and +insert the output into an Org-mode buffer. Valid choices are + +lisp Interpret Emacs Lisp code and display the result +shell Pass command to the shell and display the result +perl The perl interpreter +python Thy python interpreter +ruby The ruby interpreter" + :group 'org-eval-light + :set 'org-eval-light-set-interpreters + :type '(set :greedy t + (const "lisp") + (const "emacs-lisp") + (const "perl") + (const "python") + (const "ruby") + (const "shell"))) + +;;; functions +(defun org-eval-light-inside-snippet () + (interactive) + (save-excursion + (let ((case-fold-search t) + (start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n") + (end-re "\n#\\+end_src") + (pos (point)) + beg end) + (if (and (setq beg (re-search-backward start-re nil t)) + (setq end (re-search-forward end-re nil t)) + (<= beg pos) (>= end pos)) + t)))) + +(defun org-eval-light-make-region-example (beg end) + "Comment out region using either the '^:' or the BEGIN_EXAMPLE +syntax based on the size of the region as compared to +`org-eval-light-example-size-cutoff'." + (interactive "*r") + (let ((size (abs (- (line-number-at-pos end) + (line-number-at-pos beg))))) + (if (= size 0) + (let ((result (buffer-substring beg end))) + (delete-region beg end) + (insert (concat ": " result))) + (if (<= size org-eval-light-example-size-cutoff) + (save-excursion + (goto-char beg) + (dotimes (n size) + (move-beginning-of-line 1) (insert ": ") (forward-line 1))) + (let ((result (buffer-substring beg end))) + (delete-region beg end) + (insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n"))))))) + +(defun org-eval-light-current-snippet (&optional arg) + "Execute the current #+begin_src #+end_src block, and dump the +results into the buffer immediately following the src block, +commented by `org-eval-light-make-region-example'." + (interactive "P") + (let ((line (org-current-line)) + (case-fold-search t) + (info (org-edit-src-find-region-and-lang)) + beg end lang result) + (setq beg (nth 0 info) + end (nth 1 info) + lang (nth 2 info)) + (unless (member lang org-eval-light-interpreters) + (error "Language is not in `org-eval-light-interpreters': %s" lang)) + (goto-line line) + (setq result (org-eval-light-code lang (buffer-substring beg end))) + (unless arg + (save-excursion + (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2) + (let ((beg (point)) + (end (progn (insert result) + (point)))) + (message (format "from %S %S" beg end)) + (org-eval-light-make-region-example beg end)))))) + +(defun org-eval-light-eval-subtree (&optional arg) + "Replace EVAL snippets in the entire subtree." + (interactive "P") + (save-excursion + (org-narrow-to-subtree) + (goto-char (point-min)) + (while (re-search-forward org-eval-light-regexp nil t) + (org-eval-light-current-snippet arg)) + (widen))) + +(defun org-eval-light-code (interpreter code) + (cond + ((member interpreter '("lisp" "emacs-lisp")) + (org-eval-light-lisp (concat "(progn\n" code "\n)"))) + ((equal interpreter "shell") + (shell-command-to-string code)) + ((member interpreter '("perl" "python" "ruby")) + (org-eval-light-run (executable-find interpreter) code)) + (t (error "Cannot evaluate code type %s" interpreter)))) + +(defun org-eval-light-lisp (form) + "Evaluate the given form and return the result as a string." + (require 'pp) + (save-match-data + (condition-case err + (let ((object (eval (read form)))) + (cond + ((stringp object) object) + ((and (listp object) + (not (eq object nil))) + (let ((string (pp-to-string object))) + (substring string 0 (1- (length string))))) + ((numberp object) + (number-to-string object)) + ((eq object nil) "") + (t + (pp-to-string object)))) + (error + (org-display-warning (format "%s: Error evaluating %s: %s" + "???" form err)) + "; INVALID LISP CODE")))) + +(defun org-eval-light-run (cmd code) + (with-temp-buffer + (insert code) + (shell-command-on-region (point-min) (point-max) cmd nil 'replace) + (buffer-string))) + +(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate) + (if (org-eval-light-inside-snippet) + (call-interactively 'org-eval-light-current-snippet) + ad-do-it)) + +(provide 'org-eval-light) +;;; org-eval-light.el ends here
\ No newline at end of file diff --git a/.emacs.d/org-7.4/contrib/lisp/org-eval.el b/.emacs.d/org-7.4/contrib/lisp/org-eval.el new file mode 100644 index 0000000..0dd3ade --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-eval.el @@ -0,0 +1,220 @@ +;;; org-eval.el --- Display result of evaluating code in various languages +;; Copyright (C) 2008 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 0.04 +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This modules allows to include output from various commands into an +;; Org-mode buffer, both for live display, and for export. +;; This technique has been copied from emacs-wiki and Emacs Muse, and +;; we try to make it work here in a way as similar as possible to +;; Muse, so that people who move between both worlds don't need to learn +;; new syntax. +;; +;; Basically it works like this: +;; +;; <lisp>(concat "aaa" "bbb")</lisp> +;; +;; will display "aaabbb" in the buffer and export like that as well. +;; The leading lisp tag will also accept the attributes "markup" and +;; "lang", to specify how the text should be formatted during export. +;; For example, +;; +;; <lisp markup="src" lang="emacs-lisp"> .... </lisp> +;; +;; will format the result of the lisp form as if it was lisp source +;; code. Internally, it will wrap the text into a +;; +;; #+begin_src emacs-lisp +;; #+end_src +;; +;; structure so that the right things happen when the exporter is running. +;; +;; By default, only the <lisp> tag is turned on, but you can configure +;; the variable `org-eval-interpreters' to add more interpreters like +;; `perl', `python', or the `shell'. +;; +;; You can edit the code snippets with "C-c '" (org-edit-src-code). +;; +;; Please note that this mechanism is potentially dangerous, because it +;; executes code that you don't even see. This gives you great power, +;; but also enough rope to hang yourself. And, it gives your friends +;; who send you Org files plenty of opportunity for good and bad jokes. +;; This is also why this module is not turned on by default, but only +;; available as a contributed package. +;; +;; +;; +(require 'org) + +;;; Customization + +(defgroup org-eval nil + "Options concerning including output from commands into the Org-mode buffer." + :tag "Org Eval" + :group 'org) + +(defface org-eval + (org-compatible-face nil + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey40")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey60")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for command output that is included into an Org-mode buffer." + :group 'org-eval + :group 'org-faces + :version "22.1") + +(defvar org-eval-regexp nil) + +(defun org-eval-set-interpreters (var value) + (set-default var value) + (setq org-eval-regexp + (concat "<\\(" + (mapconcat 'regexp-quote value "\\|") + "\\)" + "\\([^>]\\{0,50\\}?\\)>" + "\\([^\000]+?\\)</\\1>"))) + +(defcustom org-eval-interpreters '("lisp") + "Interpreters allows for evaluation tags. +This is a list of program names (as strings) that can evaluate code and +insert the output into an Org-mode buffer. Valid choices are + +lisp Interpret Emacs Lisp code and display the result +shell Pass command to the shell and display the result +perl The perl interpreter +python Thy python interpreter +ruby The ruby interpreter" + :group 'org-eval + :set 'org-eval-set-interpreters + :type '(set :greedy t + (const "lisp") + (const "perl") + (const "python") + (const "ruby") + (const "shell"))) + +(defun org-eval-handle-snippets (limit &optional replace) + "Evaluate code snippets and display the results as display property. +When REPLACE is non-nil, replace the code region with the result (used +for export)." + (let (a) + (while (setq a (text-property-any (point) (or limit (point-max)) + 'org-eval t)) + (remove-text-properties + a (next-single-property-change a 'org-eval nil limit) + '(display t intangible t org-eval t)))) + (while (re-search-forward org-eval-regexp limit t) + (let* ((beg (match-beginning 0)) + (end (match-end 0)) + (kind (match-string 1)) + (attr (match-string 2)) + (code (match-string 3)) + (value (org-eval-code kind code)) + markup lang) + (if replace + (progn + (setq attr (save-match-data (org-eval-get-attributes attr)) + markup (cdr (assoc "markup" attr)) + lang (cdr (assoc "lang" attr))) + (replace-match + (concat (if markup (format "#+BEGIN_%s" (upcase markup))) + (if (and markup (equal (downcase markup) "src")) + (concat " " (or lang "fundamental"))) + "\n" + value + (if markup (format "\n#+END_%s\n" (upcase markup)))) + t t)) + (add-text-properties + beg end + (list 'display value 'intangible t 'font-lock-multiline t + 'face 'org-eval + 'org-eval t)))))) + +(defun org-eval-replace-snippts () + "Replace EVAL snippets in the entire buffer. +This should go into the `org-export-preprocess-hook'." + (goto-char (point-min)) + (org-eval-handle-snippets nil 'replace)) + +(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts) +(add-hook 'org-font-lock-hook 'org-eval-handle-snippets) + +(defun org-eval-get-attributes (str) + (let ((start 0) key value rtn) + (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start) + (setq key (match-string 1 str) + value (match-string 2 str) + start (match-end 0)) + (push (cons key value) rtn)) + rtn)) + +(defun org-eval-code (interpreter code) + (cond + ((equal interpreter "lisp") + (org-eval-lisp (concat "(progn\n" code "\n)"))) + ((equal interpreter "shell") + (shell-command-to-string code)) + ((member interpreter '("perl" "python" "ruby")) + (org-eval-run (executable-find interpreter) code)) + (t (error "Cannot evaluate code type %s" interpreter)))) + +(defun org-eval-lisp (form) + "Evaluate the given form and return the result as a string." + (require 'pp) + (save-match-data + (condition-case err + (let ((object (eval (read form)))) + (cond + ((stringp object) object) + ((and (listp object) + (not (eq object nil))) + (let ((string (pp-to-string object))) + (substring string 0 (1- (length string))))) + ((numberp object) + (number-to-string object)) + ((eq object nil) "") + (t + (pp-to-string object)))) + (error + (org-display-warning (format "%s: Error evaluating %s: %s" + "???" form err)) + "; INVALID LISP CODE")))) + +(defun org-eval-run (cmd code) + (with-temp-buffer + (insert code) + (shell-command-on-region (point-min) (point-max) cmd nil 'replace) + (buffer-string))) + +(provide 'org-eval) + +;;; org-eval.el ends here + diff --git a/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el b/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el new file mode 100644 index 0000000..ab6a6b0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-exp-bibtex.el @@ -0,0 +1,155 @@ +;;; org-exp-bibtex.el --- Export bibtex fragments + +;; Copyright (C) 2009 Taru Karttunen + +;; Author: Taru Karttunen <taruti@taruti.net > + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; +;; This is an utility to handle BibTeX export to both LaTeX and html +;; exports. It uses the bibtex2html software from +;; http://www.lri.fr/~filliatr/bibtex2html/ +;; +;; The usage is as follows: +;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options +;; e.g. given foo.bib and using style plain: +;; #+BIBLIOGRAPHY: foo plain option:-d +;; +;; Optional options are of the form: +;; +;; option:-foobar pass '-foobar' to bibtex2html +;; e.g. +;; option:-d sort by date. +;; option:-a sort as BibTeX (usually by author) *default* +;; option:-u unsorted i.e. same order as in .bib file +;; option:-r reverse the sort. +;; see the bibtex2html man page for more. Multiple options can be combined like: +;; option:-d option:-r +;; +;; Limiting to only the entries cited in the document: +;; limit:t + +;; For LaTeX export this simply inserts the lines +;; \bibliographystyle{plain} +;; \bibliography{foo} +;; into the tex-file when exporting. + +;; For Html export it: +;; 1) converts all \cite{foo} to links to the bibliography +;; 2) creates a foo.html and foo_bib.html +;; 3) includes the contents of foo.html in the exported html file + +(require 'org) +(require 'org-exp) +(defun org-export-bibtex-preprocess () + "Export all BibTeX." + (interactive) + (save-window-excursion + (setq oebp-cite-plist '()) + + ;; Convert #+BIBLIOGRAPHY: name style + (goto-char (point-min)) + (while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t) + (let ((file (match-string 1)) + (style (match-string 2)) + (opt (org-exp-bibtex-options-to-plist (match-string 3)))) + (replace-match + (cond + (htmlp ;; We are exporting to HTML + (let (extra-args cite-list end-hook tmp-files) + (dolist (elt opt) + (when (equal "option" (car elt)) + (setq extra-args (cons (cdr elt) extra-args)))) + + + (when (assoc "limit" opt) ;; Limit is true - collect references + (org-exp-bibtex-docites (lambda () + (dolist (c (org-split-string (match-string 1) ",")) + (add-to-list 'cite-list c)))) +;; (message "cites: %s" cite-list) + (let ((tmp (make-temp-file "org-exp-bibtex"))) + (with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n")))) + (setq tmp-files (cons tmp tmp-files)) + (setq extra-args (append extra-args `("-citefile" ,tmp))))) + + (when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil) + `("-a" "--nodoc" "--style" ,style "--no-header") + extra-args + (list (concat file ".bib")))))) + (error "Executing bibtex2html failed")) + + (dolist (f tmp-files) (delete-file f))) + + (with-temp-buffer + (save-match-data + (insert-file-contents (concat file ".html")) + (goto-char (point-min)) + (while (re-search-forward "a name=\"\\(\\w+\\)\">\\(\\w+\\)" nil t) + (setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist))) + (goto-char (point-min)) + (while (re-search-forward "<hr>" nil t) + (replace-match "<hr/>" t t)) + (concat "\n#+BEGIN_HTML\n<div id=\"bibliography\">\n" (buffer-string) "\n</div>\n#+END_HTML\n")))) + (latexp ;; Latex export + (concat "\n#+LATEX: \\bibliographystyle{" style "}" + "\n#+LATEX: \\bibliography{" file "}\n"))) t t))) + + + ;; Convert cites to links in html + (when htmlp + ;; Split citation commands with multiple keys + (org-exp-bibtex-docites + (lambda () + (let ((keys (save-match-data (org-split-string (match-string 1) ",")))) + (when (> (length keys) 1) + (replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "") + t t))))) + ;; Replace the citation commands with links + (org-exp-bibtex-docites + (lambda () (let* ((cn (match-string 1)) + (cv (assoc cn oebp-cite-plist))) +;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]")) + (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t)))) + + +)) + +(defun org-exp-bibtex-docites (fun) + (save-excursion + (save-match-data + (goto-char (point-min)) + (when htmlp + (while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t) + (apply fun nil)))))) + + +(defun org-exp-bibtex-options-to-plist (options) + (save-match-data + (flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s))))) + (mapcar 'f (split-string options nil t))))) + + + + +(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess) + +(provide 'org-exp-bibtex) + +;;; org-exp-bibtex.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-expiry.el b/.emacs.d/org-7.4/contrib/lisp/org-expiry.el new file mode 100644 index 0000000..4a49399 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-expiry.el @@ -0,0 +1,346 @@ +;;; org-expiry.el --- expiry mechanism for Org entries +;; +;; Copyright 2007 2008 Bastien Guerry +;; +;; Author: bzg AT altern DOT org +;; Version: 0.2 +;; Keywords: org expiry +;; URL: http://www.cognition.ens.fr/~guerry/u/org-expiry.el +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; +;; This gives you a chance to get rid of old entries in your Org files +;; by expiring them. +;; +;; By default, entries that have no EXPIRY property are considered to be +;; new (i.e. 0 day old) and only entries older than one year go to the +;; expiry process, which consist in adding the ARCHIVE tag. None of +;; your tasks will be deleted with the default settings. +;; +;; When does an entry expires? +;; +;; Consider this entry: +;; +;; * Stop watching TV +;; :PROPERTIES: +;; :CREATED: <2008-01-07 lun 08:01> +;; :EXPIRY: <2008-01-09 08:01> +;; :END: +;; +;; This entry will expire on the 9th, january 2008. + +;; * Stop watching TV +;; :PROPERTIES: +;; :CREATED: <2008-01-07 lun 08:01> +;; :EXPIRY: +1w +;; :END: +;; +;; This entry will expire on the 14th, january 2008, one week after its +;; creation date. +;; +;; What happen when an entry is expired? Nothing until you explicitely +;; M-x org-expiry-process-entries When doing this, org-expiry will check +;; for expired entries and request permission to process them. +;; +;; Processing an expired entries means calling the function associated +;; with `org-expiry-handler-function'; the default is to add the tag +;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive +;; the subtree. +;; +;; Is this useful? Well, when you're in a brainstorming session, it +;; might be useful to know about the creation date of an entry, and be +;; able to archive those entries that are more than xxx days/weeks old. +;; +;; When you're in such a session, you can insinuate org-expiry like +;; this: M-x org-expiry-insinuate +;; +;; Then, each time you're pressing M-RET to insert an item, the CREATION +;; property will be automatically added. Same when you're scheduling or +;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate + +;;; Code: + +;;; User variables: + +(defgroup org-expiry nil + "Org expiry process." + :tag "Org Expiry" + :group 'org) + +(defcustom org-expiry-created-property-name "CREATED" + "The name of the property for setting the creation date." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-expiry-property-name "EXPIRY" + "The name of the property for setting the expiry date/delay." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-keyword "EXPIRED" + "The default keyword for `org-expiry-add-keyword'." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-wait "+1y" + "Time span between the creation date and the expiry. +The default value for this variable (\"+1y\") means that entries +will expire if there are at least one year old. + +If the expiry delay cannot be retrieved from the entry or the +subtree above, the expiry process compares the expiry delay with +`org-expiry-wait'. This can be either an ISO date or a relative +time specification. See `org-read-date' for details." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-created-date "+0d" + "The default creation date. +The default value of this variable (\"+0d\") means that entries +without a creation date will be handled as if they were created +today. + +If the creation date cannot be retrieved from the entry or the +subtree above, the expiry process will compare the expiry delay +with this date. This can be either an ISO date or a relative +time specification. See `org-read-date' for details on relative +time specifications." + :type 'string + :group 'org-expiry) + +(defcustom org-expiry-handler-function 'org-toggle-archive-tag + "Function to process expired entries. +Possible candidates for this function are: + +`org-toggle-archive-tag' +`org-expiry-add-keyword' +`org-expiry-archive-subtree'" + :type 'function + :group 'org-expiry) + +(defcustom org-expiry-confirm-flag t + "Non-nil means confirm expiration process." + :type '(choice + (const :tag "Always require confirmation" t) + (const :tag "Do not require confirmation" nil) + (const :tag "Require confirmation in interactive expiry process" + interactive)) + :group 'org-expiry) + +(defcustom org-expiry-advised-functions + '(org-scheduled org-deadline org-time-stamp) + "A list of advised functions. +`org-expiry-insinuate' will activate the expiry advice for these +functions. `org-expiry-deinsinuate' will deactivate them." + :type 'boolean + :group 'list) + +;;; Advices and insinuation: + +(defadvice org-schedule (after org-schedule-update-created) + "Update the creation-date property when calling `org-schedule'." + (org-expiry-insert-created)) + +(defadvice org-deadline (after org-deadline-update-created) + "Update the creation-date property when calling `org-deadline'." + (org-expiry-insert-created)) + +(defadvice org-time-stamp (after org-time-stamp-update-created) + "Update the creation-date property when calling `org-time-stamp'." + (org-expiry-insert-created)) + +(defun org-expiry-insinuate (&optional arg) + "Add hooks and activate advices for org-expiry. +If ARG, also add a hook to `before-save-hook' in `org-mode' and +restart `org-mode' if necessary." + (interactive "P") + (ad-activate 'org-schedule) + (ad-activate 'org-time-stamp) + (ad-activate 'org-deadline) + (add-hook 'org-insert-heading-hook 'org-expiry-insert-created) + (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) + (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created) + (when arg + (add-hook 'org-mode-hook + (lambda() (add-hook 'before-save-hook + 'org-expiry-process-entries t t))) + ;; need this to refresh org-mode hooks + (when (org-mode-p) + (org-mode) + (if (interactive-p) + (message "Org-expiry insinuated, `org-mode' restarted."))))) + +(defun org-expiry-deinsinuate (&optional arg) + "Remove hooks and deactivate advices for org-expiry. +If ARG, also remove org-expiry hook in Org's `before-save-hook' +and restart `org-mode' if necessary." + (interactive "P") + (ad-deactivate 'org-schedule) + (ad-deactivate 'org-time-stamp) + (ad-deactivate 'org-deadline) + (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created) + (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created) + (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created) + (remove-hook 'org-mode-hook + (lambda() (add-hook 'before-save-hook + 'org-expiry-process-entries t t))) + (when arg + ;; need this to refresh org-mode hooks + (when (org-mode-p) + (org-mode) + (if (interactive-p) + (message "Org-expiry de-insinuated, `org-mode' restarted."))))) + +;;; org-expiry-expired-p: + +(defun org-expiry-expired-p () + "Check if the entry at point is expired. +Return nil if the entry is not expired. Otherwise return the +amount of time between today and the expiry date. + +If there is no creation date, use `org-expiry-created-date'. +If there is no expiry date, use `org-expiry-expiry-date'." + (let* ((ex-prop org-expiry-expiry-property-name) + (cr-prop org-expiry-created-property-name) + (ct (current-time)) + (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t) "+0d"))) + (ex-field (or (org-entry-get (point) ex-prop t) org-expiry-wait)) + (ex (if (string-match "^[ \t]?[+-]" ex-field) + (time-add cr (time-subtract (org-read-date nil t ex-field) ct)) + (org-read-date nil t ex-field)))) + (if (time-less-p ex ct) + (time-subtract ct ex)))) + +;;; Expire an entry or a region/buffer: + +(defun org-expiry-process-entry (&optional force) + "Call `org-expiry-handler-function' on entry. +If FORCE is non-nil, don't require confirmation from the user. +Otherwise rely on `org-expiry-confirm-flag' to decide." + (interactive "P") + (save-excursion + (when (interactive-p) (org-reveal)) + (when (org-expiry-expired-p) + (org-back-to-heading) + (looking-at org-complex-heading-regexp) + (let* ((ov (make-overlay (point) (match-end 0))) + (e (org-expiry-expired-p)) + (d (time-to-number-of-days e))) + (overlay-put ov 'face 'secondary-selection) + (if (or force + (null org-expiry-confirm-flag) + (and (eq org-expiry-confirm-flag 'interactive) + (not (interactive))) + (and org-expiry-confirm-flag + (y-or-n-p (format "Entry expired by %d days. Process? " d)))) + (funcall 'org-expiry-handler-function)) + (delete-overlay ov))))) + +(defun org-expiry-process-entries (beg end) + "Process all expired entries between BEG and END. +The expiry process will run the function defined by +`org-expiry-handler-functions'." + (interactive "r") + (save-excursion + (let ((beg (if (org-region-active-p) + (region-beginning) (point-min))) + (end (if (org-region-active-p) + (region-end) (point-max)))) + (goto-char beg) + (let ((expired 0) (processed 0)) + (while (and (outline-next-heading) (< (point) end)) + (when (org-expiry-expired-p) + (setq expired (1+ expired)) + (if (if (interactive-p) + (call-interactively 'org-expiry-process-entry) + (org-expiry-process-entry)) + (setq processed (1+ processed))))) + (if (equal expired 0) + (message "No expired entry") + (message "Processed %d on %d expired entries" + processed expired)))))) + +;;; Insert created/expiry property: + +(defun org-expiry-insert-created (&optional arg) + "Insert or update a property with the creation date. +If ARG, always update it. With one `C-u' prefix, silently update +to today's date. With two `C-u' prefixes, prompt the user for to +update the date." + (interactive "P") + (let* ((d (org-entry-get (point) org-expiry-created-property-name)) + d-time d-hour) + (when (or (null d) arg) + ;; update if no date or non-nil prefix argument + ;; FIXME Use `org-time-string-to-time' + (setq d-time (if d (apply 'encode-time (org-parse-time-string d)) + (current-time))) + (setq d-hour (format-time-string "%H:%M" d-time)) + (save-excursion + (org-entry-put + (point) org-expiry-created-property-name + ;; two C-u prefixes will call org-read-date + (if (equal arg '(16)) + (concat "<" (org-read-date + nil nil nil nil d-time d-hour) ">") + (format-time-string (cdr org-time-stamp-formats)))))))) + +(defun org-expiry-insert-expiry (&optional today) + "Insert a property with the expiry date. +With one `C-u' prefix, don't prompt interactively for the date +and insert today's date." + (interactive "P") + (let* ((d (org-entry-get (point) org-expiry-expiry-property-name)) + d-time d-hour) + (setq d-time (if d (apply 'encode-time (org-parse-time-string d)) + (current-time))) + (setq d-hour (format-time-string "%H:%M" d-time)) + (save-excursion + (org-entry-put + (point) org-expiry-expiry-property-name + (if today (format-time-string (cdr org-time-stamp-formats)) + (concat "<" (org-read-date + nil nil nil nil d-time d-hour) ">")))))) + +;;; Functions to process expired entries: + +(defun org-expiry-archive-subtree () + "Archive the entry at point if it is expired." + (interactive) + (save-excursion + (if (org-expiry-expired-p) + (org-archive-subtree) + (if (interactive-p) + (message "Entry at point is not expired."))))) + +(defun org-expiry-add-keyword (&optional keyword) + "Add KEYWORD to the entry at point if it is expired." + (interactive "sKeyword: ") + (if (or (member keyword org-todo-keywords-1) + (setq keyword org-expiry-keyword)) + (save-excursion + (if (org-expiry-expired-p) + (org-todo keyword) + (if (interactive-p) + (message "Entry at point is not expired.")))) + (error "\"%s\" is not a to-do keyword in this buffer" keyword))) + +;; FIXME what about using org-refile ? + +(provide 'org-expiry) + +;;; org-expiry.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el b/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el new file mode 100644 index 0000000..f8e8c4a --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-export-generic.el @@ -0,0 +1,1385 @@ +;; org-export-generic.el --- Export frameworg with custom backends + +;; Copyright (C) 2009 Free Software Foundation, Inc. + +;; Author: Wes Hardaker <hardaker at users dot sourceforge dot net> +;; Keywords: outlines, hypermedia, calendar, wp, export +;; Homepage: http://orgmode.org +;; Version: 6.25trans +;; Acks: Much of this code was stolen form the ascii export from Carsten +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; +;; ---------------------------------------------------------------------- +;; +;; OVERVIEW +;; +;; org-export-generic is basically a simple translation system that +;; knows how to parse at least most of a .org buffer and then add +;; various formatting prefixes before and after each section type. It +;; does this by examining a property list stored in org-generic-alist. +;; You can dynamically add propety lists of your own using the +;; org-set-generic-type function: +;; +;; (org-set-generic-type +;; "really-basic-text" +;; '(:file-suffix ".txt" +;; :key-binding ?R +;; +;; :title-format "=== %s ===\n" +;; :body-header-section-numbers t +;; :body-header-section-number-format "%s) " +;; :body-section-header-prefix "\n" +;; :body-section-header-suffix "\n" +;; :body-line-format " %s\n" +;; :body-line-wrap 75 +;; )) +;; +;; Note: Upper case key-bindings are reserved for your use. Lower +;; case key bindings may conflict with future export-generic +;; publications. +;; +;; Then run org-export (ctrl-c ctrl-e) and select generic or run +;; org-export-generic. You'll then be prompted with a list of export +;; types to choose from which will include your new type assigned to +;; the key "r". +;; +;; ---------------------------------------------------------------------- +;; +;; TODO (non-ordered) +;; * handle function references +;; * handle other types of multi-complex-listy-things to do +;; ideas: (t ?- "%s" ?-) +;; * handle indent specifiers better +;; ideas: (4 ?\ "%s") +;; * need flag to remove indents from body text +;; * handle links +;; * handle internationalization strings better +;; * date/author/etc needs improvment (internationalization too) +;; * allow specifying of section ordering +;; ideas: :ordering ("header" "toc" "body" "footer") +;; ^ matches current hard coded ordering +;; * err, actually *do* a footer +;; * deal with usage of org globals +;; *** should we even consider them, or let the per-section specifiers do it +;; *** answer: remove; mostly removed now +;; * deal with interactive support for picking a export specifier label +;; * char specifiers that need extra length because of formatting +;; idea: (?- 4) for 4-longer +;; * centering specifier +;; idea: ('center " -- %s -- ") +;; * remove more of the unneeded export-to-ascii copy code +;; * tags +;; *** supported now, but need separate format per tag +;; *** allow different open/closing prefixes +;; * properties +;; * drawers +;; * oh my +;; * optmization (many plist extracts should be in let vars) +;; * define defcustom spec for the specifier list +;; * fonts: at least monospace is not handled at all here. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +(require 'org-exp) +(require 'assoc) + +(defgroup org-export-generic nil + "Options specific for ASCII export of Org-mode files." + :tag "Org Export ASCII" + :group 'org-export) + +(defcustom org-export-generic-links-to-notes t + "Non-nil means convert links to notes before the next headline. +When nil, the link will be exported in place. If the line becomes long +in this way, it will be wrapped." + :group 'org-export-generic + :type 'boolean) + + +(defvar org-generic-current-indentation nil) ; For communication + +(defvar org-generic-alist + '( + ;; + ;; generic DEMO exporter + ;; + ;; (this tries to use every specifier for demo purposes) + ;; + ("demo" + :file-suffix ".txt" + :key-binding ?d + + :header-prefix "<header>\n" + :header-suffix "</header>\n" + + :author-export t + :tags-export t + + :drawers-export t + + + :title-prefix ?= + :title-format "<h1>%s</h1>\n" + :title-suffix ?= + + :date-export t + :date-prefix "<date>" + :date-format "<br /><b>Date:</b> <i>%s</i><br />" + :date-suffix "</date>\n\n" + + :toc-export t + :toc-header-prefix "<tocname>\n" + :toc-header-format "__%s__\n" + :toc-header-suffix "</tocname>\n" + + :toc-prefix "<toc>\n" + :toc-suffix "</toc>\n" + + :toc-section-numbers t + :toc-section-number-format "\#(%s) " + :toc-format "--%s--" + :toc-format-with-todo "!!%s!!\n" + :toc-indent-char ?\ + :toc-indent-depth 4 + + :toc-tags-export t + :toc-tags-prefix " <tags>" + :toc-tags-format "*%s*" + :toc-tags-suffix "</tags>\n" + :toc-tags-none-string "\n" + + :body-header-section-numbers 3 ; t = all, nil = none + + ; lists indicate different things per level + ; list contents or straight value can either be a + ; ?x char reference for printing strings that match the header len + ; "" string to print directly + :body-section-header-prefix ("<h1>" "<h2>" "<h3>" + "<h4>" "<h5>" "<h6>") + :body-section-header-format "%s" + :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n" + "</h4>\n" "</h5>\n" "</h6>\n") + + :timestamps-export t + :priorities-export t + :todo-keywords-export t + + :body-tags-export t + :body-tags-prefix " <tags>" + :body-tags-suffix "</tags>\n" + + ; section prefixes/suffixes can be direct strings or lists as well + :body-section-prefix "<secprefix>\n" + :body-section-suffix "</secsuffix>\n" +; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n") +; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n") + + + ; if preformated text should be included (eg, : prefixed) + :body-line-export-preformated t + :body-line-fixed-prefix "<pre>\n" + :body-line-fixed-suffix "\n</pre>\n" + :body-line-fixed-format "%s\n" + + + :body-list-prefix "<list>\n" + :body-list-suffix "</list>\n" + :body-list-format "<li>%s</li>\n" + + :body-number-list-prefix "<ol>\n" + :body-number-list-suffix "</ol>\n" + :body-number-list-format "<li>%s</li>\n" + :body-number-list-leave-number t + + :body-list-checkbox-todo "<checkbox type=\"todo\">" + :body-list-checkbox-todo-end "</checkbox (todo)>" + :body-list-checkbox-done "<checkbox type=\"done\">" + :body-list-checkbox-done-end "</checkbox (done)>" + :body-list-checkbox-half "<checkbox type=\"half\">" + :body-list-checkbox-half-end "</checkbox (half)>" + + + + + ; other body lines + :body-line-format "%s" + :body-line-wrap 60 ; wrap at 60 chars + + ; print above and below all body parts + :body-text-prefix "<p>\n" + :body-text-suffix "</p>\n" + + ) + + ;; + ;; ascii exporter + ;; + ;; (close to the original ascii specifier) + ;; + ("ascii" + :file-suffix ".txt" + :key-binding ?a + + :header-prefix "" + :header-suffix "" + + :title-prefix ?= + :title-format "%s\n" + :title-suffix ?= + + :date-export t + :date-prefix "" + :date-format "Date: %s\n" + :date-suffix "" + + :toc-header-prefix "" + :toc-header-format "%s\n" + :toc-header-suffix ?= + + :toc-export t + :toc-section-numbers t + :toc-section-number-format "%s " + :toc-format "%s\n" + :toc-format-with-todo "%s (*)\n" + :toc-indent-char ?\ + :toc-indent-depth 4 + + :body-header-section-numbers 3 + :body-section-prefix "\n" + +; :body-section-header-prefix "\n" +; :body-section-header-format "%s\n" +; :body-section-header-suffix (?\$ ?\# ?^ ?\~ ?\= ?\-) + + :body-section-header-prefix ("" "" "" "* " " + " " - ") + :body-section-header-format "%s\n" + :body-section-header-suffix (?~ ?= ?- "\n" "\n" "\n") + +; :body-section-marker-prefix "" +; :body-section-marker-chars (?\$ ?\# ?^ ?\~ ?\= ?\-) +; :body-section-marker-suffix "\n" + + :body-line-export-preformated t + :body-line-format "%s\n" + :body-line-wrap 75 + +; :body-text-prefix "<t>\n" +; :body-text-suffix "</t>\n" + + + :body-bullet-list-prefix (?* ?+ ?-) +; :body-bullet-list-suffix (?* ?+ ?-) + ) + + ;; + ;; wikipedia + ;; + ("wikipedia" + :file-suffix ".txt" + :key-binding ?w + + :header-prefix "" + :header-suffix "" + + :title-format "= %s =\n" + + :date-export nil + + :toc-export nil + + :body-header-section-numbers nil + :body-section-prefix "\n" + + :body-section-header-prefix ("= " "== " "=== " + "==== " "===== " "====== ") + :body-section-header-suffix (" =\n\n" " ==\n\n" " ===\n\n" + " ====\n\n" " =====\n\n" " ======\n\n") + + :body-line-export-preformated t ;; yes/no/maybe??? + :body-line-format "%s\n" + :body-line-wrap 75 + + :body-line-fixed-format " %s\n" + + :body-list-format "* %s\n" + :body-number-list-format "# %s\n" + + :body-bullet-list-prefix ("* " "** " "*** " "**** " "***** ") + ) + + ;; + ;; minimal html exporter + ;; + ("html" + ;; simple html output + :file-suffix ".html" + :key-binding ?h + + :header-prefix "<body>" + + :title-format "<h1>%s</h1>\n\n" + + :date-export t + :date-format "<br /><b>Date:</b> <i>%s</i><br />\n\n" + + :toc-export nil + + :body-header-section-numbers 3 + + :body-section-header-prefix ("<h1>" "<h2>" "<h3>" + "<h4>" "<h5>" "<h6>") + :body-section-header-format "%s" + :body-section-header-suffix ("</h1>\n" "</h2>\n" "</h3>\n" + "</h4>\n" "</h5>\n" "</h6>\n") + + :body-section-prefix "<secprefix>\n" + :body-section-suffix "</secsuffix>\n" +; :body-section-prefix ("<sec1>\n" "<sec2>\n" "<sec3>\n") +; :body-section-suffix ("</sec1>\n" "</sec2>\n" "</sec3>\n") + + :body-line-export-preformated t + :body-line-format "%s\n" + + :body-text-prefix "<p>\n" + :body-text-suffix "</p>\n" + + :body-bullet-list-prefix (?* ?+ ?-) +; :body-bullet-list-suffix (?* ?+ ?-) + ) + + ;; + ;; internet-draft .xml for xml2rfc exporter + ;; + ("ietfid" + ;; this tries to use every specifier for demo purposes + :file-suffix ".xml" + :key-binding ?i + + :title-prefix "<?xml version=\"1.0\"\?> +<!DOCTYPE rfc SYSTEM \"rfc2629.dtd\" [ +<!ENTITY rfcs PUBLIC '' 'blah'> +<?rfc strict=\"yes\" ?> +<?rfc toc=\"yes\" ?> +<?rfc tocdepth=\"4\" ?> +<?rfc symrefs=\"yes\" ?> +<?rfc compact=\"yes\" ?> +<?rfc subcompact=\"no\" ?> +<rfc category=\"std\" ipr=\"pre5378Trust200902\" docName=\"FILLME.txt\"> + <front> +" + :title-format "<title abbrev=\"ABBREV HERE\">\n%s\n</title>\n" + :title-suffix "<author initials=\"A.A\" surname=\"LASTNAME\" fullname=\"FULL NAME\"> + <organization>Comany, Inc..</organization> + <address> + <postal> + <street></street> + <city></city> + <region></region> + <code></code> + <country></country> + </postal> + <phone></phone> + <email></email> + </address> + </author> + <date month=\"FILLMONTH\" year=\"FILLYEAR\"/> + <area>Operations and Management</area> + <workgroup>FIXME</workgroup> +<abstract>\n" + :date-export nil + + :toc-export nil + + :body-header-section-numbers nil + + :body-section-header-format "<section title=\"%s\">\n" + :body-section-suffix "</section>\n" + + ; if preformated text should be included (eg, : prefixed) + :body-line-export-preformated t + :body-line-fixed-prefix "<figure>\n<artwork>\n" + :body-line-fixed-suffix "\n</artwork>\n</figure>\n" + + ; other body lines + :body-line-format "%s" + :body-line-wrap 75 + + ; print above and below all body parts + :body-text-prefix "<t>\n" + :body-text-suffix "</t>\n" + + :body-list-prefix "<list style=\"symbols\">\n" + :body-list-suffix "</list>\n" + :body-list-format "<t>%s</t>\n" + + ) + ) + "A assoc list of property lists to specify export definitions" +) + +(setq org-generic-export-type "demo") + +(defvar org-export-generic-section-type "") +(defvar org-export-generic-section-suffix "") + +;;;###autoload +(defun org-set-generic-type (type definition) + "Adds a TYPE and DEFINITION to the existing list of defined generic +export definitions." + (aput 'org-generic-alist type definition)) + +;;; helper functions for org-set-generic-type +(defvar org-export-generic-keywords nil) +(defmacro* def-org-export-generic-keyword (keyword + &key documentation + type) + "Define KEYWORD as a legitimate element for inclusion in +the body of an org-set-generic-type definition." + `(progn + (pushnew ,keyword org-export-generic-keywords) + ;; TODO: push the documentation and type information + ;; somewhere where it will do us some good. + )) + +(def-org-export-generic-keyword :body-newline-paragraph + :documentation "Bound either to NIL or to a pattern to be +inserted in the output for every blank line in the input. + The intention is to handle formats where text is flowed, and +newlines are interpreted as significant \(e.g., as indicating +preformatted text\). A common non-nil value for this keyword +is \"\\n\". Should typically be combined with a value for +:body-line-format that does NOT end with a newline." + :type string) + +;;; fontification keywords +(def-org-export-generic-keyword :bold-format) +(def-org-export-generic-keyword :italic-format) +(def-org-export-generic-keyword :underline-format) +(def-org-export-generic-keyword :strikethrough-format) +(def-org-export-generic-keyword :code-format) +(def-org-export-generic-keyword :verbatim-format) + + + + +(defun org-export-generic-remember-section (type suffix &optional prefix) + (setq org-export-generic-section-type type) + (setq org-export-generic-section-suffix suffix) + (if prefix + (insert prefix)) +) + +(defun org-export-generic-check-section (type &optional prefix suffix) + "checks to see if type is already in use, or we're switching parts +If we're switching, then insert a potentially previously remembered +suffix, and insert the current prefix immediately and then save the +suffix a later change time." + + (when (not (equal type org-export-generic-section-type)) + (if org-export-generic-section-suffix + (insert org-export-generic-section-suffix)) + (setq org-export-generic-section-type type) + (setq org-export-generic-section-suffix suffix) + (if prefix + (insert prefix)))) + +;;;###autoload +(defun org-export-generic (arg) + "Export the outline as generic output. +If there is an active region, export only the region. +The prefix ARG specifies how many levels of the outline should become +underlined headlines. The default is 3." + (interactive "P") + (setq-default org-todo-line-regexp org-todo-line-regexp) + (let* ((opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (region-p (org-region-active-p)) + (rbeg (and region-p (region-beginning))) + (rend (and region-p (region-end))) + (subtree-p + (when region-p + (save-excursion + (goto-char rbeg) + (and (org-at-heading-p) + (>= (org-end-of-subtree t t) rend))))) + (level-offset (if subtree-p + (save-excursion + (goto-char rbeg) + (+ (funcall outline-level) + (if org-odd-levels-only 1 0))) + 0)) + (opt-plist (setq org-export-opt-plist + (if subtree-p + (org-export-add-subtree-options opt-plist rbeg) + opt-plist))) + + helpstart + (bogus (mapc (lambda (x) + (setq helpstart + (concat helpstart "\[" + (char-to-string + (plist-get (cdr x) :key-binding)) + "] " (car x) "\n"))) + org-generic-alist)) + + (help (concat helpstart " + +\[ ] the current setting of the org-generic-export-type variable +")) + + (cmds + + (append + (mapcar (lambda (x) + (list + (plist-get (cdr x) :key-binding) + (car x))) + org-generic-alist) + (list (list ? "default")))) + + r1 r2 ass + + ;; read in the type to use + (export-plist + (progn + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Org Export/Generic Styles Help*" + (princ help)) + (org-fit-window-to-buffer (get-buffer-window + "*Org Export/Generic Styles Help*")) + (message "Select command: ") + (setq r1 (read-char-exclusive)))) + (setq r2 (if (< r1 27) (+ r1 96) r1)) + (unless (setq ass (cadr (assq r2 cmds))) + (error "No command associated with key %c" r1)) + + (cdr (assoc + (if (equal ass "default") org-generic-export-type ass) + org-generic-alist)))) + + (custom-times org-display-custom-times) + (org-generic-current-indentation '(0 . 0)) + (level 0) (old-level 0) line txt lastwastext + (umax nil) + (umax-toc nil) + (case-fold-search nil) + (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) + (filesuffix (or (plist-get export-plist :file-suffix) ".foo")) + (filename (concat (file-name-as-directory + (org-export-directory :ascii opt-plist)) + (file-name-sans-extension + (or (and subtree-p + (org-entry-get (region-beginning) + "EXPORT_FILE_NAME" t)) + (file-name-nondirectory bfname))) + filesuffix)) + (filename (if (equal (file-truename filename) + (file-truename bfname)) + (concat filename filesuffix) + filename)) + (buffer (find-file-noselect filename)) + (org-levels-open (make-vector org-level-max nil)) + (odd org-odd-levels-only) + (date (plist-get opt-plist :date)) + (author (plist-get opt-plist :author)) + (title (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (file-name-sans-extension + (file-name-nondirectory bfname)))) + (email (plist-get opt-plist :email)) + (language (plist-get opt-plist :language)) + (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) +; (quote-re (concat "^\\(\\*+\\)\\([ \t]*" org-quote-string "\\>\\)")) + (todo nil) + (lang-words nil) + (region + (buffer-substring + (if (org-region-active-p) (region-beginning) (point-min)) + (if (org-region-active-p) (region-end) (point-max)))) + (lines (org-split-string + (org-export-preprocess-string + region + :for-ascii t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get export-plist :drawers-export) + :tags (plist-get export-plist :tags-export) + :priority (plist-get export-plist :priority-export) + :footnotes (plist-get export-plist :footnotes-export) + :timestamps (plist-get export-plist :timestamps-export) + :todo-keywords (plist-get export-plist :todo-keywords-export) + :verbatim-multiline t + :select-tags (plist-get export-plist :select-tags-export) + :exclude-tags (plist-get export-plist :exclude-tags-export) + :emph-multiline t + :archived-trees + (plist-get export-plist :archived-trees-export) + :add-text (plist-get opt-plist :text)) + "\n")) + ;; export-generic plist variables + (withtags (plist-get export-plist :tags-export)) + (tagsintoc (plist-get export-plist :toc-tags-export)) + (tocnotagsstr (or (plist-get export-plist :toc-tags-none-string) "")) + (tocdepth (plist-get export-plist :toc-indent-depth)) + (tocindentchar (plist-get export-plist :toc-indent-char)) + (tocsecnums (plist-get export-plist :toc-section-numbers)) + (tocsecnumform (plist-get export-plist :toc-section-number-format)) + (tocformat (plist-get export-plist :toc-format)) + (tocformtodo (plist-get export-plist :toc-format-with-todo)) + (tocprefix (plist-get export-plist :toc-prefix)) + (tocsuffix (plist-get export-plist :toc-suffix)) + (bodyfixedpre (plist-get export-plist :body-line-fixed-prefix)) + (bodyfixedsuf (plist-get export-plist :body-line-fixed-suffix)) + (bodyfixedform (or (plist-get export-plist :body-line-fixed-format) + "%s")) + (listprefix (plist-get export-plist :body-list-prefix)) + (listsuffix (plist-get export-plist :body-list-suffix)) + (listformat (or (plist-get export-plist :body-list-format) "%s\n")) + (numlistleavenum + (plist-get export-plist :body-number-list-leave-number)) + (numlistprefix (plist-get export-plist :body-number-list-prefix)) + (numlistsuffix (plist-get export-plist :body-number-list-suffix)) + (numlistformat + (or (plist-get export-plist :body-number-list-format) "%s\n")) + (listchecktodo + (or (plist-get export-plist :body-list-checkbox-todo) "\\1")) + (listcheckdone + (or (plist-get export-plist :body-list-checkbox-done) "\\1")) + (listcheckhalf + (or (plist-get export-plist :body-list-checkbox-half) "\\1")) + (listchecktodoend + (or (plist-get export-plist :body-list-checkbox-todo-end) "")) + (listcheckdoneend + (or (plist-get export-plist :body-list-checkbox-done-end) "")) + (listcheckhalfend + (or (plist-get export-plist :body-list-checkbox-half-end) "")) + (bodynewline-paragraph (plist-get export-plist :body-newline-paragraph)) + (bodytextpre (plist-get export-plist :body-text-prefix)) + (bodytextsuf (plist-get export-plist :body-text-suffix)) + (bodylinewrap (plist-get export-plist :body-line-wrap)) + (bodylineform (or (plist-get export-plist :body-line-format) "%s")) + (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t")) + (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n")) + + ;; dynamic variables used heinously in fontification + ;; not referenced locally... + (format-boldify (plist-get export-plist :bold-format)) + (format-italicize (plist-get export-plist :italic-format)) + (format-underline (plist-get export-plist :underline-format)) + (format-strikethrough (plist-get export-plist :strikethrough-format)) + (format-code (plist-get export-plist :code-format)) + (format-verbatim (plist-get export-plist :verbatim-format)) + + + + thetoc toctags have-headings first-heading-pos + table-open table-buffer link-buffer link desc desc0 rpl wrap) + + (let ((inhibit-read-only t)) + (org-unmodified + (remove-text-properties (point-min) (point-max) + '(:org-license-to-kill t)))) + + (setq org-min-level (org-get-min-level lines level-offset)) + (setq org-last-level org-min-level) + (org-init-section-numbers) + + (find-file-noselect filename) + + (setq lang-words (or (assoc language org-export-language-setup) + (assoc "en" org-export-language-setup))) + (switch-to-buffer-other-window buffer) + (erase-buffer) + (fundamental-mode) + ;; create local variables for all options, to make sure all called + ;; functions get the correct information + (mapc (lambda (x) + (set (make-local-variable (nth 2 x)) + (plist-get opt-plist (car x)))) + org-export-plist-vars) + (org-set-local 'org-odd-levels-only odd) + (setq umax (if arg (prefix-numeric-value arg) + org-export-headline-levels)) + (setq umax-toc umax) + + ;; File header + (if title + (insert + (org-export-generic-header title export-plist + :title-prefix + :title-format + :title-suffix))) + + (if (and (or author email) + (plist-get export-plist :author-export)) + (insert (concat (nth 1 lang-words) ": " (or author "") + (if email (concat " <" email ">") "") + "\n"))) + + (cond + ((and date (string-match "%" date)) + (setq date (format-time-string date))) + (date) + (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) + + (if (and date (plist-get export-plist :date-export)) + (insert + (org-export-generic-header date export-plist + :date-prefix + :date-format + :date-suffix))) + + ;; export the table of contents first + (if (plist-get export-plist :toc-export) + (progn + (push + (org-export-generic-header (nth 3 lang-words) export-plist + :toc-header-prefix + :toc-header-format + :toc-header-suffix) + thetoc) + + (if tocprefix + (push tocprefix thetoc)) + + (mapc '(lambda (line) + (if (string-match org-todo-line-regexp line) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (match-string 3 line) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) + ; TODO, not DONE + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (setq txt (org-html-expand-for-generic txt)) + + (while (string-match org-bracket-link-regexp txt) + (setq txt + (replace-match + (match-string (if (match-end 2) 3 1) txt) + t t txt))) + + (if (and (not tagsintoc) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt)) + (setq txt (replace-match "" t t txt)) + ; include tags but formated + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") + txt) + (progn + (setq + toctags + (org-export-generic-header + (match-string 1 txt) + export-plist :toc-tags-prefix + :toc-tags-format :toc-tags-suffix)) + (string-match + (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + txt) + (setq txt (replace-match "" t t txt))) + (setq toctags tocnotagsstr))) + + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + + (if (<= level umax-toc) + (progn + (push + (concat + + (make-string + (* (max 0 (- level org-min-level)) tocdepth) + tocindentchar) + + (if tocsecnums + (format tocsecnumform + (org-section-number level)) + "") + + (format + (if todo tocformtodo tocformat) + txt) + + toctags) + + thetoc) + (setq org-last-level level)) + )))) + lines) + (if tocsuffix + (push tocsuffix thetoc)) + (setq thetoc (if have-headings (nreverse thetoc) nil)))) + + (org-init-section-numbers) + (org-export-generic-check-section "top") + (while (setq line (pop lines)) + (when (and link-buffer (string-match "^\\*+ " line)) + (org-export-generic-push-links (nreverse link-buffer)) + (setq link-buffer nil)) + (setq wrap nil) + ;; Remove the quoted HTML tags. + ;; XXX + (setq line (org-html-expand-for-generic line)) + ;; Replace links with the description when possible + ;; XXX + (while (string-match org-bracket-link-regexp line) + (setq link (match-string 1 line) + desc0 (match-string 3 line) + desc (or desc0 (match-string 1 line))) + (if (and (> (length link) 8) + (equal (substring link 0 8) "coderef:")) + (setq line (replace-match + (format (org-export-get-coderef-format (substring link 8) desc) + (cdr (assoc + (substring link 8) + org-export-code-refs))) + t t line)) + (setq rpl (concat "[" + (or (match-string 3 line) (match-string 1 line)) + "]")) + (when (and desc0 (not (equal desc0 link))) + (if org-export-generic-links-to-notes + (push (cons desc0 link) link-buffer) + (setq rpl (concat rpl " (" link ")") + wrap (+ (length line) (- (length (match-string 0 line))) + (length desc))))) + (setq line (replace-match rpl t t line)))) + (when custom-times + (setq line (org-translate-time line))) + (cond + ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ;; + ;; a Headline + ;; + (org-export-generic-check-section "headline") + + (setq first-heading-pos (or first-heading-pos (point))) + (setq level (org-tr-level (- (match-end 1) (match-beginning 1) + level-offset)) + txt (match-string 2 line)) + (org-generic-level-start level old-level txt umax export-plist lines) + (setq old-level level)) + + ((and org-export-with-tables + (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) + ;; + ;; a Table + ;; + (org-export-generic-check-section "table") + + (if (not table-open) + ;; New table starts + (setq table-open t table-buffer nil)) + ;; Accumulate table lines + (setq table-buffer (cons line table-buffer)) + (when (or (not lines) + (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" + (car lines)))) + (setq table-open nil + table-buffer (nreverse table-buffer)) + (insert (mapconcat + (lambda (x) + (org-fix-indentation x org-generic-current-indentation)) + (org-format-table-generic table-buffer) + "\n") "\n"))) + + ((string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line) + ;; + ;; pre-formatted text + ;; + (setq line (replace-match "\\1" nil nil line)) + + (org-export-generic-check-section "preformat" bodyfixedpre bodyfixedsuf) + + (insert (format bodyfixedform line))) + + ((or (string-match "^\\([ \t]*\\)\\([\-\+][ \t]*\\)" line) + ;; if the bullet list item is an asterisk, the leading space is /mandatory/ + ;; [2010/02/02:rpg] + (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line)) + ;; + ;; plain list item + ;; TODO: nested lists + ;; + ;; first add a line break between any previous paragraph or line item and this + ;; one + (when bodynewline-paragraph + (insert bodynewline-paragraph)) + + ;; I believe this gets rid of leading whitespace. + (setq line (replace-match "" nil nil line)) + + ;; won't this insert the suffix /before/ the last line of the list? + ;; also isn't it spoofed by bulleted lists that have a line skip between the list items + ;; unless 'org-empty-line-terminates-plain-lists' is true? + (org-export-generic-check-section "liststart" listprefix listsuffix) + + ;; deal with checkboxes + (cond + ((string-match "^\\(\\[ \\]\\)[ \t]*" line) + (setq line (concat (replace-match listchecktodo nil nil line) + listchecktodoend))) + ((string-match "^\\(\\[X\\]\\)[ \t]*" line) + (setq line (concat (replace-match listcheckdone nil nil line) + listcheckdoneend))) + ((string-match "^\\(\\[/\\]\\)[ \t]*" line) + (setq line (concat (replace-match listcheckhalf nil nil line) + listcheckhalfend))) + ) + + (insert (format listformat (org-export-generic-fontify line)))) + ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line) + ;; + ;; numbered list item + ;; + ;; TODO: nested lists + ;; + (setq line (replace-match (if numlistleavenum "\\2" "") nil nil line)) + + (org-export-generic-check-section "numliststart" + numlistprefix numlistsuffix) + + ;; deal with checkboxes + ;; TODO: whoops; leaving the numbers is a problem for ^ matching + (cond + ((string-match "\\(\\[ \\]\\)[ \t]*" line) + (setq line (concat (replace-match listchecktodo nil nil line) + listchecktodoend))) + ((string-match "\\(\\[X\\]\\)[ \t]*" line) + (setq line (concat (replace-match listcheckdone nil nil line) + listcheckdoneend))) + ((string-match "\\(\\[/\\]\\)[ \t]*" line) + (setq line (concat (replace-match listcheckhalf nil nil line) + listcheckhalfend))) + ) + + (insert (format numlistformat (org-export-generic-fontify line)))) + + ((equal line "ORG-BLOCKQUOTE-START") + (setq line blockquotestart)) + ((equal line "ORG-BLOCKQUOTE-END") + (setq line blockquoteend)) + ((string-match "^\\s-*$" line) + ;; blank line + (if bodynewline-paragraph + (insert bodynewline-paragraph))) + (t + ;; + ;; body + ;; + (org-export-generic-check-section "body" bodytextpre bodytextsuf) + + (setq line + (org-export-generic-fontify line)) + + ;; XXX: properties? list? + (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) + (setq line (replace-match "\\1\\3:" t nil line))) + + (setq line (org-fix-indentation line org-generic-current-indentation)) + + ;; Remove forced line breaks + (if (string-match "\\\\\\\\[ \t]*$" line) + (setq line (replace-match "" t t line))) + + (if bodylinewrap + ;; XXX: was dependent on wrap var which was calculated by??? + (if (> (length line) bodylinewrap) + (setq line + (org-export-generic-wrap line bodylinewrap)) + (setq line line))) + (insert (format bodylineform line))))) + + ;; if we're at a level > 0; insert the closing body level stuff + (let ((counter 0)) + (while (> (- level counter) 0) + (insert + (org-export-generic-format export-plist :body-section-suffix 0 + (- level counter))) + (setq counter (1+ counter)))) + + (org-export-generic-check-section "bottom") + + (org-export-generic-push-links (nreverse link-buffer)) + + (normal-mode) + + ;; insert the table of contents + (when thetoc + (goto-char (point-min)) + (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) + (progn + (goto-char (match-beginning 0)) + (replace-match "")) + (goto-char first-heading-pos)) + (mapc 'insert thetoc) + (or (looking-at "[ \t]*\n[ \t]*\n") + (insert "\n\n"))) + + ;; Convert whitespace place holders + (goto-char (point-min)) + (let (beg end) + (while (setq beg (next-single-property-change (point) 'org-whitespace)) + (setq end (next-single-property-change beg 'org-whitespace)) + (goto-char beg) + (delete-region beg end) + (insert (make-string (- end beg) ?\ )))) + + (save-buffer) + + ;; remove display and invisible chars + (let (beg end) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'display)) + (setq end (next-single-property-change beg 'display)) + (delete-region beg end) + (goto-char beg) + (insert "=>")) + (goto-char (point-min)) + (while (setq beg (next-single-property-change (point) 'org-cwidth)) + (setq end (next-single-property-change beg 'org-cwidth)) + (delete-region beg end) + (goto-char beg))) + (goto-char (point-min)))) + + +(defun org-export-generic-format (export-plist prop &optional len n reverse) + "converts a property specification to a string given types of properties + +The EXPORT-PLIST should be defined as the lookup plist. +The PROP should be the property name to search for in it. +LEN is set to the length of multi-characters strings to generate (or 0) +N is the tree depth +REVERSE means to reverse the list if the plist match is a list + " + (let* ((prefixtype (plist-get export-plist prop)) + subtype) + (cond + ((null prefixtype) "") + ((and len (char-or-string-p prefixtype) (not (stringp prefixtype))) + ;; sequence of chars + (concat (make-string len prefixtype) "\n")) + ((stringp prefixtype) + prefixtype) + ((and n (listp prefixtype)) + (if reverse + (setq prefixtype (reverse prefixtype))) + (setq subtype (if (> n (length prefixtype)) + (car (last prefixtype)) + (nth (1- n) prefixtype))) + (if (stringp subtype) + subtype + (concat (make-string len subtype) "\n"))) + (t "")) + )) + +(defun org-export-generic-header (header export-plist + prefixprop formatprop postfixprop + &optional n reverse) + "convert a header to an output string given formatting property names" + (let* ((formatspec (plist-get export-plist formatprop)) + (len (length header))) + (concat + (org-export-generic-format export-plist prefixprop len n reverse) + (format (or formatspec "%s") header) + (org-export-generic-format export-plist postfixprop len n reverse)) + )) + +(defun org-export-generic-preprocess (parameters) + "Do extra work for ASCII export" + ;; Put quotes around verbatim text + (goto-char (point-min)) + (while (re-search-forward org-verbatim-re nil t) + (goto-char (match-end 2)) + (backward-delete-char 1) (insert "'") + (goto-char (match-beginning 2)) + (delete-char 1) (insert "`") + (goto-char (match-end 2))) + ;; Remove target markers + (goto-char (point-min)) + (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) + (replace-match "\\1\\2"))) + +(defun org-html-expand-for-generic (line) + "Handle quoted HTML for ASCII export." + (if org-export-html-expand + (while (string-match "@<[^<>\n]*>" line) + ;; We just remove the tags for now. + (setq line (replace-match "" nil nil line)))) + line) + +(defun org-export-generic-wrap (line where) + "Wrap LINE at or before WHERE." + (let* ((ind (org-get-indentation line)) + (indstr (make-string ind ?\ )) + (len (length line)) + (result "") + pos didfirst) + (while (> len where) + (catch 'found + (loop for i from where downto (/ where 2) do + (and (equal (aref line i) ?\ ) + (setq pos i) + (throw 'found t)))) + (if pos + (progn + (setq result + (concat result + (if didfirst indstr "") + (substring line 0 pos) + "\n")) + (setq didfirst t) + (setq line (substring line (1+ pos))) + (setq len (length line))) + (setq result (concat result line)) + (setq len 0))) + (concat result indstr line))) + +(defun org-export-generic-push-links (link-buffer) + "Push out links in the buffer." + (when link-buffer + ;; We still have links to push out. + (insert "\n") + (let ((ind "")) + (save-match-data + (if (save-excursion + (re-search-backward + "^\\(\\([ \t]*\\)\\|\\(\\*+ \\)\\)[^ \t\n]" nil t)) + (setq ind (or (match-string 2) + (make-string (length (match-string 3)) ?\ ))))) + (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) + link-buffer)) + (insert "\n"))) + +(defun org-generic-level-start (level old-level title umax export-plist + &optional lines) + "Insert a new level in a generic export." + (let ((n (- level umax 1)) + (ind 0) + (diff (- level old-level)) (counter 0) + (secnums (plist-get export-plist :body-header-section-numbers)) + (secnumformat + (plist-get export-plist :body-header-section-number-format)) + char tagstring) + (unless org-export-with-tags + (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (setq title (replace-match "" t t title)))) + + (cond + ;; going deeper + ((> level old-level) + (while (< (+ old-level counter) (1- level)) + (insert + (org-export-generic-format export-plist :body-section-prefix 0 + (+ old-level counter))) + (setq counter (1+ counter)) + )) + ;; going up + ((< level old-level) + (while (> (- old-level counter) (1- level)) + (insert + (org-export-generic-format export-plist :body-section-suffix 0 + (- old-level counter))) + (setq counter (1+ counter)) + )) + ;; same level + ((= level old-level) + (insert + (org-export-generic-format export-plist :body-section-suffix 0 level)) + ) + ) + (insert + (org-export-generic-format export-plist :body-section-prefix 0 level)) + + (if (and org-export-with-section-numbers + secnums + (or (not (numberp secnums)) + (< level secnums))) + (setq title + (concat (format (or secnumformat "%s ") + (org-section-number level)) title))) + + ;; handle tags and formatting + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") title) + (progn + (if (plist-get export-plist :body-tags-export) + (setq tagstring (org-export-generic-header (match-string 1 title) + export-plist + :body-tags-prefix + :body-tags-format + :body-tags-suffix))) + (string-match (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") title) + (setq title (replace-match "" t t title))) + (setq tagstring (plist-get export-plist :body-tags-none-string))) + + (insert + (org-export-generic-header title export-plist + :body-section-header-prefix + :body-section-header-format + :body-section-header-suffix + level)) + (if tagstring + (insert tagstring)) + + (setq org-generic-current-indentation '(0 . 0)))) + +(defun org-insert-centered (s &optional underline) + "Insert the string S centered and underline it with character UNDERLINE." + (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) + (insert (make-string ind ?\ ) s "\n") + (if underline + (insert (make-string ind ?\ ) + (make-string (string-width s) underline) + "\n")))) + +(defvar org-table-colgroup-info nil) +(defun org-format-table-generic (lines) + "Format a table for ascii export." + (if (stringp lines) + (setq lines (org-split-string lines "\n"))) + (if (not (string-match "^[ \t]*|" (car lines))) + ;; Table made by table.el - test for spanning + lines + + ;; A normal org table + ;; Get rid of hlines at beginning and end + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) + (setq lines (nreverse lines)) + (when org-export-table-remove-special-lines + ;; Check if the table has a marking column. If yes remove the + ;; column and the special lines + (setq lines (org-table-clean-before-export lines))) + ;; Get rid of the vertical lines except for grouping + (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) + rtn line vl1 start) + (while (setq line (pop lines)) + (if (string-match org-table-hline-regexp line) + (and (string-match "|\\(.*\\)|" line) + (setq line (replace-match " \\1" t nil line))) + (setq start 0 vl1 vl) + (while (string-match "|" line start) + (setq start (match-end 0)) + (or (pop vl1) (setq line (replace-match " " t t line))))) + (push line rtn)) + (nreverse rtn)))) + +(defun org-colgroup-info-to-vline-list (info) + (let (vl new last) + (while info + (setq last new new (pop info)) + (if (or (memq last '(:end :startend)) + (memq new '(:start :startend))) + (push t vl) + (push nil vl))) + (setq vl (nreverse vl)) + (and vl (setcar vl nil)) + vl)) + + +;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg] +(defvar org-export-generic-emphasis-alist + '(("*" format-boldify nil) + ("/" format-italicize nil) + ("_" format-underline nil) + ("+" format-strikethrough nil) + ("=" format-code t) + ("~" format-verbatim t)) + "Alist of org format -> formatting variables for fontification. +Each element of the list is a list of three elements. +The first element is the character used as a marker for fontification. +The second element is a variable name, set in org-export-generic. That +variable will be dereferenced to obtain a formatting string to wrap +fontified text with. +The third element decides whether to protect converted text from other +conversions.") + +;;; Cargo-culted from the latex translation. I couldn't figure out how +;;; to keep the structure since the generic export operates on lines, rather +;;; than on a buffer as in the latex export, meaning that none of the +;;; search forward code could be kept. This led me to rewrite the +;;; whole thing recursively. A huge lose for efficiency (potentially), +;;; but I couldn't figure out how to make the looping work. +;;; Worse, it's /doubly/ recursive, because this function calls +;;; org-export-generic-emph-format, which can call it recursively... +;;; [2010/05/20:rpg] +(defun org-export-generic-fontify (string) + "Convert fontification according to generic rules." + (if (string-match org-emph-re string) + ;; The match goes one char after the *string*, except at the end of a line + (let ((emph (assoc (match-string 3 string) + org-export-generic-emphasis-alist)) + (beg (match-beginning 0)) + (end (match-end 0))) + (unless emph + (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\"" + (match-string 3 string))) + ;; now we need to determine whether we have strikethrough or + ;; a list, which is a bit nasty + (if (and (equal (match-string 3 string) "+") + (save-match-data + (string-match "\\`-+\\'" (match-string 4 string)))) + ;; a list --- skip this match and recurse on the point after the + ;; first emph char... + (concat (substring string 0 (1+ (match-beginning 3))) + (org-export-generic-fontify (substring string (match-beginning 3)))) + (concat (substring string 0 beg) ;; part before the match + (match-string 1 string) + (org-export-generic-emph-format (second emph) + (match-string 4 string) + (third emph)) + (or (match-string 5 string) "") + (org-export-generic-fontify (substring string end))))) + string)) + +(defun org-export-generic-emph-format (format-varname string protect) + "Return a string that results from applying the markup indicated by +FORMAT-VARNAME to STRING." + (let ((format (symbol-value format-varname))) + (let ((string-to-emphasize + (if protect + string + (org-export-generic-fontify string)))) + (if format + (format format string-to-emphasize) + string-to-emphasize)))) + +(provide 'org-generic) +(provide 'org-export-generic) + +;;; org-export-generic.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-git-link.el b/.emacs.d/org-7.4/contrib/lisp/org-git-link.el new file mode 100644 index 0000000..195bf9b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-git-link.el @@ -0,0 +1,219 @@ +;;; org-git-link.el --- Provide org links to specific file version + +;; Copyright (C) 2009 Reimar Finken + +;; Author: Reimar Finken <reimar.finken@gmx.de> +;; Keywords: files, calendar, hypermedia + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distaributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; `org-git-link.el' defines two new link types. The `git' link +;; type is meant to be used in the typical scenario and mimics the +;; `file' link syntax as closely as possible. The `gitbare' link +;; type exists mostly for debugging reasons, but also allows e.g. +;; linking to files in a bare git repository for the experts. + +;; * User friendy form +;; [[git:/path/to/file::searchstring]] + +;; This form is the familiar from normal org file links +;; including search options. However, its use is +;; restricted to files in a working directory and does not +;; handle bare repositories on purpose (see the bare form for +;; that). + +;; The search string references a commit (a tree-ish in Git +;; terminology). The two most useful types of search strings are + +;; - A symbolic ref name, usually a branch or tag name (e.g. +;; master or nobelprize). +;; - A ref followed by the suffix @ with a date specification +;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2 +;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00}) +;; to specify the value of the ref at a prior point in time +;; +;; * Bare git form +;; [[gitbare:$GIT_DIR::$OBJECT]] +;; +;; This is the more bare metal version, which gives the user most +;; control. It directly translates to the git command +;; git --no-pager --git-dir=$GIT_DIR show $OBJECT +;; Using this version one can also view files from a bare git +;; repository. For detailed information on how to specify an +;; object, see the man page of `git-rev-parse' (section +;; SPECIFYING REVISIONS). A specific blob (file) can be +;; specified by a suffix clolon (:) followed by a path. + +;;; Code: + +(require 'org) +(defcustom org-git-program "git" + "Name of the git executable used to follow git links." + :type '(string) + :group 'org) + +;; org link functions +;; bare git link +(org-add-link-type "gitbare" 'org-gitbare-open) + +(defun org-gitbare-open (str) + (let* ((strlist (org-git-split-string str)) + (gitdir (first strlist)) + (object (second strlist))) + (org-git-open-file-internal gitdir object))) + + +(defun org-git-open-file-internal (gitdir object) + (let* ((sha (org-git-blob-sha gitdir object)) + (tmpdir (concat temporary-file-directory "org-git-" sha)) + (filename (org-git-link-filename object)) + (tmpfile (expand-file-name filename tmpdir))) + (unless (file-readable-p tmpfile) + (make-directory tmpdir) + (with-temp-file tmpfile + (org-git-show gitdir object (current-buffer)))) + (org-open-file tmpfile) + (set-buffer (get-file-buffer tmpfile)) + (setq buffer-read-only t))) + +;; user friendly link +(org-add-link-type "git" 'org-git-open) + +(defun org-git-open (str) + (let* ((strlist (org-git-split-string str)) + (filepath (first strlist)) + (commit (second strlist)) + (dirlist (org-git-find-gitdir (file-truename filepath))) + (gitdir (first dirlist)) + (relpath (second dirlist))) + (org-git-open-file-internal gitdir (concat commit ":" relpath)))) + + +;; Utility functions (file names etc) + +(defun org-git-split-dirpath (dirpath) + "Given a directory name, return '(dirname basname)" + (let ((dirname (file-name-directory (directory-file-name dirpath))) + (basename (file-name-nondirectory (directory-file-name dirpath)))) + (list dirname basename))) + +;; finding the git directory +(defun org-git-find-gitdir (path) + "Given a file (not necessarily existing) file path, return the + a pair (gitdir relpath), where gitdir is the path to the first + .git subdirectory found updstream and relpath is the rest of + the path. Example: (org-git-find-gitdir + \"~/gitrepos/foo/bar.txt\") returns + '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil." + (let ((dir (file-name-directory path)) + (relpath (file-name-nondirectory path))) + (catch 'toplevel + (while (not (file-exists-p (expand-file-name ".git" dir))) + (let ((dirlist (org-git-split-dirpath dir))) + (when (string= (second dirlist) "") ; at top level + (throw 'toplevel nil)) + (setq dir (first dirlist) + relpath (concat (file-name-as-directory (second dirlist)) relpath)))) + (list (expand-file-name ".git" dir) relpath)))) + + +(if (featurep 'xemacs) + (defalias 'org-git-gitrepos-p 'org-git-find-gitdir) + (defalias 'org-git-gitrepos-p 'org-git-find-gitdir + "Return non-nil if path is in git repository")) + +;; splitting the link string + +;; Both link open functions are called with a string of +;; consisting of two parts separated by a double colon (::). +(defun org-git-split-string (str) + "Given a string of the form \"str1::str2\", return a list of + two substrings \'(\"str1\" \"str2\"). If the double colon is mising, take str2 to be the empty string." + (let ((strlist (split-string str "::"))) + (cond ((= 1 (length strlist)) + (list (car strlist) "")) + ((= 2 (length strlist)) + strlist) + (t (error "org-git-split-string: only one :: allowed: %s" str))))) + +;; finding the file name part of a commit +(defun org-git-link-filename (str) + "Given an object description (see the man page of + git-rev-parse), return the nondirectory part of the referenced + filename, if it can be extracted. Otherwise, return a valid + filename." + (let* ((match (and (string-match "[^:]+$" str) + (match-string 0 str))) + (filename (and match (file-name-nondirectory match)))) ;extract the final part without slash + filename)) + +;; creating a link +(defun org-git-create-searchstring (branch timestring) + (concat branch "@{" timestring "}")) + + +(defun org-git-create-git-link (file) + "Create git link part to file at specific time" + (interactive "FFile: ") + (let* ((gitdir (first (org-git-find-gitdir (file-truename file)))) + (branchname (org-git-get-current-branch gitdir)) + (timestring (format-time-string "%Y-%m-%d" (current-time)))) + (org-make-link "git:" file "::" (org-git-create-searchstring branchname timestring)))) + +(defun org-git-store-link () + "Store git link to current file." + (when (buffer-file-name) + (let ((file (abbreviate-file-name (buffer-file-name)))) + (when (org-git-gitrepos-p file) + (org-store-link-props + :type "git" + :link (org-git-create-git-link file)))))) + +(add-hook 'org-store-link-functions 'org-git-store-link) + +(defun org-git-insert-link-interactively (file searchstring &optional description) + (interactive "FFile: \nsSearch string: \nsDescription: ") + (insert (org-make-link-string (org-make-link "git:" file "::" searchstring) description))) + +;; Calling git +(defun org-git-show (gitdir object buffer) + "Show the output of git --git-dir=gitdir show object in buffer." + (unless + (zerop (call-process org-git-program nil buffer nil + "--no-pager" (concat "--git-dir=" gitdir) "show" object)) + (error "git error: %s " (save-excursion (set-buffer buffer) + (buffer-string))))) + +(defun org-git-blob-sha (gitdir object) + "Return sha of the referenced object" + (with-temp-buffer + (if (zerop (call-process org-git-program nil t nil + "--no-pager" (concat "--git-dir=" gitdir) "rev-parse" object)) + (buffer-substring (point-min) (1- (point-max))) ; to strip off final newline + (error "git error: %s " (buffer-string))))) + +(defun org-git-get-current-branch (gitdir) + "Return the name of the current branch." + (with-temp-buffer + (if (not (zerop (call-process org-git-program nil t nil + "--no-pager" (concat "--git-dir=" gitdir) "symbolic-ref" "-q" "HEAD"))) + (error "git error: %s " (buffer-string)) + (goto-char (point-min)) + (if (looking-at "^refs/heads/") ; 11 characters + (buffer-substring 12 (1- (point-max))))))) ; to strip off final newline + +(provide 'org-git-link) +;;; org-git-link.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el b/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el new file mode 100644 index 0000000..1051e7c --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-interactive-query.el @@ -0,0 +1,310 @@ +;;; org-interactive-query.el --- Interactive modification of agenda query +;; +;; Copyright 2007 Free Software Foundation, Inc. +;; +;; Author: Christopher League <league at contrapunctus dot net> +;; Version: 1.0 +;; Keywords: org, wp +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; + +;; This library implements interactive modification of a tags/todo query +;; in the org-agenda. It adds 4 keys to the agenda +;; +;; / add a keyword as a positive selection criterion +;; \ add a keyword as a newgative selection criterion +;; = clear a keyword from the selection string +;; ; + +(require 'org) + +(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd) +(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd) +(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd) +(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd) + +;;; Agenda interactive query manipulation + +(defcustom org-agenda-query-selection-single-key t + "Non-nil means query manipulation exits after first change. +When nil, you have to press RET to exit it. +During query selection, you can toggle this flag with `C-c'. +This variable can also have the value `expert'. In this case, the window +displaying the tags menu is not even shown, until you press C-c again." + :group 'org-agenda + :type '(choice + (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Expert" expert))) + +(defun org-agenda-query-selection (current op table &optional todo-table) + "Fast query manipulation with single keys. +CURRENT is the current query string, OP is the initial +operator (one of \"+|-=\"), TABLE is an alist of tags and +corresponding keys, possibly with grouping information. +TODO-TABLE is a similar table with TODO keywords, should these +have keys assigned to them. If the keys are nil, a-z are +automatically assigned. Returns the new query string, or nil to +not change the current one." + (let* ((fulltable (append table todo-table)) + (maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + fulltable))) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + (expert (eq org-agenda-query-selection-single-key 'expert)) + (exit-after-next org-agenda-query-selection-single-key) + (done-keywords org-done-keywords) + tbl char cnt e groups ingroup + tg c2 c c1 ntable rtn) + (save-window-excursion + (if expert + (set-buffer (get-buffer-create " *Org tags*")) + (delete-other-windows) + (split-window-vertically) + (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*"))) + (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) + (insert "Query: " current "\n") + (org-agenda-query-op-line op) + (insert "\n\n") + (org-fast-tag-show-exit exit-after-next) + (setq tbl fulltable char ?a cnt 0) + (while (setq e (pop tbl)) + (cond + ((equal e '(:startgroup)) + (push '() groups) (setq ingroup t) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n")) + (insert "{ ")) + ((equal e '(:endgroup)) + (setq ingroup nil cnt 0) + (insert "}\n")) + (t + (setq tg (car e) c2 nil) + (if (cdr e) + (setq c (cdr e)) + ;; automatically assign a character. + (setq c1 (string-to-char + (downcase (substring + tg (if (= (string-to-char tg) ?@) 1 0))))) + (if (or (rassoc c1 ntable) (rassoc c1 table)) + (while (or (rassoc char ntable) (rassoc char table)) + (setq char (1+ char))) + (setq c2 c1)) + (setq c (or c2 char))) + (if ingroup (push tg (car groups))) + (setq tg (org-add-props tg nil 'face + (cond + ((not (assoc tg table)) + (org-get-todo-face tg)) + (t nil)))) + (if (and (= cnt 0) (not ingroup)) (insert " ")) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (push (cons tg c) ntable) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (if ingroup (insert " ")) + (setq cnt 0))))) + (setq ntable (nreverse ntable)) + (insert "\n") + (goto-char (point-min)) + (if (and (not expert) (fboundp 'fit-window-to-buffer)) + (fit-window-to-buffer)) + (setq rtn + (catch 'exit + (while t + (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s" + (if groups " [!] no groups" " [!]groups") + (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) + (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (cond + ((= c ?\r) (throw 'exit t)) + ((= c ?!) + (setq groups (not groups)) + (goto-char (point-min)) + (while (re-search-forward "[{}]" nil t) (replace-match " "))) + ((= c ?\C-c) + (if (not expert) + (org-fast-tag-show-exit + (setq exit-after-next (not exit-after-next))) + (setq expert nil) + (delete-other-windows) + (split-window-vertically) + (org-switch-to-buffer-other-window " *Org tags*") + (and (fboundp 'fit-window-to-buffer) + (fit-window-to-buffer)))) + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c ntable)))) + (setq quit-flag t)) + ((= c ?\ ) + (setq current "") + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\[) ; clear left + (org-agenda-query-decompose current) + (setq current (concat "/" (match-string 2 current))) + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\]) ; clear right + (org-agenda-query-decompose current) + (setq current (match-string 1 current)) + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\t) + (condition-case nil + (setq current (read-string "Query: " current)) + (quit)) + (if exit-after-next (setq exit-after-next 'now))) + ;; operators + ((or (= c ?/) (= c ?+)) (setq op "+")) + ((or (= c ?\;) (= c ?|)) (setq op "|")) + ((or (= c ?\\) (= c ?-)) (setq op "-")) + ((= c ?=) (setq op "=")) + ;; todos + ((setq e (rassoc c todo-table) tg (car e)) + (setq current (org-agenda-query-manip + current op groups 'todo tg)) + (if exit-after-next (setq exit-after-next 'now))) + ;; tags + ((setq e (rassoc c ntable) tg (car e)) + (setq current (org-agenda-query-manip + current op groups 'tag tg)) + (if exit-after-next (setq exit-after-next 'now)))) + (if (eq exit-after-next 'now) (throw 'exit t)) + (goto-char (point-min)) + (beginning-of-line 1) + (delete-region (point) (point-at-eol)) + (insert "Query: " current) + (beginning-of-line 2) + (delete-region (point) (point-at-eol)) + (org-agenda-query-op-line op) + (goto-char (point-min))))) + (if rtn current nil)))) + +(defun org-agenda-query-op-line (op) + (insert "Operator: " + (org-agenda-query-op-entry (equal op "+") "/+" "and") + (org-agenda-query-op-entry (equal op "|") ";|" "or") + (org-agenda-query-op-entry (equal op "-") "\\-" "not") + (org-agenda-query-op-entry (equal op "=") "=" "clear"))) + +(defun org-agenda-query-op-entry (matchp chars str) + (if matchp + (org-add-props (format "[%s %s] " chars (upcase str)) + nil 'face 'org-todo) + (format "[%s]%s " chars str))) + +(defun org-agenda-query-decompose (current) + (string-match "\\([^/]*\\)/?\\(.*\\)" current)) + +(defun org-agenda-query-clear (current prefix tag) + (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current) + (replace-match "" t t current) + current)) + +(defun org-agenda-query-manip (current op groups kind tag) + "Apply an operator to a query string and a tag. +CURRENT is the current query string, OP is the operator, GROUPS is a +list of lists of tags that are mutually exclusive. KIND is 'tag for a +regular tag, or 'todo for a TODO keyword, and TAG is the tag or +keyword string." + ;; If this tag is already in query string, remove it. + (setq current (org-agenda-query-clear current "[-\\+&|]?" tag)) + (if (equal op "=") current + ;; When using AND, also remove mutually exclusive tags. + (if (equal op "+") + (loop for g in groups do + (if (member tag g) + (mapc (lambda (x) + (setq current + (org-agenda-query-clear current "\\+" x))) + g)))) + ;; Decompose current query into q1 (tags) and q2 (TODOs). + (org-agenda-query-decompose current) + (let* ((q1 (match-string 1 current)) + (q2 (match-string 2 current))) + (cond + ((eq kind 'tag) + (concat q1 op tag "/" q2)) + ;; It's a TODO; when using AND, drop all other TODOs. + ((equal op "+") + (concat q1 "/+" tag)) + (t + (concat q1 "/" q2 op tag)))))) + +(defun org-agenda-query-global-todo-keys (&optional files) + "Return alist of all TODO keywords and their fast keys, in all FILES." + (let (alist) + (unless (and files (car files)) + (setq files (org-agenda-files))) + (save-excursion + (loop for f in files do + (set-buffer (find-file-noselect f)) + (loop for k in org-todo-key-alist do + (setq alist (org-agenda-query-merge-todo-key + alist k))))) + alist)) + +(defun org-agenda-query-merge-todo-key (alist entry) + (let (e) + (cond + ;; if this is not a keyword (:startgroup, etc), ignore it + ((not (stringp (car entry)))) + ;; if keyword already exists, replace char if it's null + ((setq e (assoc (car entry) alist)) + (when (null (cdr e)) (setcdr e (cdr entry)))) + ;; if char already exists, prepend keyword but drop char + ((rassoc (cdr entry) alist) + (message "TRACE POSITION 2") + (setq alist (cons (cons (car entry) nil) alist))) + ;; else, prepend COPY of entry + (t + (setq alist (cons (cons (car entry) (cdr entry)) alist))))) + alist) + +(defun org-agenda-query-generic-cmd (op) + "Activate query manipulation with OP as initial operator." + (let ((q (org-agenda-query-selection org-agenda-query-string op + org-tag-alist + (org-agenda-query-global-todo-keys)))) + (when q + (setq org-agenda-query-string q) + (org-agenda-redo)))) + +(defun org-agenda-query-clear-cmd () + "Activate query manipulation, to clear a tag from the string." + (interactive) + (org-agenda-query-generic-cmd "=")) + +(defun org-agenda-query-and-cmd () + "Activate query manipulation, initially using the AND (+) operator." + (interactive) + (org-agenda-query-generic-cmd "+")) + +(defun org-agenda-query-or-cmd () + "Activate query manipulation, initially using the OR (|) operator." + (interactive) + (org-agenda-query-generic-cmd "|")) + +(defun org-agenda-query-not-cmd () + "Activate query manipulation, initially using the NOT (-) operator." + (interactive) + (org-agenda-query-generic-cmd "-")) + +(provide 'org-interactive-query)
\ No newline at end of file diff --git a/.emacs.d/org-7.4/contrib/lisp/org-invoice.el b/.emacs.d/org-7.4/contrib/lisp/org-invoice.el new file mode 100644 index 0000000..7e2dad2 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-invoice.el @@ -0,0 +1,399 @@ +;;; org-invoice.el --- Help manage client invoices in OrgMode +;; +;; Copyright (C) 2008 pmade inc. (Peter Jones pjones@pmade.com) +;; +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: +;; +;; The above copyright notice and this permission notice shall be +;; included in all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +;; +;; Commentary: +;; +;; Building on top of the terrific OrgMode, org-invoice tries to +;; provide functionality for managing invoices. Currently, it does +;; this by implementing an OrgMode dynamic block where invoice +;; information is aggregated so that it can be exported. +;; +;; It also provides a library of functions that can be used to collect +;; this invoice information and use it in other ways, such as +;; submitting it to on-line invoicing tools. +;; +;; I'm already working on an elisp package to submit this invoice data +;; to the FreshBooks on-line accounting tool. +;; +;; Usage: +;; +;; In your ~/.emacs: +;; (autoload 'org-invoice-report "org-invoice") +;; (autoload 'org-dblock-write:invoice "org-invoice") +;; +;; See the documentation in the following functions: +;; +;; `org-invoice-report' +;; `org-dblock-write:invoice' +;; +;; Latest version: +;; +;; git clone git://pmade.com/elisp +(eval-when-compile + (require 'cl) + (require 'org)) + +(defgroup org-invoice nil + "OrgMode Invoice Helper" + :tag "Org-Invoice" :group 'org) + +(defcustom org-invoice-long-date-format "%A, %B %d, %Y" + "The format string for long dates." + :type 'string :group 'org-invoice) + +(defcustom org-invoice-strip-ts t + "Remove org timestamps that appear in headings." + :type 'boolean :group 'org-invoice) + +(defcustom org-invoice-default-level 2 + "The heading level at which a new invoice starts. This value +is used if you don't specify a scope option to the invoice block, +and when other invoice helpers are trying to find the heading +that starts an invoice. + +The default is 2, assuming that you structure your invoices so +that they fall under a single heading like below: + +* Invoices +** This is invoice number 1... +** This is invoice number 2... + +If you don't structure your invoices using those conventions, +change this setting to the number that corresponds to the heading +at which an invoice begins." + :type 'integer :group 'org-invoice) + +(defcustom org-invoice-start-hook nil + "Hook called when org-invoice is about to collect data from an +invoice heading. When this hook is called, point will be on the +heading where the invoice begins. + +When called, `org-invoice-current-invoice' will be set to the +alist that represents the info for this invoice." + :type 'hook :group 'org-invoice) + + (defcustom org-invoice-heading-hook nil + "Hook called when org-invoice is collecting data from a +heading. You can use this hook to add additional information to +the alist that represents the heading. + +When this hook is called, point will be on the current heading +being processed, and `org-invoice-current-item' will contain the +alist for the current heading. + +This hook is called repeatedly for each invoice item processed." + :type 'hook :group 'org-invoice) + +(defvar org-invoice-current-invoice nil + "Information about the current invoice.") + +(defvar org-invoice-current-item nil + "Information about the current invoice item.") + +(defvar org-invoice-table-params nil + "The table parameters currently being used.") + +(defvar org-invoice-total-time nil + "The total invoice time for the summary line.") + +(defvar org-invoice-total-price nil + "The total invoice price for the summary line.") + +(defconst org-invoice-version "1.0.0" + "The org-invoice version number.") + +(defun org-invoice-goto-tree (&optional tree) + "Move point to the heading that represents the head of the +current invoice. The heading level will be taken from +`org-invoice-default-level' unless tree is set to a string that +looks like tree2, where the level is 2." + (let ((level org-invoice-default-level)) + (save-match-data + (when (and tree (string-match "^tree\\([0-9]+\\)$" tree)) + (setq level (string-to-number (match-string 1 tree))))) + (org-back-to-heading) + (while (and (> (org-reduced-level (org-outline-level)) level) + (org-up-heading-safe))))) + +(defun org-invoice-heading-info () + "Return invoice information from the current heading." + (let ((title (org-no-properties (org-get-heading t))) + (date (org-entry-get nil "TIMESTAMP" 'selective)) + (work (org-entry-get nil "WORK" nil)) + (rate (or (org-entry-get nil "RATE" t) "0")) + (level (org-outline-level)) + raw-date long-date) + (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" 'selective))) + (unless date (setq date (org-entry-get nil "TIMESTAMP" t))) + (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" t))) + (unless work (setq work (org-entry-get nil "CLOCKSUM" nil))) + (unless work (setq work "00:00")) + (when date + (setq raw-date (apply 'encode-time (org-parse-time-string date))) + (setq long-date (format-time-string org-invoice-long-date-format raw-date))) + (when (and org-invoice-strip-ts (string-match org-ts-regexp-both title)) + (setq title (replace-match "" nil nil title))) + (when (string-match "^[ \t]+" title) + (setq title (replace-match "" nil nil title))) + (when (string-match "[ \t]+$" title) + (setq title (replace-match "" nil nil title))) + (setq work (org-hh:mm-string-to-minutes work)) + (setq rate (string-to-number rate)) + (setq org-invoice-current-item (list (cons 'title title) + (cons 'date date) + (cons 'raw-date raw-date) + (cons 'long-date long-date) + (cons 'work work) + (cons 'rate rate) + (cons 'level level) + (cons 'price (* rate (/ work 60.0))))) + (run-hook-with-args 'org-invoice-heading-hook) + org-invoice-current-item)) + +(defun org-invoice-level-min-max (ls) + "Return a list where the car is the min level, and the cdr the max." + (let ((max 0) min level) + (dolist (info ls) + (when (cdr (assoc 'date info)) + (setq level (cdr (assoc 'level info))) + (when (or (not min) (< level min)) (setq min level)) + (when (> level max) (setq max level)))) + (cons (or min 0) max))) + +(defun org-invoice-collapse-list (ls) + "Reorganize the given list by dates." + (let ((min-max (org-invoice-level-min-max ls)) new) + (dolist (info ls) + (let* ((date (cdr (assoc 'date info))) + (work (cdr (assoc 'work info))) + (price (cdr (assoc 'price info))) + (long-date (cdr (assoc 'long-date info))) + (level (cdr (assoc 'level info))) + (bucket (cdr (assoc date new)))) + (if (and (/= (car min-max) (cdr min-max)) + (= (car min-max) level) + (= work 0) (not bucket) date) + (progn + (setq info (assq-delete-all 'work info)) + (push (cons 'total-work 0) info) + (push (cons date (list info)) new) + (setq bucket (cdr (assoc date new)))) + (when (and date (not bucket)) + (setq bucket (list (list (cons 'date date) + (cons 'title long-date) + (cons 'total-work 0) + (cons 'price 0)))) + (push (cons date bucket) new) + (setq bucket (cdr (assoc date new)))) + (when (and date bucket) + (setcdr (assoc 'total-work (car bucket)) + (+ work (cdr (assoc 'total-work (car bucket))))) + (setcdr (assoc 'price (car bucket)) + (+ price (cdr (assoc 'price (car bucket))))) + (nconc bucket (list info)))))) + (nreverse new))) + +(defun org-invoice-info-to-table (info) + "Create a single org table row from the given info alist." + (let ((title (cdr (assoc 'title info))) + (total (cdr (assoc 'total-work info))) + (work (cdr (assoc 'work info))) + (price (cdr (assoc 'price info))) + (with-price (plist-get org-invoice-table-params :price))) + (unless total + (setq + org-invoice-total-time (+ org-invoice-total-time work) + org-invoice-total-price (+ org-invoice-total-price price))) + (setq total (and total (org-minutes-to-hh:mm-string total))) + (setq work (and work (org-minutes-to-hh:mm-string work))) + (insert-before-markers + (concat "|" title + (cond + (total (concat "|" total)) + (work (concat "|" work))) + (and with-price price (concat "|" (format "%.2f" price))) + "|" "\n")))) + +(defun org-invoice-list-to-table (ls) + "Convert a list of heading info to an org table" + (let ((with-price (plist-get org-invoice-table-params :price)) + (with-summary (plist-get org-invoice-table-params :summary)) + (with-header (plist-get org-invoice-table-params :headers)) + (org-invoice-total-time 0) + (org-invoice-total-price 0)) + (insert-before-markers + (concat "| Task / Date | Time" (and with-price "| Price") "|\n")) + (dolist (info ls) + (insert-before-markers "|-\n") + (mapc 'org-invoice-info-to-table (if with-header (cdr info) (cdr (cdr info))))) + (when with-summary + (insert-before-markers + (concat "|-\n|Total:|" + (org-minutes-to-hh:mm-string org-invoice-total-time) + (and with-price (concat "|" (format "%.2f" org-invoice-total-price))) + "|\n"))))) + +(defun org-invoice-collect-invoice-data () + "Collect all the invoice data from the current OrgMode tree and +return it. Before you call this function, move point to the +heading that begins the invoice data, usually using the +`org-invoice-goto-tree' function." + (let ((org-invoice-current-invoice + (list (cons 'point (point)) (cons 'buffer (current-buffer)))) + (org-invoice-current-item nil)) + (save-restriction + (org-narrow-to-subtree) + (org-clock-sum) + (run-hook-with-args 'org-invoice-start-hook) + (cons org-invoice-current-invoice + (org-invoice-collapse-list + (org-map-entries 'org-invoice-heading-info t 'tree 'archive)))))) + +(defun org-dblock-write:invoice (params) + "Function called by OrgMode to write the invoice dblock. To +create an invoice dblock you can use the `org-invoice-report' +function. + +The following parameters can be given to the invoice block (for +information about dblock parameters, please see the Org manual): + +:scope Allows you to override the `org-invoice-default-level' + variable. The only supported values right now are ones + that look like :tree1, :tree2, etc. + +:prices Set to nil to turn off the price column. + +:headers Set to nil to turn off the group headers. + +:summary Set to nil to turn off the final summary line." + (let ((scope (plist-get params :scope)) + (org-invoice-table-params params) + (zone (move-marker (make-marker) (point))) + table) + (unless scope (setq scope 'default)) + (unless (plist-member params :price) (plist-put params :price t)) + (unless (plist-member params :summary) (plist-put params :summary t)) + (unless (plist-member params :headers) (plist-put params :headers t)) + (save-excursion + (cond + ((eq scope 'tree) (org-invoice-goto-tree "tree1")) + ((eq scope 'default) (org-invoice-goto-tree)) + ((symbolp scope) (org-invoice-goto-tree (symbol-name scope)))) + (setq table (org-invoice-collect-invoice-data)) + (goto-char zone) + (org-invoice-list-to-table (cdr table)) + (goto-char zone) + (org-table-align) + (move-marker zone nil)))) + +(defun org-invoice-in-report-p () + "Check to see if point is inside an invoice report." + (let ((pos (point)) start) + (save-excursion + (end-of-line 1) + (and (re-search-backward "^#\\+BEGIN:[ \t]+invoice" nil t) + (setq start (match-beginning 0)) + (re-search-forward "^#\\+END:.*" nil t) + (>= (match-end 0) pos) + start)))) + +(defun org-invoice-report (&optional jump) + "Create or update an invoice dblock report. If point is inside +an existing invoice report, the report is updated. If point +isn't inside an invoice report, a new report is created. + +When called with a prefix argument, move to the first invoice +report after point and update it. + +For information about various settings for the invoice report, +see the `org-dblock-write:invoice' function documentation. + +An invoice report is created by reading a heading tree and +collecting information from various properties. It is assumed +that all invoices start at a second level heading, but this can +be configured using the `org-invoice-default-level' variable. + +Here is an example, where all invoices fall under the first-level +heading Invoices: + +* Invoices +** Client Foo (Jan 01 - Jan 15) +*** [2008-01-01 Tue] Built New Server for Production +*** [2008-01-02 Wed] Meeting with Team to Design New System +** Client Bar (Jan 01 - Jan 15) +*** [2008-01-01 Tue] Searched for Widgets on Google +*** [2008-01-02 Wed] Billed You for Taking a Nap + +In this layout, invoices begin at level two, and invoice +items (tasks) are at level three. You'll notice that each level +three heading starts with an inactive timestamp. The timestamp +can actually go anywhere you want, either in the heading, or in +the text under the heading. But you must have a timestamp +somewhere so that the invoice report can group your items by +date. + +Properties are used to collect various bits of information for +the invoice. All properties can be set on the invoice item +headings, or anywhere in the tree. The invoice report will scan +up the tree looking for each of the properties. + +Properties used: + +CLOCKSUM: You can use the Org clock-in and clock-out commands to + create a CLOCKSUM property. Also see WORK. + +WORK: An alternative to the CLOCKSUM property. This property + should contain the amount of work that went into this + invoice item formatted as HH:MM (e.g. 01:30). + +RATE: Used to calculate the total price for an invoice item. + Should be the price per hour that you charge (e.g. 45.00). + It might make more sense to place this property higher in + the hierarchy than on the invoice item headings. + +Using this information, a report is generated that details the +items grouped by days. For each day you will be able to see the +total number of hours worked, the total price, and the items +worked on. + +You can place the invoice report anywhere in the tree you want. +I place mine under a third-level heading like so: + +* Invoices +** An Invoice Header +*** [2008-11-25 Tue] An Invoice Item +*** Invoice Report +#+BEGIN: invoice +#+END:" + (interactive "P") + (let ((report (org-invoice-in-report-p))) + (when (and (not report) jump) + (when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t) + (org-show-entry) + (beginning-of-line) + (setq report (point)))) + (if report (goto-char report) + (org-create-dblock (list :name "invoice"))) + (org-update-dblock))) + +(provide 'org-invoice) diff --git a/.emacs.d/org-7.4/contrib/lisp/org-jira.el b/.emacs.d/org-7.4/contrib/lisp/org-jira.el new file mode 100644 index 0000000..d224c8f --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-jira.el @@ -0,0 +1,65 @@ +;;; org-jira.el --- add a jira:ticket protocol to Org +(defconst org-jira-version "0.1") +;; Copyright (c)2008 Jonathan Arkell. (by)(nc)(sa) Some rights reserved. +;; Author: Jonathan Arkell <jonnay@jonnay.net> + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation version 2. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; For a copy of the GNU General Public License, search the Internet, +;; or write to the Free Software Foundation, Inc., 59 Temple Place, +;; Suite 330, Boston, MA 02111-1307 USA + +;;; Commentary: +;; This adds a jira protocol to org mode. + +;;; Commands: +;; +;; Below are complete command list: +;; +;; +;;; Customizable Options: +;; +;; Below are customizable option list: +;; + +;; I had initially planned on adding bi-directional linking, so you +;; could store links from a jira ticket. I also wanted to import +;; tickets assigned to you as a task. However, I am no longer working +;; with JIRA, so this is now abandonware. + +;;; Installation: +;; Put org-jira.el somewhere in your load-path. +;; (Use M-x show-variable RET load-path to see what your load path is.) +;; Add this to your emacs init file, preferably after you load org mode. +;(require 'org-jira) + +;;; TODO: +;; - bi-directional links +;; - deeper importing, like tasks...? + +;;; CHANGELOG: +;; v 0.2 - ran through checkdoc +;; - Abandoned. +;; v 0.1 - Initial release + +(require 'jira) + +(org-add-link-type "jira" 'org-jira-open) + +(defun org-jira-open (path) + "Open a Jira Link from PATH." + (jira-show-issue path)) + + +(provide 'org-jira) + +;;; org-jira.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-learn.el b/.emacs.d/org-7.4/contrib/lisp/org-learn.el new file mode 100644 index 0000000..1078001 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-learn.el @@ -0,0 +1,180 @@ +;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm + +;; Copyright (C) 2009 +;; Free Software Foundation, Inc. + +;; Author: John Wiegley <johnw at gnu dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.32trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; The file implements the learning algorithm described at +;; http://supermemo.com/english/ol/sm5.htm, which is a system for reading +;; material according to "spaced repetition". See +;; http://en.wikipedia.org/wiki/Spaced_repetition for more details. +;; +;; To use, turn on state logging and schedule some piece of information you +;; want to read. Then in the agenda buffer type + +(require 'org) +(eval-when-compile + (require 'cl)) + +(defgroup org-learn nil + "Options concerning the learning code in Org-mode." + :tag "Org Learn" + :group 'org-progress) + +(defcustom org-learn-always-reschedule nil + "If non-nil, always reschedule items, even if retention was \"perfect\"." + :type 'boolean + :group 'org-learn) + +(defcustom org-learn-fraction 0.5 + "Controls the rate at which EF is increased or decreased. +Must be a number between 0 and 1 (the greater it is the faster +the changes of the OF matrix)." + :type 'float + :group 'org-learn) + +(defun initial-optimal-factor (n ef) + (if (= 1 n) + 4 + ef)) + +(defun get-optimal-factor (n ef of-matrix) + (let ((factors (assoc n of-matrix))) + (or (and factors + (let ((ef-of (assoc ef (cdr factors)))) + (and ef-of (cdr ef-of)))) + (initial-optimal-factor n ef)))) + +(defun set-optimal-factor (n ef of-matrix of) + (let ((factors (assoc n of-matrix))) + (if factors + (let ((ef-of (assoc ef (cdr factors)))) + (if ef-of + (setcdr ef-of of) + (push (cons ef of) (cdr factors)))) + (push (cons n (list (cons ef of))) of-matrix))) + of-matrix) + +(defun inter-repetition-interval (n ef &optional of-matrix) + (let ((of (get-optimal-factor n ef of-matrix))) + (if (= 1 n) + of + (* of (inter-repetition-interval (1- n) ef of-matrix))))) + +(defun modify-e-factor (ef quality) + (if (< ef 1.3) + 1.3 + (+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02))))))) + +(defun modify-of (of q fraction) + (let ((temp (* of (+ 0.72 (* q 0.07))))) + (+ (* (- 1 fraction) of) (* fraction temp)))) + +(defun calculate-new-optimal-factor (interval-used quality used-of + old-of fraction) + "This implements the SM-5 learning algorithm in Lisp. +INTERVAL-USED is the last interval used for the item in question. +QUALITY is the quality of the repetition response. +USED-OF is the optimal factor used in calculation of the last +interval used for the item in question. +OLD-OF is the previous value of the OF entry corresponding to the +relevant repetition number and the E-Factor of the item. +FRACTION is a number belonging to the range (0,1) determining the +rate of modifications (the greater it is the faster the changes +of the OF matrix). + +Returns the newly calculated value of the considered entry of the +OF matrix." + (let (;; the value proposed for the modifier in case of q=5 + (mod5 (/ (1+ interval-used) interval-used)) + ;; the value proposed for the modifier in case of q=2 + (mod2 (/ (1- interval-used) interval-used)) + ;; the number determining how many times the OF value will + ;; increase or decrease + modifier) + (if (< mod5 1.05) + (setq mod5 1.05)) + (if (< mod2 0.75) + (setq mod5 0.75)) + (if (> quality 4) + (setq modifier (1+ (* (- mod5 1) (- quality 4)))) + (setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality))))) + (if (< modifier 0.05) + (setq modifier 0.05)) + (setq new-of (* used-of modifier)) + (if (> quality 4) + (if (< new-of old-of) + (setq new-of old-of))) + (if (< quality 4) + (if (> new-of old-of) + (setq new-of old-of))) + (setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction)))) + (if (< new-of 1.2) + (setq new-of 1.2) + new-of))) + +(defvar initial-repetition-state '(-1 1 2.5 nil)) + +(defun determine-next-interval (n ef quality of-matrix) + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (if (< quality 3) + (list (inter-repetition-interval n ef) (1+ n) ef nil) + (let ((next-ef (modify-e-factor ef quality))) + (setq of-matrix + (set-optimal-factor n next-ef of-matrix + (modify-of (get-optimal-factor n ef of-matrix) + quality org-learn-fraction)) + ef next-ef) + ;; For a zero-based quality of 4 or 5, don't repeat + (if (and (>= quality 4) + (not org-learn-always-reschedule)) + (list 0 (1+ n) ef of-matrix) + (list (inter-repetition-interval n ef of-matrix) (1+ n) + ef of-matrix))))) + +(defun org-smart-reschedule (quality) + (interactive "nHow well did you remember the information (on a scale of 0-5)? ") + (let* ((learn-str (org-entry-get (point) "LEARN_DATA")) + (learn-data (or (and learn-str + (read learn-str)) + (copy-list initial-repetition-state))) + closed-dates) + (setq learn-data + (determine-next-interval (nth 1 learn-data) + (nth 2 learn-data) + quality + (nth 3 learn-data))) + (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data)) + (if (= 0 (nth 0 learn-data)) + (org-schedule t) + (org-schedule nil (time-add (current-time) + (days-to-time (nth 0 learn-data))))))) + +(provide 'org-learn) + +;; arch-tag: a46bb0e5-e4fb-4004-a9b8-63933c55af33 + +;;; org-learn.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el b/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el new file mode 100644 index 0000000..2510aa7 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-mac-iCal.el @@ -0,0 +1,249 @@ +;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary + +;; Copyright (C) 2009 Christopher Suckling + +;; Author: Christopher Suckling <suckling at gmail dot com> + +;; This file is Free Software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; It is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;; Version: 0.1057.104 +;; Keywords: outlines, calendar + +;;; Commentary: +;; +;; This file provides the import of events from Mac OS X 10.5 iCal.app +;; into the Emacs diary (it is not compatible with OS X < 10.5). The +;; function org-mac-iCal will import events in all checked iCal.app +;; calendars for the date range org-mac-iCal-range months, centered +;; around the current date. +;; +;; CAVEAT: This function is destructive; it will overwrite the current +;; contents of the Emacs diary. +;; +;; Installation: add (require 'org-mac-iCal) to your .emacs. +;; +;; If you view Emacs diary entries in org-agenda, the following hook +;; will ensure that all-day events are not orphaned below TODO items +;; and that any supplementary fields to events (e.g. Location) are +;; grouped with their parent event +;; +;; (add-hook 'org-agenda-cleanup-fancy-diary-hook +;; (lambda () +;; (goto-char (point-min)) +;; (save-excursion +;; (while (re-search-forward "^[a-z]" nil t) +;; (goto-char (match-beginning 0)) +;; (insert "0:00-24:00 "))) +;; (while (re-search-forward "^ [a-z]" nil t) +;; (goto-char (match-beginning 0)) +;; (save-excursion +;; (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t)) +;; (insert (match-string 0))))) + +;;; Code: + +(defcustom org-mac-iCal-range 2 + "The range in months to import iCal.app entries into the Emacs +diary. The import is centered around today's date; thus a value +of 2 imports entries for one month before and one month after +today's date" + :group 'org-time + :type 'integer) + +(defun org-mac-iCal () + "Selects checked calendars in iCal.app and imports them into +the the Emacs diary" + (interactive) + + ;; kill diary buffers then empty diary files to avoid duplicates + (setq currentBuffer (buffer-name)) + (setq openBuffers (mapcar (function buffer-name) (buffer-list))) + (omi-kill-diary-buffer openBuffers) + (with-temp-buffer + (insert-file-contents diary-file) + (delete-region (point-min) (point-max)) + (write-region (point-min) (point-max) diary-file)) + + ;; determine available calendars + (setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$")) + (setq caldav-calendars nil) + (mapc + (lambda (x) + (setq caldav-calendars (nconc caldav-calendars (directory-files x 1 ".*calendar$")))) + caldav-folders) + + (setq local-calendars nil) + (setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$")) + + (setq all-calendars (append caldav-calendars local-calendars)) + + ;; parse each calendar's Info.plist to see if calendar is checked in iCal + (setq all-calendars (delq 'nil (mapcar + (lambda (x) + (omi-checked x)) + all-calendars))) + + ;; for each calendar, concatenate individual events into a single ics file + (with-temp-buffer + (shell-command "sw_vers" (current-buffer)) + (when (re-search-backward "10\\.[56]" nil t) + (omi-concat-leopard-ics all-calendars))) + + ;; move all caldav ics files to the same place as local ics files + (mapc + (lambda (x) + (mapc + (lambda (y) + (rename-file (concat x "/" y); + (concat "~/Library/Calendars/" y))) + (directory-files x nil ".*ics$"))) + caldav-folders) + + ;; check calendar has contents and import + (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$")) + (mapc + (lambda (x) + (when (/= (nth 7 (file-attributes x 'string)) 0) + (omi-import-ics x))) + import-calendars) + + ;; tidy up intermediate files and buffers + (setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list))) + (omi-kill-ics-buffer usedCalendarsBuffers) + (setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$")) + (omi-delete-ics-file usedCalendarsFiles) + + (switch-to-buffer currentBuffer)) + +(defun omi-concat-leopard-ics (list) + "Leopard stores each iCal.app event in a separate ics file. +Whilst useful for Spotlight indexing, this is less helpful for +icalendar-import-file. omi-concat-leopard-ics concatenates these +individual event files into a single ics file" + (mapc + (lambda (x) + (setq omi-leopard-events (directory-files (concat x "/Events") 1 ".*ics$")) + (with-temp-buffer + (mapc + (lambda (y) + (insert-file-contents (expand-file-name y))) + omi-leopard-events) + (write-region (point-min) (point-max) (concat (expand-file-name x) ".ics")))) + list)) + +(defun omi-import-ics (string) + "Imports an ics file into the Emacs diary. First tidies up the +ics file so that it is suitable for import and selects a sensible +date range so that Emacs calendar view doesn't grind to a halt" + (with-temp-buffer + (insert-file-contents string) + (goto-char (point-min)) + (while + (re-search-forward "^BEGIN:VCALENDAR$" nil t) + (setq startEntry (match-beginning 0)) + (re-search-forward "^END:VCALENDAR$" nil t) + (setq endEntry (match-end 0)) + (save-restriction + (narrow-to-region startEntry endEntry) + (goto-char (point-min)) + (re-search-forward "\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t) + (if (or (eq (match-string 2) nil) (eq (match-string 3) nil)) + (progn + (setq yearEntry 0) + (setq monthEntry 0)) + (setq yearEntry (string-to-number (match-string 2))) + (setq monthEntry (string-to-number (match-string 3)))) + (setq year (string-to-number (format-time-string "%Y"))) + (setq month (string-to-number (format-time-string "%m"))) + (when (or + (and + (= yearEntry year) + (or (< monthEntry (- month (/ org-mac-iCal-range 2))) (> monthEntry (+ month (/ org-mac-iCal-range 2))))) + (< yearEntry (- year 1)) + (> yearEntry (+ year 1)) + (and + (= yearEntry (- year 1)) (/= monthEntry 12)) + (and + (= yearEntry (+ year 1)) (/= monthEntry 1))) + (delete-region startEntry endEntry)))) + (while + (re-search-forward "^END:VEVENT$" nil t) + (delete-blank-lines)) + (goto-line 1) + (insert "BEGIN:VCALENDAR\n\n") + (goto-line 2) + (while + (re-search-forward "^BEGIN:VCALENDAR$" nil t) + (replace-match "\n")) + (goto-line 2) + (while + (re-search-forward "^END:VCALENDAR$" nil t) + (replace-match "\n")) + (insert "END:VCALENDAR") + (goto-line 1) + (delete-blank-lines) + (while + (re-search-forward "^END:VEVENT$" nil t) + (delete-blank-lines)) + (goto-line 1) + (while + (re-search-forward "^ORG.*" nil t) + (replace-match "\n")) + (goto-line 1) + (write-region (point-min) (point-max) string)) + + (icalendar-import-file string diary-file)) + +(defun omi-kill-diary-buffer (list) + (mapc + (lambda (x) + (if (string-match "^diary" x) + (kill-buffer x))) + list)) + +(defun omi-kill-ics-buffer (list) + (mapc + (lambda (x) + (if (string-match "ics$" x) + (kill-buffer x))) + list)) + +(defun omi-delete-ics-file (list) + (mapc + (lambda (x) + (delete-file x)) + list)) + +(defun omi-checked (directory) + "Parse Info.plist in iCal.app calendar folder and determine +whether Checked key is 1. If Checked key is not 1, remove +calendar from list of calendars for import" + (let* ((root (xml-parse-file (car (directory-files directory 1 "Info.plist")))) + (plist (car root)) + (dict (car (xml-get-children plist 'dict))) + (keys (cdr (xml-node-children dict))) + (keys (mapcar + (lambda (x) + (cond ((listp x) + x))) + keys)) + (keys (delq 'nil keys))) + (when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked"))))) + directory))) + +(provide 'org-mac-iCal) + +;;; org-mac-iCal.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el b/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el new file mode 100644 index 0000000..8ec428b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-mac-link-grabber.el @@ -0,0 +1,465 @@ +;;; org-mac-link-grabber.el --- Grab links and url from various mac +;;; application and insert them as links into org-mode documents +;; +;; Copyright (c) 2010 Free Software Foundation, Inc. +;; +;; Author: Anthony Lander <anthony.lander@gmail.com> +;; Version: 1.0.1 +;; Keywords: org, mac, hyperlink +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;;; Commentary: +;; +;; This code allows you to grab either the current selected items, or +;; the frontmost url in various mac appliations, and insert them as +;; hyperlinks into the current org-mode document at point. +;; +;; This code is heavily based on, and indeed requires, +;; org-mac-message.el written by John Weigley and Christopher +;; Suckling. +;; +;; Detailed comments for each application interface are inlined with +;; the code. Here is a brief overview of how the code interacts with +;; each application: +;; +;; Finder.app - grab links to the selected files in the frontmost window +;; Mail.app - grab links to the selected messages in the message list +;; AddressBook.app - Grab links to the selected addressbook Cards +;; Firefox.app - Grab the url of the frontmost tab in the frontmost window +;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window +;; Safari.app - Grab the url of the frontmost tab in the frontmost window +;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window +;; Together.app - Grab links to the selected items in the library list +;; +;; +;; Installation: +;; +;; add (require 'org-mac-link-grabber) to your .emacs, and optionally +;; bind a key to activate the link grabber menu, like this: +;; +;; (add-hook 'org-mode-hook (lambda () +;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link))) +;; +;; +;; Usage: +;; +;; Type C-c g (or whatever key you defined, as above), or type M-x +;; omlg-grab-link RET to activate the link grabber. This will present +;; you with a menu to choose an application from which to grab a link +;; to insert at point. You may also type C-g to abort. +;; +;; Customizing: +;; +;; You may customize which applications appear in the grab menu by +;; customizing the group org-mac-link-grabber. Changes take effect +;; immediately. +;; +;; +;;; Code: + +(require 'org) +(require 'org-mac-message) + +(defgroup org-mac-link-grabber nil + "Options concerning grabbing links from external Mac +applications and inserting them in org documents" + :tag "Org Mac link grabber" + :group 'org-link) + +(defcustom org-mac-grab-Finder-app-p t + "Enable menu option [F]inder to grab links from the Finder" + :tag "Grab Finder.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Mail-app-p t + "Enable menu option [m]ail to grab links from Mail.app" + :tag "Grab Mail.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Addressbook-app-p t + "Enable menu option [a]ddressbook to grab links from AddressBook.app" + :tag "Grab AddressBook.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Safari-app-p t + "Enable menu option [s]afari to grab links from Safari.app" + :tag "Grab Safari.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Firefox-app-p t + "Enable menu option [f]irefox to grab links from Firefox.app" + :tag "Grab Firefox.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Firefox+Vimperator-p nil + "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin" + :tag "Grab Vimperator/Firefox.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Chrome-app-p t + "Enable menu option [f]irefox to grab links from Google Chrome.app" + :tag "Grab Google Chrome.app links" + :group 'org-mac-link-grabber + :type 'boolean) + +(defcustom org-mac-grab-Together-app-p nil + "Enable menu option [t]ogether to grab links from Together.app" + :tag "Grab Together.app links" + :group 'org-mac-link-grabber + :type 'boolean) + + +(defun omlg-grab-link () + "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point" + (interactive) + (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p) + ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p) + ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p) + ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p) + ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p) + ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p) + ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p) + ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p))) + (menu-string (make-string 0 ?x)) + input) + + ;; Create the menu string for the keymap + (mapc '(lambda (descriptor) + (when (elt descriptor 3) + (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " ")))) + descriptors) + (setf (elt menu-string (- (length menu-string) 1)) ?:) + + ;; Prompt the user, and grab the link + (message menu-string) + (setq input (read-char-exclusive)) + (mapc '(lambda (descriptor) + (let ((key (elt (elt descriptor 0) 0)) + (active (elt descriptor 3)) + (grab-function (elt descriptor 2))) + (when (and active (eq input key)) + (call-interactively grab-function)))) + descriptors))) + +(defalias 'omgl-grab-link 'omlg-grab-link + "Renamed, and this alias will be obsolete next revision.") + +(defun org-mac-paste-applescript-links (as-link-list) + "Paste in a list of links from an applescript handler. The + links are of the form <link>::split::<name>" + (let* ((link-list + (mapcar + (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) + (split-string as-link-list "[\r\n]+"))) + split-link URL description orglink orglink-insert rtn orglink-list) + (while link-list + (setq split-link (split-string (pop link-list) "::split::")) + (setq URL (car split-link)) + (setq description (cadr split-link)) + (when (not (string= URL "")) + (setq orglink (org-make-link-string URL description)) + (push orglink orglink-list))) + (setq rtn (mapconcat 'identity orglink-list "\n")) + (kill-new rtn) + rtn)) + + + +;; Handle links from Firefox.app +;; +;; This code allows you to grab the current active url from the main +;; Firefox.app window, and insert it as a link into an org-mode +;; document. Unfortunately, firefox does not expose an applescript +;; dictionary, so this is necessarily introduces some limitations. +;; +;; The applescript to grab the url from Firefox.app uses the System +;; Events application to give focus to the firefox application, select +;; the contents of the url bar, and copy it. It then uses the title of +;; the window as the text of the link. There is no way to grab links +;; from other open tabs, and further, if there is more than one window +;; open, it is not clear which one will be used (though emperically it +;; seems that it is always the last active window). + +(defun as-mac-firefox-get-frontmost-url () + (let ((result (do-applescript + (concat + "set oldClipboard to the clipboard\n" + "set frontmostApplication to path to frontmost application\n" + "tell application \"Firefox\"\n" + " activate\n" + " delay 0.15\n" + " tell application \"System Events\"\n" + " keystroke \"l\" using command down\n" + " keystroke \"c\" using command down\n" + " end tell\n" + " delay 0.15\n" + " set theUrl to the clipboard\n" + " set the clipboard to oldClipboard\n" + " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" + "end tell\n" + "activate application (frontmostApplication as text)\n" + "set links to {}\n" + "copy theResult to the end of links\n" + "return links as string\n")))) + (car (split-string result "[\r\n]+" t)))) + +(defun org-mac-firefox-get-frontmost-url () + (interactive) + (message "Applescript: Getting Firefox url...") + (let* ((url-and-title (as-mac-firefox-get-frontmost-url)) + (split-link (split-string url-and-title "::split::")) + (URL (car split-link)) + (description (cadr split-link)) + (org-link)) + (when (not (string= URL "")) + (setq org-link (org-make-link-string URL description))) + (kill-new org-link) + org-link)) + +(defun org-mac-firefox-insert-frontmost-url () + (interactive) + (insert (org-mac-firefox-get-frontmost-url))) + + +;; Handle links from Google Firefox.app running the Vimperator extension +;; Grab the frontmost url from Firefox+Vimperator. Same limitations are +;; Firefox + +(defun as-mac-vimperator-get-frontmost-url () + (let ((result (do-applescript + (concat + "set oldClipboard to the clipboard\n" + "set frontmostApplication to path to frontmost application\n" + "tell application \"Firefox\"\n" + " activate\n" + " delay 0.15\n" + " tell application \"System Events\"\n" + " keystroke \"y\"\n" + " end tell\n" + " delay 0.15\n" + " set theUrl to the clipboard\n" + " set the clipboard to oldClipboard\n" + " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" + "end tell\n" + "activate application (frontmostApplication as text)\n" + "set links to {}\n" + "copy theResult to the end of links\n" + "return links as string\n")))) + (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t))))) + + +(defun org-mac-vimperator-get-frontmost-url () + (interactive) + (message "Applescript: Getting Vimperator url...") + (let* ((url-and-title (as-mac-vimperator-get-frontmost-url)) + (split-link (split-string url-and-title "::split::")) + (URL (car split-link)) + (description (cadr split-link)) + (org-link)) + (when (not (string= URL "")) + (setq org-link (org-make-link-string URL description))) + (kill-new org-link) + org-link)) + +(defun org-mac-vimperator-insert-frontmost-url () + (interactive) + (insert (org-mac-vimperator-get-frontmost-url))) + + +;; Handle links from Google Chrome.app +;; Grab the frontmost url from Google Chrome. Same limitations are +;; Firefox because Chrome doesn't publish an Applescript dictionary + +(defun as-mac-chrome-get-frontmost-url () + (let ((result (do-applescript + (concat + "set oldClipboard to the clipboard\n" + "set frontmostApplication to path to frontmost application\n" + "tell application \"Google Chrome\"\n" + " activate\n" + " delay 0.15\n" + " tell application \"System Events\"\n" + " keystroke \"l\" using command down\n" + " keystroke \"c\" using command down\n" + " end tell\n" + " delay 0.15\n" + " set theUrl to the clipboard\n" + " set the clipboard to oldClipboard\n" + " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" + "end tell\n" + "activate application (frontmostApplication as text)\n" + "set links to {}\n" + "copy theResult to the end of links\n" + "return links as string\n")))) + (car (split-string result "[\r\n]+" t)))) + +(defun org-mac-chrome-get-frontmost-url () + (interactive) + (message "Applescript: Getting Chrome url...") + (let* ((url-and-title (as-mac-chrome-get-frontmost-url)) + (split-link (split-string url-and-title "::split::")) + (URL (car split-link)) + (description (cadr split-link)) + (org-link)) + (when (not (string= URL "")) + (setq org-link (org-make-link-string URL description))) + (kill-new org-link) + org-link)) + +(defun org-mac-chrome-insert-frontmost-url () + (interactive) + (insert (org-mac-chrome-get-frontmost-url))) + + +;; Handle links from Safari.app +;; Grab the frontmost url from Safari. + +(defun as-mac-safari-get-frontmost-url () + (let ((result (do-applescript + (concat + "tell application \"Safari\"\n" + " set theUrl to URL of document 1\n" + " set theName to the name of the document 1\n" + " return theUrl & \"::split::\" & theName & \"\n\"\n" + "end tell\n")))) + (car (split-string result "[\r\n]+" t)))) + +(defun org-mac-safari-get-frontmost-url () + (interactive) + (message "Applescript: Getting Safari url...") + (let* ((url-and-title (as-mac-safari-get-frontmost-url)) + (split-link (split-string url-and-title "::split::")) + (URL (car split-link)) + (description (cadr split-link)) + (org-link)) + (when (not (string= URL "")) + (setq org-link (org-make-link-string URL description))) + (kill-new org-link) + org-link)) + +(defun org-mac-safari-insert-frontmost-url () + (interactive) + (insert (org-mac-safari-get-frontmost-url))) + + +;; +;; +;; Handle links from together.app +;; +;; + +(org-add-link-type "x-together-item" 'org-mac-together-item-open) + +(defun org-mac-together-item-open (uid) + "Open the given uid, which is a reference to an item in Together" + (shell-command (concat "open -a Together \"x-together-item:" uid "\""))) + +(defun as-get-selected-together-items () + (do-applescript + (concat + "tell application \"Together\"\n" + " set theLinkList to {}\n" + " set theSelection to selected items\n" + " repeat with theItem in theSelection\n" + " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n" + " copy theLink to end of theLinkList\n" + " end repeat\n" + " return theLinkList as string\n" + "end tell"))) + +(defun org-mac-together-get-selected () + (interactive) + (message "Applescript: Getting Togther items...") + (org-mac-paste-applescript-links (as-get-selected-together-items))) + +(defun org-mac-together-insert-selected () + (interactive) + (insert (org-mac-together-get-selected))) + + +;; +;; +;; Handle links from Finder.app +;; +;; + +(defun as-get-selected-finder-items () + (do-applescript +(concat +"tell application \"Finder\"\n" +" set theSelection to the selection\n" +" set links to {}\n" +" repeat with theItem in theSelection\n" +" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n" +" copy theLink to the end of links\n" +" end repeat\n" +" return links as string\n" +"end tell\n"))) + +(defun org-mac-finder-item-get-selected () + (interactive) + (message "Applescript: Getting Finder items...") + (org-mac-paste-applescript-links (as-get-selected-finder-items))) + +(defun org-mac-finder-insert-selected () + (interactive) + (insert (org-mac-finder-item-get-selected))) + + +;; +;; +;; Handle links from AddressBook.app +;; +;; + +(org-add-link-type "addressbook" 'org-mac-addressbook-item-open) + +(defun org-mac-addressbook-item-open (uid) + "Open the given uid, which is a reference to an item in Together" + (shell-command (concat "open \"addressbook:" uid "\""))) + +(defun as-get-selected-addressbook-items () + (do-applescript + (concat + "tell application \"Address Book\"\n" + " set theSelection to the selection\n" + " set links to {}\n" + " repeat with theItem in theSelection\n" + " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n" + " copy theLink to the end of links\n" + " end repeat\n" + " return links as string\n" + "end tell\n"))) + +(defun org-mac-addressbook-item-get-selected () + (interactive) + (message "Applescript: Getting Address Book items...") + (org-mac-paste-applescript-links (as-get-selected-addressbook-items))) + +(defun org-mac-addressbook-insert-selected () + (interactive) + (insert (org-mac-addressbook-item-get-selected))) + + +(provide 'org-mac-link-grabber) + +;;; org-mac-link-grabber.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mairix.el b/.emacs.d/org-7.4/contrib/lisp/org-mairix.el new file mode 100644 index 0000000..1f62b95 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-mairix.el @@ -0,0 +1,332 @@ +;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs +;; +;; Copyright (C) 2007 Georg C. F. Greve +;; mutt support by Adam Spiers <orgmode at adamspiers dot org> +;; +;; Author: Georg C. F. Greve <greve at fsfeurope dot org> +;; Keywords: outlines, hypermedia, calendar, wp, email, mairix +;; Purpose: Integrate mairix email searching into Org mode +;; See http://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/ +;; Version: 0.5 +;; +;; This file is Free Software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; It is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; USAGE NOTE +;; +;; You will need to configure mairix first, which involves setting up your +;; .mairixrc in your home directory. Once it is working, you should set up +;; your way to display results in your favorite way -- usually a MUA. +;; Currently gnus and mutt are supported. +;; +;; After both steps are done, all you should need to hook mairix, org +;; and your MUA together is to do (require 'org-mairix) in your +;; startup file. Everything can then be configured normally through +;; Emacs customisation. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'org) + +;;; The custom variables + +(defgroup org-mairix nil + "Mairix support/integration in org." + :tag "Org Mairix" + :group 'org) + +(defcustom org-mairix-threaded-links t + "Should new links be created as threaded links? +If t, links will be stored as threaded searches. +If nil, links will be stored as non-threaded searches." + :group 'org-mairix + :type 'boolean) + +(defcustom org-mairix-augmented-links nil + "Should new links be created as augmenting searches? +If t, links will be stored as augmenting searches. +If nil, links will be stored as normal searches. + +Attention: When activating this option, you will need +to remove old articles from your mairix results group +in some other way, mairix will not do it for you." + :group 'org-mairix + :type 'boolean) + +(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results + "Hook to call to display the results of a successful mairix search. +Defaults to Gnus, feel free to add your own MUAs or methods." + :group 'org-mairix + :type 'hook) + +(defcustom org-mairix-open-command "mairix %args% '%search%'" + "The mairix command-line to use. If your paths are set up +correctly, you should not need to change this. + +'%search%' will get substituted with the search expression, and +'%args%' with any additional arguments." + :group 'org-mairix + :type 'string) + +;;; The hooks to integrate mairix into org + +(org-add-link-type "mairix" 'org-mairix-open) +(add-hook 'org-store-link-functions 'org-mairix-store-gnus-link) + +;;; Generic org-mairix functions + +(defun org-mairix-construct-link (message-id) + "Construct a mairix: hyperlink based on message-id." + (concat "mairix:" + (if org-mairix-threaded-links "t:") + (if org-mairix-augmented-links "a:") + "@@" + (org-remove-angle-brackets message-id))) + +(defun org-store-mairix-link-props (&rest plist) + "Take a property list describing a mail, and add mairix link +and description properties so that org can build a mairix link to +it." + ;; We have to call `org-store-link-props' twice: + ;; + ;; - It extracts 'fromname'/'fromaddress' from 'from' property, + ;; and stores the updated plist to `org-store-link-plist'. + ;; + ;; - `org-email-link-description' uses these new properties to + ;; build a description from the previously stored plist. I + ;; wrote a tiny patch to `org-email-link-description' so it + ;; could take a non-stored plist as an optional 2nd argument, + ;; but the plist provided still needs 'fromname'/'fromaddress'. + ;; + ;; - Ideally we would decouple the storing bit of + ;; `org-store-link-props' from the extraction bit, but lots of + ;; stuff in `org-store-link' which calls it would need to be + ;; changed. Maybe just factor out the extraction so it can be + ;; reused separately? + (let ((mid (plist-get plist :message-id))) + (apply 'org-store-link-props + (append plist + (list :type "mairix" + :link (org-mairix-construct-link mid)))) + (apply 'org-store-link-props + (append org-store-link-plist + (list :description (org-email-link-description)))))) + +(defun org-mairix-message-send-and-exit-with-link () + "Function that can be assigned as an alternative sending function, +it sends the message and then stores a mairix link to it before burying +the buffer just like 'message-send-and-exit' does." + (interactive) + (message-send) + (let* ((message-id (message-fetch-field "Message-Id")) + (subject (message-fetch-field "Subject")) + (link (org-mairix-construct-link message-id)) + (desc (concat "Email: '" subject "'"))) + (setq org-stored-links + (cons (list link desc) org-stored-links))) + (message-bury (current-buffer))) + +(defun org-mairix-open (search) + "Function to open mairix link. + +We first need to split it into its individual parts, and then +extract the message-id to be passed on to the display function +before call mairix, evaluate the number of matches returned, and +make sure to only call display of mairix succeeded in matching." + (let* ((args "")) + (if (equal (substring search 0 2) "t:" ) + (progn (setq search (substring search 2 nil)) + (setq args (concat args " --threads")))) + (if (equal (substring search 0 2) "a:") + (progn (setq search (substring search 2 nil)) + (setq args (concat args " --augment")))) + (let ((cmdline (org-mairix-command-substitution + org-mairix-open-command search args))) + (print cmdline) + (setq retval (shell-command-to-string cmdline)) + (string-match "\[0-9\]+" retval) + (setq matches (string-to-number (match-string 0 retval))) + (if (eq matches 0) (message "Link failed: no matches, sorry") + (message "Link returned %d matches" matches) + (run-hook-with-args 'org-mairix-display-hook search args))))) + +(defun org-mairix-command-substitution (cmd search args) + "Substitute '%search%' and '%args% in mairix search command." + (while (string-match "%search%" cmd) + (setq cmd (replace-match search 'fixedcase 'literal cmd))) + (while (string-match "%args%" cmd) + (setq cmd (replace-match args 'fixedcase 'literal cmd))) + cmd) + +;;; Functions necessary for integration of external MUAs. + +;; Of course we cannot call `org-store-link' from within an external +;; MUA, so we need some other way of storing a link for later +;; retrieval by org-mode and/or remember-mode. To do this we use a +;; temporary file as a kind of dedicated clipboard. + +(defcustom org-mairix-link-clipboard "~/.org-mairix-link" + "Pseudo-clipboard file where mairix URLs get copied to by external +applications in order to mimic `org-store-link'. Used by +`org-mairix-insert-link'." + :group 'org-mairix + :type 'string) + +;; When we resolve some of the issues with `org-store-link' detailed +;; at <http://thread.gmane.org/gmane.emacs.orgmode/4217/focus=4635>, +;; we might not need org-mairix-insert-link. + +(defun org-mairix-insert-link () + "Insert link from file defined by `org-mairix-link-clipboard'." + (interactive) + (let ((bytes (cadr (insert-file-contents + (expand-file-name org-mairix-link-clipboard))))) + (forward-char bytes) + (save-excursion + (forward-char -1) + (if (looking-at "\n") + (delete-char 1))))) + +;;; Functions necessary for mutt integration + +(defgroup org-mairix-mutt nil + "Use mutt for mairix support in org." + :tag "Org Mairix Mutt" + :group 'org-mairix) + +(defcustom org-mairix-mutt-display-command + "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f +~/mail/mairix -e \"push <display-message>\"' &" + "Command to execute to display mairix search results via mutt within +an xterm. + +'%search%' will get substituted with the search expression, and +'%args%' with any additional arguments used in the search." + :group 'org-mairix-mutt + :type 'string) + +(defun org-mairix-mutt-display-results (search args) + "Display results of mairix search in mutt, using the command line +defined in `org-mairix-mutt-display-command'." + ;; By default, async `shell-command' invocations display the temp + ;; buffer, which is annoying here. We choose a deterministic + ;; buffer name so we can hide it again immediately. + ;; Note: `call-process' is synchronous so not useful here. + (let ((cmd (org-mairix-command-substitution + org-mairix-mutt-display-command search args)) + (tmpbufname (generate-new-buffer-name " *mairix-view*"))) + (shell-command cmd tmpbufname) + (delete-windows-on (get-buffer tmpbufname)))) + +;;; Functions necessary for gnus integration + +(defgroup org-mairix-gnus nil + "Use gnus for mairix support in org." + :tag "Org Mairix Gnus" + :group 'org-mairix) + +(defcustom org-mairix-gnus-results-group "nnmaildir:mairix" + "The group that is configured to hold the mairix search results, +which needs to be setup independently of the org-mairix integration, +along with general mairix configuration." + :group 'org-mairix-gnus + :type 'string) + +(defcustom org-mairix-gnus-select-display-group-function +'org-mairix-gnus-select-display-group-function-gg + "Hook to call to select the group that contains the matching articles. +We should not need this, it is owed to a problem of gnus that people were +not yet able to figure out, see + http://article.gmane.org/gmane.emacs.gnus.general/65248 + http://article.gmane.org/gmane.emacs.gnus.general/65265 + http://article.gmane.org/gmane.emacs.gnus.user/9596 +for reference. + +It seems gnus needs a 'forget/ignore everything you think you +know about that group' function. Volunteers?" + :group 'org-mairix-gnus + :type 'hook) + +(defun org-mairix-store-gnus-link () + "Store a link to the current gnus message as a Mairix search for its +Message ID." + + ;; gnus integration + (when (memq major-mode '(gnus-summary-mode gnus-article-mode)) + (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) + (let* ((article (gnus-summary-article-number)) + (header (gnus-summary-article-header article)) + (from (mail-header-from header)) + (message-id (mail-header-id header)) + (subject (gnus-summary-subject-string))) + (org-store-mairix-link-props :from from + :subject subject + :message-id message-id)))) + +(defun org-mairix-gnus-display-results (search args) + "Display results of mairix search in Gnus. + +Note: This does not work as cleanly as I would like it to. The +problem being that Gnus should simply reread the group cleanly, +without remembering anything. At the moment it seems to be unable +to do that -- so you're likely to see zombies floating around. + +If you can improve this, please do!" + (if (not (equal (substring search 0 2) "m:" )) + (error "org-mairix-gnus-display-results: display of search other than +message-id not implemented yet")) + (setq message-id (substring search 2 nil)) + (require 'gnus) + (require 'gnus-sum) + ;; FIXME: (bzg/gg) We might need to make sure gnus is running here, + ;; and to start it in case it isn't running already. Does + ;; anyone know a function to do that? It seems main org mode + ;; does not do this, either. + (funcall (cdr (assq 'gnus org-link-frame-setup))) + (if gnus-other-frame-object (select-frame gnus-other-frame-object)) + + ;; FIXME: This is horribly broken. Please see + ;; http://article.gmane.org/gmane.emacs.gnus.general/65248 + ;; http://article.gmane.org/gmane.emacs.gnus.general/65265 + ;; http://article.gmane.org/gmane.emacs.gnus.user/9596 + ;; for reference. + ;; + ;; It seems gnus needs a "forget/ignore everything you think you + ;; know about that group" function. Volunteers? + ;; + ;; For now different methods seem to work differently well for + ;; different people. So we're playing hook-selection here to make + ;; it easy to play around until we found a proper solution. + (run-hook-with-args 'org-mairix-gnus-select-display-group-function) + (gnus-summary-select-article + nil t t (car (gnus-find-matching-articles "message-id" message-id)))) + +(defun org-mairix-gnus-select-display-group-function-gg () + "Georg's hack to select a group that gnus (falsely) believes to be +empty to then call rebuilding of the summary. It leaves zombies of +old searches around, though." + (gnus-group-quick-select-group 0 org-mairix-gnus-results-group) + (gnus-group-clear-data) + (gnus-summary-reselect-current-group t t)) + +(defun org-mairix-gnus-select-display-group-function-bzg () + "This is the classic way the org mode is using, and it seems to be +using better for Bastien, so it may work for you." + (gnus-group-clear-data org-mairix-gnus-results-group) + (gnus-group-read-group t nil org-mairix-gnus-results-group)) + +(provide 'org-mairix) + +;;; org-mairix.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-man.el b/.emacs.d/org-7.4/contrib/lisp/org-man.el new file mode 100644 index 0000000..27e8cca --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-man.el @@ -0,0 +1,64 @@ +;;; org-man.el - Support for links to manpages in Org-mode +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 1.0 +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +(require 'org) + +(org-add-link-type "man" 'org-man-open) +(add-hook 'org-store-link-functions 'org-man-store-link) + +(defcustom org-man-command 'man + "The Emacs command to be used to display a man page." + :group 'org-link + :type '(choice (const man) (const woman))) + +(defun org-man-open (path) + "Visit the manpage on PATH. +PATH should be a topic that can be thrown at the man command." + (funcall org-man-command path)) + +(defun org-man-store-link () + "Store a link to a README file." + (when (memq major-mode '(Man-mode woman-mode)) + ;; This is a man page, we do make this link + (let* ((page (org-man-get-page-name)) + (link (concat "man:" page)) + (description (format "Manpage for %s" page))) + (org-store-link-props + :type "man" + :link link + :description description)))) + +(defun org-man-get-page-name () + "Extract the page name from the buffer name." + ;; This works for both `Man-mode' and `woman-mode'. + (if (string-match " \\(\\S-+\\)\\*" (buffer-name)) + (match-string 1 (buffer-name)) + (error "Cannot create link to this man page"))) + +(provide 'org-man) + +;;; org-man.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mime.el b/.emacs.d/org-7.4/contrib/lisp/org-mime.el new file mode 100644 index 0000000..bca6e91 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-mime.el @@ -0,0 +1,245 @@ +;;; org-mime.el --- org html export for text/html MIME emails + +;; Copyright (C) 2010 Eric Schulte + +;; Author: Eric Schulte +;; Keywords: mime, mail, email, html +;; Homepage: http://orgmode.org/worg/org-contrib/org-mime.php +;; Version: 0.01 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; WYSWYG, html mime composition using org-mode +;; +;; For mail composed using the orgstruct-mode minor mode, this +;; provides a function for converting all or part of your mail buffer +;; to embedded html as exported by org-mode. Call `org-mime-htmlize' +;; in a message buffer to convert either the active region or the +;; entire buffer to html. +;; +;; Similarly the `org-mime-org-buffer-htmlize' function can be called +;; from within an org-mode buffer to convert the buffer to html, and +;; package the results into an email handling with appropriate MIME +;; encoding. +;; +;; you might want to bind this to a key with something like the +;; following message-mode binding +;; +;; (add-hook 'message-mode-hook +;; (lambda () +;; (local-set-key "\C-c\M-o" 'org-mime-htmlize))) +;; +;; and the following org-mode binding +;; +;; (add-hook 'org-mode-hook +;; (lambda () +;; (local-set-key "\C-c\M-o" 'org-mime-org-buffer-htmlize))) + +;;; Code: +(require 'cl) + +(defcustom org-mime-default-header + "#+OPTIONS: latex:t\n" + "Default header to control html export options, and ensure + first line isn't assumed to be a title line." + :group 'org-mime + :type 'string) + +(defcustom org-mime-library 'mml + "Library to use for marking up MIME elements." + :group 'org-mime + :type '(choice 'mml 'semi 'vm)) + +(defcustom org-mime-preserve-breaks t + "Used as temporary value of `org-export-preserve-breaks' during + mime encoding." + :group 'org-mime + :type 'boolean) + +(defcustom org-mime-fixedwith-wrap + "<pre style=\"font-family: courier, monospace;\">\n%s</pre>\n" + "Format string used to wrap a fixedwidth HTML email." + :group 'org-mime + :type 'string) + +(defcustom org-mime-html-hook nil + "Hook to run over the html buffer before attachment to email. + This could be used for example to post-process html elements." + :group 'org-mime + :type 'hook) + +;; example hook, for setting a dark background in <pre style="background-color: #EEE;"> elements +(defun org-mime-change-element-style (element style) + "Set new default htlm style for <ELEMENT> elements in exported html." + (while (re-search-forward (format "<%s" element) nil t) + (replace-match (format "<%s style=\"%s\"" element style)))) + +(defun org-mime-change-class-style (class style) + "Set new default htlm style for objects with classs=CLASS in +exported html." + (while (re-search-forward (format "class=\"%s\"" class) nil t) + (replace-match (format "class=\"%s\" style=\"%s\"" class style)))) + +;; ;; example addition to `org-mime-html-hook' adding a dark background +;; ;; color to <pre> elements +;; (add-hook 'org-mime-html-hook +;; (lambda () +;; (org-mime-change-element-style +;; "pre" (format "color: %s; background-color: %s;" +;; "#E6E1DC" "#232323")) +;; (org-mime-change-class-style +;; "verse" "border-left: 2px solid gray; padding-left: 4px;"))) + +(defun org-mime-file (ext path id) + "Markup a file for attachment." + (case org-mime-library + ('mml (format + "<#part type=\"%s\" filename=\"%s\" id=\"<%s>\">\n<#/part>\n" + ext path id)) + ('semi (concat + (format + "--[[%s\nContent-Disposition: inline;\nContent-ID: <%s>][base64]]\n" + ext id) + (base64-encode-string + (with-temp-buffer + (set-buffer-multibyte nil) + (binary-insert-encoded-file path) + (buffer-string))))) + ('vm "?"))) + +(defun org-mime-multipart (plain html) + "Markup a multipart/alternative with text/plain and text/html + alternatives." + (case org-mime-library + ('mml (format (concat "<#multipart type=alternative><#part type=text/plain>" + "%s<#part type=text/html>%s<#/multipart>\n") + plain html)) + ('semi (concat + "--" "<<alternative>>-{\n" + "--" "[[text/plain]]\n" plain + "--" "[[text/html]]\n" html + "--" "}-<<alternative>>\n")) + ('vm "?"))) + +(defun org-mime-replace-images (str current-file) + "Replace images in html files with cid links." + (let (html-images) + (cons + (replace-regexp-in-string ;; replace images in html + "src=\"\\([^\"]+\\)\"" + (lambda (text) + (format + "src=\"cid:%s\"" + (let* ((url (and (string-match "src=\"\\([^\"]+\\)\"" text) + (match-string 1 text))) + (path (expand-file-name + url (file-name-directory current-file))) + (ext (file-name-extension path)) + (id (replace-regexp-in-string "[\/\\\\]" "_" path))) + (add-to-list 'html-images + (org-mime-file (concat "image/" ext) path id)) + id))) + str) + html-images))) + +(defun org-mime-htmlize (arg) + "Export a portion of an email body composed using `mml-mode' to +html using `org-mode'. If called with an active region only +export that region, otherwise export the entire body." + (interactive "P") + (let* ((region-p (org-region-active-p)) + (html-start (or (and region-p (region-beginning)) + (save-excursion + (goto-char (point-min)) + (search-forward mail-header-separator) + (+ (point) 1)))) + (html-end (or (and region-p (region-end)) + ;; TODO: should catch signature... + (point-max))) + (raw-body (buffer-substring html-start html-end)) + (tmp-file (make-temp-name (expand-file-name "mail" temporary-file-directory))) + (body (org-export-string raw-body "org" (file-name-directory tmp-file))) + ;; because we probably don't want to skip part of our mail + (org-export-skip-text-before-1st-heading nil) + ;; because we probably don't want to export a huge style file + (org-export-htmlize-output-type 'inline-css) + ;; makes the replies with ">"s look nicer + (org-export-preserve-breaks org-mime-preserve-breaks) + ;; to hold attachments for inline html images + (html-and-images + (org-mime-replace-images + (org-export-string raw-body "html" (file-name-directory tmp-file)) + tmp-file)) + (html-images (unless arg (cdr html-and-images))) + (html (org-mime-apply-html-hook + (if arg + (format org-mime-fixedwith-wrap body) + (car html-and-images))))) + (delete-region html-start html-end) + (save-excursion + (goto-char html-start) + (insert (org-mime-multipart body html) + (mapconcat 'identity html-images "\n"))))) + +(defun org-mime-apply-html-hook (html) + (if org-mime-html-hook + (with-temp-buffer + (insert html) + (goto-char (point-min)) + (run-hooks 'org-mime-html-hook) + (buffer-string)) + html)) + +(defun org-mime-org-buffer-htmlize () + "Export the current org-mode buffer to HTML using +`org-export-as-html' and package the results into an email +handling with appropriate MIME encoding." + (interactive) + (require 'reporter) + (let* ((region-p (org-region-active-p)) + (current-file (buffer-file-name (current-buffer))) + (html-start (or (and region-p (region-beginning)) + (save-excursion + (goto-char (point-min))))) + (html-end (or (and region-p (region-end)) + (point-max))) + (temp-body-file (make-temp-file "org-mime-export")) + (raw-body (buffer-substring html-start html-end)) + (body (with-temp-buffer + (insert raw-body) + (write-file temp-body-file) + (org-export-as-org nil nil nil 'string t))) + (org-link-file-path-type 'absolute) + ;; because we probably don't want to export a huge style file + (org-export-htmlize-output-type 'inline-css) + ;; to hold attachments for inline html images + (html-and-images (org-mime-replace-images + (org-export-as-html nil nil nil 'string t) + current-file)) + (html-images (cdr html-and-images)) + (html (org-mime-apply-html-hook (car html-and-images)))) + ;; dump the exported html into a fresh message buffer + (reporter-compose-outgoing) + (goto-char (point-max)) + (prog1 (insert (org-mime-multipart body html) + (mapconcat 'identity html-images "\n")) + (delete-file temp-body-file)))) + +(provide 'org-mime)
\ No newline at end of file diff --git a/.emacs.d/org-7.4/contrib/lisp/org-mtags.el b/.emacs.d/org-7.4/contrib/lisp/org-mtags.el new file mode 100644 index 0000000..2406552 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-mtags.el @@ -0,0 +1,257 @@ +;;; org-mtags.el --- Muse-like tags in Org-mode +;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 0.01 +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This modules implements some of the formatting tags available in +;; Emacs Muse. This is not a way if adding new functionality, but just +;; a different way to write some formatting directives. The advantage is +;; that files written in this way can be read by Muse reasonably well, +;; and that this provides an alternative way of writing formatting +;; directives in Org, a way that some might find more pleasant to type +;; and look at that the Org's #+BEGIN..#+END notation. + +;; The goal of this development is to make it easier for people to +;; move between both worlds as they see fit for different tasks. + +;; The following muse tags will be translated during export into their +;; native Org equivalents: +;; +;; <br> +;; Needs to be at the end of a line. Will be translated to "\\". +;; +;; <example switches="-n -r"> +;; Needs to be on a line by itself, similarly the </example> tag. +;; Will be translated into Org's #+BEGIN_EXAMPLE construct. +;; +;; <quote> +;; Needs to be on a line by itself, similarly the </quote> tag. +;; Will be translated into Org's #+BEGIN_QUOTE construct. +;; +;; <comment> +;; Needs to be on a line by itself, similarly the </comment> tag. +;; Will be translated into Org's #+BEGIN_COMMENT construct. +;; +;; <verse> +;; Needs to be on a line by itself, similarly the </verse> tag. +;; Will be translated into Org's #+BEGIN_VERSE construct. +;; +;; <contents> +;; This gets translated into "[TABLE-OF-CONTENTS]". It will not +;; trigger the production of a table of contents - that is done +;; in Org with the "#+OPTIONS: toc:t" setting. But it will define +;; the location where the TOC will be placed. +;; +;; <literal style="STYLE"> ;; only latex, html, and docbook supported +;; in Org. +;; Needs to be on a line by itself, similarly the </literal> tag. +;; +;; <src lang="LANG" switches="-n -r"> +;; Needs to be on a line by itself, similarly the </src> tag. +;; Will be translated into Org's BEGIN_SRC construct. +;; +;; <include file="FILE" markup="MARKUP" lang="LANG" +;; prefix="str" prefix1="str" switches="-n -r"> +;; Needs to be on a line by itself. +;; Will be translated into Org's #+INCLUDE construct. +;; +;; The lisp/perl/ruby/python tags can be implemented using the +;; `org-eval.el' module, which see. + +(require 'org) + +;;; Customization + +(defgroup org-mtags nil + "Options concerning Muse tags in Org mode." + :tag "Org Muse Tags" + :group 'org) + +(defface org-mtags ; similar to shadow + (org-compatible-face 'shadow + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50")) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70")) + (((class color) (min-colors 8) (background light)) + (:foreground "green")) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow")))) + "Face for Muse-like tags in Org." + :group 'org-mtags + :group 'org-faces) + +(defcustom org-mtags-prefer-muse-templates t + "Non-nil means prefere Muse tags for structure elements. +This is relevane when expanding the templates defined in the variable +`org-structure-templates'." + :group 'org-mtags + :type 'boolean) + +(defconst org-mtags-supported-tags + '("example" "quote" "comment" "verse" "contents" "literal" "src" "include") + "The tags that are supported by org-mtags.el for conversion. +In addition to this list, the <br> tag is supported as well.") + +(defconst org-mtags-fontification-re + (concat + "^[ \t]*</?\\(" + (mapconcat 'identity org-mtags-supported-tags "\\|") + "\\)\\>[^>]*>\\|<br>[ \t]*$") + "Regular expression used for fontifying muse tags.") + +(defun org-mtags-replace () + "Replace Muse-like tags with the appropriate Org constructs. +The is done in the entire buffer." + (interactive) ;; FIXME + (let ((re (concat "^[ \t]*\\(</?\\(" + (mapconcat 'identity org-mtags-supported-tags "\\|") + "\\)\\>\\)")) + info tag rpl style markup lang file prefix prefix1 switches) + ;; First, do the <br> tag + (goto-char (point-min)) + (while (re-search-forward "<br>[ \t]*$" nil t) + (replace-match "\\\\" t t)) + ;; Now, all the other tags + (goto-char (point-min)) + (while (re-search-forward re nil t) + (goto-char (match-beginning 1)) + (setq info (org-mtags-get-tag-and-attributes)) + (if (not info) + (end-of-line 1) + (setq tag (plist-get info :tag)) + (cond + ((equal tag "contents") + (setq rpl "[TABLE-OF-CONTENTS]") + ;; FIXME: also trigger TOC in options-plist????? + ) + ((member tag '("quote" "comment" "verse")) + (if (plist-get info :closing) + (setq rpl (format "#+END_%s" (upcase tag))) + (setq rpl (format "#+BEGIN_%s" (upcase tag))))) + ((equal tag "literal") + (setq style (plist-get info :style)) + (and style (setq style (downcase style))) + (if (plist-get info :closing) + (setq rpl (cond + ((member style '("latex")) + "#+END_LaTeX") + ((member style '("html")) + "#+END_HTML") + ((member style '("docbook")) + "#+END_DOCBOOK") + ((member style '("ascii")) + "#+END_ASCII"))) + (setq rpl (cond + ((member style '("latex")) + "#+BEGIN_LaTeX") + ((member style '("html")) + "#+BEGIN_HTML") + ((member style '("ascii")) + "#+BEGIN_ASCII"))))) + ((equal tag "example") + (if (plist-get info :closing) + (setq rpl "#+END_EXAMPLE") + (setq rpl "#+BEGIN_EXAMPLE") + (when (setq switches (plist-get info :switches)) + (setq rpl (concat rpl " " switches))))) + ((equal tag "src") + (if (plist-get info :closing) + (setq rpl "#+END_SRC") + (setq rpl "#+BEGIN_SRC") + (when (setq lang (plist-get info :lang)) + (setq rpl (concat rpl " " lang)) + (when (setq switches (plist-get info :switches)) + (setq rpl (concat rpl " " switches)))))) + ((equal tag "include") + (setq file (plist-get info :file) + markup (downcase (plist-get info :markup)) + lang (plist-get info :lang) + prefix (plist-get info :prefix) + prefix1 (plist-get info :prefix1) + switches (plist-get info :switches)) + (setq rpl "#+INCLUDE") + (setq rpl (concat rpl " " (prin1-to-string file))) + (when markup + (setq rpl (concat rpl " " markup)) + (when (and (equal markup "src") lang) + (setq rpl (concat rpl " " lang)))) + (when prefix + (setq rpl (concat rpl " :prefix " (prin1-to-string prefix)))) + (when prefix1 + (setq rpl (concat rpl " :prefix1 " (prin1-to-string prefix1)))) + (when switches + (setq rpl (concat rpl " " switches))))) + (when rpl + (goto-char (plist-get info :match-beginning)) + (delete-region (point-at-bol) (plist-get info :match-end)) + (insert rpl)))))) + +(defun org-mtags-get-tag-and-attributes () + "Parse a Muse-like tag at point ant rturn the information about it. +The return value is a property list which contains all the attributes +with string values. In addition, it reutnrs the following properties: + +:tag The tag as a string. +:match-beginning The beginning of the match, just before \"<\". +:match-end The end of the match, just after \">\". +:closing t when the tag starts with \"</\"." + (when (looking-at "<\\(/\\)?\\([a-zA-Z]+\\>\\)\\([^>]*\\)>") + (let ((start 0) + tag rest prop attributes endp val) + (setq tag (org-match-string-no-properties 2) + endp (match-end 1) + rest (and (match-end 3) + (org-match-string-no-properties 3)) + attributes (list :tag tag + :match-beginning (match-beginning 0) + :match-end (match-end 0) + :closing endp)) + (when rest + (while (string-match "\\([a-zA-Z]+\\)=\\([^ \t\n>]+\\|\"[^>]+\"\\)" + rest start) + (setq start (match-end 0) + prop (org-match-string-no-properties 1 rest) + val (org-remove-double-quotes + (org-match-string-no-properties 2 rest))) + (setq attributes (plist-put attributes + (intern (concat ":" prop)) val)))) + attributes))) + +(defun org-mtags-fontify-tags (limit) + "Fontify the muse-like tags." + (while (re-search-forward org-mtags-fontification-re limit t) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-mtags font-lock-multiline t + font-lock-fontified t)))) + +(add-hook 'org-export-preprocess-hook 'org-mtags-replace) +(add-hook 'org-font-lock-hook 'org-mtags-fontify-tags) + +(provide 'org-mtags) + +;;; org-mtags.el ends here + diff --git a/.emacs.d/org-7.4/contrib/lisp/org-panel.el b/.emacs.d/org-7.4/contrib/lisp/org-panel.el new file mode 100644 index 0000000..fe0ec64 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-panel.el @@ -0,0 +1,642 @@ +;;; org-panel.el --- Simple routines for us with bad memory +;; +;; Author: Lennart Borgman (lennart O borgman A gmail O com) +;; Created: Thu Nov 15 15:35:03 2007 +;; Version: 0.21 +;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100) +;; URL: +;; Keywords: +;; Compatibility: +;; +;; Features that might be required by this library: +;; +;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax', +;; `time-date'. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This defines a kind of control panel for `org-mode'. This control +;; panel should make it fast to move around and edit structure etc. +;; +;; To bring up the control panel type +;; +;; M-x orgpan-panel +;; +;; Type ? there for help. +;; +;; I suggest you add the following to your .emacs for quick access of +;; the panel: +;; +;; (eval-after-load 'org-mode +;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel)) +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Change log: +;; +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth +;; Floor, Boston, MA 02110-1301, USA. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +(require 'org) +(require 'outline) + +;; Fix-me: this is for testing. A minor mode version interferes badly +;; with emulation minor modes. On the other hand, the other version +;; interferes badly with (interactive ...). +(defvar orgpan-minor-mode-version t) + +(defface orgpan-field + '((t (:inherit 'widget-field))) + "Face for fields." + :group 'winsize) +(defvar orgpan-field-face 'orgpan-field) + +(defface orgpan-active-field + '((t (:inherit 'highlight))) + "Face for fields." + :group 'winsize) +(defvar orgpan-active-field-face 'orgpan-active-field) + +(defface orgpan-spaceline + '((t (:height 0.2))) + "Face for spacing lines." + :group 'winsize) + +(defcustom orgpan-panel-buttons nil + "Panel style, if non-nil use buttons. +If there are buttons in the panel they are used to change the way +the arrow keys work. The panel looks something like this, with +the first button chosen: + + [Navigate] [Restructure] [TODO/Priority] + ---------- + up/down, left: Go to, right: Visibility + +The line below the buttons try to give a short hint about what +the arrow keys does. \(Personally I prefer the version without +buttons since I then do not have to remember which button is +active.)" + :type 'boolean + :group 'winsize) + +;; Fix-me: add org-mode-map +(defconst orgpan-org-mode-commands nil) +(defconst orgpan-org-commands + '( + orgpan-copy-subtree + orgpan-cut-subtree + orgpan-paste-subtree + undo + ;; + ;orgpan-occur + ;; + org-cycle + org-global-cycle + outline-up-heading + outline-next-visible-heading + outline-previous-visible-heading + outline-forward-same-level + outline-backward-same-level + org-todo + org-show-todo-tree + org-priority-up + org-priority-down + org-move-subtree-up + org-move-subtree-down + org-do-promote + org-do-demote + org-promote-subtree + org-demote-subtree)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Hook functions etc + +;;(defvar orgpan-this-panel-window nil) + +(defun orgpan-delete-panel () + "Remove the panel." + (interactive) + (when (buffer-live-p orgpan-panel-buffer) + (delete-windows-on orgpan-panel-buffer) + (kill-buffer orgpan-panel-buffer)) + (setq orgpan-panel-buffer nil) + (setq orgpan-panel-window nil) + (orgpan-panel-minor-mode 0) + (remove-hook 'post-command-hook 'orgpan-minor-post-command) + (remove-hook 'post-command-hook 'orgpan-mode-post-command) + ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change) + ) + +(defvar orgpan-last-command-was-from-panel nil) +(defun orgpan-mode-pre-command () + (setq orgpan-last-command-was-from-panel nil) + (condition-case err + (if (not (and (windowp orgpan-org-window) + (window-live-p orgpan-org-window))) + (progn + (setq this-command 'ignore) + (orgpan-delete-panel) + (message "The window belonging to the panel had disappeared, removed panel.")) + (let ((buf (window-buffer orgpan-org-window))) + (when (with-current-buffer buf + (derived-mode-p 'org-mode)) + (setq orgpan-last-org-buffer buf)) + ;; Fix me: add a list of those commands that are not + ;; meaningful from the panel (for example org-time-stamp) + (when (or (memq this-command orgpan-org-commands) + (memq this-command orgpan-org-mode-commands) + ;; For some reason not all org commands are found above: + (string= "org-" (substring (format "%s" this-command) 0 4))) + (if (not (with-current-buffer buf + (derived-mode-p 'org-mode))) + (progn + (if (buffer-live-p orgpan-org-buffer) + (set-window-buffer orgpan-org-window orgpan-org-buffer) + (message "Please use `l' or `b' to choose an org-mode buffer")) + (setq this-command 'ignore)) + (setq orgpan-org-buffer (window-buffer orgpan-org-window)) + (setq orgpan-last-command-was-from-panel t) + (select-window orgpan-org-window) + ;;(when (active-minibuffer-window + ;;(set-buffer orgpan-org-buffer) + )))) + (error (lwarn 't :warning "orgpan-pre: %S" err)))) + +(defun orgpan-mode-post-command () + (condition-case err + (progn + (unless (and (windowp orgpan-panel-window) + (window-live-p orgpan-panel-window) + (bufferp orgpan-panel-buffer) + (buffer-live-p orgpan-panel-buffer)) + ;;(orgpan-delete-panel) + ) + (when (and orgpan-last-command-was-from-panel + (windowp orgpan-panel-window) + (window-live-p orgpan-panel-window)) + (select-window orgpan-panel-window) + (when (derived-mode-p 'orgpan-mode) + (setq deactivate-mark t) + (when orgpan-panel-buttons + (unless (and orgpan-point + (= (point) orgpan-point)) + ;; Go backward so it is possible to click on a "button": + (orgpan-backward-field))))) + (setq orgpan-this-panel-window nil)) + (error (lwarn 't :warning "orgpan-post: %S" err)))) + +;; (defun orgpan-window-config-change () +;; "Check if any frame is displaying an orgpan panel. +;; If not remove `orgpan-mode-post-command' and this function from +;; the hooks." +;; (condition-case err +;; (unless (and ( +;; (let ((found-pan nil)) +;; (dolist (f (frame-list)) +;; (dolist (w (window-list f 'nomini)) +;; (with-current-buffer (window-buffer w) +;; (when (derived-mode-p 'orgpan-mode) +;; (setq found-pan t))))) +;; (unless found-pan +;; (remove-hook 'post-command-hook 'orgpan-mode-post-command) +;; (remove-hook 'window-configuration-change-hook 'orgpan-window-config-change))) +;; (error (lwarn 't :warning "Error in orgpan-config-change: %S" err)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Commands + +(defun orgpan-last-buffer () + "Open last org-mode buffer in panels org window." + (interactive) + (let ((buf (window-buffer orgpan-org-window)) + (last-buf orgpan-last-org-buffer)) + (when (with-current-buffer buf + (derived-mode-p 'org-mode)) + (setq orgpan-last-org-buffer buf)) + (when (eq last-buf buf) + (setq last-buf nil)) + (if (not last-buf) + (orgpan-switch-buffer) + (set-window-buffer orgpan-org-window last-buf)))) + +(defun orgpan-switch-buffer () + "Switch to next org-mode buffer in panels org window." + (interactive) + (let ((buf (window-buffer orgpan-org-window)) + (org-buffers nil)) + (with-current-buffer buf + (when (derived-mode-p 'org-mode) + (bury-buffer buf) + (setq orgpan-last-org-buffer buf))) + (setq org-buffers (delq nil (mapcar (lambda (buf) + (when (with-current-buffer buf + (derived-mode-p 'org-mode)) + buf)) + (buffer-list)))) + (setq org-buffers (delq buf org-buffers)) + (set-window-buffer orgpan-org-window (car org-buffers)) + (setq orgpan-org-buffer (car org-buffers)))) + +(defun orgpan-paste-subtree () + (interactive) + (if (y-or-n-p "Paste subtree here? ") + (org-paste-subtree) + (message "Nothing was pasted"))) + +(defun orgpan-cut-subtree () + (interactive) + (let ((heading (progn + (org-back-to-heading) + (buffer-substring (point) (line-end-position)) + ))) + (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading)) + (org-cut-subtree) + (message "Nothing was cut")))) + +(defun orgpan-copy-subtree () + (interactive) + (let ((heading (progn + (org-back-to-heading) + (buffer-substring (point) (line-end-position)) + ))) + (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading)) + (org-copy-subtree) + (message "Nothing was copied")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Buttons + +(defvar orgpan-ovl-help nil) + +(defun orgpan-check-panel-mode () + (unless (derived-mode-p 'orgpan-mode) + (error "Not orgpan-mode in buffer: " major-mode))) + +(defun orgpan-display-bindings-help () + (orgpan-check-panel-mode) + (setq orgpan-point (point)) + (let* ((ovls (overlays-at (point))) + (ovl (car ovls)) + (help (when ovl (overlay-get ovl 'orgpan-explain)))) + (dolist (o (overlays-in (point-min) (point-max))) + (overlay-put o 'face orgpan-field-face)) + (overlay-put ovl 'face orgpan-active-field-face) + (overlay-put orgpan-ovl-help 'before-string help))) + +(defun orgpan-forward-field () + (interactive) + (orgpan-check-panel-mode) + (let ((pos (next-overlay-change (point)))) + (unless (overlays-at pos) + (setq pos (next-overlay-change pos))) + (when (= pos (point-max)) + (setq pos (point-min)) + (unless (overlays-at pos) + (setq pos (next-overlay-change pos)))) + (goto-char pos)) + (orgpan-display-bindings-help)) + +(defun orgpan-backward-field () + (interactive) + (orgpan-check-panel-mode) + (when (= (point) (point-min)) + (goto-char (point-max))) + (let ((pos (previous-overlay-change (point)))) + (unless (overlays-at pos) + (setq pos (previous-overlay-change pos))) + (goto-char pos)) + (orgpan-display-bindings-help)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Mode + +(defconst orgpan-mode-map + ;; Fix-me: clean up here! + ;; Fix-me: viper support + (let ((map (make-sparse-keymap))) + (define-key map [?q] 'orgpan-delete-panel) + (define-key map [??] 'orgpan-help) + ;; Copying etc + (define-key map [?c] 'orgpan-copy-subtree) + (define-key map [?x] 'orgpan-cut-subtree) + (define-key map [?p] 'orgpan-paste-subtree) + (define-key map [?z] 'undo) + ;; Buffers: + (define-key map [?b] 'orgpan-switch-buffer) + (define-key map [?l] 'orgpan-last-buffer) + ;; Some keys for moving between headings. Emacs keys for next/prev + ;; line seems ok: + (define-key map [(control ?p)] 'outline-previous-visible-heading) + (define-key map [(control ?n)] 'outline-next-visible-heading) + (define-key map [(shift control ?p)] 'outline-backward-same-level) + (define-key map [(shift control ?n)] 'outline-forward-same-level) + ;; A mnemunic for up: + (define-key map [(control ?u)] 'outline-up-heading) + ;; Search sparse tree: + ;; + ;; Fix-me: Search does not work, some problem with + ;; interactive. Probably have to turn the whole thing around and + ;; always be in the org buffer, but with a minor mode running + ;; there. + ;; + ;;(define-key map [?s] 'org-sparse-tree) + (define-key map [?s] 'orgpan-occur) + ;; Same as in org-mode: + ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree) + ;; Fix-me: This leads to strange problems: + ;;(define-key map [t] 'ignore) + map)) + +(defun orgpan-occur () + "Replacement for `org-occur'. +Technical reasons." + (interactive) + (let ((rgx (read-from-minibuffer "my mini Regexp: "))) + (setq orgpan-last-command-was-from-panel t) + (select-window orgpan-org-window) + (org-occur rgx))) + +(defvar orgpan-panel-window nil + "The window showing `orgpan-panel-buffer'.") + +(defvar orgpan-panel-buffer nil + "The panel buffer. +There can be only one such buffer at any time.") + +(defvar orgpan-org-window nil) +;;(make-variable-buffer-local 'orgpan-org-window) + +;; Fix-me: used? +(defvar orgpan-org-buffer nil) +;;(make-variable-buffer-local 'orgpan-org-buffer) + +(defvar orgpan-last-org-buffer nil) +;;(make-variable-buffer-local 'orgpan-last-org-buffer) + +(defvar orgpan-point nil) +;;(make-variable-buffer-local 'orgpan-point) + +(defun orgpan-avoid-viper-in-buffer () + ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state': + (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode)) + (set (make-local-variable 'viper-new-major-mode-buffer-list) nil) + (local-set-key [?\ ] 'ignore)) + +(define-derived-mode orgpan-mode nil "Org-Panel" + "Mode for org-simple.el control panel." + (setq buffer-read-only t) + (unless orgpan-minor-mode-version + (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t) + (add-hook 'post-command-hook 'orgpan-mode-post-command t)) + (orgpan-avoid-viper-in-buffer) + (setq cursor-type nil)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Panel layout + +(defun orgpan-insert-field (text keymap explain) + (insert text) + (let* ((end (point)) + (len (length text)) + (beg (- end len)) + (ovl (make-overlay beg end))) + (overlay-put ovl 'face orgpan-field-face) + (overlay-put ovl 'keymap keymap) + (overlay-put ovl 'orgpan-explain explain))) + +(defconst orgpan-with-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map org-mode-map) + ;; Users are used to tabbing between fields: + (define-key map [(tab)] 'orgpan-forward-field) + (define-key map [(shift tab)] 'orgpan-backward-field) + ;; Now we must use something else for visibility (first does not work if Viper): + (define-key map [(meta tab)] 'org-cycle) + (define-key map [(control meta tab)] 'org-global-cycle) + map)) + +(defconst orgpan-without-keymap + (let ((map (make-sparse-keymap))) + (set-keymap-parent map org-mode-map) + ;; Visibility (those are in org-mode-map): + ;;(define-key map [tab] 'org-cycle) + ;;(define-key map [(shift tab)] 'org-global-cycle) + ;; Navigate: + (define-key map [left] 'outline-up-heading) + (define-key map [right] 'org-cycle) + (define-key map [up] 'outline-previous-visible-heading) + (define-key map [down] 'outline-next-visible-heading) + (define-key map [(shift down)] 'outline-forward-same-level) + (define-key map [(shift up)] 'outline-backward-same-level) + ;; Restructure: + (define-key map [(control up)] 'org-move-subtree-up) + (define-key map [(control down)] 'org-move-subtree-down) + (define-key map [(control left)] 'org-do-promote) + (define-key map [(control right)] 'org-do-demote) + (define-key map [(control shift left)] 'org-promote-subtree) + (define-key map [(control shift right)] 'org-demote-subtree) + ;; Todo etc + (define-key map [?+] 'org-priority-up) + (define-key map [?-] 'org-priority-down) + (define-key map [?t] 'org-todo) + map)) + +(defun orgpan-make-panel-without-buttons (buf) + (with-current-buffer buf + (insert (propertize "Org Panel" 'face 'orgpan-active-field)) + (insert " ? for help, q quit\n") + (insert (propertize "arrows" 'face 'font-lock-keyword-face) + ": Go to, " + (propertize "C-arrows" 'face 'font-lock-keyword-face) + ": Edit tree\n" + (propertize "cxpz" 'face 'font-lock-keyword-face) + ": copy cut paste undo, " + (propertize "tT+-" 'face 'font-lock-keyword-face) + ": todo priority, " + (propertize "s" 'face 'font-lock-keyword-face) + " search" + ) + (set-keymap-parent orgpan-mode-map orgpan-without-keymap) + )) + +(defun orgpan-make-panel-with-buttons (buf) + (with-current-buffer buf + (let* ((base-map (make-sparse-keymap)) + (space-line (propertize "\n\n" 'face 'orgpan-spaceline)) + (arrow-face 'font-lock-keyword-face) + (L (propertize "left" 'face arrow-face)) + (R (propertize "right" 'face arrow-face)) + (U (propertize "up" 'face arrow-face)) + (D (propertize "down" 'face arrow-face))) + ;;(message D)(sit-for 2) + (define-key base-map [left] 'ignore) + (define-key base-map [right] 'ignore) + (define-key base-map [up] 'ignore) + (define-key base-map [down] 'ignore) + (define-key base-map [?q] 'delete-window) + (define-key base-map [??] 'orgpan-help) + ;; Navigating + (let ((map (copy-keymap base-map))) + (define-key map [left] 'outline-up-heading) + (define-key map [right] 'org-cycle) + (define-key map [up] 'outline-previous-visible-heading) + (define-key map [down] 'outline-next-visible-heading) + (define-key map [(shift down)] 'outline-forward-same-level) + (define-key map [(shift up)] 'outline-backward-same-level) + (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, " R ": Visibility"))) + (insert " ") + (let ((map (copy-keymap base-map))) + (define-key map [up] 'org-move-subtree-up) + (define-key map [down] 'org-move-subtree-down) + (define-key map [left] 'org-do-promote) + (define-key map [right] 'org-do-demote) + (define-key map [(shift left)] 'org-promote-subtree) + (define-key map [(shift right)] 'org-demote-subtree) + (orgpan-insert-field + "Restructure" map + (concat U "/" D ": " + (propertize "Move" 'face 'font-lock-warning-face) + ", " L "/" R ": " + (propertize "Level (w S: Subtree Level)" 'face 'font-lock-warning-face)))) + (insert " ") + (let ((map (copy-keymap base-map))) + (define-key map [up] 'org-priority-up) + (define-key map [down] 'org-priority-down) + (define-key map [right] 'org-todo) + (orgpan-insert-field "TODO/priority" map + (concat R ": TODO, " U "/" D ": Priority"))) + ) + (insert " ? for help, q quit\n") + (orgpan-display-bindings-help) + (setq orgpan-ovl-help (make-overlay (point) (point))) + )) + +(defun orgpan-make-panel-buffer () + "Make the panel buffer." + (let* ((buf-name "*Org Panel*")) + (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer)) + (setq orgpan-panel-buffer (get-buffer-create buf-name)) + (if orgpan-panel-buttons + (orgpan-make-panel-with-buttons orgpan-panel-buffer) + (orgpan-make-panel-without-buttons orgpan-panel-buffer)) + (with-current-buffer orgpan-panel-buffer + (orgpan-mode) + (goto-char (point-min))) + orgpan-panel-buffer)) + +(defun orgpan-help () + (interactive) + (set-keymap-parent orgpan-with-keymap nil) + (set-keymap-parent orgpan-without-keymap nil) + (describe-function 'orgpan-panel) + (set-keymap-parent orgpan-with-keymap org-mode-map) + (set-keymap-parent orgpan-without-keymap org-mode-map) + (message "Use 'l' to remove help window") + ) + +(defun orgpan-panel () + "Create a control panel for current `org-mode' buffer. +The control panel may be used to quickly move around and change +the headings. The idea is that when you want to to a lot of this +kind of editing you should be able to do that with few +keystrokes (and without having to remember the complicated +keystrokes). A typical situation when this perhaps can be useful +is when you are looking at your notes file \(usually ~/.notes, +see `remember-data-file') where you have saved quick notes with +`remember'. + +The keys below are defined in the panel. Note that the commands +are carried out in the `org-mode' buffer that belongs to the +panel. + +\\{orgpan-mode-map} + +In addition to the keys above most of the keys in `org-mode' can +also be used from the panel. + +Note: There are two forms of the control panel, one with buttons +and one without. The default is without, see +`orgpan-panel-buttons'. If buttons are used choosing a different +button changes the binding of the arrow keys." + (interactive) + (unless (derived-mode-p 'org-mode) + (error "Buffer is not in org-mode")) + (orgpan-delete-panel) + (unless orgpan-org-mode-commands + (map-keymap (lambda (ev def) + (when (and def + (symbolp def) + (fboundp def)) + (setq orgpan-org-mode-commands + (cons def orgpan-org-mode-commands)))) + org-mode-map)) + ;;(org-back-to-heading) + ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change) + (split-window) + (set-window-buffer (selected-window) (orgpan-make-panel-buffer)) + (setq orgpan-panel-window (selected-window)) + ;;(set-window-dedicated-p (selected-window) t) + (fit-window-to-buffer nil nil 3) + (setq orgpan-org-window (next-window)) + ;; The minor mode version starts here: + (when orgpan-minor-mode-version + (select-window orgpan-org-window) + (orgpan-panel-minor-mode 1) + (add-hook 'post-command-hook 'orgpan-minor-post-command t))) + +(defun orgpan-minor-post-command () + (unless (and + ;; Check org window and buffer + (windowp orgpan-org-window) + (window-live-p orgpan-org-window) + (eq orgpan-org-window (selected-window)) + (derived-mode-p 'org-mode) + ;; Check panel window and buffer + (windowp orgpan-panel-window) + (window-live-p orgpan-panel-window) + (bufferp orgpan-panel-buffer) + (buffer-live-p orgpan-panel-buffer) + (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer) + ;; Check minor mode + orgpan-panel-minor-mode) + (orgpan-delete-panel))) + +(define-minor-mode orgpan-panel-minor-mode + "Minor mode used in `org-mode' buffer when showing panel." + :keymap orgpan-mode-map + :lighter " PANEL" + :group 'orgpan + ) + + +(provide 'org-panel) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; org-panel.el ends here + + diff --git a/.emacs.d/org-7.4/contrib/lisp/org-registry.el b/.emacs.d/org-7.4/contrib/lisp/org-registry.el new file mode 100644 index 0000000..ad382f0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-registry.el @@ -0,0 +1,271 @@ +;;; org-registry.el --- a registry for Org links +;; +;; Copyright 2007, 2008 Bastien Guerry +;; +;; Emacs Lisp Archive Entry +;; Filename: org-registry.el +;; Version: 0.1a +;; Author: Bastien Guerry <bzg AT altern DOT org> +;; Maintainer: Bastien Guerry <bzg AT altern DOT org> +;; Keywords: org, wp, registry +;; Description: Shows Org files where the current buffer is linked +;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: +;; +;; This library add a registry to your Org setup. +;; +;; Org files are full of links inserted with `org-store-link'. This links +;; point to e-mail, webpages, files, dirs, info pages, man pages, etc. +;; Actually, they come from potentially *everywhere* since Org lets you +;; define your own storing/following functions. +;; +;; So, what if you are on a e-mail, webpage or whatever and want to know if +;; this buffer has already been linked to somewhere in your agenda files? +;; +;; This is were org-registry comes in handy. +;; +;; M-x org-registry-show will tell you the name of the file +;; C-u M-x org-registry-show will directly jump to the file +;; +;; In case there are several files where the link lives in: +;; +;; M-x org-registry-show will display them in a new window +;; C-u M-x org-registry-show will prompt for a file to visit +;; +;; Add this to your Org configuration: +;; +;; (require 'org-registry) +;; (org-registry-initialize) +;; +;; If you want to update the registry with newly inserted links in the +;; current buffer: M-x org-registry-update +;; +;; If you want this job to be done each time you save an Org buffer, +;; hook 'org-registry-update to the local 'after-save-hook in org-mode: +;; +;; (org-registry-insinuate) + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(defgroup org-registry nil + "A registry for Org." + :group 'org) + +(defcustom org-registry-file + (concat (getenv "HOME") "/.org-registry.el") + "The Org registry file." + :group 'org-registry + :type 'file) + +(defcustom org-registry-find-file 'find-file-other-window + "How to find visit files." + :type 'function + :group 'org-registry) + +(defvar org-registry-alist nil + "An alist containing the Org registry.") + +;;;###autoload +(defun org-registry-show (&optional visit) + "Show Org files where there are links pointing to the current +buffer." + (interactive "P") + (org-registry-initialize) + (let* ((blink (or (org-remember-annotation) "")) + (link (when (string-match org-bracket-link-regexp blink) + (match-string-no-properties 1 blink))) + (desc (or (and (string-match org-bracket-link-regexp blink) + (match-string-no-properties 3 blink)) "No description")) + (files (org-registry-assoc-all link)) + file point selection tmphist) + (cond ((and files visit) + ;; result(s) to visit + (cond ((< 1 (length files)) + ;; more than one result + (setq tmphist (mapcar (lambda(entry) + (format "%s (%d) [%s]" + (nth 3 entry) ; file + (nth 2 entry) ; point + (nth 1 entry))) files)) + (setq selection (completing-read "File: " tmphist + nil t nil 'tmphist)) + (string-match "\\(.+\\) (\\([0-9]+\\))" selection) + (setq file (match-string 1 selection)) + (setq point (string-to-number (match-string 2 selection)))) + ((eq 1 (length files)) + ;; just one result + (setq file (nth 3 (car files))) + (setq point (nth 2 (car files))))) + ;; visit the (selected) file + (funcall org-registry-find-file file) + (goto-char point) + (unless (org-before-first-heading-p) + (org-show-context))) + ((and files (not visit)) + ;; result(s) to display + (cond ((eq 1 (length files)) + ;; show one file + (message "Link in file %s (%d) [%s]" + (nth 3 (car files)) + (nth 2 (car files)) + (nth 1 (car files)))) + (t (org-registry-display-files files link)))) + (t (message "No link to this in org-agenda-files"))))) + +(defun org-registry-display-files (files link) + "Display files in a separate window." + (switch-to-buffer-other-window + (get-buffer-create " *Org registry info*")) + (erase-buffer) + (insert (format "Files pointing to %s:\n\n" link)) + (let (file) + (while (setq file (pop files)) + (insert (format "%s (%d) [%s]\n" (nth 3 file) + (nth 2 file) (nth 1 file))))) + (shrink-window-if-larger-than-buffer) + (other-window 1)) + +(defun org-registry-assoc-all (link &optional registry) + "Return all associated entries of LINK in the registry." + (org-registry-find-all + (lambda (entry) (string= link (car entry))) + registry)) + +(defun org-registry-find-all (test &optional registry) + "Return all entries satisfying `test' in the registry." + (delq nil + (mapcar + (lambda (x) (and (funcall test x) x)) + (or registry org-registry-alist)))) + +;;;###autoload +(defun org-registry-visit () + "If an Org file contains a link to the current location, visit +this file." + (interactive) + (org-registry-show t)) + +;;;###autoload +(defun org-registry-initialize (&optional from-scratch) + "Initialize `org-registry-alist'. +If FROM-SCRATCH is non-nil or the registry does not exist yet, +create a new registry from scratch and eval it. If the registry +exists, eval `org-registry-file' and make it the new value for +`org-registry-alist'." + (interactive "P") + (if (or from-scratch (not (file-exists-p org-registry-file))) + ;; create a new registry + (let ((files org-agenda-files) file) + (while (setq file (pop files)) + (setq file (expand-file-name file)) + (mapc (lambda (entry) + (add-to-list 'org-registry-alist entry)) + (org-registry-get-entries file))) + (when from-scratch + (org-registry-create org-registry-alist))) + ;; eval the registry file + (with-temp-buffer + (insert-file-contents org-registry-file) + (eval-buffer)))) + +;;;###autoload +(defun org-registry-insinuate () + "Call `org-registry-update' after saving in Org-mode. +Use with caution. This could slow down things a bit." + (interactive) + (add-hook 'org-mode-hook + (lambda() (add-hook 'after-save-hook + 'org-registry-update t t)))) + +(defun org-registry-get-entries (file) + "List Org links in FILE that will be put in the registry." + (let (bufstr result) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward org-angle-link-re nil t) + (let* ((point (match-beginning 0)) + (link (match-string-no-properties 0)) + (desc (match-string-no-properties 0))) + (add-to-list 'result (list link desc point file)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp nil t) + (let* ((point (match-beginning 0)) + (link (match-string-no-properties 1)) + (desc (or (match-string-no-properties 3) "No description"))) + (add-to-list 'result (list link desc point file))))) + ;; return the list of new entries + result)) + +;;;###autoload +(defun org-registry-update () + "Update the registry for the current Org file." + (interactive) + (unless (org-mode-p) (error "Not in org-mode")) + (let* ((from-file (expand-file-name (buffer-file-name))) + (new-entries (org-registry-get-entries from-file))) + (with-temp-buffer + (unless (file-exists-p org-registry-file) + (org-registry-initialize t)) + (find-file org-registry-file) + (goto-char (point-min)) + (while (re-search-forward (concat from-file "\")$") nil t) + (let ((end (1+ (match-end 0))) + (beg (progn (re-search-backward "^(\"" nil t) + (match-beginning 0)))) + (delete-region beg end))) + (goto-char (point-min)) + (re-search-forward "^(\"" nil t) + (goto-char (match-beginning 0)) + (mapc (lambda (elem) + (insert (with-output-to-string (prin1 elem)) "\n")) + new-entries) + (save-buffer) + (kill-buffer (current-buffer))) + (message (format "Org registry updated for %s" + (file-name-nondirectory from-file))))) + +(defun org-registry-create (entries) + "Create `org-registry-file' with ENTRIES." + (let (entry) + (with-temp-buffer + (find-file org-registry-file) + (erase-buffer) + (insert + (with-output-to-string + (princ ";; -*- emacs-lisp -*-\n") + (princ ";; Org registry\n") + (princ ";; You shouldn't try to modify this buffer manually\n\n") + (princ "(setq org-registry-alist\n'(\n") + (while entries + (when (setq entry (pop entries)) + (prin1 entry) + (princ "\n"))) + (princ "))\n"))) + (save-buffer) + (kill-buffer (current-buffer)))) + (message "Org registry created")) + +(provide 'org-registry) + +;;; User Options, Variables + +;;; org-registry.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-screen.el b/.emacs.d/org-7.4/contrib/lisp/org-screen.el new file mode 100644 index 0000000..fb1e73f --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-screen.el @@ -0,0 +1,108 @@ +;;; org-screen.el --- Integreate Org-mode with screen. + +;; Copyright (c) 2008 Andrew Hyatt +;; +;; Author: Andrew Hyatt <ahyatt at gmail dot com> +;; Maintainer: Carsten Dominik <carsten at orgmode dot org> +;; +;; This file is not yet part of GNU Emacs. +;; +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This file contains functionality to integrate screen and org-mode. +;; When using org-mode, it is often useful to take tasks that have +;; some command-line work associated with them, and associate them +;; with a screen session. Screen is used rather than a direct +;; terminal to facilitate portability of the resulting session. +;; +;; To use screen in org, in your .emacs file, simply put this file in +;; a directory in your load-path and write: +;; +;; (require 'org-screen) +;; +;; When have a task and want to start some command-line activity +;; associated with that task, go to the end of your item and type: +;; +;; M-x org-screen +;; +;; This will prompt you for a name of a screen session. Type in a +;; name and it will insert a link into your org file at your current +;; location. +;; +;; When you want to visit the link, go to the link and type C-c C-o to +;; open the link. +;; +;; You may want to get rid of the constant queries about whether you +;; really want to execute lisp code. Do so by adding to your .emacs: +;; +;; (setq org-confirm-elisp-link-function nil) + +(require 'term) +(require 'org) + +(defcustom org-screen-program-name "/usr/bin/screen" + "Full location of the screen executable." + :group 'org-screen + :type 'string) + +(defun org-screen (name) + "Start a screen session with name" + (interactive "MScreen name: ") + (save-excursion + (org-screen-helper name "-S")) + (insert-string (concat "[[screen:" name "]]"))) + +(defun org-screen-buffer-name (name) + "Returns the buffer name corresponding to the screen name given." + (concat "*screen " name "*")) + +(defun org-screen-helper (name arg) + "This method will create a screen session with a specified name +and taking the specified screen arguments. Much of this function +is copied from ansi-term method." + + ;; Pick the name of the new buffer. + (let ((term-ansi-buffer-name + (generate-new-buffer-name + (org-screen-buffer-name name)))) + (setq term-ansi-buffer-name + (term-ansi-make-term + term-ansi-buffer-name org-screen-program-name 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 org-screen-goto (name) + "Open the screen with the specified name in the window" + (interactive "MScreen name: ") + (let ((screen-buffer-name (org-screen-buffer-name name))) + (if (member screen-buffer-name + (mapcar 'buffer-name (buffer-list))) + (switch-to-buffer screen-buffer-name) + (switch-to-buffer (org-screen-helper name "-dr"))))) + +(if org-link-abbrev-alist + (add-to-list 'org-link-abbrev-alist + '("screen" . "elisp:(org-screen-goto \"%s\")")) + (setq org-link-abbrev-alist + '(("screen" . "elisp:(org-screen-goto \"%s\")")))) + +(provide 'org-screen) diff --git a/.emacs.d/org-7.4/contrib/lisp/org-secretary.el b/.emacs.d/org-7.4/contrib/lisp/org-secretary.el new file mode 100644 index 0000000..353e5c3 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-secretary.el @@ -0,0 +1,232 @@ +;;; org-secretary.el --- Team management with org-mode +;; Copyright (C) 2010 Juan Reyero +;; +;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com> +;; Keywords: outlines, tasks, team, management +;; Homepage: http://juanreyero.com/article/emacs/org-teams.html +;; Version: 0.02 +;; +;; This file is not part of GNU Emacs. +;; +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; THis file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This module implements helper functions for team management. It +;; makes it easy to keep track of the work of several people. It +;; keeps context (with whom and where you are) and allows you to use +;; it to metadata to your notes, and to query the tasks associated +;; with the people you are with and the place. +;; +;; See http://juanreyero.com/article/emacs/org-teams.html for a full +;; explanation and configuration instructions. +;; +;;; Configuration +;;;;;;;;;;;;;;;;; +;; +;; In short; your todos use the TODO keyword, your team's use TASK. +;; Your org-todo-keywords should look something like this: +;; +;; (setq org-todo-keywords +;; '((sequence "TODO(t)" "|" "DONE(d)" "CANCELLED(c)") +;; (sequence "TASK(f)" "|" "DONE(d)") +;; (sequence "MAYBE(m)" "|" "CANCELLED(c)"))) +;; +;; It helps to distinguish them by color, like this: +;; +;; (setq org-todo-keyword-faces +;; '(("TODO" . (:foreground "DarkOrange1" :weight bold)) +;; ("MAYBE" . (:foreground "sea green")) +;; ("DONE" . (:foreground "light sea green")) +;; ("CANCELLED" . (:foreground "forest green")) +;; ("TASK" . (:foreground "blue")))) +;; +;; If you want to keep track of stuck projects you should tag your +;; projects with :prj:, and define: +;; +;; (setq org-tags-exclude-from-inheritance '("prj") +;; org-stuck-projects '("+prj/-MAYBE-DONE" +;; ("TODO" "TASK") ())) +;; +;; Define a tag that marks TASK entries as yours: +;; +;; (setq org-sec-me "juanre") +;; +;; Finally, you add the special views to your org-agenda-custom-commands: +;; +;; (setq org-agenda-custom-commands +;; '(("h" "Work todos" tags-todo +;; "-personal-doat={.+}-dowith={.+}/!-TASK" +;; ((org-agenda-todo-ignore-scheduled t))) +;; ("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE" +;; ((org-agenda-todo-ignore-scheduled nil))) +;; ("A" "Work todos with doat or dowith" tags-todo +;; "-personal+doat={.+}|dowith={.+}/!-TASK" +;; ((org-agenda-todo-ignore-scheduled nil))) +;; ("j" "TODO dowith and TASK with" +;; ((org-sec-with-view "TODO dowith") +;; (org-sec-where-view "TODO doat") +;; (org-sec-assigned-with-view "TASK with") +;; (org-sec-stuck-with-view "STUCK with"))) +;; ("J" "Interactive TODO dowith and TASK with" +;; ((org-sec-who-view "TODO dowith"))))) +;; +;;; Usage +;;;;;;;;; +;; +;; Do C-c w to say with whom you are meeting (a space-separated list +;; of names). Maybe do also C-c W to say where you are. Then do C-c a +;; j to see: +;; - Todo items defined with TODO (ie, mine) in which the +;; =dowith= property matches any of the people with me. +;; - Todo items defined with TODO in which the =doat= property +;; matches my current location. +;; - Todo items defined with TASK that are tagged with the name +;; of any of the people with me (this is, assigned to them). +;; - Stuck projects tagged with the name of the people with me. +;; +;; Use C-c j to add meta-data with the people with me, the +;; location and the time to entries. + +(require 'org) + +(defvar org-sec-me nil + "Tag that defines TASK todo entries associated to me") + +(defvar org-sec-with nil + "Value of the :with: property when doing an + org-sec-tag-entry. Change it with org-sec-set-with, + set to C-c w. Defaults to org-sec-me") + +(defvar org-sec-where "" + "Value of the :at: property when doing an + org-sec-tag-entry. Change it with org-sec-set-with, + set to C-c W") + +(defvar org-sec-with-history '() + "History list of :with: properties") + +(defvar org-sec-where-history '() + "History list of :where: properties") + +(defun org-sec-set-with () + "Changes the value of the org-sec-with variable for use in the + next call of org-sec-tag-entry. Leave it empty to default to + org-sec-me (you)." + (interactive) + (setq org-sec-with (let ((w (read-string "With: " nil + 'org-sec-with-history ""))) + (if (string= w "") + nil + w)))) +(global-set-key "\C-cw" 'org-sec-set-with) + +(defun org-sec-set-where () + "Changes the value of the org-sec-where variable for use + in the next call of org-sec-tag-entry." + (interactive) + (setq org-sec-where + (read-string "Where: " nil + 'org-sec-where-history ""))) +(global-set-key "\C-cW" 'org-sec-set-where) + +(defun org-sec-set-dowith () + "Sets the value of the dowith property." + (interactive) + (let ((do-with + (read-string "Do with: " + nil 'org-sec-dowith-history ""))) + (unless (string= do-with "") + (org-entry-put nil "dowith" do-with)))) +(global-set-key "\C-cd" 'org-sec-set-dowith) + +(defun org-sec-set-doat () + "Sets the value of the doat property." + (interactive) + (let ((do-at (read-string "Do at: " + nil 'org-sec-doat-history ""))) + (unless (string= do-at "") + (org-entry-put nil "doat" do-at)))) +(global-set-key "\C-cD" 'org-sec-set-doat) + +(defun org-sec-tag-entry () + "Adds a :with: property with the value of org-sec-with if + defined, an :at: property with the value of org-sec-where + if defined, and an :on: property with the current time." + (interactive) + (save-excursion + (org-entry-put nil "on" (format-time-string + (org-time-stamp-format 'long) + (current-time))) + (unless (string= org-sec-where "") + (org-entry-put nil "at" org-sec-where)) + (if org-sec-with + (org-entry-put nil "with" org-sec-with)))) +(global-set-key "\C-cj" 'org-sec-tag-entry) + +(defun join (lst sep &optional pre post) + (mapconcat (function (lambda (x) (concat pre x post))) lst sep)) + +(defun org-sec-get-with () + (if org-sec-with + org-sec-with + org-sec-me)) + +(defun org-sec-with-view (par &optional who) + "Select tasks marked as dowith=who, where who + defaults to the value of org-sec-with." + (org-tags-view '(4) (join (split-string (if who + who + (org-sec-get-with))) + "|" "dowith=\"" "\""))) + +(defun org-sec-where-view (par) + "Select tasks marked as doat=org-sec-where." + (org-tags-view '(4) (concat "doat={" org-sec-where "}"))) + +(defun org-sec-assigned-with-view (par &optional who) + "Select tasks assigned to who, by default org-sec-with." + (org-tags-view '(4) + (concat (join (split-string (if who + who + (org-sec-get-with))) + "|") + "/TASK"))) + +(defun org-sec-stuck-with-view (par &optional who) + "Select stuck projects assigned to who, by default + org-sec-with." + (let ((org-stuck-projects + `(,(concat "+prj+" + (join (split-string (if who + who + (org-sec-get-with))) "|") + "/-MAYBE-DONE") + ("TODO" "TASK") ()))) + (org-agenda-list-stuck-projects))) + +(defun org-sec-who-view (par) + "Builds agenda for a given user. Queried. " + (let ((who (read-string "Build todo for user/tag: " + "" "" ""))) + (org-sec-with-view "TODO dowith" who) + (org-sec-assigned-with-view "TASK with" who) + (org-sec-stuck-with-view "STUCK with" who))) + +(provide 'org-secretary) + +;;; org-secretary.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el b/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el new file mode 100644 index 0000000..80e2b89 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-special-blocks.el @@ -0,0 +1,94 @@ +;;; org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs + +;; Copyright (C) 2009 Chris Gray + +;; Author: Chris Gray <chrismgray@gmail.com> + +;; This file is not currently part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; + +;; This package generalizes the #+begin_foo and #+end_foo tokens. + +;; To use, put the following in your init file: +;; +;; (require 'org-special-blocks) + +;; The tokens #+begin_center, #+begin_verse, etc. existed previously. +;; This package generalizes them (at least for the LaTeX and html +;; exporters). When a #+begin_foo token is encountered by the LaTeX +;; exporter, it is expanded into \begin{foo}. The text inside the +;; environment is not protected, as text inside environments generally +;; is. When #+begin_foo is encountered by the html exporter, a div +;; with class foo is inserted into the HTML file. It is up to the +;; user to add this class to his or her stylesheet if this div is to +;; mean anything. + +(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$" + "A regexp indicating the names of blocks that should be ignored +by org-special-blocks. These blocks will presumably be +interpreted by other mechanisms.") + +(defun org-special-blocks-make-special-cookies () + "Adds special cookies when #+begin_foo and #+end_foo tokens are +seen. This is run after a few special cases are taken care of." + (when (or htmlp latexp) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) + (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) + (replace-match + (if (equal (downcase (match-string 1)) "begin") + (concat "ORG-" (match-string 2) "-START") + (concat "ORG-" (match-string 2) "-END")) + t t))))) + +(add-hook 'org-export-preprocess-after-blockquote-hook + 'org-special-blocks-make-special-cookies) + +(defun org-special-blocks-convert-latex-special-cookies () + "Converts the special cookies into LaTeX blocks." + (goto-char (point-min)) + (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t) + (replace-match + (if (equal (match-string 3) "START") + (concat "\\begin{" (match-string 1) "}" (match-string 2)) + (concat "\\end{" (match-string 1) "}")) + t t))) + + +(add-hook 'org-export-latex-after-blockquotes-hook + 'org-special-blocks-convert-latex-special-cookies) + +(defun org-special-blocks-convert-html-special-cookies () + "Converts the special cookies into div blocks." + ;; Uses the dynamically-bound variable `line'. + (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) +; (org-close-par-maybe) + (message "%s" (match-string 1)) + (if (equal (match-string 2 line) "START") + (insert "<div class=\"" (match-string 1 line) "\">\n") + (insert "</div>\n")) + (throw 'nextline nil))) + +(add-hook 'org-export-html-after-blockquotes-hook + 'org-special-blocks-convert-html-special-cookies) + +(provide 'org-special-blocks) + +;;; org-special-blocks.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el b/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el new file mode 100644 index 0000000..6a9f0ec --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-static-mathjax.el @@ -0,0 +1,171 @@ +;;; org-static-mathjax.el --- Muse-like tags in Org-mode +;; +;; Author: Jan Böker <jan dot boecker at jboecker dot de> + +;; This elisp code integrates Static MathJax into the +;; HTML export process of Org-mode. +;; +;; The supporting files for this package are in contrib/scripts/staticmathjax +;; Please read the README.org file in that directory for more information. + +;; To use it, evaluate it on startup, add the following to your .emacs: + +;; (require 'org-static-mathjax) +;; +;; You will then have to customize the following two variables: +;; - org-static-mathjax-app-ini-path +;; - org-static-mathjax-local-mathjax-path +;; +;; If xulrunner is not in your $PATH, you will also need to customize +;; org-static-mathjax-xulrunner-path. +;; +;; If everything is setup correctly, you can trigger Static MathJax on +;; export to HTML by adding the following line to your Org file: +;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html" +;; +;; You can omit either argument. +;; embed-fonts defaults to nil. If you do not specify output-file-name, +;; the exported file is overwritten with the static version. +;; +;; If embed-fonts is non-nil, the fonts are embedded directly into the +;; output file using data: URIs. +;; +;; output-file-name specifies the file name of the static version. You +;; can use any arbitrary lisp form here, for example: +;; output-file-name:(concat (file-name-sans-extension buffer-file-name) "-static.html") +;; +;; The StaticMathJax XULRunner application expects a UTF-8 encoded +;; input file. If the static version displays random characters instead +;; of your math, add the following line at the top of your Org file: +;; -*- coding: utf-8; -*- +;; +;; License: GPL v2 or later + +(defcustom org-static-mathjax-app-ini-path + (or (expand-file-name + "../scripts/staticmatchjax/application.ini" + (file-name-directory (or load-file-name buffer-file-name))) + "") + "Path to \"application.ini\" of the Static MathJax XULRunner application. +If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set +this to ~/.local/staticmathjax/application.ini" + :type 'string) + +(defcustom org-static-mathjax-xulrunner-path + "xulrunner" + "Path to your xulrunner binary" + :type 'string) + +(defcustom org-static-mathjax-local-mathjax-path + "" + "Extract the MathJax zip file somewhere on your local +hard drive and specify the path here. + +The directory has to be writeable, as org-static-mathjax +creates a temporary file there during export." + :type 'string) + +(defvar org-static-mathjax-debug + nil + "If non-nil, org-static-mathjax will print some debug messages") + +(defun org-static-mathjax-hook-installer () + "Installs org-static-mathjax-process in after-save-hook. + +Sets the following buffer-local variables for org-static-mathjax-process to pick up: +org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML export +org-static-mathjax-options: The string given with #+STATICMATHJAX: in the file" + (let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax))) + (if static-mathjax-option-string + (progn (set (make-local-variable 'org-static-mathjax-options) static-mathjax-option-string) + (set (make-local-variable 'org-static-mathjax-mathjax-path) + (nth 1 (assq 'path org-export-html-mathjax-options))) + (let ((mathjax-options (plist-get opt-plist :mathjax))) + (if mathjax-options + (if (string-match "\\<path:" mathjax-options) + (set 'org-static-mathjax-mathjax-path + (car (read-from-string + (substring mathjax-options (match-end 0)))))))) + (add-hook 'after-save-hook + 'org-static-mathjax-process + nil t))))) + + +(defun org-static-mathjax-process () + (save-excursion + ; some sanity checking + (if (or (string= org-static-mathjax-app-ini-path "") + (not (file-exists-p org-static-mathjax-app-ini-path))) + (error "Static MathJax: You must customize org-static-mathjax-app-ini-path!")) + (if (or (string= org-static-mathjax-local-mathjax-path "") + (not (file-exists-p org-static-mathjax-local-mathjax-path))) + (error "Static MathJax: You must customize org-static-mathjax-local-mathjax-path!")) + + ; define variables + (let* ((options org-static-mathjax-options) + (output-file-name buffer-file-name) + (input-file-name (let ((temporary-file-directory (file-name-directory org-static-mathjax-local-mathjax-path))) + (make-temp-file "org-static-mathjax-" nil ".html"))) + (html-code (buffer-string)) + (mathjax-oldpath (concat "src=\"" org-static-mathjax-mathjax-path)) + (mathjax-newpath (concat "src=\"" org-static-mathjax-local-mathjax-path)) + embed-fonts) + ; read file-local options + (mapc + (lambda (symbol) + (if (string-match (concat "\\<" (symbol-name symbol) ":") options) + (set symbol (eval (car (read-from-string + (substring options (match-end 0)))))))) + '(embed-fonts output-file-name)) + + ; debug + (when org-static-mathjax-debug + (message "output file name, embed-fonts") + (print output-file-name) + (print embed-fonts)) + + ; open (temporary) input file, copy contents there, replace MathJax path with local installation + (with-temp-buffer + (insert html-code) + (goto-char 1) + (replace-regexp mathjax-oldpath mathjax-newpath) + (write-file input-file-name)) + + ; prepare argument list for call-process + (let ((call-process-args (list org-static-mathjax-xulrunner-path + nil nil nil + org-static-mathjax-app-ini-path + input-file-name + output-file-name))) + ; if fonts are embedded, just append the --embed-fonts flag + (if embed-fonts + (add-to-list 'call-process-args "--embed-fonts" t)) + ; if fonts are not embedded, the XULRunner app must replace all references + ; to the font files with the real location (Firefox inserts file:// URLs there, + ; because we are using a local MathJax installation here) + (if (not embed-fonts) + (progn + (add-to-list 'call-process-args "--final-mathjax-url" t) + (add-to-list 'call-process-args + (file-name-directory org-static-mathjax-mathjax-path) + t))) + + ; debug + (when org-static-mathjax-debug + (print call-process-args)) + ; call it + (apply 'call-process call-process-args) + ; delete our temporary input file + (kill-buffer) + (delete-file input-file-name) + (let ((backup-file (concat input-file-name "~"))) + (if (file-exists-p backup-file) + (delete-file backup-file))))))) + +(add-to-list 'org-export-inbuffer-options-extra +'("STATICMATHJAX" :static-mathjax)) + +(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer) + + +(provide 'org-static-mathjax) diff --git a/.emacs.d/org-7.4/contrib/lisp/org-toc.el b/.emacs.d/org-7.4/contrib/lisp/org-toc.el new file mode 100644 index 0000000..2c5eb9c --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-toc.el @@ -0,0 +1,488 @@ +;;; org-toc.el --- Table of contents for Org-mode buffer + +;; Copyright 2007 Bastien Guerry +;; +;; Author: Bastien Guerry <bzg AT altern DOT org> +;; Keywords: Org table of contents +;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-toc.el +;; Version: 0.8 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This library implements a browsable table of contents for Org files. + +;; Put this file into your load-path and the following into your ~/.emacs: +;; (require 'org-toc) + +;;; Code: + +(provide 'org-toc) +(eval-when-compile + (require 'cl)) + +;;; Custom variables: +(defvar org-toc-base-buffer nil) +(defvar org-toc-columns-shown nil) +(defvar org-toc-odd-levels-only nil) +(defvar org-toc-config-alist nil) +(defvar org-toc-cycle-global-status nil) +(defalias 'org-show-table-of-contents 'org-toc-show) + +(defgroup org-toc nil + "Options concerning the browsable table of contents of Org-mode." + :tag "Org TOC" + :group 'org) + +(defcustom org-toc-default-depth 1 + "Default depth when invoking `org-toc-show' without argument." + :group 'org-toc + :type '(choice + (const :tag "same as base buffer" nil) + (integer :tag "level"))) + +(defcustom org-toc-follow-mode nil + "Non-nil means navigating through the table of contents will +move the point in the Org buffer accordingly." + :group 'org-toc + :type 'boolean) + +(defcustom org-toc-info-mode nil + "Non-nil means navigating through the table of contents will +show the properties for the current headline in the echo-area." + :group 'org-toc + :type 'boolean) + +(defcustom org-toc-show-subtree-mode nil + "Non-nil means show subtree when going to headline or following +it while browsing the table of contents." + :group 'org-toc + :type '(choice + (const :tag "show subtree" t) + (const :tag "show entry" nil))) + +(defcustom org-toc-recenter-mode t + "Non-nil means recenter the Org buffer when following the +headlines in the TOC buffer." + :group 'org-toc + :type 'boolean) + +(defcustom org-toc-recenter 0 + "Where to recenter the Org buffer when unfolding a subtree. +This variable is only used when `org-toc-recenter-mode' is set to +'custom. A value >=1000 will call recenter with no arg." + :group 'org-toc + :type 'integer) + +(defcustom org-toc-info-exclude '("ALLTAGS") + "A list of excluded properties when displaying info in the +echo-area. The COLUMNS property is always exluded." + :group 'org-toc + :type 'lits) + +;;; Org TOC mode: +(defvar org-toc-mode-map (make-sparse-keymap) + "Keymap for `org-toc-mode'.") + +(defun org-toc-mode () + "A major mode for browsing the table of contents of an Org buffer. + +\\{org-toc-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map org-toc-mode-map) + (setq mode-name "Org TOC") + (setq major-mode 'org-toc-mode)) + +;; toggle modes +(define-key org-toc-mode-map "f" 'org-toc-follow-mode) +(define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode) +(define-key org-toc-mode-map "s" 'org-toc-store-config) +(define-key org-toc-mode-map "g" 'org-toc-restore-config) +(define-key org-toc-mode-map "i" 'org-toc-info-mode) +(define-key org-toc-mode-map "r" 'org-toc-recenter-mode) + +;; navigation keys +(define-key org-toc-mode-map "p" 'org-toc-previous) +(define-key org-toc-mode-map "n" 'org-toc-next) +(define-key org-toc-mode-map [(left)] 'org-toc-previous) +(define-key org-toc-mode-map [(right)] 'org-toc-next) +(define-key org-toc-mode-map [(up)] 'org-toc-previous) +(define-key org-toc-mode-map [(down)] 'org-toc-next) +(define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1 (point)))) +(define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2 (point)))) +(define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3 (point)))) +(define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4 (point)))) +(define-key org-toc-mode-map " " 'org-toc-goto) +(define-key org-toc-mode-map "q" 'org-toc-quit) +(define-key org-toc-mode-map "x" 'org-toc-quit) +;; go to the location and stay in the base buffer +(define-key org-toc-mode-map [(tab)] 'org-toc-jump) +(define-key org-toc-mode-map "v" 'org-toc-jump) +;; go to the location and delete other windows +(define-key org-toc-mode-map [(return)] + (lambda() (interactive) (org-toc-jump t))) + +;; special keys +(define-key org-toc-mode-map "c" 'org-toc-columns) +(define-key org-toc-mode-map "?" 'org-toc-help) +(define-key org-toc-mode-map ":" 'org-toc-cycle-subtree) +(define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point) +;; global cycling in the base buffer +(define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>") + 'org-toc-cycle-base-buffer) +;; subtree cycling in the base buffer +(define-key org-toc-mode-map [(control tab)] + (lambda() (interactive) (org-toc-goto nil t))) + +;;; Toggle functions: +(defun org-toc-follow-mode () + "Toggle follow mode in a `org-toc-mode' buffer." + (interactive) + (setq org-toc-follow-mode (not org-toc-follow-mode)) + (message "Follow mode is %s" + (if org-toc-follow-mode "on" "off"))) + +(defun org-toc-info-mode () + "Toggle info mode in a `org-toc-mode' buffer." + (interactive) + (setq org-toc-info-mode (not org-toc-info-mode)) + (message "Info mode is %s" + (if org-toc-info-mode "on" "off"))) + +(defun org-toc-show-subtree-mode () + "Toggle show subtree mode in a `org-toc-mode' buffer." + (interactive) + (setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode)) + (message "Show subtree mode is %s" + (if org-toc-show-subtree-mode "on" "off"))) + +(defun org-toc-recenter-mode (&optional line) + "Toggle recenter mode in a `org-toc-mode' buffer. If LINE is +specified, then make `org-toc-recenter' use this value." + (interactive "P") + (setq org-toc-recenter-mode (not org-toc-recenter-mode)) + (when (numberp line) + (setq org-toc-recenter-mode t) + (setq org-toc-recenter line)) + (message "Recenter mode is %s" + (if org-toc-recenter-mode + (format "on, line %d" org-toc-recenter) "off"))) + +(defun org-toc-cycle-subtree () + "Locally cycle a headline through two states: 'children and +'folded" + (interactive) + (let ((beg (point)) + (end (save-excursion (end-of-line) (point))) + (ov (car (overlays-at (point)))) + status) + (if ov (setq status (overlay-get ov 'status)) + (setq ov (make-overlay beg end))) + ;; change the folding status of this headline + (cond ((or (null status) (eq status 'folded)) + (show-children) + (message "CHILDREN") + (overlay-put ov 'status 'children)) + ((eq status 'children) + (show-branches) + (message "BRANCHES") + (overlay-put ov 'status 'branches)) + (t (hide-subtree) + (message "FOLDED") + (overlay-put ov 'status 'folded))))) + +;;; Main show function: +;; FIXME name this org-before-first-heading-p? +(defun org-toc-before-first-heading-p () + "Before first heading?" + (save-excursion + (null (re-search-backward "^\\*+ " nil t)))) + +;;;###autoload +(defun org-toc-show (&optional depth position) + "Show the table of contents of the current Org-mode buffer." + (interactive "P") + (if (org-mode-p) + (progn (setq org-toc-base-buffer (current-buffer)) + (setq org-toc-odd-levels-only org-odd-levels-only)) + (if (eq major-mode 'org-toc-mode) + (switch-to-buffer org-toc-base-buffer) + (error "Not in an Org buffer"))) + ;; create the new window display + (let ((pos (or position + (save-excursion + (if (org-toc-before-first-heading-p) + (progn (re-search-forward "^\\*+ " nil t) + (match-beginning 0)) + (point)))))) + (setq org-toc-cycle-global-status org-cycle-global-status) + (delete-other-windows) + (and (get-buffer "*org-toc*") (kill-buffer "*org-toc*")) + (switch-to-buffer-other-window + (make-indirect-buffer org-toc-base-buffer "*org-toc*")) + ;; make content before 1st headline invisible + (goto-char (point-min)) + (let* ((beg (point-min)) + (end (and (re-search-forward "^\\*" nil t) + (1- (match-beginning 0)))) + (ov (make-overlay beg end)) + (help (format "Table of contents for %s (press ? for a quick help):\n" + (buffer-name org-toc-base-buffer)))) + (overlay-put ov 'invisible t) + (overlay-put ov 'before-string help)) + ;; build the browsable TOC + (cond (depth + (let* ((dpth (if org-toc-odd-levels-only + (1- (* depth 2)) depth))) + (org-content dpth) + (setq org-toc-cycle-global-status + `(org-content ,dpth)))) + ((null org-toc-default-depth) + (if (eq org-toc-cycle-global-status 'overview) + (progn (org-overview) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview)) + (progn (org-overview) + ;; FIXME org-content to show only headlines? + (org-content) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)))) + (t (let* ((dpth0 org-toc-default-depth) + (dpth (if org-toc-odd-levels-only + (1- (* dpth0 2)) dpth0))) + (org-content dpth) + (setq org-toc-cycle-global-status + `(org-content ,dpth))))) + (goto-char pos)) + (move-beginning-of-line nil) + (org-toc-mode) + (shrink-window-if-larger-than-buffer) + (setq buffer-read-only t)) + +;;; Navigation functions: +(defun org-toc-goto (&optional jump cycle) + "From Org TOC buffer, follow the targeted subtree in the Org window. +If JUMP is non-nil, go to the base buffer. +If JUMP is 'delete, go to the base buffer and delete other windows. +If CYCLE is non-nil, cycle the targeted subtree in the Org window." + (interactive) + (let ((pos (point)) + (toc-buf (current-buffer))) + (switch-to-buffer-other-window org-toc-base-buffer) + (goto-char pos) + (if cycle (org-cycle) + (progn (org-overview) + (if org-toc-show-subtree-mode + (org-show-subtree) + (org-show-entry)) + (org-show-context))) + (if org-toc-recenter-mode + (if (>= org-toc-recenter 1000) (recenter) + (recenter org-toc-recenter))) + (cond ((null jump) + (switch-to-buffer-other-window toc-buf)) + ((eq jump 'delete) + (delete-other-windows))))) + +(defun org-toc-cycle-base-buffer () + "Call `org-cycle' with a prefix argument in the base buffer." + (interactive) + (switch-to-buffer-other-window org-toc-base-buffer) + (org-cycle t) + (other-window 1)) + +(defun org-toc-jump (&optional delete) + "From Org TOC buffer, jump to the targeted subtree in the Org window. +If DELETE is non-nil, delete other windows when in the Org buffer." + (interactive "P") + (if delete (org-toc-goto 'delete) + (org-toc-goto t))) + +(defun org-toc-previous () + "Go to the previous headline of the TOC." + (interactive) + (if (save-excursion + (beginning-of-line) + (re-search-backward "^\\*" nil t)) + (outline-previous-visible-heading 1) + (message "No previous heading")) + (if org-toc-info-mode (org-toc-info)) + (if org-toc-follow-mode (org-toc-goto))) + +(defun org-toc-next () + "Go to the next headline of the TOC." + (interactive) + (outline-next-visible-heading 1) + (if org-toc-info-mode (org-toc-info)) + (if org-toc-follow-mode (org-toc-goto))) + +(defun org-toc-quit () + "Quit the current Org TOC buffer." + (interactive) + (kill-this-buffer) + (other-window 1) + (delete-other-windows)) + +;;; Special functions: +(defun org-toc-columns () + "Toggle columns view in the Org buffer from Org TOC." + (interactive) + (let ((indirect-buffer (current-buffer))) + (switch-to-buffer org-toc-base-buffer) + (if (not org-toc-columns-shown) + (progn (org-columns) + (setq org-toc-columns-shown t)) + (progn (org-columns-remove-overlays) + (setq org-toc-columns-shown nil))) + (switch-to-buffer indirect-buffer))) + +(defun org-toc-info () + "Show properties of current subtree in the echo-area." + (interactive) + (let ((pos (point)) + (indirect-buffer (current-buffer)) + props prop msg) + (switch-to-buffer org-toc-base-buffer) + (goto-char pos) + (setq props (org-entry-properties)) + (while (setq prop (pop props)) + (unless (or (equal (car prop) "COLUMNS") + (member (car prop) org-toc-info-exclude)) + (let ((p (car prop)) + (v (cdr prop))) + (if (equal p "TAGS") + (setq v (mapconcat 'identity (split-string v ":" t) " "))) + (setq p (concat p ":")) + (add-text-properties 0 (length p) '(face org-special-keyword) p) + (setq msg (concat msg p " " v " "))))) + (switch-to-buffer indirect-buffer) + (message msg))) + +;;; Store and restore TOC configuration: +(defun org-toc-store-config () + "Store the current status of the tables of contents in +`org-toc-config-alist'." + (interactive) + (let ((file (buffer-file-name org-toc-base-buffer)) + (pos (point)) + (hlcfg (org-toc-get-headlines-status))) + (setq org-toc-config-alist + (delete (assoc file org-toc-config-alist) + org-toc-config-alist)) + (add-to-list 'org-toc-config-alist + `(,file ,pos ,org-toc-cycle-global-status ,hlcfg)) + (message "TOC configuration saved: (%s)" + (if (listp org-toc-cycle-global-status) + (concat "org-content " + (number-to-string + (cadr org-toc-cycle-global-status))) + (symbol-name org-toc-cycle-global-status))))) + +(defun org-toc-restore-config () + "Get the stored status in `org-toc-config-alist' and set the +current table of contents to it." + (interactive) + (let* ((file (buffer-file-name org-toc-base-buffer)) + (conf (cdr (assoc file org-toc-config-alist))) + (pos (car conf)) + (status (cadr conf)) + (hlcfg (caddr conf)) hlcfg0 ov) + (cond ((listp status) + (org-toc-show (cadr status) (point))) + ((eq status 'overview) + (org-overview) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview)) + (t + (org-overview) + (org-content) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents))) + (while (setq hlcfg0 (pop hlcfg)) + (save-excursion + (goto-char (point-min)) + (when (search-forward (car hlcfg0) nil t) + (unless (overlays-at (match-beginning 0)) + (setq ov (make-overlay (match-beginning 0) + (match-end 0)))) + (cond ((eq (cdr hlcfg0) 'children) + (show-children) + (message "CHILDREN") + (overlay-put ov 'status 'children)) + ((eq (cdr hlcfg0) 'branches) + (show-branches) + (message "BRANCHES") + (overlay-put ov 'status 'branches)))))) + (goto-char pos) + (if org-toc-follow-mode (org-toc-goto)) + (message "Last TOC configuration restored") + (sit-for 1) + (if org-toc-info-mode (org-toc-info)))) + +(defun org-toc-get-headlines-status () + "Return an alist of headlines and their associated folding +status." + (let (output ovs) + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (goto-char (next-overlay-change (point)))) + (when (looking-at "^\\*+ ") + (add-to-list + 'output + (cons (buffer-substring-no-properties + (match-beginning 0) + (save-excursion + (end-of-line) (point))) + (overlay-get + (car (overlays-at (point))) 'status)))))) + ;; return an alist like (("* Headline" . 'status)) + output)) + +;; In Org TOC buffer, hide headlines below the first level. +(defun org-toc-help () + "Display a quick help message in the echo-area for `org-toc-mode'." + (interactive) + (let ((st-start 0) + (help-message + "\[space\] show heading \[1-4\] hide headlines below this level +\[TAB\] jump to heading \[f\] toggle follow mode (currently %s) +\[return\] jump and delete others windows \[i\] toggle info mode (currently %s) +\[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode (currently %s) +\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode (currently %s) +\[:\] cycle subtree (in TOC) \[c\] toggle column view (currently %s) +\[n/p\] next/previous heading \[s\] save TOC configuration +\[q\] quit the TOC \[g\] restore last TOC configuration")) + (while (string-match "\\[[^]]+\\]" help-message st-start) + (add-text-properties (match-beginning 0) + (match-end 0) '(face bold) help-message) + (setq st-start (match-end 0))) + (message help-message + (if org-toc-follow-mode "on" "off") + (if org-toc-info-mode "on" "off") + (if org-toc-show-subtree-mode "on" "off") + (if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off") + (if org-toc-columns-shown "on" "off")))) + + +;;;;########################################################################## +;;;; User Options, Variables +;;;;########################################################################## + + + +;;; org-toc.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-track.el b/.emacs.d/org-7.4/contrib/lisp/org-track.el new file mode 100644 index 0000000..e65364e --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-track.el @@ -0,0 +1,219 @@ +;;; org-track.el --- Track the most recent Org-mode version available. +;; +;; Copyright (C) 2009 +;; Free Software Foundation, Inc. +;; +;; Author: Bastien Guerry <bzg at altern dot org> +;; Eric S Fraga <e.fraga at ucl.ac dot uk> +;; Sebastian Rose <sebastian_rose at gmx dot de> +;; The Worg people http://orgmode.org/worg/ +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.29a +;; +;; Released under the GNU General Public License version 3 +;; see: http://www.gnu.org/licenses/gpl-3.0.html +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; Download the latest development tarball, unpack and optionally compile it +;; +;; Usage: +;; +;; (require 'org-track) +;; +;; ;; ... somewhere in your setup (use customize): +;; +;; (setq org-track-directory "~/test/") +;; (setq org-track-compile-sources nil) +;; (setq org-track-remove-package t) +;; +;; M-x org-track-update RET + + + +(require 'url-parse) +(require 'url-handlers) +(autoload 'url-file-local-copy "url-handlers") +(autoload 'url-generic-parse-url "url-parse") + + + + + +;;; Variables: + +(defgroup org-track nil + "Track the most recent Org-mode version available. + +To use org-track, adjust `org-track-directory'. +Org will download the archived latest git version for you, +unpack it into that directory (i.e. a subdirectory +`org-mode/' is added), create the autoloads file +`org-install.el' for you and, optionally, compile the +sources. +All you'll have to do is call `M-x org-track-update' from +time to time." + :version "22.1" + :group 'org) + +(defcustom org-track-directory "~/.emacs.d/org/lisp" + "Directory where your org-mode/ directory lives. +If that directory does not exist, it will be created." + :type 'directory) + +(defcustom org-track-compile-sources t + "If `nil', never compile org-sources. +Org will only create the autoloads file `org-install.el' for +you then. If `t', compile the sources, too. +Note, that emacs preferes compiled elisp files over +non-compiled ones." + :type 'boolean) + +(defcustom org-track-org-url "http://orgmode.org/" + "The URL where the package to download can be found. +Please append a slash." + :type 'string) + +(defcustom org-track-org-package "org-latest.tar.gz" + "The basename of the package you use. +Defaults to the development version of Org-mode. +This should be a *.tar.gz package, since emacs provides all +you need to unpack it." + :type 'string) + +(defcustom org-track-remove-package nil + "Remove org-latest.tar.gz after updates?" + :type 'boolean) + + + + + +;;; Frontend + +(defun org-track-update () + "Update to current Org-mode version. +Also, generate autoloads and evtl. compile the sources." + (interactive) + (let* ((base (file-truename org-track-directory)) + (org-exists (file-exists-p + (file-truename + (concat base "/org-mode/lisp/org.el")))) + (nobase (not (file-directory-p + (file-truename org-track-directory))))) + (if nobase + (when (y-or-n-p + (format "Directory %s does not exist. Create it?" base)) + (make-directory base t) + (setq nobase nil))) + (if nobase + (message "Not creating %s - giving up." org-track-directory) + (condition-case err + (progn + (org-track-fetch-package) + (org-track-compile-org)) + (error (message "%s" (error-message-string err))))))) + + + + +;;; tar related functions + +;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure +;; that? If the maintainers of that package decide, that an assynchronous +;; download might be better??? (used by `url-file-local-copy') + +;;;###autoload +(defun org-track-fetch-package (&optional directory) + "Fetch Org package depending on `org-track-fetch-package-extension'. +If DIRECTORY is defined, unpack the package there, i.e. add the +subdirectory org-mode/ to DIRECTORY." + (interactive "Dorg-track directory: ") + (let* ((pack (concat + (if (string-match "/$" org-track-org-url) + org-track-org-url + (concat org-track-org-url "/")) + org-track-org-package)) + (base (file-truename + (or directory org-track-directory))) + (target (file-truename + (concat base "/" org-track-org-package))) + url download tarbuff) + (message "Fetching to %s - this might take some time..." base) + (setq url (url-generic-parse-url pack)) + (setq download (url-file-local-copy url)) ;; errors if fail + (copy-file download target t) + (delete-file download) + ;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to + ;; ensure tar-mode is used: + (add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode)) + (setq tarbuff (find-file target)) + (with-current-buffer tarbuff ;; with-temp-buffer does not work with tar-mode?? + (tar-untar-buffer)) + (kill-buffer tarbuff) + (if org-track-remove-package + (delete-file target)))) + + + + +;;; Compile Org-mode sources + + +;;;###autoload +(defun org-track-compile-org (&optional directory) + "Compile all *.el files that come with org-mode. +Generate the autoloads file `org-install.el'. + +DIRECTORY is where the directory org-mode/ lives (i.e. the + parent directory of your local repo." + (interactive) + ;; file-truename expands the filename and removes double slash, if exists: + (setq directory (file-truename + (concat + (or directory + (file-truename (concat org-track-directory "/org-mode/lisp"))) + "/"))) + (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) + + (mapc (lambda (f) + (if (file-exists-p (concat f "c")) + (delete-file (concat f "c")))) + list-of-org-files) + (if org-track-compile-sources + (mapc (lambda (f) (byte-compile-file f)) list-of-org-files)))) + + +(provide 'org-track) + +;;; org-track.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-velocity.el b/.emacs.d/org-7.4/contrib/lisp/org-velocity.el new file mode 100644 index 0000000..2a1f41b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-velocity.el @@ -0,0 +1,527 @@ +;;; org-velocity.el --- something like Notational Velocity for Org. + +;; Copyright (C) 2010 Paul M. Rodriguez + +;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com> +;; Created: 2010-05-05 +;; Version: 2.2 + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation version 2. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; For a copy of the GNU General Public License, search the Internet, +;; or write to the Free Software Foundation, Inc., 59 Temple Place, +;; Suite 330, Boston, MA 02111-1307 USA + +;;; Commentary: +;; Org-Velocity.el implements an interface for Org inspired by the +;; minimalist notetaking program Notational Velocity. The idea is to +;; allow you to maintain, amass and access brief notes on many +;; subjects with minimal fuss. + +;; It can be used in two ways: to store and access notes from any +;; buffer a universal bucket file; or as a method for navigating any +;; Org file. + +;; The name of the bucket-file (`org-velocity-bucket') and whether to +;; always use it (`org-velocity-always-use-bucket-file') are set +;; through Customize. If the bucket file is set but not always to be +;; used, then calling Org-Velocity outside of Org-mode uses the bucket +;; file; calling it in Org mode uses the current buffer. If no bucket +;; file is set then Org-Velocity only works when called from Org. +;; Even if the bucket file is always to be used, calling +;; `org-velocity-read' with an argument will use the current file. + +;; The interface, unlike its inspiration, is not incremental. +;; Org-Velocity prompts for search terms in the usual way; if the user +;; has customized `org-velocity-use-completion', completion is offered +;; on the headings in the target file. If the search multiple times +;; in the target file, a buffer containing a buttonized list of the +;; headings where it occurs is displayed. Results beyond what can be +;; indexed are discarded. After clicking on a heading, or typing a +;; character associated with it, the user is taken to the heading. +;; (Typing 0 forces a new heading to be created.) If +;; `org-velocity-edit-indirectly' is so set, the heading and its +;; subtree are displayed in an indirect buffer. Otherwise the user is +;; simply taken to the proper buffer and position. + +;; If the user simply hits RET at the prompt, without making a choice, +;; then the search is restored for editing. A blank search quits. +;; This method of selection is obviously not as slick as the original, +;; but probably more useful for a keyboard-driven interface. + +;; If the search does not occur in the file the user is offered a +;; choice to create a new heading named with the search. Org-Velocity +;; will use `org-capture' or `org-remember' if they are loaded, +;; preferring `org-capture'. Otherwise the user is simply taken to a +;; new heading at the end of the file. + +;; Thanks to Richard Riley, Carsten Dominik, and Bastien Guerry for +;; their suggestions. + +;;; Usage: +;; (require 'org-velocity) +;; (setq org-velocity-bucket (concat org-directory "/bucket.org")) +;; (global-set-key (kbd "C-c v") 'org-velocity-read) + +;;; Code: +(require 'org) +(require 'button) +(require 'electric) +(eval-when-compile (require 'cl)) + +(defgroup org-velocity nil + "Notational Velocity-style interface for Org." + :tag "Org-Velocity" + :group 'outlines + :group 'hypermedia) + +(defcustom org-velocity-bucket "" + "Where is the bucket file?" + :group 'org-velocity + :type 'file) + +(defcustom org-velocity-always-use-bucket nil + "Use bucket file even when called from an Org buffer?" + :group 'org-velocity + :type 'boolean) + +(defcustom org-velocity-use-completion nil + "Complete on heading names?" + :group 'org-velocity + :type 'boolean) + +(defcustom org-velocity-edit-indirectly t + "Edit entries in an indirect buffer or just visit the file?" + :group 'org-velocity + :type 'boolean) + +(defcustom org-velocity-search-method 'phrase + "Match on whole phrase, any word, or all words?" + :group 'org-velocity + :type '(choice + (const :tag "Match whole phrase" phrase) + (const :tag "Match any word" any) + (const :tag "Match all words" all))) + +(defcustom org-velocity-create-method 'capture + "Prefer `org-capture', `org-remember', or neither?" + :group 'org-velocity + :type '(choice + (const :tag "Prefer capture > remember > default." capture) + (const :tag "Prefer remember > default." remember) + (const :tag "Edit in buffer." buffer))) + +(defcustom org-velocity-allow-regexps nil + "Allow searches to use regular expressions?" + :group 'org-velocity + :type 'boolean) + +(defstruct (org-velocity-heading + (:constructor org-velocity-make-heading) + (:type list)) + (marker (point-marker)) + (name (substring-no-properties + (org-get-heading)))) + +(defconst org-velocity-index + (eval-when-compile + (nconc (number-sequence 49 57) ;numbers + (number-sequence 97 122) ;lowercase letters + (number-sequence 65 90))) ;uppercase letters + "List of chars for indexing results.") + +(defun org-velocity-use-file () + "Return the proper file for Org-Velocity to search. +If `org-velocity-always-use-bucket' is t, use bucket file; complain +if missing. Otherwise if this is an Org file, use it." + (let ((org-velocity-bucket + (and org-velocity-bucket (expand-file-name org-velocity-bucket)))) + (if org-velocity-always-use-bucket + (or org-velocity-bucket (error "Bucket required but not defined")) + (if (and (eq major-mode 'org-mode) + (buffer-file-name)) + (buffer-file-name) + (or org-velocity-bucket + (error "No bucket and not an Org file")))))) + +(defsubst org-velocity-display-buffer () + "Return the proper buffer for Org-Velocity to display in." + (get-buffer-create "*Velocity headings*")) + +(defsubst org-velocity-bucket-buffer () + "Return proper buffer for bucket operations." + (find-file-noselect (org-velocity-use-file))) + +(defun org-velocity-quote (search) + "Quote SEARCH as a regexp if `org-velocity-allow-regexps' is non-nil. +Acts like `regexp-quote' on a string, `regexp-opt' on a list." + (if org-velocity-allow-regexps + search + (if (listp search) + (regexp-opt search) + (regexp-quote search)))) + +(defun org-velocity-nearest-heading (position) + "Return last heading at POSITION. +If there is no last heading, return nil." + (save-excursion + (goto-char position) + (unless (org-before-first-heading-p) + (org-back-to-heading) + (org-velocity-make-heading)))) + +(defun org-velocity-make-button-action (heading) + "Return a form to visit HEADING." + `(lambda (button) + (run-hooks 'mouse-leave-buffer-hook) ;turn off temporary modes + (if org-velocity-edit-indirectly + (org-velocity-edit-entry ',heading) + (progn + (message "%s" ,(org-velocity-heading-name heading)) + (switch-to-buffer (marker-buffer + ,(org-velocity-heading-marker heading))) + (goto-char (marker-position + ,(org-velocity-heading-marker heading))))))) + +(defun org-velocity-edit-entry (heading) + "Edit entry at HEADING in an indirect buffer." + (let ((buffer (make-indirect-buffer + (marker-buffer (org-velocity-heading-marker heading)) + (generate-new-buffer-name + (org-velocity-heading-name heading))))) + (with-current-buffer buffer + (let ((org-inhibit-startup t)) + (org-mode)) + (goto-char (marker-position (org-velocity-heading-marker heading))) + (narrow-to-region (point) + (save-excursion + (org-end-of-subtree) + (point))) + (goto-char (point-min)) + (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t)) + (pop-to-buffer buffer) + (set (make-local-variable 'header-line-format) + (format "%s Use C-c C-c to finish." + (abbreviate-file-name + (buffer-file-name + (marker-buffer + (org-velocity-heading-marker heading)))))))) + +(defun org-velocity-dismiss () + "Save current entry and close indirect buffer." + (progn + (save-buffer) + (kill-buffer))) + +(defun org-velocity-buttonize (heading) + "Insert HEADING as a text button." + (insert (format "#%c " (nth (1- (line-number-at-pos)) + org-velocity-index))) + (let ((action (org-velocity-make-button-action heading))) + (insert-text-button + (org-velocity-heading-name heading) + 'action action)) + (newline)) + +(defun org-velocity-remember (heading &optional region) + "Use `org-remember' to record a note to HEADING. +If there is a REGION that will be inserted." + (let ((org-remember-templates + (list (list + "Velocity entry" + ?v + (format "* %s\n\n%%?%s" heading (or region "")) + (org-velocity-use-file) + 'bottom)))) + (org-remember nil ?v))) + +(defun org-velocity-capture (heading &optional region) + "Use `org-capture' to record a note to HEADING. +If there is a REGION that will be inserted." + (let ((org-capture-templates + (list `("v" + "Velocity entry" + entry + (file ,(org-velocity-use-file)) + ,(format "* %s\n\n%%?%s" heading (or region "")))))) + (if (fboundp 'org-capture) ;; quiet compiler + (org-capture nil "v")))) + +(defun org-velocity-insert-heading (heading) + "Add a new heading named HEADING." + (with-current-buffer (org-velocity-bucket-buffer) + (goto-char (point-max)) + (newline) + (org-insert-heading) (insert heading) + (newline) + (goto-char (point-max)))) + +(defun org-velocity-create-heading (search region) + "Add and visit a new heading named SEARCH. +If REGION is non-nil insert as the contents of the heading." + (org-velocity-insert-heading search) + (switch-to-buffer (org-velocity-bucket-buffer)) + (when region (insert region))) + +(defun org-velocity-all-search (search) + "Return entries containing all words in SEARCH." + (when (file-exists-p (org-velocity-use-file)) + (save-excursion + (delq nil + (let ((keywords + (mapcar 'org-velocity-quote + (split-string search))) + (case-fold-search t)) + (org-map-entries + (lambda () + (if (loop with limit = (save-excursion + (org-end-of-subtree) + (point)) + for word in keywords + always (save-excursion + (re-search-forward word limit t))) + (org-velocity-nearest-heading + (match-beginning 0)))))))))) + +(defun org-velocity-generic-search (search) + "Return entries containing SEARCH." + (save-excursion + (delq nil + (nreverse + (let (matches (case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward search + (point-max) t) + (push (org-velocity-nearest-heading (match-beginning 0)) + matches) + (outline-next-heading)) + matches))))) + +(defsubst org-velocity-phrase-search (search) + "Return entries containing SEARCH as a phrase." + (org-velocity-generic-search (org-velocity-quote search))) + +(defsubst org-velocity-any-search (search) + "Return entries containing any word in SEARCH." + (org-velocity-generic-search (org-velocity-quote (split-string search)))) + +(defun org-velocity-present (headings) + "Buttonize HEADINGS in `org-velocity-display-buffer'." + (and (listp headings) (delete-dups headings)) + (let ((cdr (nthcdr + (1- (length org-velocity-index)) + headings))) + (and (consp cdr) (setcdr cdr nil))) + (with-current-buffer (org-velocity-display-buffer) + (mapc + 'org-velocity-buttonize + headings) + (goto-char (point-min)))) + +(defun org-velocity-create-1 (search region) + "Create a new heading named SEARCH. +If REGION is non-nil insert as contents of new heading. +The possible methods are `org-velocity-capture', +`org-velocity-remember', or `org-velocity-create-heading', in +that order. Which is preferred is determined by +`org-velocity-create-method'." + (funcall + (ecase org-velocity-create-method + (capture (or (and (featurep 'org-capture) 'org-velocity-capture) + (and (featurep 'org-remember) 'org-velocity-remember) + 'org-velocity-create-heading)) + (remember (or (and (featurep 'org-remember) 'org-velocity-remember) + 'org-velocity-create-heading)) + (buffer 'org-velocity-create-heading)) + search region)) + +(defun org-velocity-create (search &optional ask) + "Create new heading named SEARCH. +If ASK is non-nil, ask first." + (if (or (null ask) + (y-or-n-p "No match found, create? ")) + ;; if there's a region, we want to insert it + (let ((region (if (use-region-p) + (buffer-substring + (region-beginning) + (region-end))))) + (with-current-buffer (org-velocity-bucket-buffer) + (org-velocity-create-1 search region)) + (when region (message "%s" "Inserted region")) + search))) + +(defun org-velocity-get-matches (search) + "Return matches for SEARCH in current bucket. +Use method specified by `org-velocity-search-method'." + (with-current-buffer (org-velocity-bucket-buffer) + (case org-velocity-search-method + ('phrase (org-velocity-phrase-search search)) + ('any (org-velocity-any-search search)) + ('all (org-velocity-all-search search))))) + +(defun org-velocity-engine (search) + "Display a list of headings where SEARCH occurs." + (with-current-buffer (org-velocity-display-buffer) + (erase-buffer) + (setq cursor-type nil)) + (unless (or + (not (stringp search)) + (string-equal "" search)) ;exit on empty string + (case + (with-current-buffer (org-velocity-bucket-buffer) + (save-excursion + (let ((matches (org-velocity-get-matches search))) + (org-velocity-present matches) + (cond ((zerop (length matches)) 'new) + ((= (length matches) 1) 'follow) + ((> (length matches) 1) 'prompt))))) + ('prompt (progn + (Electric-pop-up-window (org-velocity-display-buffer)) + (let ((hint (org-velocity-electric-follow-hint))) + (if hint + (case hint + (edit (org-velocity-read nil search)) + (new (org-velocity-create search)) + (otherwise (org-velocity-activate-button hint))))))) + ('new (unless (org-velocity-create search t) + (org-velocity-read nil search))) + ('follow (if (y-or-n-p "One match, follow? ") + (progn + (set-buffer (org-velocity-display-buffer)) + (goto-char (point-min)) + (button-activate (next-button (point)))) + (org-velocity-read nil search)))))) + +(defun org-velocity-position (item list) + "Return first position of ITEM in LIST." + (loop for elt in list + for i from 0 + if (equal elt item) + return i)) + +(defun org-velocity-activate-button (char) + "Go to button on line number associated with CHAR in `org-velocity-index'." + (goto-char (point-min)) + (forward-line (org-velocity-position char org-velocity-index)) + (goto-char + (button-start + (next-button (point)))) + (message "%s" (button-label (button-at (point)))) + (button-activate (button-at (point)))) + +(defun org-velocity-electric-undefined () + "Complain about an undefined key." + (interactive) + (message "%s" + (substitute-command-keys + "\\[org-velocity-electric-new] for new entry, \\[org-velocity-electric-edit] to edit search, \\[scroll-up] to scroll.")) + (sit-for 4)) + +(defun org-velocity-electric-follow (ev) + "Follow a hint indexed by keyboard event EV." + (interactive (list last-command-event)) + (if (not (> (org-velocity-position ev org-velocity-index) + (1- (count-lines (point-min) (point-max))))) + (throw 'org-velocity-select ev) + (call-interactively 'org-velocity-electric-undefined))) + +(defun org-velocity-electric-click (ev) + "Follow hint indexed by a mouse event EV." + (interactive "e") + (throw 'org-velocity-select + (nth (1- (count-lines + (point-min) + (posn-point (event-start ev)))) + org-velocity-index))) + +(defun org-velocity-electric-edit () + "Edit the search string." + (interactive) + (throw 'org-velocity-select 'edit)) + +(defun org-velocity-electric-new () + "Force a new entry." + (interactive) + (throw 'org-velocity-select 'new)) + +(defvar org-velocity-electric-map + (let ((map (make-sparse-keymap))) + (define-key map [t] 'org-velocity-electric-undefined) (loop for c in org-velocity-index + do (define-key map (char-to-string c) 'org-velocity-electric-follow)) + (define-key map "0" 'org-velocity-electric-new) + (define-key map [tab] 'scroll-up) + (define-key map [return] 'org-velocity-electric-edit) + (define-key map [mouse-1] 'org-velocity-electric-click) + (define-key map [mouse-2] 'org-velocity-electric-click) + (define-key map [escape escape escape] 'keyboard-quit) + (define-key map "\C-h" 'help-command) + map)) + +(defun org-velocity-electric-follow-hint () + "Read index of button electrically." + (with-current-buffer (org-velocity-display-buffer) + (use-local-map org-velocity-electric-map) + (catch 'org-velocity-select + (Electric-command-loop 'org-velocity-select + "Follow: ")))) + +(defun org-velocity-read-with-completion (prompt) + "Like `completing-read' on entries with PROMPT. +Use `minibuffer-local-filename-completion-map'." + (let ((minibuffer-local-completion-map + minibuffer-local-filename-completion-map)) + (completing-read + prompt + (mapcar 'substring-no-properties + (org-map-entries 'org-get-heading))))) + +(defun org-velocity-read-string (prompt &optional initial-input) + "Read string with PROMPT followed by INITIAL-INPUT." + ;; The use of initial inputs to the minibuffer is deprecated (see + ;; `read-from-minibuffer'), but in this case it is the user-friendly + ;; thing to do. + (minibuffer-with-setup-hook + (lexical-let ((initial-input initial-input)) + (lambda () + (and initial-input (insert initial-input)) + (goto-char (point-max)))) + (if (and org-velocity-use-completion + ;; map-entries complains for nonexistent files + (file-exists-p (org-velocity-use-file))) + (org-velocity-read-with-completion prompt) + (read-string prompt)))) + +(defun org-velocity-read (arg &optional search) + "Read a search string SEARCH for Org-Velocity interface. +This means that a buffer will display all headings where SEARCH +occurs, where one can be selected by a mouse click or by typing +its index. If SEARCH does not occur, then a new heading may be +created named SEARCH. + +If `org-velocity-bucket' is defined and +`org-velocity-always-use-bucket' is non-nil, then the bucket file +will be used; otherwise, this will work when called in any Org +file. Calling with ARG forces current file." + (interactive "P") + (let ((org-velocity-always-use-bucket + (if arg nil org-velocity-always-use-bucket))) + ;; complain if inappropriate + (assert (org-velocity-use-file)) + (unwind-protect + (org-velocity-engine + (org-velocity-read-string "Velocity search: " search)) + (progn + (kill-buffer (org-velocity-display-buffer)) + (delete-other-windows))))) + +(provide 'org-velocity) +;;; org-velocity.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el b/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el new file mode 100644 index 0000000..85c32f6 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org-wikinodes.el @@ -0,0 +1,339 @@ +;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 7.01trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'org) +(eval-when-compile + (require 'cl)) + +(defgroup org-wikinodes nil + "Wiki-like CamelCase links words to outline nodes in Org mode." + :tag "Org WikiNodes" + :group 'org) + +(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>" + "Regular expression matching CamelCase words.") + +(defcustom org-wikinodes-active t + "Should CamelCase links be active in the current file?" + :group 'org-wikinodes + :type 'boolean) +(put 'org-wikinodes-active 'safe-local-variable 'booleanp) + +(defcustom org-wikinodes-scope 'file + "The scope of searches for wiki targets. +Allowed values are: + +file Search for targets in the current file only +directory Search for targets in all org files in the current directory" + :group 'org-wikinodes + :type '(choice + (const :tag "Find targets in current file" file) + (const :tag "Find targets in current directory" directory))) + +(defcustom org-wikinodes-create-targets 'query + "Non-nil means create Wiki target when following a wiki link fails. +Allowed values are: + +nil never create node, just throw an error if the target does not exist +query ask the user what to do +t create the node in the current buffer +\"file.org\" create the node in the file \"file.org\", in the same directory + +If you are using wiki links across files, you need to set `org-wikinodes-scope' +to `directory'." + :group 'org-wikinodes + :type '(choice + (const :tag "Never automatically create node" nil) + (const :tag "In current file" t) + (file :tag "In one special file\n") + (const :tag "Query the user" query))) + +;;; Link activation + +(defun org-wikinodes-activate-links (limit) + "Activate CamelCase words as links to Wiki targets." + (when org-wikinodes-active + (let (case-fold-search) + (if (re-search-forward org-wikinodes-camel-regexp limit t) + (if (equal (char-after (point-at-bol)) ?*) + (progn + ;; in heading - deactivate flyspell + (org-remove-flyspell-overlays-in (match-beginning 0) + (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + '(org-no-flyspell t)) + t) + ;; this is a wiki link + (org-remove-flyspell-overlays-in (match-beginning 0) + (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'face 'org-link + 'keymap org-mouse-map + 'help-echo "Wiki Link")) + t))))) + +;;; Following links and creating non-existing target nodes + +(defun org-wikinodes-open-at-point () + "Check if the cursor is on a Wiki link and follow the link. + +This function goes into `org-open-at-point-functions'." + (and org-wikinodes-active + (not (org-on-heading-p)) + (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp)) + (progn (org-wikinodes-follow-link (match-string 0)) t))) + +(defun org-wikinodes-follow-link (target) + "Follow a wiki link to TARGET. + +This need to be found as an exact headline match, either in the current +buffer, or in any .org file in the current directory, depending on the +variable `org-wikinodes-scope'. + +If a target headline is not found, it may be created according to the +setting of `org-wikinodes-create-targets'." + (if current-prefix-arg (org-wikinodes-clear-direcory-targets-cache)) + (let ((create org-wikinodes-create-targets) + visiting buffer m pos file rpl) + (setq pos + (or (org-find-exact-headline-in-buffer target (current-buffer)) + (and (eq org-wikinodes-scope 'directory) + (setq file (org-wikinodes-which-file target)) + (org-find-exact-headline-in-buffer + target (or (get-file-buffer file) + (find-file-noselect file)))))) + (if pos + (progn + (org-mark-ring-push (point)) + (org-goto-marker-or-bmk pos) + (move-marker pos nil)) + (when (eq create 'query) + (if (eq org-wikinodes-scope 'directory) + (progn + (message "Node \"%s\" does not exist. Should it be created? +\[RET] in this buffer [TAB] in another file [q]uit" target) + (setq rpl (read-char-exclusive)) + (cond + ((member rpl '(?\C-g ?q)) (error "Abort")) + ((equal rpl ?\C-m) (setq create t)) + ((equal rpl ?\C-i) + (setq create (file-name-nondirectory + (read-file-name "Create in file: ")))) + (t (error "Invalid selection")))) + (if (y-or-n-p (format "Create new node \"%s\" in current buffer? " + target)) + (setq create t) + (error "Abort")))) + + (cond + ((not create) + ;; We are not allowed to create the new node + (error "No match for link to \"%s\"" target)) + ((stringp create) + ;; Make new node in another file + (org-mark-ring-push (point)) + (switch-to-buffer (find-file-noselect create)) + (goto-char (point-max)) + (or (bolp) (newline)) + (insert "\n* " target "\n") + (backward-char 1) + (org-wikinodes-add-target-to-cache target) + (message "New Wiki target `%s' created in file \"%s\"" + target create)) + (t + ;; Make new node in current buffer + (org-mark-ring-push (point)) + (goto-char (point-max)) + (or (bolp) (newline)) + (insert "* " target "\n") + (backward-char 1) + (org-wikinodes-add-target-to-cache target) + (message "New Wiki target `%s' created in current buffer" + target)))))) + +;;; The target cache + +(defvar org-wikinodes-directory-targets-cache nil) + +(defun org-wikinodes-clear-cache-when-on-target () + "When on a headline that is a Wiki target, clear the cache." + (when (and (org-on-heading-p) + (org-in-regexp (format org-complex-heading-regexp-format + org-wikinodes-camel-regexp)) + (org-in-regexp org-wikinodes-camel-regexp)) + (org-wikinodes-clear-direcory-targets-cache) + t)) + +(defun org-wikinodes-clear-direcory-targets-cache () + "Clear the cache where to find wiki targets." + (interactive) + (setq org-wikinodes-directory-targets-cache nil) + (message "Wiki target cache cleared, so that it will update when used again")) + +(defun org-wikinodes-get-targets () + "Return a list of all wiki targets in the current buffer." + (let ((re (format org-complex-heading-regexp-format + org-wikinodes-camel-regexp)) + (case-fold-search nil) + targets) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (push (org-match-string-no-properties 4) targets)))) + (nreverse targets))) + +(defun org-wikinodes-get-links-for-directory (dir) + "Return an alist that connects wiki links to files in directory DIR." + (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'")) + (org-inhibit-startup t) + target-file-alist file visiting m buffer) + (while (setq file (pop files)) + (setq visiting (org-find-base-buffer-visiting file)) + (setq buffer (or visiting (find-file-noselect file))) + (with-current-buffer buffer + (mapc + (lambda (target) + (setq target-file-alist (cons (cons target file) target-file-alist))) + (org-wikinodes-get-targets))) + (or visiting (kill-buffer buffer))) + target-file-alist)) + +(defun org-wikinodes-add-target-to-cache (target &optional file) + (setq file (or file buffer-file-name (error "No file for new wiki target"))) + (set-text-properties 0 (length target) nil target) + (let ((dir (file-name-directory (expand-file-name file))) + a) + (setq a (assoc dir org-wikinodes-directory-targets-cache)) + (if a + ;; Push the new target onto the existing list + (push (cons target (expand-file-name file)) (cdr a)) + ;; Call org-wikinodes-which-file so that the cache will be filled + (org-wikinodes-which-file target dir)))) + +(defun org-wikinodes-which-file (target &optional directory) + "Return the file for wiki headline TARGET DIRECTORY. +If there is no such wiki target, return nil." + (setq directory (expand-file-name (or directory default-directory))) + (unless (assoc directory org-wikinodes-directory-targets-cache) + (push (cons directory (org-wikinodes-get-links-for-directory directory)) + org-wikinodes-directory-targets-cache)) + (cdr (assoc target (cdr (assoc directory + org-wikinodes-directory-targets-cache))))) + +;;; Exporting Wiki links + +(defvar target) +(defvar target-alist) +(defvar last-section-target) +(defvar org-export-target-aliases) +(defun org-wikinodes-set-wiki-targets-during-export () + (let ((line (buffer-substring (point-at-bol) (point-at-eol))) + (case-fold-search nil) + wtarget a) + (when (string-match (format org-complex-heading-regexp-format + org-wikinodes-camel-regexp) + line) + (setq wtarget (match-string 4 line)) + (push (cons wtarget target) target-alist) + (setq a (or (assoc last-section-target org-export-target-aliases) + (progn + (push (list last-section-target) + org-export-target-aliases) + (car org-export-target-aliases)))) + (push (caar target-alist) (cdr a))))) + +(defvar org-current-export-file) +(defun org-wikinodes-process-links-for-export () + "Process Wiki links in the export preprocess buffer. + +Try to find target matches in the wiki scope and replace CamelCase words +with working links." + (let ((re org-wikinodes-camel-regexp) + (case-fold-search nil) + link file) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (org-if-unprotected-at (match-beginning 0) + (unless (save-match-data + (or (org-on-heading-p) + (org-in-regexp org-bracket-link-regexp) + (org-in-regexp org-plain-link-re) + (org-in-regexp "<<[^<>]+>>"))) + (setq link (match-string 0)) + (delete-region (match-beginning 0) (match-end 0)) + (save-match-data + (cond + ((org-find-exact-headline-in-buffer link (current-buffer)) + ;; Found in current buffer + (insert (format "[[#%s][%s]]" link link))) + ((eq org-wikinodes-scope 'file) + ;; No match in file, and other files are not allowed + (insert (format "%s" link))) + ((setq file + (and (org-string-nw-p org-current-export-file) + (org-wikinodes-which-file + link (file-name-directory org-current-export-file)))) + ;; Match in another file in the current directory + (insert (format "[[file:%s::%s][%s]]" file link link))) + (t ;; No match for this link + (insert (format "%s" link)))))))))) + +;;; Hook the WikiNode mechanism into Org + +;; `C-c C-o' should follow wiki links +(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point) + +;; `C-c C-c' should clear the cache +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target) + +;; Make Wiki haeding create additional link names for headlines +(add-hook 'org-export-define-heading-targets-headline-hook + 'org-wikinodes-set-wiki-targets-during-export) + +;; Turn Wiki links into links the exporter will treat correctly +(add-hook 'org-export-preprocess-after-radio-targets-hook + 'org-wikinodes-process-links-for-export) + +;; Activate CamelCase words as part of Org mode font lock + +(defun org-wikinodes-add-to-font-lock-keywords () + "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'." + (let ((m (member '(org-activate-plain-links) org-font-lock-extra-keywords))) + (if m + (setcdr m (cons '(org-wikinodes-activate-links) (cdr m))) + (message + "Failed to add wikinodes to `org-font-lock-extra-keywords'.")))) + +(add-hook 'org-font-lock-set-keywords-hook + 'org-wikinodes-add-to-font-lock-keywords) + +(provide 'org-wikinodes) + +;; arch-tag: e3b56e38-a2be-478c-b56c-68a913ec54ec + +;;; org-wikinodes.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/org2rem.el b/.emacs.d/org-7.4/contrib/lisp/org2rem.el new file mode 100644 index 0000000..5d160dc --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/org2rem.el @@ -0,0 +1,653 @@ +;;; org2rem.el --- Convert org appointments into reminders + +;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc. + +;; Author: Bastien Guerry and Shatad Pratap +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.09a +;; +;; This file is not part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; (require 'org2rem) +;; To export, do +;; +;; M-x org2rem-combine-agenda-files +;; +;; Then you can use reming like this: +;; +;; $ remind ~/org.rem +;; +;; If you want to use this regualrly, try in .emacs +;; +;; (add-hook 'org-mode-hook +;; (lambda() (add-hook 'after-save-hook +;; 'org-export-remind-all-agenda-files t t))) + +(require 'org) +(require 'org-agenda) +(require 'org-exp) +(eval-and-compile + (require 'cl)) + +(defgroup org2rem nil + "Options specific for Remind export of Org-mode files." + :tag "Org Export Remind" + :group 'org-export) + +(defcustom org-combined-agenda-remind-file "~/org.rem" + "The file name for the Remind file covering all agenda files. +This file is created with the command \\[org2rem-all-agenda-files]. +The file name should be absolute, the file will be overwritten without warning." + :group 'org2rem + :type 'file) + +(defcustom org-remind-combined-name "OrgMode" + "Calendar name for the combined Remind representing all agenda files." + :group 'org2rem + :type 'string) + +(defcustom org-remind-use-deadline '(event-if-not-todo todo-due) + "Contexts where Remind export should use a deadline time stamp. +This is a list with several symbols in it. Valid symbol are: + +event-if-todo Deadlines in TODO entries become calendar events. +event-if-not-todo Deadlines in non-TODO entries become calendar events. +todo-due Use deadlines in TODO entries as due-dates" + :group 'org2rem + :type '(set :greedy t + (const :tag "Deadlines in non-TODO entries become events" + event-if-not-todo) + (const :tag "Deadline in TODO entries become events" + event-if-todo) + (const :tag "Deadlines in TODO entries become due-dates" + todo-due))) + +(defcustom org-remind-use-scheduled '(todo-start) + "Contexts where Remind export should use a scheduling time stamp. +This is a list with several symbols in it. Valid symbol are: + +event-if-todo Scheduling time stamps in TODO entries become an event. +event-if-not-todo Scheduling time stamps in non-TODO entries become an event. +todo-start Scheduling time stamps in TODO entries become start date. + Some calendar applications show TODO entries only after + that date." + :group 'org2rem + :type '(set :greedy t + (const :tag + "SCHEDULED timestamps in non-TODO entries become events" + event-if-not-todo) + (const :tag "SCHEDULED timestamps in TODO entries become events" + event-if-todo) + (const :tag "SCHEDULED in TODO entries become start date" + todo-start))) + +(defcustom org-remind-categories '(local-tags category) + "Items that should be entered into the categories field. +This is a list of symbols, the following are valid: + +category The Org-mode category of the current file or tree +todo-state The todo state, if any +local-tags The tags, defined in the current line +all-tags All tags, including inherited ones." + :group 'org2rem + :type '(repeat + (choice + (const :tag "The file or tree category" category) + (const :tag "The TODO state" todo-state) + (const :tag "Tags defined in current line" local-tags) + (const :tag "All tags, including inherited ones" all-tags)))) + +(defcustom org-remind-include-todo nil + "Non-nil means export to remind files should also cover TODO items." + :group 'org2rem + :type '(choice + (const :tag "None" nil) + (const :tag "Unfinished" t) + (const :tag "All" all))) + +(defcustom org-remind-include-sexps t + "Non-nil means export to Remind files should also cover sexp entries. +These are entries like in the diary, but directly in an Org-mode file." + :group 'org2rem + :type 'boolean) + +(defcustom org-remind-deadline-over-scheduled t + "Non-nil means use deadline as target when both deadline and +scheduled present, vice-versa. Default is Non-nil." + :group 'org2rem + :type 'boolean) + +(defcustom org-remind-escape-percentage t + "Non-nil means % will be escaped, vice-versa. Default is Non-nil." + :group 'org2rem + :type 'boolean) + +(defcustom org-remind-extra-warn-days 3 + "Extra days Remind keep reminding." + :group 'org2rem + :type 'number) + +(defcustom org-remind-advanced-warn-days 3 + "Advanced days Remind start reminding." + :group 'org2rem + :type 'number) + +(defcustom org-remind-suppress-last-newline nil + "Non-nil means suppress last newline REM body. Default is nil." + :group 'org2rem + :type 'boolean) + +(defcustom org-remind-include-body 100 + "Amount of text below headline to be included in Remind export. +This is a number of characters that should maximally be included. +Properties, scheduling and clocking lines will always be removed. +The text will be inserted into the DESCRIPTION field." + :group 'org2rem + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Everything" t) + (integer :tag "Max characters"))) + +(defcustom org-remind-store-UID nil + "Non-nil means store any created UIDs in properties. +The Remind standard requires that all entries have a unique identifyer. +Org will create these identifiers as needed. When this variable is non-nil, +the created UIDs will be stored in the ID property of the entry. Then the +next time this entry is exported, it will be exported with the same UID, +superceeding the previous form of it. This is essential for +synchronization services. +This variable is not turned on by default because we want to avoid creating +a property drawer in every entry if people are only playing with this feature, +or if they are only using it locally." + :group 'org2rem + :type 'boolean) + +;;;; Exporting + +;;; Remind export + +;;;###autoload +(defun org2rem-this-file () + "Export current file as an Remind file. +The Remind file will be located in the same directory as the Org-mode +file, but with extension `.rem'." + (interactive) + (org2rem nil buffer-file-name)) + +;;;###autoload +(defun org2rem-all-agenda-files () + "Export all files in `org-agenda-files' to Remind .rem files. +Each Remind file will be located in the same directory as the Org-mode +file, but with extension `.rem'." + (interactive) + (apply 'org2rem nil (org-agenda-files t))) + +;;;###autoload +(defun org2rem-combine-agenda-files () + "Export all files in `org-agenda-files' to a single combined Remind file. +The file is stored under the name `org-combined-agenda-remind-file'." + (interactive) + (apply 'org2rem t (org-agenda-files t))) + +(defun org2rem (combine &rest files) + "Create Remind files for all elements of FILES. +If COMBINE is non-nil, combine all calendar entries into a single large +file and store it under the name `org-combined-agenda-remind-file'." + (save-excursion + (org-prepare-agenda-buffers files) + (let* ((dir (org-export-directory + :ical (list :publishing-directory + org-export-publishing-directory))) + file rem-file rem-buffer category started org-agenda-new-buffers) + (and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*")) + (when combine + (setq rem-file + (if (file-name-absolute-p org-combined-agenda-remind-file) + org-combined-agenda-remind-file + (expand-file-name org-combined-agenda-remind-file dir)) + rem-buffer (org-get-agenda-file-buffer rem-file)) + (set-buffer rem-buffer) (erase-buffer)) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file)) + (unless combine + (setq rem-file (concat (file-name-as-directory dir) + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ".rem")) + (setq rem-buffer (org-get-agenda-file-buffer rem-file)) + (with-current-buffer rem-buffer (erase-buffer))) + (setq category (or org-category + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) + (if (symbolp category) (setq category (symbol-name category))) + (let ((standard-output rem-buffer)) + (if combine + (and (not started) (setq started t) + (org-start-remind-file org-remind-combined-name)) + (org-start-remind-file category)) + (org-print-remind-entries combine) + (when (or (and combine (not files)) (not combine)) + (org-finish-remind-file) + (set-buffer rem-buffer) + (run-hooks 'org-before-save-Remind-file-hook) + (save-buffer) + (run-hooks 'org-after-save-Remind-file-hook) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)) + )))) + (org-release-buffers org-agenda-new-buffers)))) + +(defvar org-before-save-Remind-file-hook nil + "Hook run before an Remind file has been saved. +This can be used to modify the result of the export.") + +(defvar org-after-save-Remind-file-hook nil + "Hook run after an Remind file has been saved. +The Remind buffer is still current when this hook is run. +A good way to use this is to tell a desktop calenndar application to re-read +the Remind file.") + +(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el +(defun org-print-remind-entries (&optional combine) + "Print Remind entries for the current Org-mode file to `standard-output'. +When COMBINE is non nil, add the category to each line." + (require 'org-agenda) + (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) + (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) + (dts (org-rem-ts-to-string + (format-time-string (cdr org-time-stamp-formats) (current-time)) + "start time:")) + hd ts ts2 state status (inc t) pos b sexp rrule + scheduledp deadlinep todo prefix due start + tmp pri categories entry location summary desc uid + remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days) + (org-rem-aw org-remind-advanced-warn-days) + trigger diff-days (dos org-remind-deadline-over-scheduled) + (suppress-last-newline org-remind-suppress-last-newline) + (sexp-buffer (get-buffer-create "*rem-tmp*"))) + (org-refresh-category-properties) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward re1 nil t) + (catch :skip + (org-agenda-skip) + (when (boundp 'org-remind-verify-function) + (unless (funcall org-remind-verify-function) + (outline-next-heading) + (backward-char 1) + (throw :skip nil))) + (setq pos (match-beginning 0) + ts (match-string 0) + inc t + hd (condition-case nil + (org-remind-cleanup-string + (org-get-heading)) + (error (throw :skip nil))) + summary (org-remind-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-remind-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-remind-include-body (org-get-entry))) + t org-remind-include-body) + location (org-remind-cleanup-string + (org-entry-get nil "LOCATION")) + uid (if org-remind-store-UID + (org-id-get-create) + (or (org-id-get) (org-id-new))) + categories (org-export-get-remind-categories) + deadlinep nil scheduledp nil) + (if (looking-at re2) + (progn + (goto-char (match-end 0)) + (setq ts2 (match-string 1) + inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) + (setq tmp (buffer-substring (max (point-min) + (- pos org-ds-keyword-length)) + pos) + ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) + (progn + (setq inc nil) + (replace-match "\\1" t nil ts)) + ts) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + todo (org-get-todo-state) + ;; donep (org-entry-is-done-p) + )) + (when (and + deadlinep + (if todo + (not (memq 'event-if-todo org-remind-use-deadline)) + (not (memq 'event-if-not-todo org-remind-use-deadline)))) + (throw :skip t)) + (when (and + scheduledp + (if todo + (not (memq 'event-if-todo org-remind-use-scheduled)) + (not (memq 'event-if-not-todo org-remind-use-scheduled)))) + (throw :skip t)) + (setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "TS-"))) + (if (or (string-match org-tr-regexp hd) + (string-match org-ts-regexp hd)) + (setq hd (replace-match "" t t hd))) + (if (string-match "\\+\\([0-9]+\\)\\([dwmy]\\)>" ts) + (setq rrule ;is recurrence value. later give it good name. + (* (string-to-number + (cdr (assoc + (match-string 2 ts) + '(("d" . "1")("w" . "7") + ("m" . "0")("y" . "0"))))) + (string-to-number (match-string 1 ts)))) + (setq rrule nil)) + (setq summary (or summary hd)) + (if (string-match org-bracket-link-regexp summary) + (setq summary + (replace-match (if (match-end 3) + (match-string 3 summary) + (match-string 1 summary)) + t t summary))) + (if deadlinep (setq summary (concat "DEADLINE: " summary))) + (if scheduledp (setq summary (concat "SCHEDULED: " summary))) + (if (string-match "\\`<%%" ts) + (with-current-buffer sexp-buffer + (insert (substring ts 1 -1) " " summary "\n")) + (princ (format "\n## BEGIN:EVENT +## UID: %s +REM %s %s MSG EVENT:%s%s %s%s%% +## CATEGORIES:%s +## END:EVENT\n" + (concat prefix uid) + (org-rem-ts-to-string ts nil nil rrule) + (org-rem-ts-to-string ts2 "UNTIL " inc) + summary + (if (and desc (string-match "\\S-" desc)) + (concat "%_\\\n" desc) "") + (if (and location (string-match "\\S-" location)) + (concat "\nLOCATION: " location) "") + (if suppress-last-newline "" "%_") + categories))))) + + (when (and org-remind-include-sexps + (condition-case nil (require 'remind) (error nil)) + (fboundp 'remind-export-region)) + ;; Get all the literal sexps + (goto-char (point-min)) + (while (re-search-forward "^&?%%(" nil t) + (catch :skip + (org-agenda-skip) + (setq b (match-beginning 0)) + (goto-char (1- (match-end 0))) + (forward-sexp 1) + (end-of-line 1) + (setq sexp (buffer-substring b (point))) + (with-current-buffer sexp-buffer + (insert sexp "\n")))) + ;; (princ (org-diary-to-rem-string sexp-buffer)) + (kill-buffer sexp-buffer)) + + (when org-remind-include-todo + (setq prefix "TODO-") + (goto-char (point-min)) + (while (re-search-forward org-todo-line-regexp nil t) + (catch :skip + (org-agenda-skip) + (when (boundp 'org-remind-verify-function) + (unless (funcall org-remind-verify-function) + (outline-next-heading) + (backward-char 1) + (throw :skip nil))) + (setq state (match-string 2)) + (setq status (if (member state org-done-keywords) + "COMPLETED" "NEEDS-ACTION")) + (when (and state + (or (not (member state org-done-keywords)) + (eq org-remind-include-todo 'all)) + (not (member org-archive-tag (org-get-tags-at))) + ) + (setq hd (match-string 3) + summary (org-remind-cleanup-string + (org-entry-get nil "SUMMARY")) + desc (org-remind-cleanup-string + (or (org-entry-get nil "DESCRIPTION") + (and org-remind-include-body (org-get-entry))) + t org-remind-include-body) + location (org-remind-cleanup-string + (org-entry-get nil "LOCATION")) + due (and (member 'todo-due org-remind-use-deadline) + (org-entry-get nil "DEADLINE")) + start (and (member 'todo-start org-remind-use-scheduled) + (org-entry-get nil "SCHEDULED")) + categories (org-export-get-remind-categories) + uid (if org-remind-store-UID + (org-id-get-create) + (or (org-id-get) (org-id-new)))) + + (if (and due start) + (setq diff-days (org-rem-time-diff-days due start))) + + (setq remind-aw + (if due + (if diff-days + (if (> diff-days 0) + (if dos diff-days 0) + (if dos 0 diff-days)) + 1000))) + + (if (and (numberp org-rem-aw) (> org-rem-aw 0)) + (setq remind-aw (+ (or remind-aw 0) org-rem-aw))) + + (setq remind-ew + (if due + (if diff-days + (if (> diff-days 0) due nil) + due))) + + (setq trigger (if dos (if due due start) (if start start due))) + ;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw))) + (if trigger + (setq trigger (concat + (format "[trigger('%s')] *%d " + (org-rem-ts-to-remind-date-type trigger) 1) + (if remind-aw (format "++%d" remind-aw))))) + (and due (setq due (org-rem-ts-to-remind-date-type due))) + (and start (setq start (org-rem-ts-to-remind-date-type start))) + (and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew))) + + (if (string-match org-bracket-link-regexp hd) + (setq hd (replace-match (if (match-end 3) (match-string 3 hd) + (match-string 1 hd)) + t t hd))) + (if (string-match org-priority-regexp hd) + (setq pri (string-to-char (match-string 2 hd)) + hd (concat (substring hd 0 (match-beginning 1)) + (substring hd (match-end 1)))) + (setq pri org-default-priority)) + (setq pri (floor (1+ (* 8. (/ (float (- org-lowest-priority pri)) + (- org-lowest-priority org-highest-priority)))))) + + (princ (format "\n## BEGIN:TODO +## UID: %s +REM %s %s %s MSG TODO: %s%s%s%s%s%s%% +## CATEGORIES:%s +## SEQUENCE:1 +## STATUS:%s +## END:TODO\n" + (concat prefix uid) + (or trigger "") ;; dts) + (if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "") + (if pri (format "PRIORITY %d" pri) "") + (or summary hd) + (if (and desc (string-match "\\S-" desc)) + (concat "%_\\\nDESCRIPTION: " desc) "") + (if (and location (string-match "\\S-" location)) + (concat "LOCATION: " location) "") + (if start + (concat + "%_\\\n['" start "' - today()] " + "days over, for scheduled date - " + "[trigger('" start "')]") "") + (if due + (concat + "%_\\\n[today() - '" due "'] " + "days left, to deadline date - " + "[trigger('" due "')]") "") + (if suppress-last-newline "" "%_") + categories + status))))))))) + +(defun org-export-get-remind-categories () + "Get categories according to `org-remind-categories'." + (let ((cs org-remind-categories) c rtn tmp) + (while (setq c (pop cs)) + (cond + ((eq c 'category) (push (org-get-category) rtn)) + ((eq c 'todo-state) + (setq tmp (org-get-todo-state)) + (and tmp (push tmp rtn))) + ((eq c 'local-tags) + (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) + ((eq c 'all-tags) + (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) + (mapconcat 'identity (nreverse rtn) ","))) + +(defun org-remind-cleanup-string (s &optional is-body maxlength) + "Take out stuff and quote what needs to be quoted. +When IS-BODY is non-nil, assume that this is the body of an item, clean up +whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH +characters." + (if (or (not s) (string-match "^[ \t\n]*$" s)) + nil + (when is-body + (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) + (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) + (while (string-match re s) (setq s (replace-match "" t t s))) + (while (string-match re2 s) (setq s (replace-match "" t t s))))) + (if org-remind-escape-percentage + (let ((start 0)) + (while (string-match "\\([%]\\)" s start) + (setq start (+ (match-beginning 0) 2) + s (replace-match "\\1\\1" nil nil s))))) + + (let ((start 0)) + (while (string-match "\\([\n]\\)" s start) + (setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct. + s (replace-match "%_\\\\\\1" nil nil s)))) + + (let ((start 0)) + (while (string-match "\\([[]\\)" s start) + (setq start (+ (match-beginning 0) 5) + s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s)))) + +;;; (when is-body +;;; (while (string-match "[ \t]*\n[ \t]*" s) +;;; (setq s (replace-match "%_" t t s)))) + + (setq s (org-trim s)) + (if is-body + (if maxlength + (if (and (numberp maxlength) + (> (length s) maxlength)) + (setq s (substring s 0 maxlength))))) + s)) + +(defun org-get-entry () + "Clean-up description string." + (save-excursion + (org-back-to-heading t) + (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + +(defun org-start-remind-file (name) + "Start an Remind file by inserting the header." + (let ((user user-full-name) + (name (or name "unknown")) + (timezone (cadr (current-time-zone)))) + (princ + (format "# -*- Mode: shell-script; auto-fill-mode: nil -*- +## BEGIN: Reminders +## VERSION:2.0 +## Emacs with Org-mode +## Calendar:%s +## Created by: %s +## Timezone:%s +## Calscale:Gregorian\n" name user timezone)))) + +(defun org-finish-remind-file () + "Finish an Remind file by inserting the END statement." + (princ "\n## END:Reminders\n")) + +(defun org-rem-ts-to-remind-date-type (s) + (format-time-string + "%Y-%m-%d" + (apply 'encode-time (butlast (org-parse-time-string s) 3)))) + +;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn) +;; (if trigger +;; (setq trigger +;; (concat +;; (format "[trigger('%s')] *%d " +;; (org-rem-ts-to-remind-date-type trigger) day-repeat) +;; (if day-advance-warn (format "++%d" day-advance-warn)))))) + +;; (format-time-string "%Y" +;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3))) + +(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn) + "Take a time string S and convert it to Remind format. +KEYWORD is added in front, to make a complete line like DTSTART.... +When INC is non-nil, increase the hour by two (if time string contains +a time), or the day by one (if it does not contain a time)." + (let ((t1 (org-parse-time-string s 'nodefault)) + t2 fmt have-time time) + (if (and (car t1) (nth 1 t1) (nth 2 t1)) + (setq t2 t1 have-time t) + (setq t2 (org-parse-time-string s))) + (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) + (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) + (when inc + (if have-time + (if org-agenda-default-appointment-duration + (setq mi (+ org-agenda-default-appointment-duration mi)) + (setq h (+ 2 h))) + (setq d (1+ d)))) + (setq time (encode-time s mi h d m y))) + (setq fmt (concat + "%d %b %Y" + (if day-advance-warn (format " ++%d" day-advance-warn)) + (if day-repeat (format " *%d" day-repeat)) + (if have-time " AT %H:%M"))) + (concat keyword (format-time-string fmt time)))) + +(defun org-rem-time-diff-days (end start) + (floor (/ (apply '- (mapcar + (lambda (s) + (let* + ((t1 (org-parse-time-string s)) + (s (car t1)) (mi (nth 1 t1)) + (h (nth 2 t1)) (d (nth 3 t1)) + (m (nth 4 t1)) (y (nth 5 t1))) + (float-time (encode-time s mi h d m y)))) + (list end start))) (* 24 60 60)))) + +(provide 'org2rem) + +;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95 + +;;; org-exp.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el b/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el new file mode 100644 index 0000000..648e44c --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/orgtbl-sqlinsert.el @@ -0,0 +1,115 @@ +;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements. + +;; Copyright (C) 2008 Free Software Foundation + +;; Author: Jason Riedy <jason@acm.org> +;; Keywords: org, tables, sql + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Converts an orgtbl to a sequence of SQL insertion commands. +;; Table cells are quoted and escaped very conservatively. + +;;; Code: + +(defun orgtbl-to-sqlinsert (table params) + "Convert the orgtbl-mode TABLE to SQL insert statements. +TABLE is a list, each entry either the symbol `hline' for a horizontal +separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the conversion. + +Names and strings are modified slightly by default. Single-ticks +are doubled as per SQL's standard mechanism. Backslashes and +dollar signs are deleted. And tildes are changed to spaces. +These modifications were chosed for use with TeX. See +ORGTBL-SQL-STRIP-AND-QUOTE. + +Supports all parameters from ORGTBL-TO-GENERIC. New to this function +are: + +:sqlname The name of the database table; defaults to the name of the + target region. + +:nowebname If not nil, used as a wrapping noweb fragment name. + +The most important parameters of ORGTBL-TO-GENERIC for SQL are: + +:splice When set to t, return only insert statements, don't wrap + them in a transaction. Default is nil. + +:tstart, :tend + The strings used to begin and commit the transaction. + +:hfmt A function that gathers the quoted header names into a + dynamically scoped variable HDRLIST. Probably should + not be changed by the user. + +The general parameters :skip and :skipcols have already been applied when +this function is called." + (let* (hdrlist + (alignment (mapconcat (lambda (x) (if x "r" "l")) + org-table-last-alignment "")) + (nowebname (plist-get params :nowebname)) + (breakvals (plist-get params :breakvals)) + (firstheader t) + (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote) + (params2 + (list + :sqlname name + :tstart (lambda () (concat (if nowebname + (format "<<%s>>= \n" nowebname) + "") + "BEGIN TRANSACTION;")) + :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " ""))) + :hfmt (lambda (f) (progn (if firstheader (push f hdrlist)) "")) + :hlfmt (lambda (lst) (setq firstheader nil)) + :lstart (lambda () (concat "INSERT INTO " + sqlname "( " + (mapconcat 'identity (reverse hdrlist) + ", ") + " )" (if breakvals "\n" " ") + "VALUES ( ")) + :lend " );" + :sep " , " + :hline nil + :remove-nil-lines t)) + (params (org-combine-plists params2 params)) + (sqlname (plist-get params :sqlname))) + (orgtbl-to-generic table params))) + +(defun orgtbl-sql-quote (str) + "Convert single ticks to doubled single ticks and wrap in single ticks." + (concat "'" (mapconcat 'identity (split-string str "'") "''") "'")) + +(defun orgtbl-sql-strip-dollars-escapes-tildes (str) + "Strip dollarsigns and backslash escapes, replace tildes with spaces." + (mapconcat 'identity + (split-string (mapconcat 'identity + (split-string str "\\$\\|\\\\") + "") + "~") + " ")) + +(defun orgtbl-sql-strip-and-quote (str) + "Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES +to sanitize STR for use in SQL statements." + (cond ((stringp str) + (orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str))) + ((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str)) + (t nil))) + +(provide 'orgtbl-sqlinsert) +;;; orgtbl-sqlinsert.el ends here diff --git a/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el b/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el new file mode 100644 index 0000000..3af8461 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/lisp/test-org-export-preproc.el @@ -0,0 +1,39 @@ +(require 'org-export-generic) + +(defun test-preproc () + (interactive) + (let ((string + (let ((region + (buffer-substring + (if (org-region-active-p) (region-beginning) (point-min)) + (if (org-region-active-p) (region-end) (point-max)))) + (opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (export-plist '("tikiwiki" :file-suffix ".txt" :key-binding 85 :header-prefix "" :header-suffix "" :title-format "-= %s =-\n" :date-export nil :toc-export nil :body-header-section-numbers nil :body-section-prefix "\n" :body-section-header-prefix + ("! " "!! " "!!! " "!!!! " "!!!!! " "!!!!!! " "!!!!!!! ") + :body-section-header-suffix + (" \n" " \n" " \n" " \n" " \n" " \n") + :body-line-export-preformated t :body-line-format "%s " :body-line-wrap nil :body-line-fixed-format " %s\n" :body-list-format "* %s\n" :body-number-list-format "# %s\n" :blockquote-start "\n^\n" :blockquote-end "^\n\n" :body-newline-paragraph "\n" :bold-format "__%s__" :italic-format "''%s''" :underline-format "===%s===" :strikethrough-format "--%s--" :code-format "-+%s+-" :verbatim-format "~pp~%s~/pp~"))) + (org-export-preprocess-string + region + :for-ascii t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get export-plist :drawers-export) + :tags (plist-get export-plist :tags-export) + :priority (plist-get export-plist :priority-export) + :footnotes (plist-get export-plist :footnotes-export) + :timestamps (plist-get export-plist :timestamps-export) + :todo-keywords (plist-get export-plist :todo-keywords-export) + :verbatim-multiline t + :select-tags (plist-get export-plist :select-tags-export) + :exclude-tags (plist-get export-plist :exclude-tags-export) + :emph-multiline t + :archived-trees + (plist-get export-plist :archived-trees-export) + :add-text (plist-get opt-plist :text))))) + (save-excursion + (switch-to-buffer "*preproc-temp*") + (point-max) + (insert string)))) + diff --git a/.emacs.d/org-7.4/contrib/scripts/.DS_Store b/.emacs.d/org-7.4/contrib/scripts/.DS_Store Binary files differnew file mode 100644 index 0000000..5008ddf --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/.DS_Store diff --git a/.emacs.d/org-7.4/contrib/scripts/.gitignore b/.emacs.d/org-7.4/contrib/scripts/.gitignore new file mode 100644 index 0000000..20d5925 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/.gitignore @@ -0,0 +1 @@ +plantuml.jar diff --git a/.emacs.d/org-7.4/contrib/scripts/StartOzServer.oz b/.emacs.d/org-7.4/contrib/scripts/StartOzServer.oz new file mode 100644 index 0000000..4d5144e --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/StartOzServer.oz @@ -0,0 +1,220 @@ +%%% ************************************************************* +%%% Copyright (C) 2009 Torsten Anders (www.torsten-anders.de) +%%% This program is free software; you can redistribute it and/or +%%% modify it under the terms of the GNU General Public License +%%% as published by the Free Software Foundation; either version 2 +%%% of the License, or (at your option) any later version. +%%% This program is distributed in the hope that it will be useful, +%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%% GNU General Public License for more details. +%%% ************************************************************* + +%% +%% This code implements the Oz-side of the Org-babel Oz interface. It +%% creates a socket server (to which org-babel-oz.el then +%% connects). Any input to this socket must be an Oz expression. The +%% input is fed to the OPI oz compiler, and the results are send back +%% via the socket. +%% + + +declare + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Accessing the OPI compiler +%% + +MyCompiler = Emacs.condSend.compiler + + +/* % testing + +%% Feed an expression (result browsed) +{MyCompiler enqueue(setSwitch(expression true))} +{Browse + {MyCompiler enqueue(feedVirtualString("1 + 2" return(result: $)))}} +{MyCompiler enqueue(setSwitch(expression false))} + +%% It is really the OPI: I can use declare! +{MyCompiler enqueue(setSwitch(expression false))} +{MyCompiler enqueue(feedVirtualString("declare X=3\n{Browse X*X}"))} + +%% Note: expressions starting with keyword declare need keyword in +{MyCompiler enqueue(setSwitch(expression true))} +{Browse + {MyCompiler enqueue(feedVirtualString("declare X=3\nin X*X" return(result: $)))}} +{MyCompiler enqueue(setSwitch(expression false))} + +%% Alternatively you use a session with multiple feeds: first declare (statement), and then feed an expression +{MyCompiler enqueue(setSwitch(expression false))} +{MyCompiler enqueue(feedVirtualString("declare X=7" return))} +{MyCompiler enqueue(setSwitch(expression true))} +{Browse + {MyCompiler enqueue(feedVirtualString("X*X" return(result: $)))}} +{MyCompiler enqueue(setSwitch(expression false))} + +%% !!?? does not work? +%% return nil in case of any error (division by 0) +{MyCompiler enqueue(setSwitch(expression true))} +{Browse + {MyCompiler enqueue(feedVirtualString( + {LUtils.accum ["try\n" +% "skip\n" % do something in any case.. + "1 div 0" % my code +% "1" % my code + "\ncatch E then {Error.printException E}\n" + "error\n" % always return nil + "end\n"] + List.append} + return(result: $)))}} +{MyCompiler enqueue(setSwitch(expression false))} + + +%% !! catching some exceptions does not work?? + +%% exception is not catched +try {Bla} catch E then {Error.printException E} {Browse nil} end + +%% exception is catched +try {Browse 1 div 0} catch E then {Error.printException E} {Browse nil} end +{Browse ok} + + +*/ + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Socket interface +%% + + +%% +%% Create socket +%% + +MyPort = 6001 + +/** %% Creates a TCP socket server. Expects a Host (e.g., 'localhost') and a PortNo and returns a server plus its corresponding client. This client is an instance of Open.socket, and is the interface for reading and writing into the socket. +%% MakeServer blocks until the server listens. However, waiting until a connection has been accepted happens in its own thread (i.e. MakeServer does only block until the server listens). +%% NB: A port can be used only once, so assign it carefully. In case this postnnumber was shortly used before, you may need to wait a bit before reusing it. +%% */ +%% !! Alternatively, let it assign automatically and output the port number.. +%% +%% NOTE: for supporting multiple connections see http://www.mozart-oz.org/documentation/op/node13.html#section.sockets.accept +proc {MakeServer Host PortNo ?MyServer ?MyClient} + proc {Accept MyClient} + thread H in % P + %% suspends until a connection has been accepted + {MyServer accept(host:H + acceptClass:Open.socket + accepted:?MyClient)} +% {Myserver accept(host:H port:P)} % suspends until a connection has been accepted + %% !!?? port number of client is usually created randomly.. + {System.showInfo "% connection accepted from host "#H} + end + %% !!??? + %% If Accept is called recursively, then server accepts multiple connections. These share the same compiler instance (e.g. variable bindings are shared). For multiple independent compiler instances call the OzServer application multiple times. + %% However, how shall the output for multiple connections be sorted?? Would using the different client sockets created with the Server accept method work? + %% NB: The number of clients accepted concurrently must be limited to the number set by {MyServer listen} + % {Accept} + end +in + MyServer = {New Open.socket init} + %% To avoid problems with portnumbers, the port could be assigned automatically and then output.. + %%{MyServer bind(port:PortNo)} + {MyServer bind(host:Host takePort:PortNo)} + {MyServer listen} + {System.showInfo "% OzServer started at host "#Host#" and port "#PortNo} + MyClient = {Accept} +end +%% +MySocket = {MakeServer localhost MyPort _/*MyServer*/} + + +%% +%% Read socket input +%% + +declare +%% Copied from OzServer/source/Socket.oz +local + proc {Aux Socket Size Stream} + In = {Socket read(list:$ + size:Size)} + in + {Wait In} + %% !! Is this the right way to stop the processing?? + %% + %% abort condition when client stream ended (i.e. nothing was sent) + if In == nil + then {System.showInfo "socket stream ended"} + Stream = nil + else Stream = In | {Aux Socket Size} + end + end +in + /** %% The socket Server returns a stream of the strings it receives. The Server always waits until someone writes something into the socket, then the input is immediately written to a stream and the Server waits again. + %% */ + proc {ReadToStream Socket Size Xs} + thread {Aux Socket Size Xs} end + end +end + +/* % test + +MyStream = {ReadToStream MySocket 1024} + +*/ + +/* % test + +%% writing +{MySocket write(vs:"this is a test")} + +*/ + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Send socket input to compiler and send results back to socket +%% + +%% NOTE: Input code must be expression +thread + {ForAll {ReadToStream MySocket 1024} + proc {$ Code} + Result + %% Catch any exception (so the will not cause blocking) and return nil in that case + FullCode = {LUtils.accum ["try\n" +% "skip\n" % do something in any case.. + Code + "\ncatch E then {Error.printException E}\n" + "error\n" % in case of an error, return 'error' + "end\n"] + List.append} + in + %% ?? Should I make setting switches etc atomic? + {MyCompiler enqueue(setSwitch(expression true))} + Result = {MyCompiler enqueue(feedVirtualString(FullCode return(result: $)))} + {MyCompiler enqueue(setSwitch(expression false))} + %% + {Wait Result} + {MySocket write(vs: if {VirtualString.is Result} + then Result + else {Value.toVirtualString Result 1000 1000} + end)} + {Show 'Org-babel result: '#Result} + end} +end + + + + + + + + + diff --git a/.emacs.d/org-7.4/contrib/scripts/dir2org.zsh b/.emacs.d/org-7.4/contrib/scripts/dir2org.zsh new file mode 100755 index 0000000..f91ff17 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/dir2org.zsh @@ -0,0 +1,56 @@ +#!/usr/bin/env zsh + +# desc: +# +# Output an org compatible structure representing the filesystem from +# the point passed on the command line (or . by default). +# +# options: +# none +# +# usage: +# dir2org.zsh [DIR]... +# +# author: +# Phil Jackson (phil@shellarchive.co.uk) + +set -e + +function headline { + local depth="${1}" + local text="${2}" + + printf "%${depth}s %s" "" | tr ' ' '*' + echo " ${text}" +} + +function scan_and_populate { + local depth="${1}" + local dir="${2}" + + headline ${depth} "${dir}" + + # if there is no files in dir then just move on + [[ $(ls "${dir}" | wc -l) -eq 0 ]] && return + + (( depth += 1 )) + + for f in $(ls -d "${dir}"/*); do + if [ -d "${f}" ]; then + scan_and_populate ${depth} "${f}" + else + headline ${depth} "[[file://${f}][${${f##*/}%.*}]]" + fi + done + + (( depth -= 1 )) +} + +function main { + local scan_dir="${1:-$(pwd)}" + local depth=0 + + scan_and_populate ${depth} "${scan_dir}" +} + +main "${@}" diff --git a/.emacs.d/org-7.4/contrib/scripts/ditaa.jar b/.emacs.d/org-7.4/contrib/scripts/ditaa.jar Binary files differnew file mode 100644 index 0000000..6f10d4e --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/ditaa.jar diff --git a/.emacs.d/org-7.4/contrib/scripts/org2hpda b/.emacs.d/org-7.4/contrib/scripts/org2hpda new file mode 100755 index 0000000..6b308f3 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/org2hpda @@ -0,0 +1,106 @@ +# org2hpda - a small utility to generate hipster pda style printouts from org mode +# Copyright (C) 2007 Christian Egli +# +# Version: 0.6 +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. +# +# Commentary: +# =========== +# +# set cal-tex-diary to true so that diary entries show up in the calendar +# +# Usage: +# ====== +# +# run this makefile with +# +# make -f org2hpda +# +# The makfile will take the entries from your diary file and generate +# two PDFs containing nicely printed weekly and monthly calendars. One +# is done in the style of a pocketMod (http://www.pocketmod.com/) and +# the other is done in the style of the Hipster PDA +# (http://en.wikipedia.org/wiki/Hipster_PDA). +# +# Requirements: +# ============= +# +# the pdf* commands are part of the pdfjam package which can be found +# at http://www.warwick.ac.uk/go/pdfjam + +EMACS = emacs -batch -l ~/.emacs +LATEX = latex +DIARY = $($(EMACS) -eval "diary-file") + +# Number of weeks to be printed. Should be a multiple of 4, because 4 +# of them are merged on one page. Can be set when invoking the script +# as follows: make NUMBER_OF_WEEKS=8 -f org2hpda +NUMBER_OF_WEEKS = 4 + +hipsterFiles = weekCalendar.pdf yearCalendar.pdf monthCalendar3.pdf monthCalendar2.pdf monthCalendar1.pdf +pocketModFiles = weekCalendar.pdf yearCalendar-rotated.pdf \ + monthCalendar3-rotated.pdf monthCalendar2-rotated.pdf monthCalendar1-rotated.pdf + +all: pocketMod.pdf hipsterPDA.pdf + +%.dvi: %.tex + # Quick hack to massage the LaTeX produced by cal-tex + # quote '@', then increase font size of week calendars, + # increase font of diary entries in moth calendar and + # finally reduce links to their destination, i.e. + # change '[[http://foo][bar]]' to 'bar' + sed -e 's/\\verb|@|/\@/g' \ + -e 's/documentclass\[11pt\]/documentclass[12pt]/g' \ + -e 's/{\\tiny \\raggedright #3}/{\\small \\raggedright #3}/g' \ + -e 's/\[\[[^]]\+\]\[\([^]]\+\)\]\]/\1/g' \ + < $< > /tmp/temp-org-file.$$$$; mv /tmp/temp-org-file.$$$$ $< + $(LATEX) $^ + +%.pdf: %.dvi + dvipdf $^ + +%-rotated.pdf: %.pdf + cp $^ $@ + for n in 1 2 3; do \ + pdf90 --outfile tmp.pdf $@; mv tmp.pdf $@; \ + done + +weekCalendar.tex: $(DIARY) + $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-week-iso $(NUMBER_OF_WEEKS)) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + +monthCalendar1.tex: $(DIARY) + $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + +monthCalendar2.tex: $(DIARY) + $(EMACS) -eval "(progn (calendar) (calendar-forward-month 1) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + +monthCalendar3.tex: $(DIARY) + $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + +yearCalendar.tex: $(DIARY) + $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2) (cal-tex-cursor-year-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + +pocketMod.pdf: $(pocketModFiles) + pdfjoin --outfile tmp.pdf $^ + pdfnup tmp.pdf --outfile $@ --nup 4x2 --frame true + +hipsterPDA.pdf: $(hipsterFiles) + pdfnup weekCalendar.pdf --outfile page1.pdf --nup 2x2 --frame true + pdfjoin --outfile tmp.pdf monthCalendar[1-3]-rotated.pdf yearCalendar-rotated.pdf + pdfnup tmp.pdf --outfile page2.pdf --nup 2x2 --frame true + pdfjoin --outfile $@ page1.pdf page2.pdf + +clean: + rm -rf *.aux *.dvi *.tex *.log *.pdf diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/.gitignore b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.org b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.org new file mode 100644 index 0000000..d28fc90 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.org @@ -0,0 +1,79 @@ +Static MathJax v0.1 README +#+AUTHOR: Jan Böcker <jan.boecker@jboecker.de> + +Static MathJax is a XULRunner application which loads a HTML input +file that uses MathJax into a browser, waits until MathJax is done +processing, and then writes the formatted result to an output HTML +file. + +I have only tested exports from Emacs Org-mode as input files. (As of +2010-08-14, MathJax is used by default with HTML exports in the +current Org development version.) + +Optionally, references to the math fonts used will be converted to +"data:" URIs, thus embedding the font data into the HTML file itself. +(see [[http://en.wikipedia.org/wiki/Data_URI_scheme]]) + +The code is licensed under the GNU General Public License version +2, or, at your option, any later version. + + +* Usage + To run Static MathJax, an existing XULRunner installation is + required. From the directory to which you unpacked Static MathJax, + run: + + xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>> + <input file> <output file> + + If you prefer to call "staticmathjax" instead of "xulrunner + application.ini", link xulrunner-stub into the directory: + ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax + + - input file :: + name of the input file (the result of a HTML export + from Org-mode). It is assumed that this file uses the + UTF-8 character encoding. + + - output file :: + name of the output file. + + - --embed-fonts :: + if specified, the math fonts will be embedded into + the output file using data: URIs + + - --final-mathjax-url <URL> :: + if --embed-fonts is not specified, this + must be the URL to a MathJax installation folder (e.g. "MathJax" + if MathJax is installed in a subdirectory, or + "http://orgmode.org/mathjax" to use the version hosted on the Org + website. + + All references to math fonts in the output file will point to + this directory. + +* Caveats + + The input file must not use a MathJax installation on the + web. Otherwise, due to a security feature of Firefox, MathJax will + fallback to image fonts. If you have unpacked MathJax to a + subdirectory "MathJax", specify the following in your Org file: + + #+MathJax: path:"MathJax" + + The math is rendered in Firefox, so MathJax applies its + Firefox-specific settings. When viewing the output files in other + browsers, it will look slightly different than the result that + running MathJax in that browser would produce. + + Internet Explorer does not use the correct font, because it only + supports the EOT font format. For all other browsers (including + Firefox), MathJax uses the OTF font format. + + Embedding fonts into the HTML file wastes some space due to the + base64 encoding used in data: URIs. + + I have found no way to access stdout or set an exit code in an + XULRunner app, so any code which calls Static MathJax has no idea if + processing was successful and when an error occurs, graphical + message boxes are displayed. diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.txt b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.txt new file mode 100644 index 0000000..cbcaea1 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/README.txt @@ -0,0 +1,91 @@ + Static MathJax v0.1 README + ========================== + +Author: Jan Böcker <jan.boecker@jboecker.de> +Date: 2010-08-15 13:53:39 CEST + + +Static MathJax is a XULRunner application which loads a HTML input +file that uses MathJax into a browser, waits until MathJax is done +processing, and then writes the formatted result to an output HTML +file. + +I have only tested exports from Emacs Org-mode as input files. (As of +2010-08-14, MathJax is used by default with HTML exports in the +current Org development version.) + +Optionally, references to the math fonts used will be converted to +"data:" URIs, thus embedding the font data into the HTML file itself. +(see [http://en.wikipedia.org/wiki/Data_URI_scheme]) + +The code is licensed under the GNU General Public License version +2, or, at your option, any later version. + + +Table of Contents +================= +1 Usage +2 Caveats + + +1 Usage +~~~~~~~~ + To run Static MathJax, an existing XULRunner installation is + required. From the directory to which you unpacked Static MathJax, + run: + + xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>> + <input file> <output file> + + If you prefer to call "staticmathjax" instead of "xulrunner + application.ini", link xulrunner-stub into the directory: + ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax + + input file: + name of the input file (the result of a HTML export + from Org-mode). It is assumed that this file uses the + UTF-8 character encoding. + + output file: + name of the output file. + + --embed-fonts: + if specified, the math fonts will be embedded into + the output file using data: URIs + + --final-mathjax-url <URL>: + if --embed-fonts is not specified, this + must be the URL to a MathJax installation folder (e.g. "MathJax" + if MathJax is installed in a subdirectory, or + "[http://orgmode.org/mathjax]" to use the version hosted on the Org + website. + + All references to math fonts in the output file will point to + this directory. + +2 Caveats +~~~~~~~~~~ + + The input file must not use a MathJax installation on the + web. Otherwise, due to a security feature of Firefox, MathJax will + fallback to image fonts. If you have unpacked MathJax to a + subdirectory "MathJax", specify the following in your Org file: + + #+MathJax: path:"MathJax" + + The math is rendered in Firefox, so MathJax applies its + Firefox-specific settings. When viewing the output files in other + browsers, it will look slightly different than the result that + running MathJax in that browser would produce. + + Internet Explorer does not use the correct font, because it only + supports the EOT font format. For all other browsers (including + Firefox), MathJax uses the OTF font format. + + Embedding fonts into the HTML file wastes some space due to the + base64 encoding used in data: URIs. + + I have found no way to access stdout or set an exit code in an + XULRunner app, so any code which calls Static MathJax has no idea if + processing was successful and when an error occurs, graphical + message boxes are displayed. diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/application.ini b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/application.ini new file mode 100644 index 0000000..d7957b0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/application.ini @@ -0,0 +1,11 @@ +[App] +Vendor=Jan Boecker +Name=StaticMathJax +Version=0.2 +BuildID=2 +Copyright=Copyright (c) 2010 Jan Boecker +ID=xulapp@jboecker.de + +[Gecko] +MinVersion=1.8 + diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/chrome.manifest b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/chrome.manifest new file mode 100644 index 0000000..a05d8c8 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/chrome.manifest @@ -0,0 +1 @@ +content staticmathjax file:content/ diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.js b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.js new file mode 100644 index 0000000..2e71f3b --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.js @@ -0,0 +1,198 @@ +var docFrame; +var logtextbox; +var destFile; +var embedFonts = false; +var finalMathJaxURL = null; + +function log(text) +{ + logtextbox.setAttribute("value", logtextbox.getAttribute("value") + "\n" + text); +} + +function init() +{ + try { + docFrame = document.getElementById("docFrame"); + logtextbox = document.getElementById("logtextbox"); + + // parse command line arguments + var cmdLine = window.arguments[0]; + cmdLine = cmdLine.QueryInterface(Components.interfaces.nsICommandLine); + + embedFonts = cmdLine.handleFlag("embed-fonts", false); + finalMathJaxURL = cmdLine.handleFlagWithParam("final-mathjax-url", false); + + if (!embedFonts && !finalMathJaxURL) { + alert("You must eiher specify --embed-fonts or --final-mathjax-url"); + window.close(); + return; + } + + sourceFilePath = cmdLine.getArgument(0); + destFilePath = cmdLine.getArgument(1); + if ( !sourceFilePath || !destFilePath ) { + alert("Not enough parameters, expecting two arguments:\nInput file, output file"); + window.close(); + return; + } + + sourceFile = cmdLine.resolveFile(sourceFilePath); + if (! (sourceFile.exists() && sourceFile.isFile()) ) { + alert("Invalid source file path."); + window.close(); + return; + } + sourceURI = cmdLine.resolveURI(sourceFilePath); + + // create a nsIFile object for the output file + try{ + destFile = cmdLine.resolveURI(destFilePath).QueryInterface(Components.interfaces.nsIFileURL).file; + }catch(e){ + alert("Invalid destination file.\n\nException:\n" + e); + window.close(); + return; + } + + // add iframeLoaded() as an onload event handler, then navigate to the source file + docFrame.addEventListener("DOMContentLoaded", iframeLoaded, true); + docFrame.setAttribute("src", sourceURI.spec); + + } catch (e) { + alert("Error in init():\n\n" + e); + window.close(); + return; + } +} + +function iframeLoaded() +{ + /* + // print every MathJax signal to the log + docFrame.contentWindow.MathJax.Hub.Startup.signal.Interest( + function (message) {log("Startup: "+message)} + ); + docFrame.contentWindow.MathJax.Hub.signal.Interest( + function (message) {log("Hub: "+message)} + ); + */ + + // tell MathJax to call serialize() when finished + docFrame.contentWindow.MathJax.Hub.Register.StartupHook("End", function() {serialize();}); +} + +function fileURLtoDataURI(url) +{ + var ios = Components.classes["@mozilla.org/network/io-service;1"] + .getService(Components.interfaces.nsIIOService); + var url_object = ios.newURI(url, "", null); + var file = url_object.QueryInterface(Components.interfaces.nsIFileURL).file; + + var data = ""; + var fstream = Components.classes["@mozilla.org/network/file-input-stream;1"]. + createInstance(Components.interfaces.nsIFileInputStream); + fstream.init(file, -1, -1, false); + var bstream = Components.classes["@mozilla.org/binaryinputstream;1"]. + createInstance(Components.interfaces.nsIBinaryInputStream); + bstream.setInputStream(fstream); + + var bytes = bstream.readBytes(bstream.available()); + b64bytes = btoa(bytes); + + return "data:;base64," + b64bytes; + +} + +function serialize() +{ + var MathJaxURL = docFrame.contentWindow.MathJax.Hub.config.root; + + var searchURIList = new Array(); + var replacementURIList = new Array(); + + log("serialize: preprocessing"); + + // remove the MathJax status message window + msgdiv = docFrame.contentDocument.getElementById("MathJax_Message"); + msgdiv.parentNode.removeChild(msgdiv); + + /* Loop through all CSS rules to find all @font-face rules. + At this point, they refer to local absolute paths using file:// URLs. + Replace them either with appropriate URLs relative to finalMathJaxURL + or with data URIs. */ + + for (var i = 0; i<docFrame.contentDocument.styleSheets.length; i++) { + var stylesheet = docFrame.contentDocument.styleSheets[i]; + + for (var j=0; j< stylesheet.cssRules.length; j++) { + var rule = stylesheet.cssRules[j]; + if (rule.cssText.match("font-face")) { + + url = rule.style.getPropertyValue("src"); + url = url.match(/url\(\"(.+)\"\)/)[1]; + + // Since the properties seem read-only here, we populate + // searchURIList and replacementURIList to do text substitution + // after serialization + searchURIList.push(url); + if (embedFonts) { + replacementURIList.push(fileURLtoDataURI(url)); + } else { + replacementURIList.push(url.replace(MathJaxURL, finalMathJaxURL)); + } + } + } + } + + + // find and remove the MathJax <script> tag + try{ + var scriptTags = docFrame.contentDocument.getElementsByTagName("script"); + for (var i=0; i<scriptTags.length; i++) { + if (scriptTags[i].getAttribute("src") && scriptTags[i].getAttribute("src").match(/MathJax.js/i)) + scriptTags[i].parentNode.removeChild(scriptTags[i]); + } + }catch(e){alert(e);} + + log("serialize: serializing"); + + var serializer = new XMLSerializer(); + var xhtml = serializer.serializeToString(docFrame.contentDocument); + + log("serialize: postprocessing"); + // make the MathJax URL relative again + // xhtml = xhtml.replace(findMathJaxURL, "MathJax"); + + try{ + r1 = RegExp("<!--/\\*--><!\\[CDATA\\[/\\*><!--\\*/", "g"); + xhtml = xhtml.replace(r1, ""); + r2 = RegExp("/\\*\\]\\]>\\*/-->", "g"); + xhtml = xhtml.replace(r2, ""); + r3 = RegExp("/\\*\\]\\]>\\*///-->", "g"); + xhtml = xhtml.replace(r3, ""); + }catch(e){alert(e);} + for (var i=0; i<searchURIList.length; i++) + xhtml = xhtml.replace(searchURIList[i], replacementURIList[i]); + + save(xhtml); + window.close(); +} + +function save(xhtml) +{ + try { + var foStream = Components.classes["@mozilla.org/network/file-output-stream;1"]. + createInstance(Components.interfaces.nsIFileOutputStream); + + foStream.init(destFile, 0x02 | 0x08 | 0x20, 0666, 0); + // write, create, truncate + + // write in UTF-8 encoding + var converter = Components.classes["@mozilla.org/intl/converter-output-stream;1"]. + createInstance(Components.interfaces.nsIConverterOutputStream); + converter.init(foStream, "UTF-8", 0, 0); + converter.writeString(xhtml); + converter.close(); // this closes foStream + } catch (e) { + alert("Error in save():\n\n" + e); + } +} diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.xul b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.xul new file mode 100644 index 0000000..35a00f2 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/chrome/content/main.xul @@ -0,0 +1,11 @@ +<?xml version="1.0"?> +<?xml-stylesheet href="chrome://global/skin/" type="text/css"?> + +<window onload="init();" id="main" title="Static MathJax" width="300" height="300" +xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"> + +<script language="JavaScript" src="chrome://staticmathjax/content/main.js"/> + + <browser flex="1" id="docFrame" src="" style="background-color:white;"/> + <textbox flex="1" id="logtextbox" multiline="true" style="display:none;"/> +</window> diff --git a/.emacs.d/org-7.4/contrib/scripts/staticmathjax/defaults/preferences/prefs.js b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/defaults/preferences/prefs.js new file mode 100644 index 0000000..0532ce0 --- /dev/null +++ b/.emacs.d/org-7.4/contrib/scripts/staticmathjax/defaults/preferences/prefs.js @@ -0,0 +1 @@ +pref("toolkit.defaultChromeURI", "chrome://staticmathjax/content/main.xul"); |