summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--Makefile1
-rw-r--r--README_contribute8
-rw-r--r--README_maintainer1
-rw-r--r--contrib/README5
-rw-r--r--contrib/lisp/ob-eukleides.el4
-rw-r--r--contrib/lisp/ob-fomus.el2
-rw-r--r--contrib/lisp/ob-julia.el13
-rw-r--r--contrib/lisp/ob-mathematica.el79
-rw-r--r--contrib/lisp/ob-mathomatic.el64
-rw-r--r--contrib/lisp/ob-oz.el4
-rw-r--r--contrib/lisp/ob-stata.el312
-rw-r--r--contrib/lisp/ob-tcl.el8
-rw-r--r--contrib/lisp/org-annotate-file.el26
-rw-r--r--contrib/lisp/org-bibtex-extras.el24
-rw-r--r--contrib/lisp/org-bookmark.el2
-rw-r--r--contrib/lisp/org-collector.el2
-rw-r--r--contrib/lisp/org-colview-xemacs.el147
-rw-r--r--contrib/lisp/org-contacts.el467
-rw-r--r--contrib/lisp/org-contribdir.el2
-rw-r--r--contrib/lisp/org-depend.el2
-rw-r--r--contrib/lisp/org-download.el84
-rw-r--r--contrib/lisp/org-drill.el383
-rw-r--r--contrib/lisp/org-effectiveness.el157
-rw-r--r--contrib/lisp/org-eldoc.el173
-rw-r--r--contrib/lisp/org-elisp-symbol.el2
-rw-r--r--contrib/lisp/org-eval-light.el2
-rw-r--r--contrib/lisp/org-eval.el2
-rw-r--r--contrib/lisp/org-eww.el171
-rw-r--r--contrib/lisp/org-expiry.el7
-rw-r--r--contrib/lisp/org-git-link.el27
-rw-r--r--contrib/lisp/org-index.el4183
-rw-r--r--contrib/lisp/org-interactive-query.el4
-rw-r--r--contrib/lisp/org-jira.el64
-rw-r--r--contrib/lisp/org-learn.el2
-rw-r--r--contrib/lisp/org-license.el43
-rw-r--r--contrib/lisp/org-link-edit.el327
-rw-r--r--contrib/lisp/org-mac-link.el796
-rw-r--r--contrib/lisp/org-mew.el17
-rw-r--r--contrib/lisp/org-mime.el142
-rw-r--r--contrib/lisp/org-mtags.el255
-rw-r--r--contrib/lisp/org-notify.el6
-rw-r--r--contrib/lisp/org-notmuch.el43
-rw-r--r--contrib/lisp/org-passwords.el384
-rw-r--r--contrib/lisp/org-screenshot.el13
-rw-r--r--contrib/lisp/org-sudoku.el2
-rw-r--r--contrib/lisp/org-toc.el10
-rw-r--r--contrib/lisp/org-track.el3
-rw-r--r--contrib/lisp/org-velocity.el602
-rw-r--r--contrib/lisp/org-vm.el13
-rw-r--r--contrib/lisp/org-wikinodes.el11
-rw-r--r--contrib/lisp/org-wl.el12
-rw-r--r--contrib/lisp/orgtbl-sqlinsert.el2
-rw-r--r--contrib/lisp/ox-bibtex.el88
-rw-r--r--contrib/lisp/ox-confluence.el15
-rw-r--r--contrib/lisp/ox-deck.el17
-rw-r--r--contrib/lisp/ox-extra.el190
-rw-r--r--contrib/lisp/ox-freemind.el5
-rw-r--r--contrib/lisp/ox-gfm.el192
-rw-r--r--contrib/lisp/ox-groff.el48
-rw-r--r--contrib/lisp/ox-koma-letter.el439
-rw-r--r--contrib/lisp/ox-rss.el81
-rw-r--r--contrib/lisp/ox-s5.el10
-rw-r--r--contrib/lisp/ox-taskjuggler.el63
-rw-r--r--contrib/scripts/org-docco.org2
-rw-r--r--doc/docstyle.texi10
-rw-r--r--doc/htmlxref.cnf2
-rw-r--r--doc/org.texi2878
-rw-r--r--doc/orgcard.tex2
-rw-r--r--doc/orgguide.texi125
-rw-r--r--doc/texinfo.tex3161
-rw-r--r--etc/ORG-NEWS1008
-rw-r--r--etc/styles/OrgOdtStyles.xml20
-rw-r--r--lisp/ob-C.el382
-rw-r--r--lisp/ob-J.el15
-rw-r--r--lisp/ob-R.el214
-rw-r--r--lisp/ob-abc.el18
-rw-r--r--lisp/ob-asymptote.el40
-rw-r--r--lisp/ob-awk.el29
-rw-r--r--lisp/ob-calc.el12
-rw-r--r--lisp/ob-clojure.el70
-rw-r--r--lisp/ob-comint.el28
-rw-r--r--lisp/ob-coq.el13
-rw-r--r--lisp/ob-core.el2098
-rw-r--r--lisp/ob-css.el8
-rw-r--r--lisp/ob-ditaa.el32
-rw-r--r--lisp/ob-dot.el17
-rw-r--r--lisp/ob-ebnf.el6
-rw-r--r--lisp/ob-emacs-lisp.el39
-rw-r--r--lisp/ob-eval.el11
-rw-r--r--lisp/ob-exp.el397
-rw-r--r--lisp/ob-forth.el86
-rw-r--r--lisp/ob-fortran.el45
-rw-r--r--lisp/ob-gnuplot.el41
-rw-r--r--lisp/ob-groovy.el33
-rw-r--r--lisp/ob-haskell.el22
-rw-r--r--lisp/ob-io.el23
-rw-r--r--lisp/ob-java.el36
-rw-r--r--lisp/ob-js.el15
-rw-r--r--lisp/ob-keys.el5
-rw-r--r--lisp/ob-latex.el111
-rw-r--r--lisp/ob-ledger.el9
-rw-r--r--lisp/ob-lilypond.el350
-rw-r--r--lisp/ob-lisp.el63
-rw-r--r--lisp/ob-lob.el104
-rw-r--r--lisp/ob-makefile.el10
-rw-r--r--lisp/ob-matlab.el4
-rw-r--r--lisp/ob-maxima.el17
-rw-r--r--lisp/ob-mscgen.el6
-rw-r--r--lisp/ob-ocaml.el59
-rw-r--r--lisp/ob-octave.el31
-rw-r--r--lisp/ob-org.el8
-rw-r--r--lisp/ob-perl.el16
-rw-r--r--lisp/ob-picolisp.el11
-rw-r--r--lisp/ob-plantuml.el25
-rw-r--r--lisp/ob-processing.el196
-rw-r--r--lisp/ob-python.el30
-rw-r--r--lisp/ob-ref.el195
-rw-r--r--lisp/ob-ruby.el61
-rw-r--r--lisp/ob-sass.el9
-rw-r--r--lisp/ob-scala.el23
-rw-r--r--lisp/ob-scheme.el31
-rw-r--r--lisp/ob-screen.el18
-rw-r--r--lisp/ob-sed.el107
-rw-r--r--lisp/ob-shell.el110
-rw-r--r--lisp/ob-shen.el11
-rw-r--r--lisp/ob-sql.el149
-rw-r--r--lisp/ob-sqlite.el13
-rw-r--r--lisp/ob-stan.el84
-rw-r--r--lisp/ob-table.el38
-rw-r--r--lisp/ob-tangle.el202
-rw-r--r--lisp/ob.el4
-rw-r--r--lisp/org-agenda.el2362
-rw-r--r--lisp/org-archive.el389
-rw-r--r--lisp/org-attach.el128
-rw-r--r--lisp/org-bbdb.el78
-rw-r--r--lisp/org-bibtex.el124
-rw-r--r--lisp/org-capture.el684
-rw-r--r--lisp/org-clock.el966
-rw-r--r--lisp/org-colview.el2180
-rw-r--r--lisp/org-compat.el90
-rw-r--r--lisp/org-crypt.el137
-rw-r--r--lisp/org-ctags.el44
-rw-r--r--lisp/org-datetree.el278
-rw-r--r--lisp/org-docview.el13
-rw-r--r--lisp/org-element.el3554
-rw-r--r--lisp/org-entities.el941
-rw-r--r--lisp/org-eshell.el2
-rw-r--r--lisp/org-faces.el113
-rw-r--r--lisp/org-feed.el152
-rw-r--r--lisp/org-footnote.el1172
-rw-r--r--lisp/org-gnus.el37
-rw-r--r--lisp/org-habit.el127
-rw-r--r--lisp/org-id.el9
-rw-r--r--lisp/org-indent.el237
-rw-r--r--lisp/org-info.el65
-rw-r--r--lisp/org-inlinetask.el36
-rw-r--r--lisp/org-irc.el6
-rw-r--r--lisp/org-lint.el1208
-rw-r--r--lisp/org-list.el1231
-rw-r--r--lisp/org-macro.el225
-rw-r--r--lisp/org-macs.el89
-rw-r--r--lisp/org-mhe.el12
-rw-r--r--lisp/org-mobile.el27
-rw-r--r--lisp/org-mouse.el44
-rw-r--r--lisp/org-pcomplete.el65
-rw-r--r--lisp/org-plot.el157
-rw-r--r--lisp/org-protocol.el295
-rw-r--r--lisp/org-rmail.el15
-rw-r--r--lisp/org-src.el1446
-rw-r--r--lisp/org-table.el4273
-rw-r--r--lisp/org-timer.el296
-rw-r--r--lisp/org-w3m.el2
-rw-r--r--lisp/org.el13840
-rw-r--r--lisp/ox-ascii.el1006
-rw-r--r--lisp/ox-beamer.el322
-rw-r--r--lisp/ox-html.el1727
-rw-r--r--lisp/ox-icalendar.el446
-rw-r--r--lisp/ox-latex.el2187
-rw-r--r--lisp/ox-man.el361
-rw-r--r--lisp/ox-md.el215
-rw-r--r--lisp/ox-odt.el1444
-rw-r--r--lisp/ox-org.el126
-rw-r--r--lisp/ox-publish.el456
-rw-r--r--lisp/ox-texinfo.el1750
-rw-r--r--lisp/ox.el3899
-rw-r--r--mk/default.mk4
-rwxr-xr-xmk/guidesplit.pl32
-rwxr-xr-xmk/mansplit.pl44
-rw-r--r--mk/org-fixup.el16
-rw-r--r--mk/server.mk6
-rw-r--r--mk/targets.mk20
-rw-r--r--testing/README30
-rw-r--r--testing/examples/babel.org80
-rw-r--r--testing/examples/include.html1
-rw-r--r--testing/examples/include.org25
-rw-r--r--testing/examples/ob-C-test.org88
-rw-r--r--testing/examples/ob-awk-test.org7
-rw-r--r--testing/examples/ob-fortran-test.org2
-rw-r--r--testing/examples/ob-maxima-test.org6
-rw-r--r--testing/examples/ob-sed-test.org35
-rw-r--r--testing/examples/ob-shell-test.org88
-rw-r--r--testing/examples/setupfile.org6
-rw-r--r--testing/examples/setupfile3.org6
-rw-r--r--testing/examples/subdir/setupfile2.org1
-rw-r--r--testing/lisp/test-ob-C.el161
-rw-r--r--testing/lisp/test-ob-R.el20
-rw-r--r--testing/lisp/test-ob-awk.el9
-rw-r--r--testing/lisp/test-ob-emacs-lisp.el10
-rw-r--r--testing/lisp/test-ob-exp.el286
-rw-r--r--testing/lisp/test-ob-lilypond.el372
-rw-r--r--testing/lisp/test-ob-lob.el108
-rw-r--r--testing/lisp/test-ob-python.el4
-rw-r--r--testing/lisp/test-ob-ruby.el39
-rw-r--r--testing/lisp/test-ob-sed.el60
-rw-r--r--testing/lisp/test-ob-shell.el39
-rw-r--r--testing/lisp/test-ob-tangle.el149
-rw-r--r--testing/lisp/test-ob.el854
-rw-r--r--testing/lisp/test-org-attach-annex.el96
-rw-r--r--testing/lisp/test-org-capture.el101
-rw-r--r--testing/lisp/test-org-clock.el115
-rw-r--r--testing/lisp/test-org-colview.el1358
-rw-r--r--testing/lisp/test-org-datetree.el209
-rw-r--r--testing/lisp/test-org-element.el1187
-rw-r--r--testing/lisp/test-org-feed.el112
-rw-r--r--testing/lisp/test-org-footnote.el646
-rw-r--r--testing/lisp/test-org-inlinetask.el67
-rw-r--r--testing/lisp/test-org-list.el412
-rw-r--r--testing/lisp/test-org-macro.el69
-rw-r--r--testing/lisp/test-org-pcomplete.el58
-rw-r--r--testing/lisp/test-org-protocol.el191
-rw-r--r--testing/lisp/test-org-src.el89
-rw-r--r--testing/lisp/test-org-table.el809
-rw-r--r--testing/lisp/test-org-timer.el283
-rw-r--r--testing/lisp/test-org.el3476
-rw-r--r--testing/lisp/test-ox.el1901
-rw-r--r--testing/org-test.el21
237 files changed, 54965 insertions, 33243 deletions
diff --git a/.gitignore b/.gitignore
index a9d73ad..70980ce 100644
--- a/.gitignore
+++ b/.gitignore
@@ -43,6 +43,7 @@ ORGWEBPAGE/Changes.txt
local*.mk
.gitattributes
mk/x11idle
+ChangeLog
# texi2pdf --tidy
diff --git a/Makefile b/Makefile
index ce06116..f6312f2 100644
--- a/Makefile
+++ b/Makefile
@@ -17,7 +17,6 @@ help helpall::
$(info )
$(info Getting Help)
$(info ============)
- $(info )
$(info make help - show brief help)
$(info make targets - ditto)
$(info make helpall - show extended help)
diff --git a/README_contribute b/README_contribute
index 3e1ef6d..2dc62e6 100644
--- a/README_contribute
+++ b/README_contribute
@@ -58,10 +58,10 @@ development.
new mechanism to make sure all changes end up in the right
place.
- - Creating and pushing a change to the Org-mode core requires
- you also to provide ChangeLog entries. Just press `C-x 4 a'
- in each function or variable you have modified and describe
- the change you made in the ChangeLog buffer/file.
+ - Org mode no longer uses ChangeLog entries to document
+ changes. Instead, special commit messages are used, as
+ described in the `CONTRIBUTE' file in the main Emacs
+ repository.
- Among other things, Org-mode is widely appreciated because
of its simplicity, cleanness and consistency. We should try
diff --git a/README_maintainer b/README_maintainer
index 04dc2c0..6b162aa 100644
--- a/README_maintainer
+++ b/README_maintainer
@@ -2,6 +2,7 @@
#+TITLE: Org maintainer tasks
#+STARTUP: noindent
+#+OPTIONS: ^:nil
This document describes the tasks the Org-mode maintainer has to do
and how they are performed.
diff --git a/contrib/README b/contrib/README
index 2a67b65..fdbcef0 100644
--- a/contrib/README
+++ b/contrib/README
@@ -26,18 +26,20 @@ org-depend.el --- TODO dependencies for Org-mode
org-drill.el --- Self-testing with org-learn
org-effectiveness.el --- Measuring your personal effectiveness
org-element.el --- Parser and applications for Org syntax
+org-eldoc.el --- Eldoc documentation for SRC blocks
org-elisp-symbol.el --- Org links to emacs-lisp symbols
org-eval-light.el --- Evaluate in-buffer code on demand
org-eval.el --- The <lisp> tag, adapted from Muse
+org-eww.el --- Support link/copy/paste from eww to Org-mode
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-index.el --- A personal index for org and beyond
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-license.el --- Insert free licenses to your org documents
+org-link-edit.el --- Slurp and barf with Org links
org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
org-mac-link.el --- Grab links and URLs from various Mac applications
org-mairix.el --- Hook mairix search into Org for different MUAs
@@ -80,6 +82,7 @@ ob-fomus.el --- Org-babel functions for fomus evaluation
ob-julia.el --- Org-babel functions for julia evaluation
ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
ob-oz.el --- Org-babel functions for Oz evaluation
+ob-stata.el --- Org-babel functions for Stata evaluation
ob-tcl.el --- Org-babel functions for tcl evaluation
External libraries
diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el
index c8ce881..67f3bf4 100644
--- a/contrib/lisp/ob-eukleides.el
+++ b/contrib/lisp/ob-eukleides.el
@@ -1,6 +1,6 @@
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
-;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;; Author: Luis Anaya
;; Keywords: literate programming, reproducible research
@@ -81,7 +81,7 @@ This function is called by `org-babel-execute-src-block'."
(shell-command (format org-eukleides-eps-to-raster
(concat (file-name-sans-extension out-file) ".eps")
(concat (file-name-sans-extension out-file) ".png")))
- (error "Conversion to PNG not supported. use a file with an EPS name")))
+ (error "Conversion to PNG not supported. Use a file with an EPS name")))
(with-temp-file in-file (insert body))
(message "%s" cmd) (org-babel-eval cmd "")
diff --git a/contrib/lisp/ob-fomus.el b/contrib/lisp/ob-fomus.el
index 1db32e4..7a3280e 100644
--- a/contrib/lisp/ob-fomus.el
+++ b/contrib/lisp/ob-fomus.el
@@ -48,7 +48,7 @@
(defun org-babel-expand-body:fomus (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
diff --git a/contrib/lisp/ob-julia.el b/contrib/lisp/ob-julia.el
index 4d8deb2..99fae27 100644
--- a/contrib/lisp/ob-julia.el
+++ b/contrib/lisp/ob-julia.el
@@ -30,7 +30,7 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(declare-function orgtbl-to-csv "org-table" (table params))
(declare-function julia "ext:ess-julia" (&optional start-args))
@@ -38,7 +38,6 @@
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-remove-if-not "org" (predicate seq))
(defconst org-babel-header-args:julia
'((width . :any)
@@ -125,7 +124,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-variable-assignments:julia (params)
"Return list of julia statements assigning the block's variables."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapcar
(lambda (pair)
(org-babel-julia-assign-elisp
@@ -150,9 +149,9 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-julia-assign-elisp (name value colnames-p rownames-p)
"Construct julia code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let ((max (apply #'max (mapcar #'length (org-remove-if-not
+ (let ((max (apply #'max (mapcar #'length (cl-remove-if-not
#'sequencep value))))
- (min (apply #'min (mapcar #'length (org-remove-if-not
+ (min (apply #'min (mapcar #'length (cl-remove-if-not
#'sequencep value))))
(transition-file (org-babel-temp-file "julia-import-")))
;; ensure VALUE has an orgtbl structure (depth of at least 2)
@@ -229,7 +228,7 @@ current code buffer."
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
- (case result-type
+ (cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "julia-")))
(org-babel-eval org-babel-julia-command
@@ -251,7 +250,7 @@ last statement in BODY, as elisp."
If RESULT-TYPE equals 'output then return standard output as a
string. If RESULT-TYPE equals 'value then return the value of the
last statement in BODY, as elisp."
- (case result-type
+ (cl-case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
diff --git a/contrib/lisp/ob-mathematica.el b/contrib/lisp/ob-mathematica.el
new file mode 100644
index 0000000..36331b2
--- a/dev/null
+++ b/contrib/lisp/ob-mathematica.el
@@ -0,0 +1,79 @@
+;;; ob-mathematica.el --- org-babel functions for Mathematica evaluation
+
+;; Copyright (C) 2014 Yi Wang
+
+;; Authors: Yi Wang
+;; Keywords: literate programming, reproducible research
+;; Homepage: https://github.com/tririver/wy-els/blob/master/ob-mathematica.el
+;; Distributed under the GNU GPL v2 or later
+
+;; Org-Babel support for evaluating Mathematica source code.
+
+;;; Code:
+(require 'ob)
+(require 'ob-ref)
+(require 'ob-comint)
+(require 'ob-eval)
+;; Optionally require mma.el for font lock, etc
+(require 'mma nil 'noerror)
+(add-to-list 'org-src-lang-modes '("mathematica" . "mma"))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("mathematica" . "m"))
+
+(defvar org-babel-default-header-args:mathematica '())
+
+(defvar org-babel-mathematica-command "MathematicaScript -script"
+ "Name of the command for executing Mathematica code.")
+
+(defvar org-babel-mathematica-command-alt "math -noprompt"
+ "Name of the command for executing Mathematica code.")
+
+(defun org-babel-expand-body:mathematica (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (org-babel--get-vars params)))
+ (concat
+ (mapconcat ;; define any variables
+ (lambda (pair)
+ (format "%s=%s;"
+ (car pair)
+ (org-babel-mathematica-var-to-mathematica (cdr pair))))
+ vars "\n") "\nPrint[\n" body "\n]\n")))
+
+(defun org-babel-execute:mathematica (body params)
+ "Execute a block of Mathematica code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (full-body (org-babel-expand-body:mathematica body params))
+ (tmp-script-file (org-babel-temp-file "mathematica-"))
+ (cmd org-babel-mathematica-command))
+ ;; actually execute the source-code block
+ (with-temp-file tmp-script-file (insert full-body))
+ ;; (with-temp-file "/tmp/dbg" (insert full-body))
+ ((lambda (raw)
+ (if (or (member "code" result-params)
+ (member "pp" result-params)
+ (and (member "output" result-params)
+ (not (member "table" result-params))))
+ raw
+ (org-babel-script-escape (org-babel-trim raw))))
+ (org-babel-eval (concat cmd " " tmp-script-file) ""))))
+
+(defun org-babel-prep-session:mathematica (session params)
+ "This function does nothing so far"
+ (error "Currently no support for sessions"))
+
+(defun org-babel-prep-session:mathematica (session body params)
+ "This function does nothing so far"
+ (error "Currently no support for sessions"))
+
+(defun org-babel-mathematica-var-to-mathematica (var)
+ "Convert an elisp value to a Mathematica variable.
+Convert an elisp value, VAR, into a string of Mathematica source code
+specifying a variable of the same value."
+ (if (listp var)
+ (concat "{" (mapconcat #'org-babel-mathematica-var-to-mathematica var ", ") "}")
+ (format "%S" var)))
+
+(provide 'ob-mathematica)
+
diff --git a/contrib/lisp/ob-mathomatic.el b/contrib/lisp/ob-mathomatic.el
index bfd8ecf..e6ea796 100644
--- a/contrib/lisp/ob-mathomatic.el
+++ b/contrib/lisp/ob-mathomatic.el
@@ -1,6 +1,6 @@
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Author: Eric S Fraga
;; Eric Schulte
@@ -49,37 +49,37 @@
(defun org-babel-mathomatic-expand (body params)
"Expand a block of Mathomatic code according to its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (mapconcat 'identity
- (list
- ;; graphic output
- (let ((graphic-file (org-babel-mathomatic-graphical-output-file params)))
- (if graphic-file
- (cond
- ((string-match ".\.eps$" graphic-file)
- (format ;; Need to add command to send to file.
- "set plot set terminal postscript eps\\;set output %S "
- graphic-file))
- ((string-match ".\.ps$" graphic-file)
- (format ;; Need to add command to send to file.
- "set plot set terminal postscript\\;set output %S "
- graphic-file))
-
- ((string-match ".\.pic$" graphic-file)
- (format ;; Need to add command to send to file.
- "set plot set terminal gpic\\;set output %S "
- graphic-file))
- (t
- (format ;; Need to add command to send to file.
- "set plot set terminal png\\;set output %S "
- graphic-file)))
- ""))
- ;; variables
- (mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n")
- ;; body
- body
- "")
- "\n")))
+ (let ((vars (org-babel--get-vars params)))
+ (mapconcat 'identity
+ (list
+ ;; graphic output
+ (let ((graphic-file (org-babel-mathomatic-graphical-output-file params)))
+ (if graphic-file
+ (cond
+ ((string-match ".\.eps$" graphic-file)
+ (format ;; Need to add command to send to file.
+ "set plot set terminal postscript eps\\;set output %S "
+ graphic-file))
+ ((string-match ".\.ps$" graphic-file)
+ (format ;; Need to add command to send to file.
+ "set plot set terminal postscript\\;set output %S "
+ graphic-file))
+
+ ((string-match ".\.pic$" graphic-file)
+ (format ;; Need to add command to send to file.
+ "set plot set terminal gpic\\;set output %S "
+ graphic-file))
+ (t
+ (format ;; Need to add command to send to file.
+ "set plot set terminal png\\;set output %S "
+ graphic-file)))
+ ""))
+ ;; variables
+ (mapconcat 'org-babel-mathomatic-var-to-mathomatic vars "\n")
+ ;; body
+ body
+ "")
+ "\n")))
(defun org-babel-execute:mathomatic (body params)
"Execute a block of Mathomatic entries with org-babel. This function is
diff --git a/contrib/lisp/ob-oz.el b/contrib/lisp/ob-oz.el
index 3531d95..50a5762 100644
--- a/contrib/lisp/ob-oz.el
+++ b/contrib/lisp/ob-oz.el
@@ -197,7 +197,7 @@ StartOzServer.oz is located.")
result))
(defun org-babel-expand-body:oz (body params)
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if vars
;; prepend code to define all arguments passed to the code block
(let ((var-string (mapcar (lambda (pair)
@@ -226,7 +226,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
((member "value" result-params)
(message "Org-babel: executing Oz expression")
(oz-send-string-expression full-body (or wait-time 1)))
- (t (error "either 'output' or 'results' must be members of :results.")))
+ (t (error "either 'output' or 'results' must be members of :results")))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :roname-names params))
diff --git a/contrib/lisp/ob-stata.el b/contrib/lisp/ob-stata.el
new file mode 100644
index 0000000..03f34f4
--- a/dev/null
+++ b/contrib/lisp/ob-stata.el
@@ -0,0 +1,312 @@
+;;; ob-stata.el --- org-babel functions for stata code evaluation
+
+;; Copyright (C) 2014 Ista Zahn
+;; Author: Ista Zahn istazahn@gmail.com
+;; G. Jay Kerns
+;; Eric Schulte
+;; Dan Davison
+
+
+;; 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; 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:
+
+;; The file provides Org-Babel support for evaluating stata code.
+;; It is basically result of find-and-replace "stata" for "julia"
+;; in ob-julia.el by G. Jay Kerns. Only ":results output" works: the
+;; header args must include ":results output" (this is the default).
+;; Note that I'm not sure ':results value' makes sense or is useful
+;; but I have left all the value-processing stuff inherited from
+;; ob-julia and ob-R. ':results graphics' would be nice, but I have
+;; not tried to implement it.
+;; --Ista, 07/30/2014
+
+;;; Requirements:
+;; Stata: http://stata.com
+;; ESS: http://ess.r-project.org
+
+;;; Code:
+(require 'ob)
+(require 'cl-lib)
+
+(declare-function orgtbl-to-csv "org-table" (table params))
+(declare-function stata "ext:ess-stata" (&optional start-args))
+(declare-function inferior-ess-send-input "ext:ess-inf" ())
+(declare-function ess-make-buffer-current "ext:ess-inf" ())
+(declare-function ess-eval-buffer "ext:ess-inf" (vis))
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+
+(defconst org-babel-header-args:stata
+ '((width . :any)
+ (horizontal . :any)
+ (results . ((file list vector table scalar verbatim)
+ (raw org html latex code pp wrap)
+ (replace silent append prepend)
+ ;; NOTE: not sure 'value' makes sense in stata
+ ;; we may want to remove it from the list
+ (output value graphics))))
+ "stata-specific header arguments.")
+
+(add-to-list 'org-babel-tangle-lang-exts '("stata" . "do"))
+
+;; only ':results output' currently works, so make that the default
+(defvar org-babel-default-header-args:stata '((:results . "output")))
+
+(defcustom org-babel-stata-command inferior-STA-program-name
+ "Name of command to use for executing stata code."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.3")
+ :type 'string)
+
+(defvar ess-local-process-name) ; dynamically scoped
+(defun org-babel-edit-prep:stata (info)
+ (let ((session (cdr (assoc :session (nth 2 info)))))
+ (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
+ (save-match-data (org-babel-stata-initiate-session session nil)))))
+
+(defun org-babel-expand-body:stata (body params &optional graphics-file)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((graphics-file
+ (or graphics-file (org-babel-stata-graphical-output-file params))))
+ (mapconcat
+ #'identity
+ ((lambda (inside)
+ (if graphics-file
+ inside
+ inside))
+ (append (org-babel-variable-assignments:stata params)
+ (list body))) "\n")))
+
+(defun org-babel-execute:stata (body params)
+ "Execute a block of stata code.
+This function is called by `org-babel-execute-src-block'."
+ (save-excursion
+ (let* ((result-params (cdr (assoc :result-params params)))
+ (result-type (cdr (assoc :result-type params)))
+ (session (org-babel-stata-initiate-session
+ (cdr (assoc :session params)) params))
+ (colnames-p (cdr (assoc :colnames params)))
+ (rownames-p (cdr (assoc :rownames params)))
+ (graphics-file (org-babel-stata-graphical-output-file params))
+ (full-body (org-babel-expand-body:stata body params graphics-file))
+ (result
+ (org-babel-stata-evaluate
+ session full-body result-type result-params
+ (or (equal "yes" colnames-p)
+ (org-babel-pick-name
+ (cdr (assoc :colname-names params)) colnames-p))
+ (or (equal "yes" rownames-p)
+ (org-babel-pick-name
+ (cdr (assoc :rowname-names params)) rownames-p)))))
+ (if graphics-file nil result))))
+
+(defun org-babel-prep-session:stata (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-stata-initiate-session session params))
+ (var-lines (org-babel-variable-assignments:stata params)))
+ (org-babel-comint-in-buffer session
+ (mapc (lambda (var)
+ (end-of-line 1) (insert var) (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)) var-lines))
+ session))
+
+(defun org-babel-load-session:stata (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:stata session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:stata (params)
+ "Return list of stata statements assigning the block's variables."
+ (let ((vars (org-babel--get-vars params)))
+ (mapcar
+ (lambda (pair)
+ (org-babel-stata-assign-elisp
+ (car pair) (cdr pair)
+ (equal "yes" (cdr (assoc :colnames params)))
+ (equal "yes" (cdr (assoc :rownames params)))))
+ (mapcar
+ (lambda (i)
+ (cons (car (nth i vars))
+ (org-babel-reassemble-table
+ (cdr (nth i vars))
+ (cdr (nth i (cdr (assoc :colname-names params))))
+ (cdr (nth i (cdr (assoc :rowname-names params)))))))
+ (org-number-sequence 0 (1- (length vars)))))))
+
+(defun org-babel-stata-quote-csv-field (s)
+ "Quote field S for export to stata."
+ (if (stringp s)
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
+ (format "%S" s)))
+
+(defun org-babel-stata-assign-elisp (name value colnames-p rownames-p)
+ "Construct stata code assigning the elisp VALUE to a variable named NAME."
+ (if (listp value)
+ (let ((max (apply #'max (mapcar #'length (cl-remove-if-not
+ #'sequencep value))))
+ (min (apply #'min (mapcar #'length (cl-remove-if-not
+ #'sequencep value))))
+ (transition-file (org-babel-temp-file "stata-import-")))
+ ;; ensure VALUE has an orgtbl structure (depth of at least 2)
+ (unless (listp (car value)) (setq value (list value)))
+ (with-temp-file transition-file
+ (insert
+ (orgtbl-to-csv value '(:fmt org-babel-stata-quote-csv-field))
+ "\n"))
+ (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (header (if (or (eq (nth 1 value) 'hline) colnames-p)
+ "TRUE" "FALSE"))
+ (row-names (if rownames-p "1" "NULL")))
+ (if (= max min)
+ (format "%s = insheet using \"%s\"" name file)
+ (format "%s = insheet using \"%s\""
+ name file))))
+ (format "%s = %s" name (org-babel-stata-quote-csv-field value))))
+
+(defvar ess-ask-for-ess-directory) ; dynamically scoped
+
+(defun org-babel-stata-initiate-session (session params)
+ "If there is not a current stata process then create one."
+ (unless (string= session "none")
+ (let ((session (or session "*stata*"))
+ (ess-ask-for-ess-directory
+ (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
+ (not (cdr (assoc :dir params))))))
+ (if (org-babel-comint-buffer-livep session)
+ session
+ (save-window-excursion
+ (require 'ess) (stata)
+ (rename-buffer
+ (if (bufferp session)
+ (buffer-name session)
+ (if (stringp session)
+ session
+ (buffer-name))))
+ (current-buffer))))))
+
+(defun org-babel-stata-associate-session (session)
+ "Associate stata code buffer with a stata session.
+Make SESSION be the inferior ESS process associated with the
+current code buffer."
+ (setq ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-make-buffer-current))
+
+(defun org-babel-stata-graphical-output-file (params)
+ "Name of file to which stata should send graphical output."
+ (and (member "graphics" (cdr (assq :result-params params)))
+ (cdr (assq :file params))))
+
+(defvar org-babel-stata-eoe-indicator "display \"org_babel_stata_eoe\"")
+(defvar org-babel-stata-eoe-output "org_babel_stata_eoe")
+
+(defvar org-babel-stata-write-object-command "outsheet using \"%s\"")
+
+(defun org-babel-stata-evaluate
+ (session body result-type result-params column-names-p row-names-p)
+ "Evaluate stata code in BODY."
+ (if session
+ (org-babel-stata-evaluate-session
+ session body result-type result-params column-names-p row-names-p)
+ (org-babel-stata-evaluate-external-process
+ body result-type result-params column-names-p row-names-p)))
+
+(defun org-babel-stata-evaluate-external-process
+ (body result-type result-params column-names-p row-names-p)
+ "Evaluate BODY in external stata process.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (cl-case result-type
+ (value
+ (let ((tmp-file (org-babel-temp-file "stata-")))
+ (org-babel-eval org-babel-stata-command
+ (format org-babel-stata-write-object-command
+ (org-babel-process-file-name tmp-file 'noquote)
+ (format "begin\n%s\nend" body)))
+ (org-babel-stata-process-value-result
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(4)))
+ column-names-p)))
+ (output (org-babel-eval org-babel-stata-command body))))
+
+(defun org-babel-stata-evaluate-session
+ (session body result-type result-params column-names-p row-names-p)
+ "Evaluate BODY in SESSION.
+If RESULT-TYPE equals 'output then return standard output as a
+string. If RESULT-TYPE equals 'value then return the value of the
+last statement in BODY, as elisp."
+ (cl-case result-type
+ (value
+ (with-temp-buffer
+ (insert (org-babel-chomp body))
+ (let ((ess-local-process-name
+ (process-name (get-buffer-process session)))
+ (ess-eval-visibly-p nil))
+ (ess-eval-buffer nil)))
+ (let ((tmp-file (org-babel-temp-file "stata-")))
+ (org-babel-comint-eval-invisibly-and-wait-for-file
+ session tmp-file
+ (format org-babel-stata-write-object-command
+ (org-babel-process-file-name tmp-file 'noquote) "ans"))
+ (org-babel-stata-process-value-result
+ (org-babel-result-cond result-params
+ (with-temp-buffer
+ (insert-file-contents tmp-file)
+ (buffer-string))
+ (org-babel-import-elisp-from-file tmp-file '(4)))
+ column-names-p)))
+ (output
+ (mapconcat
+ #'org-babel-chomp
+ (butlast
+ (delq nil
+ (mapcar
+ (lambda (line) (when (> (length line) 0) line))
+ (mapcar
+ (lambda (line) ;; cleanup extra prompts left in output
+ (if (string-match
+ "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ (substring line (match-end 1))
+ line))
+ (org-babel-comint-with-output (session org-babel-stata-eoe-output)
+ (insert (mapconcat #'org-babel-chomp
+ (list body org-babel-stata-eoe-indicator)
+ "\n"))
+ (inferior-ess-send-input)))))) "\n"))))
+
+(defun org-babel-stata-process-value-result (result column-names-p)
+ "stata-specific processing of return value.
+Insert hline if column names in output have been requested."
+ (if column-names-p
+ (cons (car result) (cons 'hline (cdr result)))
+ result))
+
+(provide 'ob-stata)
+
+;;; ob-stata.el ends here
diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el
index 50afe5a..f812ace 100644
--- a/contrib/lisp/ob-tcl.el
+++ b/contrib/lisp/ob-tcl.el
@@ -1,6 +1,6 @@
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Authors: Dan Davison
;; Eric Schulte
@@ -62,7 +62,7 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-prep-session:tcl (session params)
"Prepare SESSION according to the header arguments in PARAMS."
- (error "Sessions are not supported for Tcl."))
+ (error "Sessions are not supported for Tcl"))
(defun org-babel-variable-assignments:tcl (params)
"Return list of tcl statements assigning the block's variables."
@@ -71,7 +71,7 @@ This function is called by `org-babel-execute-src-block'."
(format "set %s %s"
(car pair)
(org-babel-tcl-var-to-tcl (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
;; helper functions
@@ -111,7 +111,7 @@ close $o
If RESULT-TYPE equals 'output then return a list of the outputs
of the statements in BODY, if RESULT-TYPE equals 'value then
return the value of the last statement in BODY, as elisp."
- (when session (error "Sessions are not supported for Tcl."))
+ (when session (error "Sessions are not supported for Tcl"))
(case result-type
(output (org-babel-eval org-babel-tcl-command body))
(value (let ((tmp-file (org-babel-temp-file "tcl-")))
diff --git a/contrib/lisp/org-annotate-file.el b/contrib/lisp/org-annotate-file.el
index 8fbb590..b8e8bd9 100644
--- a/contrib/lisp/org-annotate-file.el
+++ b/contrib/lisp/org-annotate-file.el
@@ -59,14 +59,24 @@
(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, add a link as a second level to the actual file location.")
-
-(defvar org-annotate-file-always-open t
- "If non-nil, always expand the full tree when visiting the annotation file.")
+(defgroup org-annotate-file nil
+ "Org Annotate"
+ :group 'org)
+
+(defcustom org-annotate-file-storage-file "~/.org-annotate-file.org"
+ "File in which to keep annotations."
+ :group 'org-annotate-file
+ :type 'file)
+
+(defcustom org-annotate-file-add-search nil
+ "If non-nil, add a link as a second level to the actual file location."
+ :group 'org-annotate-file
+ :type 'boolean)
+
+(defcustom org-annotate-file-always-open t
+ "If non-nil, always expand the full tree when visiting the annotation file."
+ :group 'org-annotate-file
+ :type 'boolean)
(defun org-annotate-file-ellipsify-desc (string &optional after)
"Return shortened STRING with appended ellipsis.
diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el
index 8d5b2ac..7b0a89d 100644
--- a/contrib/lisp/org-bibtex-extras.el
+++ b/contrib/lisp/org-bibtex-extras.el
@@ -1,6 +1,6 @@
;;; org-bibtex-extras --- extras for working with org-bibtex entries
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Eric Schulte <eric dot schulte at gmx dot com>
;; Keywords: outlines, hypermedia, bibtex, d3
@@ -83,19 +83,6 @@ For example, to point to your `obe-bibtex-file' use the following.
obe-citations))
obe-citations)))
-(defun obe-goto-citation (&optional citation)
- "Visit a citation given its ID."
- (interactive)
- (let ((citation (or citation
- (org-icompleting-read "Citation: "
- (obe-citations)))))
- (find-file (or obe-bibtex-file
- (error "`obe-bibtex-file' has not been configured")))
- (goto-char (point-min))
- (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
- (outline-previous-visible-heading 1)
- t)))
-
(defun obe-html-export-citations ()
"Convert all \\cite{...} citations in the current file into HTML links."
(save-excursion
@@ -107,15 +94,6 @@ For example, to point to your `obe-bibtex-file' use the following.
(mapcar #'org-babel-trim
(split-string (match-string 1) ",")) ", "))))))
-(defun obe-get-meta-data (citation)
- "Collect meta-data for CITATION."
- (save-excursion
- (when (obe-goto-citation citation)
- (let ((pt (point)))
- `((:authors . ,(split-string (org-entry-get pt "AUTHOR") " and " t))
- (:title . ,(org-no-properties (org-get-heading 1 1)))
- (:journal . ,(org-entry-get pt "JOURNAL")))))))
-
(defun obe-meta-to-json (meta &optional fields)
"Turn a list of META data from citations into a string of json."
(let ((counter 1) nodes links)
diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el
index 9a69bbb..40c7cd0 100644
--- a/contrib/lisp/org-bookmark.el
+++ b/contrib/lisp/org-bookmark.el
@@ -1,5 +1,5 @@
;;; org-bookmark.el - Support for links to bookmark
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
;; Version: 1.0
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
index 5894707..3e2b3c4 100644
--- a/contrib/lisp/org-collector.el
+++ b/contrib/lisp/org-collector.el
@@ -1,6 +1,6 @@
;;; org-collector --- collect properties into tables
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el
index 67a2aad..2eba1a3 100644
--- a/contrib/lisp/org-colview-xemacs.el
+++ b/contrib/lisp/org-colview-xemacs.el
@@ -1,6 +1,6 @@
;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
-;; Copyright (C) 2004-2014
+;; Copyright (C) 2004-2015
;; Carsten Dominik
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -33,6 +33,10 @@
(eval-when-compile (require 'cl))
(require 'org)
+(defsubst org-colview-xemacs-set-local (var value)
+ "Make VAR local in current buffer and set it to VALUE."
+ (set (make-local-variable var) value))
+
(declare-function org-agenda-redo "org-agenda" ())
@@ -303,10 +307,6 @@ This is the compiled version of the format.")
(beginning-of-line 1)
(and (looking-at "\\(\\**\\)\\(\\* \\)")
(org-get-level-face 2))))
- (item (save-match-data
- (org-remove-tabs
- (buffer-substring-no-properties
- (point-at-bol) (point-at-eol)))))
(color (if (featurep 'xemacs)
(save-excursion
(beginning-of-line 1)
@@ -335,10 +335,10 @@ This is the compiled version of the format.")
(while (setq column (pop fmt))
(setq property (car column)
title (nth 1 column)
- ass (if (equal property "ITEM")
- (cons "ITEM" item)
- (assoc property props))
- width (or (cdr (assoc property org-columns-current-maxwidths))
+ ass (assoc-string property props t)
+ width (or (cdr (assoc-string property
+ org-columns-current-maxwidths
+ t))
(nth 2 column)
(length property))
f (format (if (featurep 'xemacs) "%%-%d.%ds |" "%%-%d.%ds | ")
@@ -351,9 +351,7 @@ This is the compiled version of the format.")
(funcall org-columns-modify-value-for-display-function
title val))
((equal property "ITEM")
- (if (derived-mode-p 'org-mode)
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled)))
+ (org-columns-compact-links val))
((and calc (functionp calc)
(not (string= val ""))
(not (get-text-property 0 'org-computed val)))
@@ -438,7 +436,9 @@ This is the compiled version of the format.")
(while (setq column (pop fmt))
(setq property (car column)
str (or (nth 1 column) property)
- width (or (cdr (assoc property org-columns-current-maxwidths))
+ width (or (cdr (assoc-string property
+ org-columns-current-maxwidths
+ t))
(nth 2 column)
(length str))
widths (push width widths)
@@ -449,16 +449,16 @@ This is the compiled version of the format.")
(let ((ext (make-extent nil nil)))
(set-extent-endpoints ext 0 (length title) title)
(set-extent-face ext (list 'bold 'underline 'org-columns-space1))
- (org-set-local 'org-previous-header-line-format
- (specifier-specs top-gutter))
- (org-set-local 'org-columns-current-widths (nreverse widths))
+ (org-colview-xemacs-set-local 'org-previous-header-line-format
+ (specifier-specs top-gutter))
+ (org-colview-xemacs-set-local 'org-columns-current-widths (nreverse widths))
(set-specifier top-gutter (make-gutter-specifier
(cons (current-buffer) title))))
(setq title (concat
(org-add-props " " nil 'display '(space :align-to 0))
(org-add-props title nil 'face '(:weight bold :underline t))))
- (org-set-local 'org-previous-header-line-format header-line-format)
- (org-set-local 'org-columns-current-widths (nreverse widths))
+ (org-colview-xemacs-set-local 'org-previous-header-line-format header-line-format)
+ (org-colview-xemacs-set-local 'org-columns-current-widths (nreverse widths))
(setq org-columns-full-header-line-format title)
(setq org-columns-previous-hscroll -1)
(org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))))
@@ -503,26 +503,6 @@ This is the compiled version of the format.")
(current-buffer))
(setq truncate-lines org-colview-initial-truncate-line-value)))))
-
-(defun org-columns-cleanup-item (item fmt)
- "Remove from ITEM what is a column in the format FMT."
- (if (not org-complex-heading-regexp)
- item
- (when (string-match org-complex-heading-regexp item)
- (setq item
- (concat
- (org-add-props (match-string 1 item) nil
- 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
- (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
- " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
- (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
- (add-text-properties
- 0 (1+ (match-end 1))
- (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- item)
- item)))
-
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
(while (string-match org-bracket-link-regexp s)
@@ -622,7 +602,7 @@ Where possible, use the standard interface for changing this line."
(t
(setq allowed (org-property-get-allowed-values pom key 'table))
(if allowed
- (setq nval (org-icompleting-read
+ (setq nval (completing-read
"Value: " allowed nil
(not (get-text-property 0 'org-unrestricted
(caar allowed)))))
@@ -657,7 +637,7 @@ Where possible, use the standard interface for changing this line."
(org-columns-display-here)))
(org-move-to-column col)
(if (and (derived-mode-p 'org-mode)
- (nth 3 (assoc key org-columns-current-fmt-compiled)))
+ (nth 3 (assoc-string key org-columns-current-fmt-compiled t)))
(org-columns-update key)))))))
(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
@@ -736,7 +716,9 @@ an integer, select that value."
org-columns-overlays)))
(allowed (or (org-property-get-allowed-values pom key)
(and (memq
- (nth 4 (assoc key org-columns-current-fmt-compiled))
+ (nth 4 (assoc-string key
+ org-columns-current-fmt-compiled
+ t))
'(checkbox checkbox-n-of-m checkbox-percent))
'("[ ]" "[X]"))
(org-colview-construct-allowed-dates value)))
@@ -785,7 +767,7 @@ an integer, select that value."
(org-columns-eval '(org-entry-put pom key nval)))
(org-columns-display-here)))
(org-move-to-column col)
- (and (nth 3 (assoc key org-columns-current-fmt-compiled))
+ (and (nth 3 (assoc-string key org-columns-current-fmt-compiled t))
(org-columns-update key))))))
(defun org-colview-construct-allowed-dates (s)
@@ -827,7 +809,7 @@ around it."
(when (condition-case nil (org-back-to-heading) (error nil))
(setq fmt (org-entry-get nil "COLUMNS" t)))
(setq fmt (or fmt org-columns-default-format))
- (org-set-local 'org-columns-current-fmt fmt)
+ (org-colview-xemacs-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(if (marker-position org-entry-property-inherited-from)
(move-marker org-columns-top-level-marker
@@ -868,12 +850,12 @@ around it."
(push (cons (org-current-line) (org-entry-properties)) cache)))
(when cache
(setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-colview-xemacs-set-local 'org-columns-current-maxwidths maxwidths)
(org-columns-display-here-title)
(unless (local-variable-p 'org-colview-initial-truncate-line-value
(current-buffer))
- (org-set-local 'org-colview-initial-truncate-line-value
- truncate-lines))
+ (org-colview-xemacs-set-local 'org-colview-initial-truncate-line-value
+ truncate-lines))
(setq truncate-lines t)
(mapc (lambda (x)
(org-goto-line (car x))
@@ -924,9 +906,11 @@ interactive function `org-columns-new'.
"Insert a new column, to the left of the current column."
(interactive)
(let ((n (org-columns-current-column))
- (editp (and prop (assoc prop org-columns-current-fmt-compiled)))
+ (editp (and prop (assoc-string prop
+ org-columns-current-fmt-compiled
+ t)))
cell)
- (setq prop (org-icompleting-read
+ (setq prop (completing-read
"Property: " (mapcar 'list (org-buffer-property-keys t nil t))
nil nil prop))
(setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
@@ -934,9 +918,9 @@ interactive function `org-columns-new'.
(if (string-match "\\S-" width)
(setq width (string-to-number width))
(setq width nil))
- (setq fmt (org-icompleting-read "Summary [none]: "
- (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map)
- nil t))
+ (setq fmt (completing-read "Summary [none]: "
+ (mapcar (lambda (x) (list (symbol-name (cadr x)))) org-columns-compile-map)
+ nil t))
(setq fmt (intern fmt)
fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
(if (eq fmt 'none) (setq fmt nil))
@@ -980,7 +964,9 @@ interactive function `org-columns-new'.
(let* ((n (org-columns-current-column))
(entry (nth n org-columns-current-fmt-compiled))
(width (or (nth 2 entry)
- (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (cdr (assoc-string (car entry)
+ org-columns-current-maxwidths
+ t)))))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
@@ -1022,7 +1008,7 @@ This is either in the COLUMNS property of the node starting the current column
display, or in the #+COLUMNS line of the current buffer."
(let (fmt (cnt 0))
(setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
- (org-set-local 'org-columns-current-fmt fmt)
+ (org-colview-xemacs-set-local 'org-columns-current-fmt fmt)
(if (marker-position org-columns-top-level-marker)
(save-excursion
(goto-char org-columns-top-level-marker)
@@ -1039,7 +1025,7 @@ display, or in the #+COLUMNS line of the current buffer."
(or (org-at-heading-p t) (outline-next-heading))
(let ((inhibit-read-only t))
(insert-before-markers "#+COLUMNS: " fmt "\n")))
- (org-set-local 'org-columns-default-format fmt))))))
+ (org-colview-xemacs-set-local 'org-columns-default-format fmt))))))
(defvar org-agenda-overriding-columns-format nil
"When set, overrides any other format definition for the agenda.
@@ -1052,11 +1038,14 @@ Don't set this, this is meant for dynamic scoping.")
(push (cons (match-string 1 s) 1) rtn)
(setq start (match-end 0)))
(mapc (lambda (x)
- (setcdr x (apply 'max
+ (setcdr x
+ (apply 'max
+ (let ((prop (car x)))
(mapcar
(lambda (y)
- (length (or (cdr (assoc (car x) (cdr y))) " ")))
- cache))))
+ (length (or (cdr (assoc-string prop (cdr y) t))
+ " ")))
+ cache)))))
rtn)
rtn))
@@ -1081,9 +1070,11 @@ Don't set this, this is meant for dynamic scoping.")
(when (equal (overlay-get ov 'org-columns-key) property)
(setq pos (overlay-start ov))
(goto-char pos)
- (when (setq val (cdr (assoc property
- (get-text-property
- (point-at-bol) 'org-summaries))))
+ (when (setq val (cdr (assoc-string
+ property
+ (get-text-property
+ (point-at-bol) 'org-summaries)
+ t)))
(setq fmt (overlay-get ov 'org-columns-format))
(overlay-put ov 'org-columns-value val)
(if (featurep 'xemacs)
@@ -1098,11 +1089,11 @@ Don't set this, this is meant for dynamic scoping.")
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(let* ((re org-outline-regexp-bol)
- (lmax 30) ; Does anyone use deeper levels???
+ (lmax 30) ; Does anyone use deeper levels???
(lvals (make-vector lmax nil))
(lflag (make-vector lmax nil))
(level 0)
- (ass (assoc property org-columns-current-fmt-compiled))
+ (ass (assoc-string property org-columns-current-fmt-compiled t))
(format (nth 4 ass))
(printf (nth 5 ass))
(fun (nth 6 ass))
@@ -1131,12 +1122,12 @@ Don't set this, this is meant for dynamic scoping.")
str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
useval (if flag str1 (if valflag val ""))
sum-alist (get-text-property sumpos 'org-summaries))
- (if (assoc property sum-alist)
- (setcdr (assoc property sum-alist) useval)
- (push (cons property useval) sum-alist)
- (org-unmodified
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist))))
+ (let ((old (assoc-string property sum-alist t)))
+ (if old (setcdr old useval)
+ (push (cons property useval) sum-alist)
+ (org-unmodified
+ (add-text-properties sumpos (1+ sumpos)
+ (list 'org-summaries sum-alist)))))
(when (and val (not (equal val (if flag str val))))
(org-entry-put nil property (if flag str val)))
;; add current to current level accumulator
@@ -1495,7 +1486,7 @@ and tailing newline characters."
(interactive)
(when (featurep 'xemacs) (org-columns-quit))
(let ((defaults '(:name "columnview" :hlines 1))
- (id (org-icompleting-read
+ (id (completing-read
"Capture columns (local, global, entry with :ID: property) [local]: "
(append '(("global") ("local"))
(mapcar 'list (org-property-values "ID"))))))
@@ -1526,7 +1517,7 @@ and tailing newline characters."
((and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
(setq fmt org-agenda-overriding-columns-format)
- (org-set-local 'org-agenda-overriding-columns-format fmt))
+ (org-colview-xemacs-set-local 'org-agenda-overriding-columns-format fmt))
((setq m (org-get-at-bol 'org-hd-marker))
(setq fmt (or (org-entry-get m "COLUMNS" t)
(with-current-buffer (marker-buffer m)
@@ -1541,7 +1532,7 @@ and tailing newline characters."
(with-current-buffer (marker-buffer m)
org-columns-default-format)))))
(setq fmt (or fmt org-columns-default-format))
- (org-set-local 'org-columns-current-fmt fmt)
+ (org-colview-xemacs-set-local 'org-columns-current-fmt fmt)
(org-columns-compile-format fmt)
(when org-agenda-columns-compute-summary-properties
(org-agenda-colview-compute org-columns-current-fmt-compiled))
@@ -1553,7 +1544,7 @@ and tailing newline characters."
(org-get-at-bol 'org-marker)))
(setq p (org-entry-properties m))
- (when (or (not (setq a (assoc org-effort-property p)))
+ (when (or (not (setq a (assoc-string org-effort-property p t)))
(not (string-match "\\S-" (or (cdr a) ""))))
;; OK, the property is not defined. Use appointment duration?
(when (and org-agenda-columns-add-appointments-to-effort-sum
@@ -1565,7 +1556,7 @@ and tailing newline characters."
(beginning-of-line 2))
(when cache
(setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
+ (org-colview-xemacs-set-local 'org-columns-current-maxwidths maxwidths)
(org-columns-display-here-title)
(mapc (lambda (x)
(org-goto-line (car x))
@@ -1617,7 +1608,7 @@ This will add overlays to the date lines, to show the summary for each day."
(t ;; do the summary
(setq lsum nil)
(dolist (x entries)
- (setq v (cdr (assoc prop x)))
+ (setq v (cdr (assoc-string prop x t)))
(if v
(push
(funcall
@@ -1642,7 +1633,7 @@ This will add overlays to the date lines, to show the summary for each day."
(cons prop lsum))))
fmt))
(org-columns-display-here props)
- (org-set-local 'org-agenda-columns-active t)))
+ (org-colview-xemacs-set-local 'org-agenda-columns-active t)))
(if (bobp) (throw 'exit t))
(beginning-of-line 0))))))
@@ -1667,8 +1658,10 @@ This will add overlays to the date lines, to show the summary for each day."
(if (equal (car fm) "CLOCKSUM")
(org-clock-sum)
(when (and (nth 4 fm)
- (setq a (assoc (car fm)
- org-columns-current-fmt-compiled))
+ (setq a (assoc-string
+ (car fm)
+ org-columns-current-fmt-compiled
+ t))
(equal (nth 4 a) (nth 4 fm)))
(org-columns-compute (car fm)))))))))))
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index 7cc42fc..13fbf27 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -52,9 +52,7 @@
;;
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'org)
(require 'gnus-util)
(require 'gnus-art)
@@ -155,13 +153,20 @@ The following replacements are available:
:type 'string
:group 'org-contacts)
+(defcustom org-contacts-tags-props-prefix "#"
+ "Tags and properties prefix."
+ :type 'string
+ :group 'org-contacts)
+
(defcustom org-contacts-matcher
- (mapconcat 'identity (list org-contacts-email-property
- org-contacts-alias-property
- org-contacts-tel-property
- org-contacts-address-property
- org-contacts-birthday-property)
- "<>\"\"|")
+ (mapconcat #'identity
+ (mapcar (lambda (x) (concat x "<>\"\""))
+ (list org-contacts-email-property
+ org-contacts-alias-property
+ org-contacts-tel-property
+ org-contacts-address-property
+ org-contacts-birthday-property))
+ "|")
"Matching rule for finding heading that are contacts.
This can be a tag name, or a property check."
:type 'string
@@ -183,6 +188,12 @@ This overrides `org-email-link-description-format' if set."
:group 'org-contacts
:type 'boolean)
+(defcustom org-contacts-complete-functions
+ '(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name)
+ "List of functions used to complete contacts in `message-mode'."
+ :group 'org-contacts
+ :type 'hook)
+
;; Decalre external functions and variables
(declare-function org-reverse-string "org")
(declare-function diary-ordinal-suffix "ext:diary-lib")
@@ -241,33 +252,57 @@ to dead or no buffer."
(defun org-contacts-db ()
"Return the latest Org Contacts Database."
- (let* (todo-only
- (contacts-matcher
- (cdr (org-make-tags-matcher org-contacts-matcher)))
- markers result)
+ (let* ((org--matcher-tags-todo-only nil)
+ (contacts-matcher (cdr (org-make-tags-matcher org-contacts-matcher)))
+ result)
(when (org-contacts-db-need-update-p)
(let ((progress-reporter
(make-progress-reporter "Updating Org Contacts Database..." 0 (length org-contacts-files)))
(i 0))
(dolist (file (org-contacts-files))
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (unless (eq major-mode 'org-mode)
- (error "File %s is no in `org-mode'" file))
- (org-scan-tags
- '(add-to-list 'markers (set-marker (make-marker) (point)))
- contacts-matcher
- todo-only))
+ (if (catch 'nextfile
+ ;; if file doesn't exist and the user agrees to removing it
+ ;; from org-agendas-list, 'nextfile is thrown. Catch it here
+ ;; and skip processing the file.
+ ;;
+ ;; TODO: suppose that the user has set an org-contacts-files
+ ;; list that contains an element that doesn't exist in the
+ ;; file system: in that case, the org-agenda-files list could
+ ;; be updated (and saved to the customizations of the user) if
+ ;; it contained the same file even though the org-agenda-files
+ ;; list wasn't actually used. I don't think it is normal that
+ ;; org-contacts updates org-agenda-files in this case, but
+ ;; short of duplicating org-check-agenda-files and
+ ;; org-remove-files, I don't know how to avoid it.
+ ;;
+ ;; A side effect of the TODO is that the faulty
+ ;; org-contacts-files list never gets updated and thus the
+ ;; user is always queried about the missing files when
+ ;; org-contacts-db-need-update-p returns true.
+ (org-check-agenda-file file))
+ (message "Skipped %s removed from org-agenda-files list."
+ (abbreviate-file-name file))
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (unless (eq major-mode 'org-mode)
+ (error "File %s is not in `org-mode'" file))
+ (setf result
+ (append result
+ (org-scan-tags 'org-contacts-at-point
+ contacts-matcher
+ org--matcher-tags-todo-only)))))
(progress-reporter-update progress-reporter (setq i (1+ i))))
- (dolist (marker markers result)
- (org-with-point-at marker
- (add-to-list 'result
- (list (org-get-heading t) marker (org-entry-properties marker 'all)))))
(setf org-contacts-db result
org-contacts-last-update (current-time))
- (progress-reporter-done progress-reporter)))
+ (progress-reporter-done progress-reporter)))
org-contacts-db))
+(defun org-contacts-at-point (&optional pom)
+ "Return the contacts at point-or-marker POM or current position
+if nil."
+ (setq pom (or pom (point)))
+ (org-with-point-at pom
+ (list (org-get-heading t) (set-marker (make-marker) pom) (org-entry-properties pom 'all))))
+
(defun org-contacts-filter (&optional name-match tags-match prop-match)
"Search for a contact matching any of NAME-MATCH, TAGS-MATCH, PROP-MATCH.
If all match values are nil, return all contacts.
@@ -279,22 +314,22 @@ cell corresponding to the contact properties.
(null prop-match)
(null tags-match))
(org-contacts-db)
- (loop for contact in (org-contacts-db)
- if (or
- (and name-match
- (org-string-match-p name-match
- (first contact)))
- (and prop-match
- (org-find-if (lambda (prop)
- (and (string= (car prop-match) (car prop))
- (org-string-match-p (cdr prop-match) (cdr prop))))
- (caddr contact)))
- (and tags-match
- (org-find-if (lambda (tag)
- (org-string-match-p tags-match tag))
- (org-split-string
- (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
- collect contact)))
+ (cl-loop for contact in (org-contacts-db)
+ if (or
+ (and name-match
+ (org-string-match-p name-match
+ (first contact)))
+ (and prop-match
+ (org-find-if (lambda (prop)
+ (and (string= (car prop-match) (car prop))
+ (org-string-match-p (cdr prop-match) (cdr prop))))
+ (caddr contact)))
+ (and tags-match
+ (org-find-if (lambda (tag)
+ (org-string-match-p tags-match tag))
+ (org-split-string
+ (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))
+ collect contact)))
(when (not (fboundp 'completion-table-case-fold))
;; That function is new in Emacs 24...
@@ -307,34 +342,34 @@ cell corresponding to the contact properties.
"Custom implementation of `try-completion'.
This version works only with list and alist and it looks at all
prefixes rather than just the beginning of the string."
- (loop with regexp = (concat "\\b" (regexp-quote to-match))
- with ret = nil
- with ret-start = nil
- with ret-end = nil
-
- for el in collection
- for string = (if (listp el) (car el) el)
-
- for start = (when (or (null predicate) (funcall predicate string))
- (string-match regexp string))
-
- if start
- do (let ((end (match-end 0))
- (len (length string)))
- (if (= end len)
- (return t)
- (destructuring-bind (string start end)
- (if (null ret)
- (values string start end)
- (org-contacts-common-substring
- ret ret-start ret-end
- string start end))
- (setf ret string
- ret-start start
- ret-end end))))
-
- finally (return
- (replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
+ (cl-loop with regexp = (concat "\\b" (regexp-quote to-match))
+ with ret = nil
+ with ret-start = nil
+ with ret-end = nil
+
+ for el in collection
+ for string = (if (listp el) (car el) el)
+
+ for start = (when (or (null predicate) (funcall predicate string))
+ (string-match regexp string))
+
+ if start
+ do (let ((end (match-end 0))
+ (len (length string)))
+ (if (= end len)
+ (cl-return t)
+ (cl-destructuring-bind (string start end)
+ (if (null ret)
+ (values string start end)
+ (org-contacts-common-substring
+ ret ret-start ret-end
+ string start end))
+ (setf ret string
+ ret-start start
+ ret-end end))))
+
+ finally (cl-return
+ (replace-regexp-in-string "\\`[ \t\n]*" "" ret))))
(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case)
"Compare the contents of two strings, using `compare-strings'.
@@ -393,22 +428,22 @@ This function returns a list whose contains:
"Custom version of `all-completions'.
This version works only with list and alist and it looks at all
prefixes rather than just the beginning of the string."
- (loop with regexp = (concat "\\b" (regexp-quote to-match))
- for el in collection
- for string = (if (listp el) (car el) el)
- for match? = (when (and (or (null predicate) (funcall predicate string)))
- (string-match regexp string))
- if match?
- collect (progn
- (let ((end (match-end 0)))
- (org-no-properties string)
- (when (< end (length string))
- ;; Here we add a text property that will be used
- ;; later to highlight the character right after
- ;; the common part between each addresses.
- ;; See `org-contacts-display-sort-function'.
- (put-text-property end (1+ end) 'org-contacts-prefix 't string)))
- string)))
+ (cl-loop with regexp = (concat "\\b" (regexp-quote to-match))
+ for el in collection
+ for string = (if (listp el) (car el) el)
+ for match? = (when (and (or (null predicate) (funcall predicate string)))
+ (string-match regexp string))
+ if match?
+ collect (progn
+ (let ((end (match-end 0)))
+ (org-no-properties string)
+ (when (< end (length string))
+ ;; Here we add a text property that will be used
+ ;; later to highlight the character right after
+ ;; the common part between each addresses.
+ ;; See `org-contacts-display-sort-function'.
+ (put-text-property end (1+ end) 'org-contacts-prefix 't string)))
+ string)))
(defun org-contacts-make-collection-prefix (collection)
"Make a collection function from COLLECTION which will match on prefixes."
@@ -423,7 +458,7 @@ prefixes rather than just the beginning of the string."
((eq flag 'lambda)
(org-contacts-test-completion-prefix string collection predicate))
((and (listp flag) (eq (car flag) 'boundaries))
- (destructuring-bind (to-ignore &rest suffix)
+ (cl-destructuring-bind (to-ignore &rest suffix)
flag
(org-contacts-boundaries-prefix string collection predicate suffix)))
((eq flag 'metadata)
@@ -434,21 +469,21 @@ prefixes rather than just the beginning of the string."
(defun org-contacts-display-sort-function (completions)
"Sort function for contacts display."
(mapcar (lambda (string)
- (loop with len = (1- (length string))
- for i upfrom 0 to len
- if (memq 'org-contacts-prefix
- (text-properties-at i string))
- do (set-text-properties
- i (1+ i)
- (list 'font-lock-face
- (if (char-equal (aref string i)
- (string-to-char " "))
- ;; Spaces can't be bold.
- 'underline
- 'bold)) string)
- else
- do (set-text-properties i (1+ i) nil string)
- finally (return string)))
+ (cl-loop with len = (1- (length string))
+ for i upfrom 0 to len
+ if (memq 'org-contacts-prefix
+ (text-properties-at i string))
+ do (set-text-properties
+ i (1+ i)
+ (list 'font-lock-face
+ (if (char-equal (aref string i)
+ (string-to-char " "))
+ ;; Spaces can't be bold.
+ 'underline
+ 'bold)) string)
+ else
+ do (set-text-properties i (1+ i) nil string)
+ finally (cl-return string)))
completions))
(defun org-contacts-test-completion-prefix (string collection predicate)
@@ -483,9 +518,9 @@ A group FOO is composed of contacts with the tag FOO."
(propertize (concat org-contacts-group-prefix group)
'org-contacts-group group))
(org-uniquify
- (loop for contact in (org-contacts-filter)
- nconc (org-split-string
- (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
+ (cl-loop for contact in (org-contacts-filter)
+ nconc (org-split-string
+ (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
(list start end
(if (= (length completion-list) 1)
;; We've found the correct group, returns the address
@@ -493,60 +528,100 @@ A group FOO is composed of contacts with the tag FOO."
(car completion-list))))
(lambda (string pred &optional to-ignore)
(mapconcat 'identity
- (loop for contact in (org-contacts-filter
- nil
- tag)
- ;; The contact name is always the car of the assoc-list
- ;; returned by `org-contacts-filter'.
- for contact-name = (car contact)
- ;; Grab the first email of the contact
- for email = (org-contacts-strip-link (car (org-contacts-split-property
- (or
- (cdr (assoc-string org-contacts-email-property
- (caddr contact)))
- ""))))
- ;; If the user has an email address, append USER <EMAIL>.
- if email collect (org-contacts-format-email contact-name email))
+ (cl-loop for contact in (org-contacts-filter
+ nil
+ tag)
+ ;; The contact name is always the car of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+ ;; Grab the first email of the contact
+ for email = (org-contacts-strip-link
+ (or (car (org-contacts-split-property
+ (or
+ (cdr (assoc-string org-contacts-email-property
+ (cl-caddr contact)))
+ ""))) ""))
+ ;; If the user has an email address, append USER <EMAIL>.
+ if email collect (org-contacts-format-email contact-name email))
", ")))
;; We haven't found the correct group
(completion-table-case-fold completion-list
(not org-contacts-completion-ignore-case))))))))
+(defun org-contacts-complete-tags-props (start end string)
+ "Insert emails that match the tags expression.
+
+For example: FOO-BAR will match entries tagged with FOO but not
+with BAR.
+
+See (org) Matching tags and properties for a complete
+description."
+ (let* ((completion-ignore-case org-contacts-completion-ignore-case)
+ (completion-p (org-string-match-p
+ (concat "^" org-contacts-tags-props-prefix) string)))
+ (when completion-p
+ (let ((result
+ (mapconcat
+ 'identity
+ (cl-loop for contact in (org-contacts-db)
+ for contact-name = (car contact)
+ for email = (org-contacts-strip-link (or (car (org-contacts-split-property
+ (or
+ (cdr (assoc-string org-contacts-email-property
+ (cl-caddr contact)))
+ ""))) ""))
+ for tags = (cdr (assoc "TAGS" (nth 2 contact)))
+ for tags-list = (if tags
+ (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":")
+ '())
+ for marker = (nth 1 contact)
+ if (with-current-buffer (marker-buffer marker)
+ (save-excursion
+ (goto-char marker)
+ (let (todo-only)
+ (eval (cdr (org-make-tags-matcher (cl-subseq string 1)))))))
+ collect (org-contacts-format-email contact-name email))
+ ",")))
+ (when (not (string= "" result))
+ ;; return (start end function)
+ (lexical-let* ((to-return result))
+ (list start end
+ (lambda (string pred &optional to-ignore) to-return))))))))
(defun org-contacts-remove-ignored-property-values (ignore-list list)
"Remove all ignore-list's elements from list and you can use
regular expressions in the ignore list."
- (org-remove-if (lambda (el)
- (org-find-if (lambda (x)
- (string-match-p x el))
- ignore-list))
- list))
+ (cl-remove-if (lambda (el)
+ (org-find-if (lambda (x)
+ (string-match-p x el))
+ ignore-list))
+ list))
(defun org-contacts-complete-name (start end string)
"Complete text at START with a user name and email."
(let* ((completion-ignore-case org-contacts-completion-ignore-case)
(completion-list
- (loop for contact in (org-contacts-filter)
- ;; The contact name is always the car of the assoc-list
- ;; returned by `org-contacts-filter'.
- for contact-name = (car contact)
-
- ;; Build the list of the email addresses which has
- ;; been expired
- for ignore-list = (org-contacts-split-property
- (or (cdr (assoc-string org-contacts-ignore-property
- (caddr contact))) ""))
- ;; Build the list of the user email addresses.
- for email-list = (org-contacts-remove-ignored-property-values
- ignore-list
- (org-contacts-split-property
- (or (cdr (assoc-string org-contacts-email-property
- (caddr contact))) "")))
- ;; If the user has email addresses…
- if email-list
- ;; … append a list of USER <EMAIL>.
- nconc (loop for email in email-list
- collect (org-contacts-format-email contact-name (org-contacts-strip-link email)))))
+ (cl-loop for contact in (org-contacts-filter)
+ ;; The contact name is always the car of the assoc-list
+ ;; returned by `org-contacts-filter'.
+ for contact-name = (car contact)
+
+ ;; Build the list of the email addresses which has
+ ;; been expired
+ for ignore-list = (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-ignore-property
+ (nth 2 contact))) ""))
+ ;; Build the list of the user email addresses.
+ for email-list = (org-contacts-remove-ignored-property-values
+ ignore-list
+ (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-email-property
+ (nth 2 contact))) "")))
+ ;; If the user has email addresses…
+ if email-list
+ ;; … append a list of USER <EMAIL>.
+ nconc (cl-loop for email in email-list
+ collect (org-contacts-format-email contact-name (org-contacts-strip-link email)))))
(completion-list (org-contacts-all-completions-prefix
string
(org-uniquify completion-list))))
@@ -570,8 +645,8 @@ A group FOO is composed of contacts with the tag FOO."
(goto-char (match-end 0))
(point))))
(string (buffer-substring start end)))
- (or (org-contacts-complete-group start end string)
- (org-contacts-complete-name start end string))))))
+ (run-hook-with-args-until-success
+ 'org-contacts-complete-functions start end string)))))
(defun org-contacts-gnus-get-name-email ()
"Get name and email address from Gnus message."
@@ -585,13 +660,13 @@ A group FOO is composed of contacts with the tag FOO."
(let* ((address (org-contacts-gnus-get-name-email))
(name (car address))
(email (cadr address)))
- (cadar (or (org-contacts-filter
- nil
- nil
- (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b")))
- (when name
- (org-contacts-filter
- (concat "^" name "$")))))))
+ (cl-cadar (or (org-contacts-filter
+ nil
+ nil
+ (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b")))
+ (when name
+ (org-contacts-filter
+ (concat "^" name "$")))))))
(defun org-contacts-gnus-article-from-goto ()
"Go to contact in the From address of current Gnus message."
@@ -600,12 +675,7 @@ A group FOO is composed of contacts with the tag FOO."
(when marker
(switch-to-buffer-other-window (marker-buffer marker))
(goto-char marker)
- (when (eq major-mode 'org-mode)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- ;; show the next heading
- (org-flag-heading nil)))))))
+ (when (eq major-mode 'org-mode) (org-show-context 'agenda)))))
(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defun org-contacts-anniversaries (&optional field format)
@@ -621,23 +691,23 @@ Format is a string matching the following format specification:
(let ((calendar-date-style 'american)
(entry ""))
(unless format (setq format org-contacts-birthday-format))
- (loop for contact in (org-contacts-filter)
- for anniv = (let ((anniv (cdr (assoc-string
- (or field org-contacts-birthday-property)
- (caddr contact)))))
- (when anniv
- (calendar-gregorian-from-absolute
- (org-time-string-to-absolute anniv))))
- ;; Use `diary-anniversary' to compute anniversary.
- if (and anniv (apply 'diary-anniversary anniv))
- collect (format-spec format
- `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil)))
- (?h . ,(car contact))
- (?y . ,(- (calendar-extract-year date)
- (calendar-extract-year anniv)))
- (?Y . ,(let ((years (- (calendar-extract-year date)
- (calendar-extract-year anniv))))
- (format "%d%s" years (diary-ordinal-suffix years)))))))))
+ (cl-loop for contact in (org-contacts-filter)
+ for anniv = (let ((anniv (cdr (assoc-string
+ (or field org-contacts-birthday-property)
+ (nth 2 contact)))))
+ (when anniv
+ (calendar-gregorian-from-absolute
+ (org-time-string-to-absolute anniv))))
+ ;; Use `diary-anniversary' to compute anniversary.
+ if (and anniv (apply 'diary-anniversary anniv))
+ collect (format-spec format
+ `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil)))
+ (?h . ,(car contact))
+ (?y . ,(- (calendar-extract-year date)
+ (calendar-extract-year anniv)))
+ (?Y . ,(let ((years (- (calendar-extract-year date)
+ (calendar-extract-year anniv))))
+ (format "%d%s" years (diary-ordinal-suffix years)))))))))
(defun org-completing-read-date (prompt collection
&optional predicate require-match initial-input
@@ -826,7 +896,7 @@ address."
(setq email (org-contacts-strip-link email))
(org-contacts-check-mail-address email)
(compose-mail (org-contacts-format-email (org-get-heading t) email)))))
- (error (format "This contact has no mail address set (no %s property)."
+ (error (format "This contact has no mail address set (no %s property)"
org-contacts-email-property)))))))
(defun org-contacts-get-icon (&optional pom)
@@ -918,7 +988,7 @@ to do our best."
(defun org-contacts-vcard-format (contact)
"Formats CONTACT in VCard 3.0 format."
- (let* ((properties (caddr contact))
+ (let* ((properties (nth 2 contact))
(name (org-contacts-vcard-escape (car contact)))
(n (org-contacts-vcard-encode-name name))
(email (cdr (assoc-string org-contacts-email-property properties)))
@@ -960,11 +1030,39 @@ to do our best."
"END:VCARD\n\n")))
(defun org-contacts-export-as-vcard (&optional name file to-buffer)
+ "Export org contacts to V-Card 3.0.
+
+By default, all contacts are exported to `org-contacts-vcard-file'.
+
+When NAME is \\[universal-argument], prompts for a contact name.
+
+When NAME is \\[universal-argument] \\[universal-argument],
+prompts for a contact name and a file name where to export.
+
+When NAME is \\[universal-argument] \\[universal-argument]
+\\[universal-argument], prompts for a contact name and a buffer where to export.
+
+If the function is not called interactively, all parameters are
+passed to `org-contacts-export-as-vcard-internal'."
+ (interactive "P")
+ (when (called-interactively-p 'any)
+ (cl-psetf name
+ (when name
+ (read-string "Contact name: "
+ (nth 0 (org-contacts-at-point))))
+ file
+ (when (equal name '(16))
+ (read-file-name "File: " nil org-contacts-vcard-file))
+ to-buffer
+ (when (equal name '(64))
+ (read-buffer "Buffer: "))))
+ (org-contacts-export-as-vcard-internal name file to-buffer))
+
+(defun org-contacts-export-as-vcard-internal (&optional name file to-buffer)
"Export all contacts matching NAME as VCard 3.0.
If TO-BUFFER is nil, the content is written to FILE or
`org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer
is created and the VCard is written into that buffer."
- (interactive) ; TODO ask for name?
(let* ((filename (or file org-contacts-vcard-file))
(buffer (if to-buffer
(get-buffer-create to-buffer)
@@ -989,9 +1087,9 @@ Requires google-maps-el."
(error "`org-contacts-show-map' requires `google-maps-el'"))
(google-maps-static-show
:markers
- (loop
+ (cl-loop
for contact in (org-contacts-filter name)
- for addr = (cdr (assoc-string org-contacts-address-property (caddr contact)))
+ for addr = (cdr (assoc-string org-contacts-address-property (nth 2 contact)))
if addr
collect (cons (list addr) (list :label (string-to-char (car contact)))))))
@@ -1010,6 +1108,11 @@ link string and return the pure link target."
(setq colonpos (string-match ":" link))
(if startpos (substring link (1+ colonpos)) link)))))
+;; Add the link type supported by org-contacts-strip-link
+;; so everything is in order for its use in Org files
+(org-add-link-type "tel")
+
+
(defun org-contacts-split-property (string &optional separators omit-nulls)
"Custom version of `split-string'.
Split a property STRING into sub-strings bounded by matches
diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el
index d94e7a0..d0bd951 100644
--- a/contrib/lisp/org-contribdir.el
+++ b/contrib/lisp/org-contribdir.el
@@ -1,5 +1,5 @@
;;; org-contribdir.el --- Mark the location of the contrib directory
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
index 1cd4130..5e49b6c 100644
--- a/contrib/lisp/org-depend.el
+++ b/contrib/lisp/org-depend.el
@@ -1,5 +1,5 @@
;;; org-depend.el --- TODO dependencies for Org-mode
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-download.el b/contrib/lisp/org-download.el
index 39312cf..cbf335b 100644
--- a/contrib/lisp/org-download.el
+++ b/contrib/lisp/org-download.el
@@ -1,12 +1,12 @@
;;; org-download.el --- Image drag-and-drop for Emacs org-mode
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
;; Author: Oleh Krehel
;; Keywords: images, screenshots, download
;; Homepage: http://orgmode.org
-;; This file is part of GNU Emacs.
+;; 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
@@ -48,7 +48,7 @@
;; * or `org-download-image-dir' (if it's not nil).
;; `org-download-image-dir' becomes buffer-local when set,
;; so each file can customize this value, e.g with:
-;; # -*- mode: Org; org-download-image-dir: ~/Pictures/foo; -*-
+;; # -*- mode: Org; org-download-image-dir: "~/Pictures/foo"; -*-
;; 2. second part is:
;; * `org-download-heading-lvl' is nil => ""
;; * `org-download-heading-lvl' is n => the name of current
@@ -112,6 +112,14 @@ Set this to \"\" if you don't want time stamps."
:type 'string
:group 'org-download)
+(defcustom org-download-img-regex-list
+ '("<img +src=\"" "<img +\\(class=\"[^\"]+\"\\)? *src=\"")
+ "This regex is used to unalias links that look like images.
+The html to which the links points will be searched for these
+regexes, one by one, until one succeeds. The found image address
+will be used."
+ :group 'org-download)
+
(defcustom org-download-screenshot-method "gnome-screenshot -a -f %s"
"The tool to capture screenshots."
:type '(choice
@@ -129,10 +137,13 @@ Set this to \"\" if you don't want time stamps."
"Return the heading of the current entry's LVL level parent."
(save-excursion
(let ((cur-lvl (org-current-level)))
+ (if cur-lvl
+ (progn
(unless (= cur-lvl 1)
(org-up-heading-all (- (1- (org-current-level)) lvl)))
(substring-no-properties
- (org-get-heading)))))
+ (org-get-heading)))
+ ""))))
(defun org-download--dir-1 ()
"Return the first part of the directory path for `org-download--dir'.
@@ -170,17 +181,22 @@ It's affected by `org-download-timestamp' and `org-download--dir'."
(car (url-path-and-query
(url-generic-parse-url link)))))
(dir (org-download--dir)))
- (format "%s/%s%s.%s"
- dir
+ (when (string-match ".*?\\.\\(?:png\\|jpg\\)\\(.*\\)$" filename)
+ (setq filename (replace-match "" nil nil filename 1)))
+ (abbreviate-file-name
+ (expand-file-name
+ (format "%s%s.%s"
(file-name-sans-extension filename)
(format-time-string org-download-timestamp)
- (file-name-extension filename))))
+ (file-name-extension filename))
+ dir))))
(defun org-download--image (link filename)
"Save LINK to FILENAME asynchronously and show inline images in current buffer."
(when (string-match "^file://\\(.*\\)" link)
(setq link (url-unhex-string (match-string 1 link))))
- (cond ((file-exists-p link)
+ (cond ((and (not (file-remote-p link))
+ (file-exists-p link))
(org-download--image/command "cp \"%s\" \"%s\"" link filename))
((eq org-download-backend t)
(org-download--image/url-retrieve link filename))
@@ -241,6 +257,19 @@ The screenshot tool is determined by `org-download-screenshot-method'."
(defun org-download-image (link)
"Save image at address LINK to `org-download--dir'."
(interactive "sUrl: ")
+ (unless (image-type-from-file-name link)
+ (with-current-buffer
+ (url-retrieve-synchronously link t)
+ (let ((regexes org-download-img-regex-list)
+ lnk)
+ (while (and (not lnk) regexes)
+ (goto-char (point-min))
+ (when (re-search-forward (pop regexes) nil t)
+ (backward-char)
+ (setq lnk (read (current-buffer)))))
+ (if lnk
+ (setq link lnk)
+ (error "link %s does not point to an image; unaliasing failed" link)))))
(let ((filename
(if (eq org-download-method 'attach)
(let ((org-download-image-dir (progn (require 'org-attach)
@@ -255,12 +284,14 @@ The screenshot tool is determined by `org-download-screenshot-method'."
(if (looking-back "^[ \t]+")
(delete-region (match-beginning 0) (match-end 0))
(newline))
- (insert (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
+ (insert
+ (format "#+DOWNLOADED: %s @ %s\n%s [[%s]]"
link
(format-time-string "%Y-%m-%d %H:%M:%S")
(if (= org-download-image-width 0)
""
- (format "#+attr_html: :width %dpx\n" org-download-image-width))
+ (format
+ "#+attr_html: :width %dpx\n" org-download-image-width))
filename))
(org-display-inline-images))))
@@ -299,7 +330,7 @@ When TIMES isn't nil, delete only TIMES links."
(while (and (>= (decf times) 0)
(re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" end t))
(let ((str (match-string-no-properties 1)))
- (delete-region (match-beginning 0)
+ (delete-region beg
(match-end 0))
(when (file-exists-p str)
(delete-file str))))))
@@ -307,16 +338,41 @@ When TIMES isn't nil, delete only TIMES links."
(defun org-download-dnd (uri action)
"When in `org-mode' and URI points to image, download it.
Otherwise, pass URI and ACTION back to dnd dispatch."
- (if (eq major-mode 'org-mode)
+ (cond ((eq major-mode 'org-mode)
;; probably shouldn't redirect
(unless (org-download-image uri)
- (message "not an image URL"))
+ (message "not an image URL")))
+ ((eq major-mode 'dired-mode)
+ (org-download-dired uri))
;; redirect to someone else
+ (t
(let ((dnd-protocol-alist
(rassq-delete-all
'org-download-dnd
(copy-alist dnd-protocol-alist))))
- (dnd-handle-one-url nil action uri))))
+ (dnd-handle-one-url nil action uri)))))
+
+(defun org-download-dired (uri)
+ "Download URI to current directory."
+ (raise-frame)
+ (let ((filename (file-name-nondirectory
+ (car (url-path-and-query
+ (url-generic-parse-url uri))))))
+ (message "Downloading %s to %s ..."
+ filename
+ (expand-file-name filename))
+ (url-retrieve
+ uri
+ (lambda (status filename)
+ (let ((err (plist-get status :error)))
+ (if err (error
+ "\"%s\" %s" uri
+ (downcase (nth 2 (assq (nth 2 err) url-http-codes))))))
+ (let ((coding-system-for-write 'no-conversion))
+ (write-region nil nil filename nil nil nil 'confirm)))
+ (list
+ (expand-file-name filename))
+ t t)))
(defun org-download-enable ()
"Enable org-download."
diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index e5b0d49..a78b806 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/org-drill.el
@@ -1,10 +1,28 @@
-;;; -*- coding: utf-8-unix -*-
+;; -*- coding: utf-8-unix -*-
;;; org-drill.el - Self-testing using spaced repetition
;;;
+;;; Copyright (C) 2010-2015 Paul Sexton
+;;;
;;; Author: Paul Sexton <eeeickythump@gmail.com>
-;;; Version: 2.4.1
+;;; Version: 2.4.7
+;;; Keywords: flashcards, memory, learning, memorization
;;; Repository at http://bitbucket.org/eeeickythump/org-drill/
;;;
+;;; 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, 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/>.
+;;;
;;;
;;; Synopsis
;;; ========
@@ -31,6 +49,7 @@
(require 'org)
(require 'org-id)
(require 'org-learn)
+(require 'savehist)
(defgroup org-drill nil
@@ -203,6 +222,8 @@ during a drill session."
face default
window t))
+(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
+
(defvar org-drill-hint-separator "||"
"String which, if it occurs within a cloze expression, signifies that the
@@ -233,6 +254,23 @@ the hidden cloze during a test.")
(org-drill--compute-cloze-keywords))
+;; Variables defining what keys can be pressed during drill sessions to quit the
+;; session, edit the item, etc.
+(defvar org-drill--quit-key ?q
+ "If this character is pressed during a drill session, quit the session.")
+(defvar org-drill--edit-key ?e
+ "If this character is pressed during a drill session, suspend the session
+with the cursor at the current item..")
+(defvar org-drill--help-key ??
+ "If this character is pressed during a drill session, show help.")
+(defvar org-drill--skip-key ?s
+ "If this character is pressed during a drill session, skip to the next
+item.")
+(defvar org-drill--tags-key ?t
+ "If this character is pressed during a drill session, edit the tags for
+the current item.")
+
+
(defcustom org-drill-card-type-alist
'((nil org-drill-present-simple-card)
("simple" org-drill-present-simple-card)
@@ -349,16 +387,37 @@ Available choices are:
(defcustom org-drill-optimal-factor-matrix
nil
+ "Obsolete and will be removed in future. The SM5 optimal factor
+matrix data is now stored in the variable
+`org-drill-sm5-optimal-factor-matrix'."
+ :group 'org-drill
+ :type 'sexp)
+
+
+(defvar org-drill-sm5-optimal-factor-matrix
+ nil
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
-Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm.
-The matrix is saved (using the 'customize' facility) at the end of each
-drill session.
+Persistent matrix of optimal factors, used by the SuperMemo SM5
+algorithm. The matrix is saved at the end of each drill session.
Over time, values in the matrix will adapt to the individual user's
-pace of learning."
- :group 'org-drill
- :type 'sexp)
+pace of learning.")
+
+
+(add-to-list 'savehist-additional-variables
+ 'org-drill-sm5-optimal-factor-matrix)
+(unless savehist-mode
+ (savehist-mode 1))
+
+
+(defun org-drill--transfer-optimal-factor-matrix ()
+ (if (and org-drill-optimal-factor-matrix
+ (null org-drill-sm5-optimal-factor-matrix))
+ (setq org-drill-sm5-optimal-factor-matrix
+ org-drill-optimal-factor-matrix)))
+
+(add-hook 'after-init-hook 'org-drill--transfer-optimal-factor-matrix)
(defcustom org-drill-sm5-initial-interval
@@ -512,6 +571,11 @@ for review unless they were already reviewed in the recent past?")
'("LEARN_DATA" "DRILL_LAST_INTERVAL" "DRILL_REPEATS_SINCE_FAIL"
"DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY"
"DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED"))
+(defvar org-drill--lapse-very-overdue-entries-p nil
+ "If non-nil, entries more than 90 days overdue are regarded as 'lapsed'.
+This means that when the item is eventually re-tested it will be
+treated as 'failed' (quality 2) for rescheduling purposes,
+regardless of whether the test was successful.")
;;; Make the above settings safe as file-local variables.
@@ -974,7 +1038,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
;; When an item is failed, its interval is reset to 0,
;; but its EF is unchanged
(list -1 1 ef (1+ failures) meanq (1+ total-repeats)
- org-drill-optimal-factor-matrix)
+ org-drill-sm5-optimal-factor-matrix)
;; else:
(let* ((next-ef (modify-e-factor ef quality))
(interval
@@ -998,7 +1062,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(1+ n)
next-ef
failures meanq (1+ total-repeats)
- org-drill-optimal-factor-matrix))))
+ org-drill-sm5-optimal-factor-matrix))))
;;; SM5 Algorithm =============================================================
@@ -1020,7 +1084,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix)
(let ((of (get-optimal-factor-sm5 n ef (or of-matrix
- org-drill-optimal-factor-matrix))))
+ org-drill-sm5-optimal-factor-matrix))))
(if (= 1 n)
of
(* of last-interval))))
@@ -1034,7 +1098,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher
(assert (> n 0))
(assert (and (>= quality 0) (<= quality 5)))
(unless of-matrix
- (setq of-matrix org-drill-optimal-factor-matrix))
+ (setq of-matrix org-drill-sm5-optimal-factor-matrix))
(setq of-matrix (cl-copy-tree of-matrix))
(setq meanq (if meanq
@@ -1198,9 +1262,9 @@ See the documentation for `org-drill-get-item-data' for a description of these."
"If DAYS-AHEAD is supplied it must be a positive integer. The
item will be scheduled exactly this many days into the future."
(let ((delta-days (- (time-to-days (current-time))
- (time-to-days (or (org-get-scheduled-time (point))
- (current-time)))))
- (ofmatrix org-drill-optimal-factor-matrix)
+ (time-to-days (or (org-get-scheduled-time (point))
+ (current-time)))))
+ (ofmatrix org-drill-sm5-optimal-factor-matrix)
;; Entries can have weights, 1 by default. Intervals are divided by the
;; item's weight, so an item with a weight of 2 will have all intervals
;; halved, meaning you will end up reviewing it twice as often.
@@ -1239,7 +1303,7 @@ item will be scheduled exactly this many days into the future."
total-repeats meanq ease)
(if (eql 'sm5 org-drill-spaced-repetition-algorithm)
- (setq org-drill-optimal-factor-matrix new-ofmatrix))
+ (setq org-drill-sm5-optimal-factor-matrix new-ofmatrix))
(cond
((= 0 days-ahead)
@@ -1269,7 +1333,7 @@ of QUALITY."
(sm5 (determine-next-interval-sm5 last-interval repetitions
ease quality failures
meanq total-repeats
- org-drill-optimal-factor-matrix))
+ org-drill-sm5-optimal-factor-matrix))
(sm2 (determine-next-interval-sm2 last-interval repetitions
ease quality failures
meanq total-repeats))
@@ -1299,11 +1363,19 @@ of QUALITY."
"Returns quality rating (0-5), or nil if the user quit."
(let ((ch nil)
(input nil)
- (next-review-dates (org-drill-hypothetical-next-review-dates)))
+ (next-review-dates (org-drill-hypothetical-next-review-dates))
+ (key-prompt (format "(0-5, %c=help, %c=edit, %c=tags, %c=quit)"
+ org-drill--help-key
+ org-drill--edit-key
+ org-drill--tags-key
+ org-drill--quit-key)))
(save-excursion
- (while (not (memq ch '(?q ?e ?0 ?1 ?2 ?3 ?4 ?5)))
+ (while (not (memq ch (list org-drill--quit-key
+ org-drill--edit-key
+ 7 ; C-g
+ ?0 ?1 ?2 ?3 ?4 ?5)))
(setq input (read-key-sequence
- (if (eq ch ??)
+ (if (eq ch org-drill--help-key)
(format "0-2 Means you have forgotten the item.
3-5 Means you have remembered the item.
@@ -1314,11 +1386,12 @@ of QUALITY."
4 - After a little bit of thought you remembered. (+%s days)
5 - You remembered the item really easily. (+%s days)
-How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
+How well did you do? %s"
(round (nth 3 next-review-dates))
(round (nth 4 next-review-dates))
- (round (nth 5 next-review-dates)))
- "How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)")))
+ (round (nth 5 next-review-dates))
+ key-prompt)
+ (format "How well did you do? %s" key-prompt))))
(cond
((stringp input)
(setq ch (elt input 0)))
@@ -1335,7 +1408,7 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(case (car (elt input 0))
(wheel-up (ignore-errors (mwheel-scroll (elt input 0))))
(wheel-down (ignore-errors (mwheel-scroll (elt input 0)))))))
- (if (eql ch ?t)
+ (if (eql ch org-drill--tags-key)
(org-set-tags-command))))
(cond
((and (>= ch ?0) (<= ch ?5))
@@ -1343,8 +1416,9 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(failures (org-drill-entry-failure-count)))
(unless *org-drill-cram-mode*
(save-excursion
- (org-drill-smart-reschedule quality
- (nth quality next-review-dates)))
+ (let ((quality (if (org-drill--entry-lapsed-p) 2 quality)))
+ (org-drill-smart-reschedule quality
+ (nth quality next-review-dates))))
(push quality *org-drill-session-qualities*)
(cond
((<= quality org-drill-failure-quality)
@@ -1363,9 +1437,9 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)"
(sit-for 0.5)))))
(org-set-property "DRILL_LAST_QUALITY" (format "%d" quality))
(org-set-property "DRILL_LAST_REVIEWED"
- (time-to-active-org-timestamp (current-time))))
+ (time-to-inactive-org-timestamp (current-time))))
quality))
- ((= ch ?e)
+ ((= ch org-drill--edit-key)
'edit)
(t
nil))))
@@ -1436,8 +1510,12 @@ the current topic."
(apply 'format
(first fmt-and-args)
(rest fmt-and-args))
- (concat "Press key for answer, "
- "e=edit, t=tags, s=skip, q=quit."))))
+ (format (concat "Press key for answer, "
+ "%c=edit, %c=tags, %c=skip, %c=quit.")
+ org-drill--edit-key
+ org-drill--tags-key
+ org-drill--skip-key
+ org-drill--quit-key))))
(setq prompt
(format "%s %s %s %s %s %s"
(propertize
@@ -1483,7 +1561,7 @@ 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 (memq ch '(nil org-drill--tags-key))
(setq ch nil)
(while (not (input-pending-p))
(let ((elapsed (time-subtract (current-time) item-start-time)))
@@ -1494,12 +1572,12 @@ Consider reformulating the item to make it easier to remember.\n"
(sit-for 1)))
(setq input (read-key-sequence nil))
(if (stringp input) (setq ch (elt input 0)))
- (if (eql ch ?t)
+ (if (eql ch org-drill--tags-key)
(org-set-tags-command)))
(case ch
- (?q nil)
- (?e 'edit)
- (?s 'skip)
+ (org-drill--quit-key nil)
+ (org-drill--edit-key 'edit)
+ (org-drill--skip-key 'skip)
(otherwise t))))
@@ -1548,12 +1626,15 @@ visual overlay, or with the string TEXT if it is supplied."
(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.
- ;; And don't hide LaTeX math fragments.
+ ;; Don't hide:
+ ;; - org links, partly because they might contain inline
+ ;; images which we want to keep visible.
+ ;; - LaTeX math fragments
+ ;; - the contents of SRC blocks
(unless (save-match-data
(or (org-pos-in-regexp (match-beginning 0)
org-bracket-link-regexp 1)
+ (org-in-src-block-p)
(org-inside-LaTeX-fragment-p)))
(org-drill-hide-matched-cloze-text)))))
@@ -1704,7 +1785,9 @@ Note: does not actually alter the item."
(org-back-to-heading t)
(let ((lim (save-excursion
(outline-next-heading) (point))))
- (org-end-of-meta-data-and-drawers)
+ (if (fboundp 'org-end-of-meta-data-and-drawers)
+ (org-end-of-meta-data-and-drawers) ; function removed Feb 2015
+ (org-end-of-meta-data t))
(or (>= (point) lim)
(null (re-search-forward "[[:graph:]]" lim t))))))
@@ -1720,12 +1803,13 @@ Note: does not actually alter the item."
;; 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-comments
(with-hidden-cloze-hints
(with-hidden-cloze-text
(org-drill-hide-all-subheadings-except nil)
- (org-preview-latex-fragment) ; overlay all LaTeX fragments with images
+ (org-drill--show-latex-fragments) ; overlay all LaTeX fragments with images
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1744,7 +1828,7 @@ Note: does not actually alter the item."
(t
(org-drill-hide-subheadings-if 'org-drill-entry-p)
(org-drill-unhide-clozed-text)
- (org-preview-latex-fragment)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1752,6 +1836,13 @@ Note: does not actually alter the item."
(funcall reschedule-fn)))))
+(defun org-drill--show-latex-fragments ()
+ (org-remove-latex-fragment-image-overlays)
+ (if (fboundp 'org-toggle-latex-fragment)
+ (org-toggle-latex-fragment '(4))
+ (org-preview-latex-fragment '(4))))
+
+
(defun org-drill-present-two-sided-card ()
(with-hidden-comments
(with-hidden-cloze-hints
@@ -1762,7 +1853,7 @@ Note: does not actually alter the item."
(goto-char (nth (random* (min 2 (length drill-sections)))
drill-sections))
(org-show-subtree)))
- (org-preview-latex-fragment)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1780,7 +1871,7 @@ Note: does not actually alter the item."
(save-excursion
(goto-char (nth (random* (length drill-sections)) drill-sections))
(org-show-subtree)))
- (org-preview-latex-fragment)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1862,7 +1953,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)."
;; while (org-pos-in-regexp (match-beginning 0)
;; org-bracket-link-regexp 1))
;; (org-drill-hide-matched-cloze-text)))))
- (org-preview-latex-fragment)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -1911,12 +2002,12 @@ the second to last, etc."
;; org link, or if it occurs inside a LaTeX math
;; fragment
(or (org-pos-in-regexp (match-beginning 0)
- org-bracket-link-regexp 1)
+ org-bracket-link-regexp 1)
(org-inside-LaTeX-fragment-p)))
(incf cnt)
(if (= cnt to-hide)
(org-drill-hide-matched-cloze-text)))))))
- (org-preview-latex-fragment)
+ (org-drill--show-latex-fragments)
(ignore-errors
(org-display-inline-images t))
(org-cycle-hide-drawers 'all)
@@ -2111,26 +2202,28 @@ See `org-drill' for more details."
'org-drill-present-default-answer)
present-empty-cards (third presentation-fn)
presentation-fn (first presentation-fn)))
- (cond
- ((null presentation-fn)
- (message "%s:%d: Unrecognised card type '%s', skipping..."
- (buffer-name) (point) card-type)
- (sit-for 0.5)
- 'skip)
- (t
- (setq cont (funcall presentation-fn))
- (cond
- ((not cont)
- (message "Quit")
- nil)
- ((eql cont 'edit)
- 'edit)
- ((eql cont 'skip)
- 'skip)
- (t
- (save-excursion
- (funcall answer-fn
- (lambda () (org-drill-reschedule)))))))))))))
+ (prog1
+ (cond
+ ((null presentation-fn)
+ (message "%s:%d: Unrecognised card type '%s', skipping..."
+ (buffer-name) (point) card-type)
+ (sit-for 0.5)
+ 'skip)
+ (t
+ (setq cont (funcall presentation-fn))
+ (cond
+ ((not cont)
+ (message "Quit")
+ nil)
+ ((eql cont 'edit)
+ 'edit)
+ ((eql cont 'skip)
+ 'skip)
+ (t
+ (save-excursion
+ (funcall answer-fn
+ (lambda () (org-drill-reschedule))))))))
+ (org-remove-latex-fragment-image-overlays)))))))
(defun org-drill-entries-pending-p ()
@@ -2384,17 +2477,57 @@ all the markers used by Org-Drill will be freed."
(free-marker m)))
+;;; overdue-data is a list of entries, each entry has the form (POS DUE AGE)
+;;; where POS is a marker pointing to the start of the entry, and
+;;; DUE is a number indicating how many days ago the entry was due.
+;;; AGE is the number of days elapsed since item creation (nil if unknown).
+;;; if age > lapse threshold (default 90), sort by age (oldest first)
+;;; if age < lapse threshold, sort by due (biggest first)
+
+
(defun org-drill-order-overdue-entries (overdue-data)
- (setq *org-drill-overdue-entries*
- (mapcar 'car
- (sort (shuffle-list overdue-data)
- (lambda (a b) (> (cdr a) (cdr b)))))))
+ (let* ((lapsed-days (if org-drill--lapse-very-overdue-entries-p
+ 90 most-positive-fixnum))
+ (not-lapsed (remove-if (lambda (a) (> (or (second a) 0) lapsed-days))
+ overdue-data))
+ (lapsed (remove-if-not (lambda (a) (> (or (second a) 0)
+ lapsed-days)) overdue-data)))
+ (setq *org-drill-overdue-entries*
+ (mapcar 'first
+ (append
+ (sort (shuffle-list not-lapsed)
+ (lambda (a b) (> (second a) (second b))))
+ (sort lapsed
+ (lambda (a b) (> (third a) (third b)))))))))
+
+
+(defun org-drill--entry-lapsed-p ()
+ (let ((lapsed-days 90))
+ (and org-drill--lapse-very-overdue-entries-p
+ (> (or (org-drill-entry-days-overdue) 0) lapsed-days))))
+
+
+
+
+(defun org-drill-entry-days-since-creation (&optional use-last-interval-p)
+ "If USE-LAST-INTERVAL-P is non-nil, and DATE_ADDED is missing, use the
+value of DRILL_LAST_INTERVAL instead (as the item's age must be at least
+that many days)."
+ (let ((timestamp (org-entry-get (point) "DATE_ADDED")))
+ (cond
+ (timestamp
+ (- (org-time-stamp-to-now timestamp)))
+ (use-last-interval-p
+ (+ (or (org-drill-entry-days-overdue) 0)
+ (read (or (org-entry-get (point) "DRILL_LAST_INTERVAL") "0"))))
+ (t nil))))
(defun org-drill-entry-status ()
- "Returns a list (STATUS DUE) where DUE is the number of days overdue,
-zero being due today, -1 being scheduled 1 day in the future. STATUS is
-one of the following values:
+ "Returns a list (STATUS DUE AGE) where DUE is the number of days overdue,
+zero being due today, -1 being scheduled 1 day in the future.
+AGE is the number of days elapsed since the item was created (nil if unknown).
+STATUS is one of the following values:
- nil, if the item is not a drill entry, or has an empty body
- :unscheduled
- :future
@@ -2408,6 +2541,7 @@ one of the following values:
(unless (org-at-heading-p)
(org-back-to-heading))
(let ((due (org-drill-entry-days-overdue))
+ (age (org-drill-entry-days-since-creation t))
(last-int (org-drill-entry-last-interval 1)))
(list
(cond
@@ -2446,7 +2580,7 @@ one of the following values:
:young)
(t
:old))
- due))))
+ due age))))
(defun org-drill-progress-message (collected scanned)
@@ -2455,11 +2589,55 @@ one of the following values:
(sym1 (if (oddp (floor scanned (* 50 meter-width))) ?| ?.))
(sym2 (if (eql sym1 ?.) ?| ?.)))
(message "Collecting due drill items:%4d %s%s"
- collected
- (make-string (% (ceiling scanned 50) meter-width)
- sym2)
- (make-string (- meter-width (% (ceiling scanned 50) meter-width))
- sym1)))))
+ collected
+ (make-string (% (ceiling scanned 50) meter-width)
+ sym2)
+ (make-string (- meter-width (% (ceiling scanned 50) meter-width))
+ sym1)))))
+
+
+(defun org-map-drill-entry-function ()
+ (org-drill-progress-message
+ (+ (length *org-drill-new-entries*)
+ (length *org-drill-overdue-entries*)
+ (length *org-drill-young-mature-entries*)
+ (length *org-drill-old-mature-entries*)
+ (length *org-drill-failed-entries*))
+ (incf cnt))
+ (cond
+ ((not (org-drill-entry-p))
+ nil) ; skip
+ (t
+ (when (and (not warned-about-id-creation)
+ (null (org-id-get)))
+ (message (concat "Creating unique IDs for items "
+ "(slow, but only happens once)"))
+ (sit-for 0.5)
+ (setq warned-about-id-creation t))
+ (org-id-get-create) ; ensure drill entry has unique ID
+ (destructuring-bind (status due age)
+ (org-drill-entry-status)
+ (case status
+ (:unscheduled
+ (incf *org-drill-dormant-entry-count*))
+ ;; (:tomorrow
+ ;; (incf *org-drill-dormant-entry-count*)
+ ;; (incf *org-drill-due-tomorrow-count*))
+ (:future
+ (incf *org-drill-dormant-entry-count*)
+ (if (eq -1 due)
+ (incf *org-drill-due-tomorrow-count*)))
+ (:new
+ (push (point-marker) *org-drill-new-entries*))
+ (:failed
+ (push (point-marker) *org-drill-failed-entries*))
+ (:young
+ (push (point-marker) *org-drill-young-mature-entries*))
+ (:overdue
+ (push (list (point-marker) due age) overdue-data))
+ (:old
+ (push (point-marker) *org-drill-old-mature-entries*))
+ )))))
(defun org-drill (&optional scope drill-match resume-p)
@@ -2535,47 +2713,7 @@ work correctly with older versions of org mode. Your org mode version (%s) appea
(let ((org-trust-scanner-tags t)
(warned-about-id-creation nil))
(org-map-drill-entries
- (lambda ()
- (org-drill-progress-message
- (+ (length *org-drill-new-entries*)
- (length *org-drill-overdue-entries*)
- (length *org-drill-young-mature-entries*)
- (length *org-drill-old-mature-entries*)
- (length *org-drill-failed-entries*))
- (incf cnt))
- (cond
- ((not (org-drill-entry-p))
- nil) ; skip
- (t
- (when (and (not warned-about-id-creation)
- (null (org-id-get)))
- (message (concat "Creating unique IDs for items "
- "(slow, but only happens once)"))
- (sit-for 0.5)
- (setq warned-about-id-creation t))
- (org-id-get-create) ; ensure drill entry has unique ID
- (destructuring-bind (status due) (org-drill-entry-status)
- (case status
- (:unscheduled
- (incf *org-drill-dormant-entry-count*))
- ;; (:tomorrow
- ;; (incf *org-drill-dormant-entry-count*)
- ;; (incf *org-drill-due-tomorrow-count*))
- (:future
- (incf *org-drill-dormant-entry-count*)
- (if (eq -1 due)
- (incf *org-drill-due-tomorrow-count*)))
- (:new
- (push (point-marker) *org-drill-new-entries*))
- (:failed
- (push (point-marker) *org-drill-failed-entries*))
- (:young
- (push (point-marker) *org-drill-young-mature-entries*))
- (:overdue
- (push (cons (point-marker) due) overdue-data))
- (:old
- (push (point-marker) *org-drill-old-mature-entries*))
- )))))
+ 'org-map-drill-entry-function
scope drill-match)
(org-drill-order-overdue-entries overdue-data)
(setq *org-drill-overdue-entry-count*
@@ -2618,9 +2756,7 @@ work correctly with older versions of org mode. Your org mode version (%s) appea
(defun org-drill-save-optimal-factor-matrix ()
- (message "Saving optimal factor matrix...")
- (customize-save-variable 'org-drill-optimal-factor-matrix
- org-drill-optimal-factor-matrix))
+ (savehist-autosave))
(defun org-drill-cram (&optional scope drill-match)
@@ -2731,7 +2867,6 @@ values as `org-drill-scope'."
(add-to-list 'org-font-lock-extra-keywords
(first org-drill-cloze-keywords))))
-(add-hook 'org-font-lock-set-keywords-hook 'org-drill-add-cloze-fontification)
;; Can't add to org-mode-hook, because local variables won't have been loaded
;; yet.
diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el
index 9981712..a653802 100644
--- a/contrib/lisp/org-effectiveness.el
+++ b/contrib/lisp/org-effectiveness.el
@@ -1,6 +1,6 @@
;;; org-effectiveness.el --- Measuring the personal effectiveness
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
;; Keywords: effectiveness, plot
@@ -42,9 +42,10 @@ many TODO pending"
(defun org-effectiveness-advice()
"Advicing about a possible excess of TODOS"
(interactive)
- (goto-char (point-min))
- (if (< org-effectiveness-max-todo (count-matches "* TODO"))
- (message "An excess of TODOS!")))
+ (save-excursion
+ (goto-char (point-min))
+ (if (< org-effectiveness-max-todo (count-matches "* TODO"))
+ (message "An excess of TODOS!"))))
;; Check advice starting an org file
(add-hook 'org-mode-hook 'org-effectiveness-advice)
@@ -77,6 +78,13 @@ many TODO pending"
(goto-char (point-min))
(message "Number of Canceled: %d" (count-matches "* CANCEL+ED"))))
+(defun org-effectiveness-count-task()
+ "Print a message with the number of tasks and subtasks in the current buffer"
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (message "Number of tasks: %d" (count-matches "^*"))))
+
(defun org-effectiveness()
"Returns the effectiveness in the current org buffer"
(interactive)
@@ -89,25 +97,41 @@ many TODO pending"
(setq effectiveness (* 100 (/ done (+ done canc)))))
(message "Effectiveness: %f" effectiveness))))
+
(defun org-effectiveness-keywords-in-date(keyword date)
(interactive "sKeyword: \nsDate: " keyword date)
(setq count (count-matches (concat keyword ".*\n.*" date)))
(message (concat "%sS: %d" keyword count)))
-(defun org-effectiveness-dones-in-date(date)
- (interactive "sGive me a date: " date)
- (setq count (count-matches (concat "DONE.*\n.*" date)))
- (message "DONES: %d" count))
+(defun org-effectiveness-dones-in-date(date &optional notmessage)
+ (interactive "sGive me a date: " date)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((count (count-matches (concat "DONE.*\n.*" date))))
+ (if (eq notmessage 1)
+ (message "%d" count)
+ (message "DONES: %d " count)))))
-(defun org-effectivenes-todos-in-date(date)
- (interactive "sGive me a date: " date)
- (setq count (count-matches (concat "TODO.*\n.*" date)))
- (message "TODOS: %d" count))
+(defun org-effectiveness-todos-in-date(date)
+ (interactive "sGive me a date: " date)
+ (save-excursion
+ (goto-char (point-min))
+ (setq count (count-matches (concat "TODO.*\n.*" date)))
+ (message "TODOS: %d" count)))
(defun org-effectiveness-canceled-in-date(date)
- (interactive "sGive me a date: " date)
- (setq count (count-matches (concat "CANCEL+ED.*\n.*" date)))
- (message "CANCELEDS: %d" count))
+ (interactive "sGive me a date: " date)
+ (save-excursion
+ (goto-char (point-min))
+ (setq count (count-matches (concat "CANCEL+ED.*\n.*" date)))
+ (message "CANCELEDS: %d" count)))
+
+(defun org-effectiveness-ntasks-in-date(date &optional notmessage)
+ (interactive "sGive me a date: " date)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((tasks (float (count-matches (concat "^*.*\n.*" date)))))
+ (message "%d" tasks))))
(defun org-effectiveness-in-date(date &optional notmessage)
(interactive "sGive me a date: " date)
@@ -127,7 +151,7 @@ many TODO pending"
(concat "0" (number-to-string m))
(number-to-string m)))
-(defun org-effectiveness-plot(startdate enddate)
+(defun org-effectiveness-plot(startdate enddate &optional save)
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
(setq dates (org-effectiveness-check-dates startdate enddate))
(setq syear (cadr (assoc 'startyear dates)))
@@ -156,7 +180,7 @@ many TODO pending"
(let ((month startmonth)
(year startyear)
(str ""))
- (while (and (>= endyear year) (>= endmonth month))
+ (while (or (> endyear year) (and (= endyear year) (>= endmonth month)))
(setq str (concat str (number-to-string year) "-" (org-effectiveness-month-to-string month) " " (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1) "\n"))
(if (= month 12)
(progn
@@ -165,10 +189,20 @@ many TODO pending"
(setq month (+ 1 month))))
(write-region str nil "/tmp/org-effectiveness"))
;; Create the bar graph
+ (if (eq save t)
+ (setq strplot "/usr/bin/gnuplot -e 'set term png; set output \"/tmp/org-effectiveness.png\"; plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p")
+ (setq strplot "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p"))
(if (file-exists-p "/usr/bin/gnuplot")
- (call-process "/bin/bash" nil t nil "-c" "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p")
+ (call-process "/bin/bash" nil t nil "-c" strplot)
(message "gnuplot is not installed")))
+(defun org-effectiveness-plot-save(startdate enddate &optional save)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (org-effectiveness-plot startdate enddate t))
+
+;; (defun org-effectiveness-plot(startdate enddate)
+
+
(defun org-effectiveness-ascii-bar(n &optional label)
"Print a bar with the percentage from 0 to 100 printed in ascii"
(interactive "nPercentage: \nsLabel: ")
@@ -196,6 +230,18 @@ many TODO pending"
(setq z (+ z 1)))
(insert "+"))))
+(defun org-effectiveness-html-bar(n &optional label)
+ "Print a bar with the percentage from 0 to 100 printed in html"
+ (interactive "nPercentage: \nsLabel: ")
+ (if (or (< n 0) (> n 100))
+ (message "The percentage must be between 0 to 100")
+ (let ((x 0)
+ (y 0)
+ (z 0))
+ (insert (format "\n<div class='percentage-%d'>%d</div>" n n))
+)))
+
+
(defun org-effectiveness-check-dates (startdate enddate)
"Generate a list with ((startyear startmonth) (endyear endmonth))"
(setq str nil)
@@ -245,5 +291,80 @@ many TODO pending"
(switch-to-buffer "*org-effectiveness*"))
+(defun org-effectiveness-plot-ascii-ntasks (startdate enddate)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
+ (str ""))
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-ntasks-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness*")
+ (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (if (eq month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month)))))
+ (switch-to-buffer "*org-effectiveness*"))
+
+(defun org-effectiveness-plot-ascii-dones (startdate enddate)
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
+ (str ""))
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-dones-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness*")
+ (org-effectiveness-ascii-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (if (eq month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month)))))
+ (switch-to-buffer "*org-effectiveness*"))
+
+
+(defun org-effectiveness-plot-html (startdate enddate)
+ "Print html bars about the effectiveness in a buffer"
+ (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
+ (setq dates (org-effectiveness-check-dates startdate enddate))
+ (let ((syear (cadr (assoc 'startyear dates)))
+ (smonth (cadr (assoc 'startmonth dates)))
+ (year (cadr (assoc 'startyear dates)))
+ (month (cadr (assoc 'startmonth dates)))
+ (emonth (cadr (assoc 'endmonth dates)))
+ (eyear (cadr (assoc 'endyear dates)))
+ (buffer (current-buffer))
+ (str ""))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (insert "<html><head><title>Graphbar</title><meta http-equiv='Content-type' content='text/html; charset=utf-8'><link rel='stylesheet' type='text/css' href='graphbar.css' title='graphbar'></head><body>")
+ (while (or (> eyear year) (and (= eyear year) (>= emonth month)))
+ (setq str (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (org-effectiveness-html-bar (string-to-number str) (format "%s-%s" year month))
+ (switch-to-buffer buffer)
+ (format "%s-%s" year month)
+ (if (eq month 12)
+ (progn
+ (setq year (+ 1 year))
+ (setq month 1))
+ (setq month (+ 1 month))))
+ (switch-to-buffer "*org-effectiveness-html*")
+ (insert "</body></html>")))
+
(provide 'org-effectiveness)
diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el
new file mode 100644
index 0000000..3b112a6
--- a/dev/null
+++ b/contrib/lisp/org-eldoc.el
@@ -0,0 +1,173 @@
+;;; org-eldoc.el --- display org header and src block info using eldoc
+
+;; Copyright (c) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Łukasz Gruner <lukasz@gruner.lu>
+;; Maintainer: Łukasz Gruner <lukasz@gruner.lu>
+;; Version: 6
+;; Package-Requires: ((org "8"))
+;; URL: https://bitbucket.org/ukaszg/org-eldoc
+;; Created: 25/05/2014
+;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer
+
+;; This file is not part of 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:
+
+;;; Changelog:
+
+;; As of 01/11/14 switching license to GPL3 to allow submission to org-mode.
+;; 08/11/14 switch code to automatically define eldoc-documentation-function, but don't autostart eldoc-mode.
+
+;;; Code:
+
+(require 'org)
+(require 'ob-core)
+(require 'eldoc)
+
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+
+(defgroup org-eldoc nil "" :group 'org)
+
+(defcustom org-eldoc-breadcrumb-separator "/"
+ "Breadcrumb separator."
+ :group 'org-eldoc
+ :type 'string)
+
+(defcustom org-eldoc-test-buffer-name " *Org-eldoc test buffer*"
+ "Name of the buffer used while testing for mode-local variable values."
+ :group 'org-eldoc
+ :type 'string)
+
+(defun org-eldoc-get-breadcrumb ()
+ "Return breadcrumb if on a headline or nil."
+ (let ((case-fold-search t) cur)
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (when (looking-at org-complex-heading-regexp)
+ (setq cur (match-string 4))
+ (org-format-outline-path
+ (append (org-get-outline-path) (list cur))
+ (frame-width) "" org-eldoc-breadcrumb-separator))))))
+
+(defun org-eldoc-get-src-header ()
+ "Returns lang and list of header properties if on src definition line and nil otherwise."
+ (let ((case-fold-search t) info lang hdr-args)
+ (save-excursion
+ (beginning-of-line)
+ (save-match-data
+ (when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src")
+ (setq info (org-babel-get-src-block-info 'light)
+ lang (propertize (nth 0 info) 'face 'font-lock-string-face)
+ hdr-args (nth 2 info))
+ (concat
+ lang
+ ": "
+ (mapconcat
+ (lambda (elem)
+ (when (and (cdr elem) (not (string= "" (cdr elem))))
+ (concat
+ (propertize (symbol-name (car elem)) 'face 'org-list-dt)
+ " "
+ (propertize (cdr elem) 'face 'org-verbatim)
+ " ")))
+ hdr-args " ")))))))
+
+(defun org-eldoc-get-src-lang ()
+ "Return value of lang for the current block if in block body and nil otherwise."
+ (let ((element (save-match-data (org-element-at-point))))
+ (and (eq (org-element-type element) 'src-block)
+ (>= (line-beginning-position)
+ (org-element-property :post-affiliated element))
+ (<=
+ (line-end-position)
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-end-position)))
+ (org-element-property :language element))))
+
+(defvar org-eldoc-local-functions-cache (make-hash-table :size 40 :test 'equal)
+ "Cache of major-mode's eldoc-documentation-functions,
+ used by \\[org-eldoc-get-mode-local-documentation-function].")
+
+(defun org-eldoc-get-mode-local-documentation-function (lang)
+ "Check if LANG-mode sets eldoc-documentation-function and return its value."
+ (let ((cached-func (gethash lang org-eldoc-local-functions-cache 'empty))
+ (mode-func (intern-soft (format "%s-mode" lang)))
+ doc-func)
+ (if (eq 'empty cached-func)
+ (when (fboundp mode-func)
+ (with-temp-buffer
+ (funcall mode-func)
+ (setq doc-func (and eldoc-documentation-function
+ (symbol-value 'eldoc-documentation-function)))
+ (puthash lang doc-func org-eldoc-local-functions-cache))
+ doc-func)
+ cached-func)))
+
+(declare-function c-eldoc-print-current-symbol-info "c-eldoc" ())
+(declare-function css-eldoc-function "css-eldoc" ())
+(declare-function php-eldoc-function "php-eldoc" ())
+(declare-function go-eldoc--documentation-function "go-eldoc" ())
+
+(defun org-eldoc-documentation-function ()
+ "Return breadcrumbs when on a headline, args for src block header-line,
+ calls other documentation functions depending on lang when inside src body."
+ (or
+ (org-eldoc-get-breadcrumb)
+ (org-eldoc-get-src-header)
+ (let ((lang (org-eldoc-get-src-lang)))
+ (cond ((or
+ (string= lang "emacs-lisp")
+ (string= lang "elisp")) (if (fboundp 'elisp-eldoc-documentation-function)
+ (elisp-eldoc-documentation-function)
+ (let (eldoc-documentation-function)
+ (eldoc-print-current-symbol-info))))
+ ((or
+ (string= lang "c") ;; http://github.com/nflath/c-eldoc
+ (string= lang "C")) (when (require 'c-eldoc nil t)
+ (c-eldoc-print-current-symbol-info)))
+ ;; https://github.com/zenozeng/css-eldoc
+ ((string= lang "css") (when (require 'css-eldoc nil t)
+ (css-eldoc-function)))
+ ;; https://github.com/zenozeng/php-eldoc
+ ((string= lang "php") (when (require 'php-eldoc nil t)
+ (php-eldoc-function)))
+ ((or
+ (string= lang "go")
+ (string= lang "golang")) (when (require 'go-eldoc nil t)
+ (go-eldoc--documentation-function)))
+ (t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang)))
+ (when (fboundp doc-fun) (funcall doc-fun))))))))
+
+;;;###autoload
+(defun org-eldoc-load ()
+ "Set up org-eldoc documentation function."
+ (interactive)
+ (setq-local eldoc-documentation-function #'org-eldoc-documentation-function))
+
+;;;###autoload
+(add-hook 'org-mode-hook #'org-eldoc-load)
+
+(provide 'org-eldoc)
+
+;; -*- coding: utf-8-emacs; -*-
+
+;;; org-eldoc.el ends here
diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el
index 167731e..cdf868b 100644
--- a/contrib/lisp/org-elisp-symbol.el
+++ b/contrib/lisp/org-elisp-symbol.el
@@ -1,6 +1,6 @@
;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols
;;
-;; Copyright 2007-2014 Free Software Foundation, Inc.
+;; Copyright 2007-2016 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el
index 872f3a4..1449b24 100644
--- a/contrib/lisp/org-eval-light.el
+++ b/contrib/lisp/org-eval-light.el
@@ -1,6 +1,6 @@
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Eric Schulte <schulte dot eric at gmail dot com>
diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el
index cb5620c..92a4a19 100644
--- a/contrib/lisp/org-eval.el
+++ b/contrib/lisp/org-eval.el
@@ -1,5 +1,5 @@
;;; org-eval.el --- Display result of evaluating code in various languages
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-eww.el b/contrib/lisp/org-eww.el
new file mode 100644
index 0000000..11ccb68
--- a/dev/null
+++ b/contrib/lisp/org-eww.el
@@ -0,0 +1,171 @@
+;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
+;; Keywords: link, eww
+;; Homepage: http://orgmode.org
+;;
+;; 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, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; When this module is active `org-store-link' (often on key C-c l) in
+;; a eww buffer stores a link to the current url of the eww buffer.
+
+;; In an eww buffer function `org-eww-copy-for-org-mode' kills either
+;; a region or the whole buffer if no region is set and transforms the
+;; text on the fly so that it can be pasted into an org-mode buffer
+;; with hot links.
+
+;; C-c C-x C-w (and also C-c C-x M-w) trigger
+;; `org-eww-copy-for-org-mode'.
+
+;; Hint: A lot of code of this module comes from module org-w3m which
+;; has been written by Andy Steward based on the idea of Richard
+;; Riley. Thanks!
+
+;; Potential: Since the code for w3m and eww is so similar one could
+;; try to refactor.
+
+
+;;; Code:
+(require 'org)
+
+
+;; Store Org-link in eww-mode buffer
+(add-hook 'org-store-link-functions 'org-eww-store-link)
+(defun org-eww-store-link ()
+ "Store a link to the url of a eww buffer."
+ (when (eq major-mode 'eww-mode)
+ (org-store-link-props
+ :type "eww"
+ :link (if (< emacs-major-version 25)
+ eww-current-url
+ (eww-current-url))
+ :url (url-view-url t)
+ :description (if (< emacs-major-version 25)
+ (or eww-current-title eww-current-url)
+ (or (plist-get eww-data :title)
+ (eww-current-url))))))
+
+
+;; Some auxiliary functions concerning links in eww buffers
+(defun org-eww-goto-next-url-property-change ()
+ "Move cursor to the start of next link if exists. Else no
+move. Return point."
+ (goto-char
+ (or (next-single-property-change (point) 'shr-url)
+ (point))))
+
+(defun org-eww-has-further-url-property-change-p ()
+ "Return t if there is a next url property change else nil."
+ (save-excursion
+ (not (eq (point) (org-eww-goto-next-url-property-change)))))
+
+(defun org-eww-url-below-point ()
+ "Return the url below point if there is an url; otherwise, return nil."
+ (get-text-property (point) 'shr-url))
+
+
+(defun org-eww-copy-for-org-mode ()
+ "Copy current buffer content or active region with `org-mode' style links.
+This will encode `link-title' and `link-location' with
+`org-make-link-string', and insert the transformed test into the kill ring,
+so that it can be yanked into an Org-mode buffer with links working correctly.
+
+Further lines starting with a star get quoted with a comma to keep
+the structure of the org file."
+ (interactive)
+ (let* ((regionp (org-region-active-p))
+ (transform-start (point-min))
+ (transform-end (point-max))
+ return-content
+ link-location link-title
+ temp-position out-bound)
+ (when regionp
+ (setq transform-start (region-beginning))
+ (setq transform-end (region-end))
+ ;; Deactivate mark if current mark is activate.
+ (if (fboundp 'deactivate-mark) (deactivate-mark)))
+ (message "Transforming links...")
+ (save-excursion
+ (goto-char transform-start)
+ (while (and (not out-bound) ; still inside region to copy
+ (org-eww-has-further-url-property-change-p)) ; there is a next link
+ ;; store current point before jump next anchor
+ (setq temp-position (point))
+ ;; move to next anchor when current point is not at anchor
+ (or (org-eww-url-below-point)
+ (org-eww-goto-next-url-property-change))
+ (assert (org-eww-url-below-point) t
+ "program logic error: point must have an url below but it hasn't")
+ (if (<= (point) transform-end) ; if point is inside transform bound
+ (progn
+ ;; get content between two links.
+ (if (< temp-position (point))
+ (setq return-content (concat return-content
+ (buffer-substring
+ temp-position (point)))))
+ ;; get link location at current point.
+ (setq link-location (org-eww-url-below-point))
+ ;; get link title at current point.
+ (setq link-title
+ (buffer-substring
+ (point)
+ (org-eww-goto-next-url-property-change)))
+ ;; concat `org-mode' style url to `return-content'.
+ (setq return-content (concat return-content
+ (org-make-link-string
+ link-location link-title))))
+ (goto-char temp-position) ; reset point before jump next anchor
+ (setq out-bound t) ; for break out `while' loop
+ ))
+ ;; add the rest until end of the region to be copied
+ (if (< (point) transform-end)
+ (setq return-content
+ (concat return-content
+ (buffer-substring (point) transform-end))))
+ ;; quote lines starting with *
+ (org-kill-new
+ (with-temp-buffer
+ (insert return-content)
+ (goto-char 0)
+ (while (re-search-forward "^\*" nil t)
+ (replace-match ",*"))
+ (buffer-string)))
+ (message "Transforming links...done, use C-y to insert text into Org-mode file"))))
+
+
+;; Additional keys for eww-mode
+
+(defun org-eww-extend-eww-keymap ()
+ (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
+ (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
+
+(when (and (boundp 'eww-mode-map)
+ (keymapp eww-mode-map)) ; eww is already up.
+ (org-eww-extend-eww-keymap))
+
+(add-hook
+ 'eww-mode-hook
+ (lambda () (org-eww-extend-eww-keymap)))
+
+
+(provide 'org-eww)
+
+;;; org-eww.el ends here
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el
index d58043f..396f016 100644
--- a/contrib/lisp/org-expiry.el
+++ b/contrib/lisp/org-expiry.el
@@ -1,6 +1,6 @@
;;; org-expiry.el --- expiry mechanism for Org entries
;;
-;; Copyright 2007-2014 Free Software Foundation, Inc.
+;; Copyright 2007-2016 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
@@ -218,11 +218,12 @@ 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'."
+If there is no expiry date, use `org-expiry-wait'."
(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")))
+ (cr (org-read-date nil t (or (org-entry-get (point) cr-prop t)
+ org-expiry-created-date)))
(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))
diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el
index 7d95bbb..ad0ce71 100644
--- a/contrib/lisp/org-git-link.el
+++ b/contrib/lisp/org-git-link.el
@@ -98,10 +98,12 @@
(let* ((strlist (org-git-split-string str))
(filepath (first strlist))
(commit (second strlist))
+ (line (third strlist))
(dirlist (org-git-find-gitdir (file-truename filepath)))
(gitdir (first dirlist))
(relpath (second dirlist)))
- (org-git-open-file-internal gitdir (concat commit ":" relpath))))
+ (org-git-open-file-internal gitdir (concat commit ":" relpath))
+ (when line (goto-line (string-to-int line)))))
;; Utility functions (file names etc)
@@ -141,16 +143,19 @@
;; splitting the link string
;; Both link open functions are called with a string of
-;; consisting of two parts separated by a double colon (::).
+;; consisting of three 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."
+ "Given a string of the form \"str1::str2::str3\", return a list of
+ three substrings \'(\"str1\" \"str2\" \"str3\"). If there are less
+than two double colons, str2 and/or str3 may be set the empty string."
(let ((strlist (split-string str "::")))
(cond ((= 1 (length strlist))
- (list (car strlist) ""))
+ (list (car strlist) "" ""))
((= 2 (length strlist))
+ (append strlist (list "")))
+ ((= 3 (length strlist))
strlist)
- (t (error "org-git-split-string: only one :: allowed: %s" str)))))
+ (t (error "org-git-split-string: only one or two :: allowed: %s" str)))))
;; finding the file name part of a commit
(defun org-git-link-filename (str)
@@ -168,22 +173,24 @@
(concat branch "@{" timestring "}"))
-(defun org-git-create-git-link (file)
+(defun org-git-create-git-link (file &optional line)
"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))))
- (concat "git:" file "::" (org-git-create-searchstring branchname timestring))))
+ (concat "git:" file "::" (org-git-create-searchstring branchname timestring)
+ (if line (format "::%s" line) ""))))
(defun org-git-store-link ()
"Store git link to current file."
(when (buffer-file-name)
- (let ((file (abbreviate-file-name (buffer-file-name))))
+ (let ((file (abbreviate-file-name (buffer-file-name)))
+ (line (line-number-at-pos)))
(when (org-git-gitrepos-p file)
(org-store-link-props
:type "git"
- :link (org-git-create-git-link file))))))
+ :link (org-git-create-git-link file line))))))
(add-hook 'org-store-link-functions 'org-git-store-link)
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el
index ce53947..55f4e8b 100644
--- a/contrib/lisp/org-index.el
+++ b/contrib/lisp/org-index.el
@@ -1,11 +1,10 @@
-;;; org-index.el --- A personal index for org and beyond
+;;; org-index.el --- A personal index for org
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Marc Ihm <org-index@2484.de>
-;; Keywords: outlines, hypermedia, matching
-;; Requires: org
-;; Version: 2.4.2
+;; Version: 5.0.2
+;; Keywords: outlines index
;; This file is not part of GNU Emacs.
@@ -28,1443 +27,1552 @@
;; Purpose:
;;
-;; Mark and find your favorite org-locations and other points of interest
-;; easily; create and update a lookup table of references and links. When
-;; searching, frequently used entries appear at the the top and entering
-;; some keywords narrows down to matching entries only, so that the
-;; right one can be spotted easily.
+;; Fast search for selected org nodes and things outside of org.
;;
-;; References are essentially small numbers (e.g. "R237" or "-455-"),
-;; which are created by this package; they are well suited to be used
-;; outside org. Links are normal org-mode links.
+;; org-index creates and updates an index table with keywords; each line
+;; either points to a heading in org, references something outside or
+;; carries a snippet of text to yank. When searching the index, the set
+;; of matching lines is updated with every keystroke; results are sorted
+;; by usage count and date, so that frequently used entries appear first
+;; in the list of results.
+;;
+;; References are decorated numbers (e.g. 'R237' or '--455--'); they are
+;; well suited to be used outside of org, e.g. in folder names, ticket
+;; systems or on printed documents.
+;;
+;; On first invocation org-index will assist you in creating the index
+;; table.
+;;
+;; To start using your index, invoke subcommands 'add', 'ref' and 'yank'
+;; to create entries and 'occur' to find them.
;;
;;
;; Setup:
;;
+;; - Place this file in a directory from your load-path,
+;; e.g. org-mode/contrib/lisp.
+;;
;; - Add these lines to your .emacs:
;;
-;; ;; use the real path from your org-installation
-;; (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
;; (require 'org-index)
+;; (org-index-default-keybindings) ; optional
;;
-;; - Restart your emacs to make these lines effective
+;; - Maybe restart your Emacs to make these lines effective.
;;
-;; - Invoke `org-index', which will assist in creating your index
-;; table. The variable org-index-id will be persisted within your
-;; customization file (typically .emacs).
+;; - Invoke `org-index'; on first run it will assist in creating your
+;; index table.
;;
+;; - Optionally invoke `M-x org-customize' to tune some settings (choose
+;; group org-index).
;;
-;; Further reading:
;;
-;; See the documentation of `org-index', which can also be read
-;; by invoking `org-index' and and choosing the help-command.
+;; Further information:
;;
-;; For more documentation and working examples, see:
+;; - Watch the screencast at http://2484.de/org-index.html.
;;
-;; http://orgmode.org/worg/org-contrib/org-index.html
+;; - See the documentation of `org-index', which can also be read
+;; by invoking `org-index' and choosing the help-command.
;;
;;
;; Updates:
;;
-;; The latest tested version of this file can always be found at:
+;; The latest published version of this file can always be found at:
;;
-;; http://orgmode.org/w/org-mode.git?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
+;; http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/lisp/org-index.el;hb=HEAD
;;; Change Log:
-;; [2014-02-01 Sa] Version 2.4.2:
-;; - Follow mode in occur-buffer
-;; - Reorder for x-columns
+;; [2015-12-29 Tu] Version 5.0.2
+;; - New commands yank, column and edit
+;; - New column tags
+;; - All columns are now required
+;; - References are now optional
+;; - Subcommand enter has been renamed to index
+;; - Subcommands kill and edit can be invoked from an occur buffer
+;; - Many Bugfixes
+;; - Added link to screencast
;;
-;; [2014-01-02 Th] Version 2.4.0:
-;; - New command "put" to store a nodes reference in a property
-;; - New functions org-index-new-line and org-index-get-line
-;; offer access to org-index from other lisp programs
-;; - New flag p, new columns x1,x2 and x3
-;; - Major Code refactoring
-;; - Regression tests with ert
-;; - Lots of bugfixes
+;; [2015-08-20 Th] Version 4.3.0
+;; - Configuration is done now via standard customize
+;; - New sorting strategy 'mixed'
+;; - Silenced some compiler warnings
;;
-;; [2013-10-04 Fr] Version 2.3.2:
-;; - Bugfix: index-table created by assistant is found after
-;; restart of emacs instead of invoking assistent again
+;; [2015-03-18 We] Version 4.2.1
+;; - No garbage in kill-ring
+;; - No recentering after add
;;
-;; [2013-07-20 Sa] Version 2.3.0:
-;; - Renamed from "org-favtable" to "org-index"
-;; - Added an assistent to set up the index table
-;; - occur is now incremental, searching as you type
-;; - simplified the documentation and help-system
-;; - Saving keystrokes, as "+g237" is now valid input
-;; - Many bugfixes
+;; [2015-03-08 Su] Version 4.2.0
+;; - Reference numbers for subcommands can be passed as a prefix argument
+;; - New variable org-index-default-keybindings-list with a list of
+;; default keybindings for org-index-default-keybindings
+;; - Added new column level
+;; - removed flags get-category-on-add and get-heading-on-add
;;
-;; [2013-02-28 Th] Version 2.2.0:
-;; - Allowed shortcuts like "h237" for command "head" with argument "237"
-;; - Integrated with org-mark-ring-goto
+;; [2015-02-26 Th] to [2015-03-05 Th] Version 4.0.0 to 4.1.2
+;; - Removed command "leave"; rather go back with org-mark-ring-goto
+;; - Renamed column "link" to "id"
+;; - Added maintainance options to find duplicate rows, to check ids,
+;; update index or remove property org-index-ref from nodes
+;; - Shortened versin history
;;
-;; [2013-01-25 Fr] Version 2.1.0:
-;; - Added full support for links
-;; - New commands "missing" and "statistics"
-;; - Renamed the package from "org-reftable" to "org-favtable"
-;; - Additional columns are required (e.g. "link"). Error messages will
-;; guide you
+;; [2014-12-08 Mo] to [2015-01-31 Sa] Version 3.0.0 to 3.2.0:
+;; - Complete sorting of index only occurs in idle-timer
+;; - New command "maintain" with some subcommands
+;; - Rewrote command "occur" with overlays in an indirect buffer
+;; - Command "add" updates index, if node is already present
+;; - New commands "add" and "delete" to easily add and remove
+;; the current node to or from your index.
+;; - New command "example" to create an example index.
+;; - Several new flags that are explained within index node.
+;; - Removed commands "reuse", "missing", "put", "goto",
+;; "update", "link", "fill", "unhighlight"
+;; - New function `org-index-default-keybindings'
;;
-;; [2012-12-07 Fr] Version 2.0.0:
-;; - The format of the table of favorites has changed ! You need to bring
-;; your existing table into the new format by hand (which however is
-;; easy and explained below)
-;; - Reference table can be sorted after usage count or date of last access
-;; - Ask user explicitly, which command to invoke
-;; - Renamed the package from "org-refer-by-number" to "org-reftable"
+;; [2012-12-07 Fr] to [2014-04-26 Sa] Version 2.0.0 to 2.4.3:
+;; - New functions org-index-new-line and org-index-get-line
+;; offer access to org-index from other lisp programs
+;; - Regression tests with ert
+;; - Renamed from "org-favtable" to "org-index"
+;; - Added an assistant to set up the index table
+;; - occur is now incremental, searching as you type
+;; - Integrated with org-mark-ring-goto
+;; - Added full support for ids
+;; - Renamed the package from "org-reftable" to "org-favtable"
+;; - Additional columns are required (e.g. "link"). Error messages will
+;; guide you
+;; - Ask user explicitly, which command to invoke
+;; - Renamed the package from "org-refer-by-number" to "org-reftable"
;;
-;; [2012-09-22 Sa] Version 1.5.0:
+;; [2011-12-10 Sa] to [2012-09-22 Sa] Version Version 1.2.0 to 1.5.0:
;; - New command "sort" to sort a buffer or region by reference number
;; - New commands "highlight" and "unhighlight" to mark references
-;;
-;; [2012-07-13 Fr] Version 1.4.0:
;; - New command "head" to find a headline with a reference number
-;;
-;; [2012-04-28 Sa] Version 1.3.0:
;; - New commands occur and multi-occur
-;; - All commands can now be invoked explicitly
-;; - New documentation
-;; - Many bugfixes
-;;
-;; [2011-12-10 Sa] Version 1.2.0:
-;; - Fixed a bug, which lead to a loss of newly created reference numbers
-;; - Introduced single and double prefix arguments
;; - Started this Change Log
;;; Code:
(require 'org-table)
-(require 'cl)
+(require 'cl-lib)
+(require 'widget)
+
+;; Version of this package
+(defvar org-index-version "5.0.2" "Version of `org-index', format is major.minor.bugfix, where \"major\" are incompatible changes and \"minor\" are new features.")
-(defcustom org-index-id nil
+;; customizable options
+(defgroup org-index nil
+ "Options concerning the optional index for org."
+ :tag "Org Index"
+ :group 'org)
+
+(defcustom org-index-id nil
"Id of the Org-mode node, which contains the index table."
- :group 'org
:group 'org-index)
+(defcustom org-index-sort-by 'mixed
+ "Strategy for sorting index table (and whence entries in occur).
+Valid values are:
+
+last-access Sort index by date and time of last access; show
+ more recent entries first.
+count Sort by usage count; more often used entries first.
+mixed First, show all index entries, which have been
+ used today; sort them by last access. Then show
+ older entries sorted by usage count."
+ :group 'org-index
+ :set (lambda (s v)
+ (set-default s v)
+ (if (and org-index-id
+ org-index--buffer
+ (functionp 'org-index--sort-silent))
+ (org-index--sort-silent)))
+ :initialize 'custom-initialize-default
+ :type '(choice
+ (const last-accessed)
+ (const count)
+ (const mixed)))
+
+(defcustom org-index-yank-after-add 'ref
+ "Specifies which column should be yanked after adding a new index row.
+Valid values are some columns of index table."
+ :group 'org-index
+ :type '(choice
+ (const ref)
+ (const category)
+ (const keywords)))
+
+(defcustom org-index-point-on-add 'keywords
+ "Specifies in which column point will land when adding a new index row.
+Valid values are some columns of index table."
+ :group 'org-index
+ :type '(choice
+ (const category)
+ (const keywords)))
+
+(defcustom org-index-copy-heading-to-keywords t
+ "When adding a new node to index: Copy heading to keywords-column ?"
+ :group 'org-index
+ :type '(choice (const :tag "Yes" t)
+ (const :tag "No" nil)))
+
+(defcustom org-index-strip-ref-and-date-from-heading t
+ "When adding a node to index: strip leading ref or timestamps ?
+
+This can be useful, if you have the habit of adding refs and
+dates to the start of your headings; then, if you change your
+heading and want to update your index, you do not need to remove
+those pieces."
+ :group 'org-index
+ :type '(choice (const :tag "Yes" t)
+ (const :tag "No" nil)))
+
+(defcustom org-index-edit-on-add '(category keywords)
+ "List of columns to edit when adding a new row."
+ :group 'org-index
+ :type '(repeat (choice
+ (const category)
+ (const keywords))))
+
+(defcustom org-index-edit-on-yank '(yank keywords)
+ "List of columns to edit when adding new text to yank."
+ :group 'org-index
+ :type '(repeat (choice
+ (const yank)
+ (const category)
+ (const keywords))))
+
+(defcustom org-index-edit-on-ref '(category keywords)
+ "List of columns to edit when adding new ref."
+ :group 'org-index
+ :type '(repeat (choice
+ (const category)
+ (const keywords))))
+
;; Variables to hold the configuration of the index table
-(defvar org-index--maxref) ; Maximum number from reference table (e.g. "153")
-(defvar org-index--head) ; Any header before number (e.g. "R")
-(defvar org-index--tail) ; Tail after number (e.g. "}" or "")
-(defvar org-index--numcols) ; Number of columns in index table
-(defvar org-index--ref-regex) ; Regular expression to match a reference
-(defvar org-index--has-reuse nil) ; True, if table contains a line for reuse
-(defvar org-index--ref-format) ; Format, that can print a reference
-(defvar org-index--columns nil) ; Columns of index-table
-(defvar org-index--special-columns nil) ; Columns with flags
-(defvar org-index--buffer) ; Buffer of index table
-(defvar org-index--point) ; Position at start of headline of index table
-(defvar org-index--below-hline) ; Position of first cell in first line below hline
-(defvar org-index--headings) ; Headlines of index-table as a string
+(defvar org-index--maxrefnum nil "Maximum number from reference table, e.g. 153.")
+(defvar org-index--nextref nil "Next reference, that can be used, e.g. 'R154'.")
+(defvar org-index--head nil "Header before number (e.g. 'R').")
+(defvar org-index--tail nil "Tail after number (e.g. '}' or ')'.")
+(defvar org-index--numcols nil "Number of columns in index table.")
+(defvar org-index--ref-regex nil "Regular expression to match a reference.")
+(defvar org-index--ref-format nil "Format, that can print a reference.")
+(defvar org-index--columns nil "Columns of index-table.")
+(defvar org-index--buffer nil "Buffer of index table.")
+(defvar org-index--point nil "Position at start of headline of index table.")
+(defvar org-index--below-hline nil "Position of first cell in first line below hline.")
+(defvar org-index--headings nil "Headlines of index-table as a string.")
+(defvar org-index--headings-visible nil "Visible part of headlines of index-table as a string.")
+(defvar org-index--keymap nil "Keymap for shortcuts for some commands of `org-index'. Filled and activated by `org-index-default-keybings'.")
;; Variables to hold context and state
-(defvar org-index--last-action nil) ; Last action performed by org-index
-(defvar org-index--text-to-yank nil) ; Text, that can be yanked after call (mostly a reference)
-(defvar org-index--last-ref) ; Last reference created or visited
-(defvar org-index--point-before nil) ; Point in buffer with index table
-(defvar org-index--silent nil) ; t, if user should not be queried
-(defvar org-index--preferred-command) ; command, that is presented first
-(defvar org-index--active-region) ; Active region, initially. I.e. what has been marked
-(defvar org-index--below-cursor) ; Word below cursor
-(defvar org-index--within-node) ; True, if we are within node of the index table
-(defvar org-index--active-window-index nil) ; Active window with index table (if any)
-(defvar org-index--occur-follow-mode nil) ; True, if follow mode in occur-buffer is on
+(defvar org-index--last-fingerprint nil "Fingerprint of last line created.")
+(defvar org-index--category-before nil "Category of node before.")
+(defvar org-index--active-region nil "Active region, initially. I.e. what has been marked.")
+(defvar org-index--below-cursor nil "Word below cursor.")
+(defvar org-index--within-node nil "True, if we are within node of the index table.")
+(defvar org-index--within-occur nil "True, if we are within the occur-buffer.")
+(defvar org-index--message-text nil "Text that was issued as an explanation; helpful for regression tests.")
+(defvar org-index--occur-help-text nil "Text for help in occur buffer.")
+(defvar org-index--occur-help-overlay nil "Overlay for help in occur buffer.")
+(defvar org-index--occur-stack nil "Stack with overlays for hiding lines.")
+(defvar org-index--occur-tail-overlay nil "Overlay to cover invisible lines.")
+(defvar org-index--occur-lines-collected 0 "Number of lines collected in occur buffer; helpful for tests.")
+(defvar org-index--last-sort nil "Last column, the index has been sorted after.")
+(defvar org-index--sort-timer nil "Timer to sort index in correct order.")
+(defvar org-index--aligned nil "Remember for this Emacs session, if table has been aligned at least once.")
+(defvar org-index--edit-widgets nil "List of widgets used to edit.")
+(defvar org-index--context-index nil "Position and line used for index in edit buffer.")
+(defvar org-index--context-occur nil "Position and line used for occur in edit buffer.")
+(defvar org-index--context-node nil "Buffer and position for node in edit buffer.")
+
+;; static information for this program package
+(defconst org-index--commands '(occur add kill head ping index ref yank column edit help example sort multi-occur highlight maintain) "List of commands available.")
+(defconst org-index--valid-headings '(ref id created last-accessed count keywords category level yank tags) "All valid headings.")
+(defconst org-index--occur-buffer-name "*org-index-occur*" "Name of occur buffer.")
+(defconst org-index--edit-buffer-name "*org-index-edit*" "Name of edit buffer.")
+(defconst org-index--sort-idle-delay 300 "Delay in seconds after which buffer will sorted.")
+(defvar org-index-default-keybindings-list '(("a" . 'add) ("i" . 'index) ("SPC" . nil) ("o" . 'occur) ("a" . 'add) ("k" . 'kill) ("h" . 'head) ("p" . 'ping) ("." . 'ping) ("r" . 'ref) ("y" . 'yank) ("c" . 'column) ("e" . 'edit) ("?" . 'help)) "One-letter short cuts for selected subcommands of `org-index', put in effect by `org-index-default-keybindings'.")
+
+(defmacro org-index--on (column value &rest body)
+ "Execute the forms in BODY with point on index line whose COLUMN is VALUE.
+The value returned is the value of the last form in BODY or nil,
+if VALUE cannot be found."
+ (declare (indent 2) (debug t))
+ (let ((pointvar (make-symbol "point")) ; avoid clash with same-named variables in body
+ (foundvar (make-symbol "found"))
+ (retvar (make-symbol "ret")))
+ `(save-current-buffer
+ (let ((,pointvar (point))
+ ,foundvar
+ ,retvar)
+
+ (set-buffer org-index--buffer)
+
+ (setq ,foundvar (org-index--go ,column ,value))
+ (when ,foundvar
+ (setq ,retvar (progn ,@body)))
+
+ (goto-char ,pointvar)
+
+ ,retvar))))
-(setq org-index--commands '(occur head ref link leave put enter goto help + reorder fill sort update highlight unhighlight missing statistics)) ; list of commands available
-(defun org-index (&optional ARG)
- "Mark and find your favorite things and org-locations easily:
-Create and update a lookup table of references and links. Often
-used entries bubble to the top; entering some keywords narrows
-down to matching entries only, so that the right one can be
-spotted easily.
+(defun org-index (&optional command search-ref arg)
+ "Fast search index for selected org nodes and things outside of org.
-References are essentially small numbers (e.g. \"R237\" or \"-455-\"),
-which are created by this package; they are well suited to be used
-outside of org. Links are normal org-mode links.
+org-index creates and updates an index table with keywords; each line
+either points to a heading in org, references something outside or
+carries a snippet of text to yank. The index table is searched for
+keywords through an incremental occur; results are sorted by usage
+count and date, so that frequently used entries appear first among
+the results.
-This is version 2.4.0 of org-index.
+References are decorated numbers (e.g. 'R237' or '--455--'); they are
+well suited to be used outside of org, e.g. in folder names, ticket
+systems or on printed documents.
-The function `org-index' operates on a dedicated table, the index
-table, which lives within its own Org-mode node. The table and
-its node will be created, when you first invoke org-index.
+On first invocation org-index will help to create a dedicated node
+for its index table.
-Each line in the index table contains:
+To start building up your index, use subcommands 'add', 'ref' and
+'yank' to create entries and use 'occur' to find them.
- - A reference (e.g. \"R237\")
+This is version 5.0.2 of org-index.el.
- - An optional link to another location in org
- - A number, counting, how often each reference has been
- used. This number is updated automatically and the table can
- be sorted after it, so that most frequently used references
- appear at the top of the table and can be spotted easily.
+The function `org-index' is the only interactive function of this
+package and its main entry point; it will present you with a list
+of subcommands to choose from:
- - The creation date of the line
+ occur: Incremental search, that shows matching lines from the
+ index table. It is updated after every keystroke. You may
+ enter a list of words seperated by space or comma (`,'), to
+ select lines that contain all of the given words.
- - Date and time of last access. This column can alternatively be
- used to sort the table.
+ add: Add the current node to your index, so that it can be
+ found through the subcommand \"occur\". Update index,
+ if node is already present.
- - A column for your own comments
+ kill: Kill (delete) the current node from your index. Can be
+ invoked from index, from occur or from a headline.
-The index table is found through the id of the containing
-node; this id is stored within the variable `org-index-id'.
+ head: Ask for a reference number and search for this heading.
+ index: Enter index table and maybe go to a specific reference;
+ use `org-mark-ring-goto' (\\[org-mark-ring-goto]) to go back.
-The function `org-index' is the only interactive function of this
-package and its main entry point; it offers several commands to
-create, find and look up line within the index table.
+ ping: Echo line from index table for current node or first of
+ its ancestors from index.
-Commands known:
+ ref: Create a new index line with a reference.
- occur: Incremental search, that shows matching lines from the
- index table, updated after every keystroke. You may enter a
- list of words seperated by space or comma (\",\"), to select
- lines that contain all of the given words.
+ yank: Store a new string, that can be yanked when an index row
+ is chosen during occur.
- If you supply a number (e.g. \"237\"): Apply emacs standard
- multi-occur operation on all org-mode buffers to search for
- this specific reference.
+ column: If within index table, read another character and jump
+ to specified column.
- You may also read the note at the end of this help on saving
- the keystroke RET with this frequent default command.
+ edit: Present current line in a seperate buffer. Can be invoked
+ from index, from occur or from a headline.
- head: If invoked outside the index table, ask for a reference
- number and search for an entry, which either has this
- reference contained in its heading or within its property
- org-index-ref. If invoked from within the index table dont
- ask; rather use the reference or link from the current line.
+ help: Show this text.
- ref: Create a new reference, copy any previously selected text.
- If already within index table, fill in ref-column.
+ example: Create a temporary index, that will not be saved, but
+ may serve as an example.
- link: Create a new line in index table with a link to the
- current node. Do not populate the ref column; this can later
- be populated by calling the \"fill\" command from within the
- index table.
+ sort: Sort lines in index, in region or buffer by contained
+ reference, or sort index by count, reference or last access.
- leave: Leave the index table. If the last command has been
- \"ref\", the new reference is copied and ready to yank. This
- \"org-mark-ring-goto\" and can be called several times in
- succession. If you invoke org-index with a prefix argument,
- this command \"leave\" is executed without further questions.
+ multi-occur: Apply Emacs standard `multi-occur' operation on all
+ `org-mode' buffers to search for the given reference.
- put: Put the reference, that was created last, as the value of
- property org-index-ref into the current node. That way it can
- be found by a later call to \"head\".
+ highlight: Highlight or unhighlight references in active region
+ or buffer. Call with prefix argument (`C-u') to remove
+ highlights.
- enter: Just enter the node with the index table.
+ maintain: Offers some choices to check, update or fix your index.
- goto: Enter index table and go to a specific reference.
+If you invoke `org-index' for the first time, an assistant will be
+invoked, that helps you to create your own index.
- help: Show this text.
+Invoke `org-customize' to tweak the behaviour of org-index.
+Call `org-index-default-keybindings' from within your init-file
+to establish convenient keyboard shortcuts.
- +: Show all commands including the less frequently used ones
- given below. If \"+\" is followd by enough letters of such a
- command (e.g. \"+fi\"), then this command (e.g. \"fill\") is
- invoked directly.
+A numeric prefix argument is used as a reference number for
+commands, that need one (e.g. 'head').
- reorder: Temporarily reorder the index table, e.g. by count,
- reference or last access.
+Use from elisp: Optional argument COMMAND is a symbol naming the
+command to execute. SEARCH-REF specifies a reference to search
+for, if needed. ARG allows passing in a prefix argument as in
+interactive calls."
- fill: If either ref or link is missing in current line of index
- table, fill in the missing value.
+ (interactive "i\ni\nP")
- sort: Sort a set of lines (either from the active region or the
- whole buffer) by references found in each line.
+ (let (search-id ; id to search for
+ search-fingerprint ; fingerprint to search for
+ sort-what ; sort what ?
+ kill-new-text ; text that will be appended to kill ring
+ message-text) ; text that will be issued as an explanation
- update: For the given reference, update the line in the
- index table, i.e. increment its count.
+ (catch 'new-index
- highlight: Highlight references in active region or buffer.
+ ;;
+ ;; Initialize and parse
+ ;;
- unhighlight: Remove those highlights.
+ ;; creates index table, if necessary
+ (org-index--verify-id)
- missing : Search for missing reference numbers (which do not
- appear in the reference table). If requested, add additional
- lines for them, so that the command \"ref\" is able to reuse
- them.
+ ;; Get configuration of index table
+ (org-index--parse-table)
- statistics : Show some statistics (e.g. minimum and maximum
- reference) about index table.
+ ;; store context information
+ (org-index--retrieve-context)
+ ;;
+ ;; Arrange for proper sorting of index
+ ;;
-Two ways to save keystrokes:
+ ;; lets assume, that it has been sorted this way (we try hard to make sure)
+ (unless org-index--last-sort (setq org-index--last-sort org-index-sort-by))
+ ;; rearrange for index beeing sorted into default sort order after 300 secs of idle time
+ (unless org-index--sort-timer
+ (setq org-index--sort-timer
+ (run-with-idle-timer org-index--sort-idle-delay t 'org-index--sort-silent)))
-When prompting for a command, org-index puts the most likely
-one (e.g. \"occur\" or \"ref\") in front of the list, so that
-you may just type RET.
-If this first command in the list of commands needs additional
-input (like e.g. \"occur\"), you may supply this input right
-away, although you are still beeing prompted for the command. So,
-to do an occur for the string \"foo\", you can just enter \"foo\"
-RET, without even typing \"occur\".
+ ;;
+ ;; Find out, what we are supposed to do
+ ;;
+ ;; Check or read command
+ (if command
+ (unless (memq command org-index--commands)
+ (error "Unknown command '%s' passed as argument, valid choices are any of these symbols: %s"
+ command (mapconcat 'symbol-name org-index--commands ",")))
+ (setq command (intern (org-completing-read
+ "Please choose: "
+ (mapcar 'symbol-name org-index--commands)))))
-Another way to save keystrokes applies if you want to choose a
-command, that requrires a reference number and would normally
-prompt for it: In that case you may just enter enough characters
-from your command, so that it appears first in the list of
-matches; then immediately enter the number of the reference you
-are searching for. So the input \"h237\" would execute the
-command \"head\" for reference \"237\".
-"
+ ;;
+ ;; Get search string, if required; process possible sources one after
+ ;; another (lisp argument, prefix argument, user input).
+ ;;
- (interactive "P")
+ ;; Try prefix, if no lisp argument given
+ (if (and (not search-ref)
+ (numberp arg))
+ (setq search-ref (format "%s%d%s" org-index--head arg org-index--tail)))
+
+ ;; These actions really need a search string and may even prompt for it
+ (when (memq command '(index head multi-occur))
+
+ ;; search from surrounding text ?
+ (unless search-ref
+ (if org-index--within-node
- (let ((org-index--silent nil) ; t, if user can be asked
- link-id ; link of starting node, if required
- what ; what to do
- search ; what to search for
- guarded-search ; with guard against additional digits
- search-ref ; search, if search is a reference
- search-link ; search, if search is a link
- what-adjusted ; true, if we had to adjust what
- what-input ; Input on what question (need not necessary be "what")
- reorder-once ; column to use for single time sorting
- kill-new-text ; text that will be appended to kill ring
- message-text ; text that will be issued as an explanation
- initial-ref-or-link ; initial position in index table
- )
+ (if (org-at-table-p)
+ (setq search-ref (org-index--get-or-set-field 'ref)))
+
+ (if (and org-index--below-cursor
+ (string-match (concat "\\(" org-index--ref-regex "\\)")
+ org-index--below-cursor))
+ (setq search-ref (match-string 1 org-index--below-cursor)))))
+
+ ;; If we still do not have a search string, ask user explicitly
+ (unless search-ref
+ (if (eq command 'index)
+ (let ((r (org-index--read-search-for-index)))
+ (setq search-ref (first r))
+ (setq search-id (second r))
+ (setq search-fingerprint (third r)))
+ (setq search-ref (read-from-minibuffer "Search reference number: "))))
+
+ ;; Clean up search string
+ (when search-ref
+ (setq search-ref (org-trim search-ref))
+ (if (string-match "^[0-9]+$" search-ref)
+ (setq search-ref (concat org-index--head search-ref org-index--tail)))
+ (if (string= search-ref "") (setq search-ref nil)))
+
+ (if (and (not search-ref)
+ (not (eq command 'index)))
+ (error "Command %s needs a reference number" command)))
+
+
+ ;;
+ ;; Command sort needs to know in advance, what to sort for
+ ;;
+
+ (when (eq command 'sort)
+ (setq sort-what (intern (org-completing-read "You may sort:\n - index : your index table by various columns\n - region : the active region by contained reference\n - buffer : the whole current buffer\nPlease choose what to sort: " (list "index" "region" "buffer") nil t))))
+
+
+ ;;
+ ;; Enter table
+ ;;
+ ;; Arrange for beeing able to return
+ (when (and (memq command '(occur head index example sort maintain))
+ (not (string= (buffer-name) org-index--occur-buffer-name)))
+ (org-mark-ring-push))
- ;;
- ;; Initialize and parse
- ;;
+ ;; These commands will leave user in index table after they are finished
+ (when (or (memq command '(index maintain))
+ (and (eq command 'sort)
+ (eq sort-what 'index)))
- ;; creates index table, if necessary
- (org-index--verify-id)
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (org-index--unfold-buffer))
- ;; store context information
- (org-index--retrieve-context)
- ;; Get configuration of index table
- (org-index--parse-table)
+ ;;
+ ;; Actually do, what is requested
+ ;;
+ (cond
- ;;
- ;; Find out, what we are supposed to do
- ;;
- (if ARG
- (if (equal ARG '(4))
- (setq what 'leave)
- (if (and (symbolp ARG)
- (memq ARG org-index--commands))
- (setq what ARG)
- (error "Unknown command '%s' passed as argument, valid choices are a prefix argument or any of these symbols: %s"
- ARG (mapconcat 'symbol-name org-index--commands ","))))
-
- (let ((r (org-index--read-what what))) ; query user if not from argument
- (setq what (nth 0 r))
- (setq what-input (nth 1 r))
- (setq reorder-once (nth 2 r))))
+ ((eq command 'help)
+ ;; bring up help-buffer for this function
+ (describe-function 'org-index))
- ;;
- ;; Get search, if required
- ;;
- ;; These actions need a search string:
- (when (memq what '(goto occur head update))
- ;; Maybe we've got a search string from the arguments
- (setq search (org-index--get-or-read-search search what what-input))
-
- (when search
- (when (string-match org-index--ref-regex search)
- (setq search-ref search)
- (setq guarded-search (org-index--make-guarded-search search)))
- (when (string-match "^[a-fA-F0-9]\\{8\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{4\\}-[a-fA-F0-9]\\{12\\}$" search)
- (setq search-link search))))
+ ((eq command 'multi-occur)
-
- ;;
- ;; Do some sanity checking before really starting
- ;;
-
- ;; Correct requested action, if nothing to search
- (when (and (not search)
- (memq what '(search head)))
- (setq what 'enter)
- (setq what-adjusted t))
-
- ;; For a proper reference as input, we do multi-occur
- (if (and (eq what 'occur) search-ref)
- (setq what 'multi-occur))
-
- ;; Check for invalid combinations of arguments; try to be helpful
- (when (and (memq what '(head goto))
- (not search-ref)
- (not search-link))
- (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))
+ ;; Construct list of all org-buffers
+ (let (buff org-buffers)
+ (dolist (buff (buffer-list))
+ (set-buffer buff)
+ (if (string= major-mode "org-mode")
+ (setq org-buffers (cons buff org-buffers))))
-
- ;;
- ;; Sort and enter table
- ;;
-
- ;; Get link if required before moving in
- (if (eq what 'link)
- (let ((org-id-link-to-org-use-id t))
- (setq link-id (org-id-get-create))))
-
- ;; Save initial ref or link for later return
- (if (and org-index--within-node
- (org-at-table-p))
- (setq initial-ref-or-link
- (or (org-index--get-field :ref)
- (org-index--get-field :link))))
-
- ;; These commands enter index table only temporarily
- (when (memq what '(occur multi-occur statistics))
-
- (set-buffer org-index--buffer)
- (goto-char org-index--point)
-
- ;; Sort and align
- (org-index--sort reorder-once)
- (org-index--align))
+ ;; Do multi-occur
+ (multi-occur org-buffers (org-index--make-guarded-search search-ref))
- ;; These commands will leave user in index table after they are finished
- (when (memq what '(enter ref link goto missing))
+ ;; Present results
+ (if (get-buffer "*Occur*")
+ (progn
+ (setq message-text (format "multi-occur for '%s'" search-ref))
+ (other-window 1)
+ (toggle-truncate-lines 1))
+ (setq message-text (format "Did not find '%s'" search-ref)))))
- ;; Support orgmode-standard of going back (buffer and position)
- (org-mark-ring-push)
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (show-subtree)
- (org-show-context)
+ ((eq command 'add)
- ;; Sort and align
- (org-index--sort reorder-once)
- (org-index--align))
-
- ;; Return to initial position
- (when initial-ref-or-link
- (while (and (org-at-table-p)
- (not (or
- (string= initial-ref-or-link (org-index--get-field :ref))
- (string= initial-ref-or-link (org-index--get-field :link)))))
- (forward-line))
- ;; did not find ref, go back to top
- (if (not (org-at-table-p)) (goto-char org-index--point)))
-
-
- ;;
- ;; Actually do, what is requested
- ;;
+ (let ((r (org-index--do-add-or-update (if (equal arg '(4)) t nil)
+ (if (numberp arg) arg nil))))
+ (setq message-text (car r))
+ (setq kill-new-text (cdr r))))
- (cond
+ ((eq command 'kill)
+ (setq message-text (org-index--do-kill)))
- ((eq what 'help)
-
- ;; bring up help-buffer for this function
- (describe-function 'org-index))
+ ((eq command 'head)
- ((eq what 'multi-occur)
-
- ;; Position point in index buffer on reference to search for
- (goto-char org-index--below-hline)
- (let (found (initial (point)))
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found (string= search
- (org-index--get-field :ref)))))
- (if found
- (org-index--update-line nil)
- (goto-char initial)))
-
- ;; Construct list of all org-buffers
- (let (buff org-buffers)
- (dolist (buff (buffer-list))
- (set-buffer buff)
- (if (string= major-mode "org-mode")
- (setq org-buffers (cons buff org-buffers))))
-
- ;; Do multi-occur
- (multi-occur org-buffers guarded-search)
-
- ;; Present results
- (if (get-buffer "*Occur*")
- (progn
- (setq message-text (format "multi-occur for '%s'" search))
- (other-window 1)
- (toggle-truncate-lines 1))
- (setq message-text (format "Did not find '%s'" search)))))
-
-
- ((eq what 'head)
-
- (let (link)
(if (and org-index--within-node
(org-at-table-p))
- (setq link (org-index--get-field :link))))
-
- (setq message-text (org-index--do-head search-ref search-link)))
+ (setq search-id (org-index--get-or-set-field 'id)))
+
+ (if (and (not search-id) search-ref)
+ (setq search-id (org-index--id-from-ref search-ref)))
+
+ (setq message-text
+ (if search-id
+ (org-index--find-id search-id)
+ "Current line has no id")))
- ((eq what 'leave)
+ ((eq command 'index)
- (setq kill-new-text org-index--text-to-yank)
- (setq org-index--text-to-yank nil)
-
- ;; If "leave" has been called two times in succession, make
- ;; org-mark-ring-goto believe it has been called two times too
- (if (eq org-index--last-action 'leave)
- (let ((this-command nil) (last-command nil))
- (org-mark-ring-goto 1))
- (org-mark-ring-goto))
-
- ;; Return to saved position in index buffer
- (when org-index--point-before
- ;; buffer displayed in window need to set point there first
- (if (eq (window-buffer org-index--active-window-index)
- org-index--buffer)
- (set-window-point org-index--active-window-index org-index--point-before))
- ;; set position in buffer in any case and second
- (with-current-buffer org-index--buffer
- (goto-char org-index--point-before)))
- (setq org-index--point-before nil))
-
-
- ((eq what 'goto)
-
- ;; Go downward in table to requested reference
- (let (found (initial (point)))
(goto-char org-index--below-hline)
- (while (and (not found)
- (forward-line)
- (org-at-table-p))
- (save-excursion
- (setq found
- (string= search
- (org-index--get-field
- (if search-link :link :ref))))))
- (if found
- (progn
- (setq message-text (format "Found '%s'" search))
- (org-index--update-line nil)
- (org-table-goto-column (org-index--column-num :ref))
- (if (looking-back " ") (backward-char))
- ;; remember string to copy
- (setq org-index--text-to-yank
- (org-trim (org-table-get-field (org-index--column-num :copy)))))
- (setq message-text (format "Did not find '%s'" search))
- (goto-char initial)
- (forward-line)
- (setq what 'missed))))
+ (setq message-text
- ((eq what 'occur)
+ (if search-ref
+ (if (org-index--go 'ref search-ref)
+ (progn
+ (org-index--update-current-line)
+ (org-table-goto-column (org-index--column-num 'ref))
+ (format "Found index line '%s'" search-ref))
+ (format "Did not find index line with reference '%s'" search-ref))
- (org-index--do-occur what-input))
+ (if search-id
+ (if (org-index--go 'id search-id)
+ (progn
+ (org-index--update-current-line)
+ (org-table-goto-column (org-index--column-num 'ref))
+ (format "Found index line '%s'" (org-index--get-or-set-field 'ref)))
+ (format "Did not find index line with id '%s'" search-id))
+ (if search-fingerprint
+ (if (org-index--go 'fingerprint org-index--last-fingerprint)
+ (progn
+ (org-index--update-current-line)
+ (beginning-of-line)
+ (format "Found latest index line"))
+ (format "Did not find index line"))
- ((memq what '(ref link))
+ ;; simply go into table
+ "At index table"))))
- (let (new)
+ (recenter))
- ;; add a new row (or reuse existing one)
- (setq new (org-index--do-new-line (eq what 'ref)))
- ;; fill special columns with standard values
- (when (eq what 'ref)
- (org-table-goto-column (org-index--column-num :ref))
- (insert new)
- (setq org-index--last-ref new))
- (when (eq what 'link)
- (org-table-goto-column (org-index--column-num :link))
- (insert link-id))
+ ((eq command 'ping)
- (org-index--align)
-
- ;; goto point-field or copy-field or first empty one or first field
- (if (org-index--special-column :point)
- (org-table-goto-column (org-index--column-num (org-index--special-column :point)))
- (if (org-index--special-column :copy)
- (org-table-goto-column (org-index--column-num (org-index--special-column :copy)))
- (unless (catch 'empty
- (dotimes (col org-index--numcols)
- (org-table-goto-column (+ col 1))
- (if (string= (org-trim (org-table-get-field)) "")
- (throw 'empty t))))
- ;; none found, goto first
- (org-table-goto-column 1))))
-
- (if org-index--active-region (setq kill-new-text org-index--active-region))
- (if (eq what 'ref)
- (setq message-text (format "Adding a new row with ref '%s'" new))
- (setq message-text (format "Adding a new row linked to '%s'" link-id)))))
+ (let ((moved-up 0) id info reached-top)
+ (unless (string= major-mode "org-mode") (error "No node at point"))
+ ;; take id from current node or reference
+ (setq id (if search-ref
+ (org-index--id-from-ref search-ref)
+ (org-id-get)))
- ((eq what 'put)
+ ;; move up until we find a node in index
+ (save-excursion
+ (outline-back-to-heading)
+ (while (not (or info
+ reached-top))
+ (if id
+ (setq info (org-index--on 'id id
+ (mapcar (lambda (x) (org-index--get-or-set-field x))
+ (list 'ref 'count 'created 'last-accessed 'category 'keywords 'ref)))))
+
+ (setq reached-top (= (org-outline-level) 1))
+
+ (unless (or info
+ reached-top)
+ (outline-up-heading 1 t)
+ (cl-incf moved-up))
+
+ (setq id (org-id-get))))
+
+ (if info
+ (progn
+ (setq message-text
+ (apply 'format
+ (append (list "'%s'%shas been accessed %s times between %s and %s; category is '%s', keywords are '%s'"
+ (pop info)
+ (if (> moved-up 0) (format " (parent node, %d level up) " moved-up) " "))
+ info)))
+ (setq kill-new-text (car (last info))))
+ (setq message-text "Neither this node nor any of its parents is part of index"))))
- ;; put latest reference into property
-
- (if org-index--last-ref
- (progn
- (org-entry-put (point) "org-index-ref" org-index--last-ref)
- (message "Reference '%s' has been stored in property org-index-ref" org-index--last-ref))
- (setq org-index--last-ref
- (read-from-minibuffer "Reference to be stored in this node: "))
- (unless org-index--last-ref
- (message "No reference has been given."))
- ))
+ ((eq command 'occur)
-
- ((eq what 'enter)
+ (set-buffer org-index--buffer)
+ (org-index--do-occur))
- ;; simply go into table
- (goto-char org-index--below-hline)
- (show-subtree)
- (recenter)
- (if what-adjusted
- (setq message-text "Nothing to search for; at index table")
- (setq message-text "At index table")))
-
- ((eq what 'fill)
-
- ;; check, if within index table
- (unless (and org-index--within-node
- (org-at-table-p))
- (error "Not within index table"))
-
- ;; applies to missing refs and missing links alike
- (let ((ref (org-index--get-field :ref))
- (link (org-index--get-field :link)))
-
- (if (and (not ref)
- (not link))
- ;; have already checked this during parse, check here anyway
- (error "Columns ref and link are both empty in this line"))
-
- ;; fill in new ref
- (if (not ref)
- (progn
- (setq kill-new-text (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail))
- (org-index--get-field :ref kill-new-text)
- ;; remember for org-mark-ring-goto
- (setq org-index--text-to-yank kill-new-text)
- (org-id-goto link)
- (setq message-text "Filled field of index table with new reference"))
-
- ;; fill in new link
- (if (not link)
- (progn
- (setq guarded-search (org-index--make-guarded-search ref))
- (message (format "Scanning headlines for '%s' ..." ref))
- (let ((search (concat ".*" guarded-search))
- link)
- (if (catch 'found
- (org-map-entries
- (lambda ()
- (when (looking-at search)
- (setq link (org-id-get-create))
- (throw 'found t)))
- nil 'agenda)
- nil)
+ ((eq command 'ref)
- (progn
- (org-index--get-field :link link)
- (setq message-text "Inserted link"))
+ (let (args)
- (setq message-text (format "Did not find reference '%s'" ref)))))
-
- ;; nothing is missing
- (setq message-text "Columns ref and link are already filled; nothing to do")))))
-
+ (setq args (org-index--collect-values-from-user org-index-edit-on-ref))
+ (setq args (plist-put args 'category "yank"))
+ (setq args (plist-put args 'ref org-index--nextref))
+ (apply 'org-index--do-new-line args)
- ((eq what 'sort)
+ (setq kill-new-text org-index--nextref)
- ;; sort lines according to contained reference
- (let (begin end where)
- (catch 'aborted
- ;; either active region or whole buffer
- (if (and transient-mark-mode
- mark-active)
- ;; sort only region
- (progn
- (setq begin (region-beginning))
- (setq end (region-end))
- (setq where "region"))
- ;; sort whole buffer
- (setq begin (point-min))
- (setq end (point-max))
- (setq where "whole buffer")
- ;; make sure
- (unless (y-or-n-p "Sort whole buffer ")
- (setq message-text "Sort aborted")
- (throw 'aborted nil)))
+ (setq message-text (format "Added new row with ref '%s'" org-index--nextref))))
+
+
+ ((eq command 'yank)
+
+ (let (args)
+
+ (setq args (org-index--collect-values-from-user org-index-edit-on-yank))
+ (if (plist-get args 'yank)
+ (plist-put args 'yank (replace-regexp-in-string "|" (regexp-quote "\\vert") (plist-get args 'yank) nil 'literal)))
+ (setq args (plist-put args 'category "yank"))
+ (apply 'org-index--do-new-line args)
+ (setq message-text "Added new row with text to yank")))
+
+
+ ((eq command 'column)
+
+ (if (and org-index--within-node
+ (org-at-table-p))
+ (let (char col num)
+ (setq char (read-char "Please specify, which column to go to (r=ref, k=keywords, c=category, y=yank): "))
+ (unless (memq char (list ?r ?k ?c ?y))
+ (error (format "Invalid char '%c', cannot goto this column" char)))
+ (setq col (cdr (assoc char '((?r . ref) (?k . keywords) (?c . category) (?y . yank)))))
+ (setq num (org-index--column-num col))
+ (if num
+ (progn
+ (org-table-goto-column num)
+ (setq message-text (format "At column %s" (symbol-name col))))
+
+ (error (format "Column '%s' is not present" col))))
+ (error "Need to be in index table to go to a specific column")))
+
+
+ ((eq command 'edit)
+
+ (setq message-text (org-index--do-edit)))
+
+
+ ((eq command 'sort)
+
+ (let ((sorts (list "count" "last-accessed" "mixed" "id" "ref"))
+ sort groups-and-counts)
+
+ (cond
+ ((eq sort-what 'index)
+ (setq sort
+ (intern
+ (org-icompleting-read
+ "Please choose column to sort index table: "
+ (cl-copy-list sorts)
+ nil t nil nil (symbol-name org-index-sort-by))))
+
+ (org-index--do-sort-index sort)
+ (org-table-goto-column (org-index--column-num (if (eq sort 'mixed) 'last-access sort)))
+ ;; When saving index, it should again be sorted correctly
+ (with-current-buffer org-index--buffer
+ (add-hook 'before-save-hook 'org-index--sort-silent t))
+
+ (setq message-text
+ (format
+ (concat "Your index has been sorted temporarily by %s and will be sorted again by %s after %d seconds of idle time"
+ (if groups-and-counts
+ "; %d groups with equal %s and a total of %d lines have been found"
+ ""))
+ (symbol-name sort)
+ org-index-sort-by
+ org-index--sort-idle-delay
+ (second groups-and-counts)
+ (symbol-name sort)
+ (third groups-and-counts))))
+
+ ((memq sort-what '(region buffer))
+ (org-index--do-sort-lines sort-what)
+ (setq message-text (format "Sorted %s by contained references" sort-what))))))
+
+
+ ((eq command 'highlight)
+
+ (let ((where "buffer"))
(save-excursion
(save-restriction
- (goto-char (point-min))
- (narrow-to-region begin end)
- (sort-subr nil 'forward-line 'end-of-line
- (lambda ()
- (if (looking-at (concat ".*"
- (org-index--make-guarded-search org-index--ref-regex 'dont-quote)))
- (string-to-number (match-string 1))
- 0))))
- (highlight-regexp org-index--ref-regex 'isearch)
- (setq message-text (format "Sorted %s from character %d to %d, %d lines"
- where begin end
- (count-lines begin end)))))))
-
+ (when (and transient-mark-mode
+ mark-active)
+ (narrow-to-region (region-beginning) (region-end))
+ (setq where "region"))
- ((eq what 'update)
+ (if arg
+ (progn
+ (unhighlight-regexp org-index--ref-regex)
+ (setq message-text (format "Removed highlights for references in %s" where)))
+ (highlight-regexp org-index--ref-regex 'isearch)
+ (setq message-text (format "Highlighted references in %s" where)))))))
- ;; simply update line in index table
- (save-excursion
- (let ((ref-or-link (if search-link "link" "reference")))
- (beginning-of-line)
- (if (org-index--update-line search)
- (setq message-text (format "Updated %s '%s'" ref-or-link search))
- (setq message-text (format "Did not find %s '%s'" ref-or-link search))))))
+ ((eq command 'maintain)
+ (setq message-text (org-index--do-maintain)))
- ((memq what '(highlight unhighlight))
+
+ ((eq command 'example)
- (let ((where "buffer"))
- (save-excursion
- (save-restriction
- (when (and transient-mark-mode
- mark-active)
- (narrow-to-region (region-beginning) (region-end))
- (setq where "region"))
+ (if (y-or-n-p "This assistant will help you to create a temporary index with detailed comments.\nDo you want to proceed ? ")
+ (org-index--create-index t)))
- (if (eq what 'highlight)
- (progn
- (highlight-regexp org-index--ref-regex 'isearch)
- (setq message-text (format "Highlighted references in %s" where)))
- (unhighlight-regexp org-index--ref-regex)
- (setq message-text (format "Removed highlights for references in %s" where)))))))
+ (t (error "Unknown subcommand '%s'" command)))
- ((memq what '(missing statistics))
- (setq message-text (org-index--do-statistics what)))
-
-
- (t (error "This is a bug: unmatched case '%s'" what)))
+ ;; tell, what we have done and what can be yanked
+ (if kill-new-text (setq kill-new-text
+ (substring-no-properties kill-new-text)))
+ (if (string= kill-new-text "") (setq kill-new-text nil))
+ (let ((m (concat
+ message-text
+ (if (and message-text kill-new-text)
+ " and r"
+ (if kill-new-text "R" ""))
+ (if kill-new-text (format "eady to yank '%s'." kill-new-text) (if message-text "." "")))))
+ (unless (string= m "")
+ (message m)
+ (setq org-index--message-text m)))
+ (if kill-new-text (kill-new kill-new-text)))))
- ;; remember what we have done for next time
- (setq org-index--last-action what)
-
- ;; tell, what we have done and what can be yanked
- (if kill-new-text (setq kill-new-text
- (substring-no-properties kill-new-text)))
- (if (string= kill-new-text "") (setq kill-new-text nil))
- (let ((m (concat
- message-text
- (if (and message-text kill-new-text)
- " and r"
- (if kill-new-text "R" ""))
- (if kill-new-text (format "eady to yank '%s'" kill-new-text) ""))))
- (unless (string= m "") (message m)))
- (if kill-new-text (kill-new kill-new-text))))
+(defun org-index-default-keybindings (&optional prefix)
+ "Set default keybindings for `org-index'.
+
+Invoke subcommands of org index with a single key
+sequence. Establish the common prefix key 'C-c i' which should be
+followed by the first letter of a subcommand.
+
+The ist of letters and subcommands is specified in within
+`org-index-default-keybindings-list'.
+
+See `org-index' for a description of all subcommands.
+
+Optional argument PREFIX specifies common prefix, defaults to 'C-c i'"
+ (interactive)
+
+ (define-prefix-command 'org-index--keymap)
+ ;; prefix command
+ (global-set-key (kbd (or prefix "C-c i")) 'org-index--keymap)
+ ;; loop over subcommands
+ (mapc
+ (lambda (x)
+ (define-key org-index--keymap (kbd (car x))
+ `(lambda (arg) (interactive "P")
+ (message nil)
+ (org-index ,(cdr x) nil arg))))
+ org-index-default-keybindings-list))
(defun org-index-new-line (&rest keys-values)
"Create a new line within the index table, returning its reference.
-The function takes a varying number of arguments pairs; each pair
+The function takes a varying number of argument pairs; each pair
is a symbol for an existing column heading followed by its value.
-their values.
+The return value is the new reference.
Example:
- (org-index-new-line :ref t :x1 \"foo\" :link \"7f480c3e\")
+ (message \"Created reference %s\"
+ (org-index-new-line 'keywords \"foo bar\" 'category \"baz\"))
-Passing \":ref t\" will make the function create a new reference within the new line.
+Optional argument KEYS-VALUES specifies content of new line."
-"
+ (let ((ref (plist-get keys-values 'ref)))
+ (org-index--verify-id)
+ (org-index--parse-table)
+ (if (not (memq ref '(t nil)))
+ (error "Column 'ref' accepts only 't' or 'nil'"))
+ (when ref
+ (setq ref org-index--nextref)
+ (setq keys-values (plist-put keys-values 'ref ref)))
- (let ((org-index--silent t))
+ (apply 'org-index--do-new-line keys-values)
+ ref))
- (save-excursion
- (org-index--retrieve-context)
- (with-current-buffer org-index--buffer
- (goto-char org-index--point)
- (org-index--parse-table)
- ;; check arguments early
- (let ((kvs keys-values)
- k v)
+(defun org-index--do-edit ()
+ "Perform command edit."
+ (let ((maxlen 0) cols-vals buffer-keymap field-keymap keywords-pos val)
+
+ (org-index--check-can-edit-or-kill "edit")
+
+ ;; change to index, if whithin occur
+ (if org-index--within-occur
+ (let ((pos (get-text-property (point) 'org-index-lbp)))
+ (org-index--occur-test-stale pos)
+ (setq org-index--context-occur (cons (point) (org-index--line-in-canonical-form)))
+ (set-buffer org-index--buffer)
+ (goto-char pos))
+ (setq org-index--context-occur nil))
+
+ ;; change to index, if on headline
+ (if (org-at-heading-p)
+ (let ((id (org-id-get)))
+ (setq org-index--context-node (cons (current-buffer) (point)))
+ (set-buffer org-index--buffer)
+ (unless (and id (org-index--go 'id id))
+ (setq org-index--context-node nil)
+ (error "This node is not in index")))
+ (setq org-index--context-node nil))
+
+ ;; retrieve current content of index line
+ (dolist (col (mapcar 'car (reverse org-index--columns)))
+ (if (> (length (symbol-name col)) maxlen)
+ (setq maxlen (length (symbol-name col))))
+ (setq val (org-index--get-or-set-field col))
+ (if (and val (eq col 'yank)) (setq val (replace-regexp-in-string (regexp-quote "\\vert") "|" val nil 'literal)))
+ (setq cols-vals (cons (cons col val)
+ cols-vals)))
+
+ ;; we need two different keymaps
+ (setq buffer-keymap (make-sparse-keymap))
+ (set-keymap-parent buffer-keymap widget-keymap)
+ (define-key buffer-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c)
+ (define-key buffer-keymap (kbd "C-c C-k") 'org-index--edit-c-c-c-k)
+
+ (setq field-keymap (make-sparse-keymap))
+ (set-keymap-parent field-keymap widget-field-keymap)
+ (define-key field-keymap (kbd "C-c C-c") 'org-index--edit-c-c-c-c)
+ (define-key field-keymap (kbd "C-c C-k") 'org-index--edit-c-c-c-k)
+
+ ;; prepare buffer
+ (setq org-index--context-index (cons (point) (org-index--line-in-canonical-form)))
+ (if (get-buffer org-index--edit-buffer-name) (kill-buffer org-index--edit-buffer-name))
+ (switch-to-buffer (get-buffer-create org-index--edit-buffer-name))
+
+ ;; create and fill widgets
+ (setq org-index--edit-widgets nil)
+ (widget-insert "Edit this line from index; type C-c C-c when done, C-c C-k to abort.\n\n")
+ (dolist (col-val cols-vals)
+ (if (eq (car col-val) 'keywords) (setq keywords-pos (point)))
+ (setq org-index--edit-widgets (cons
+ (cons (car col-val)
+ (widget-create 'editable-field
+ :format (format (format "%%%ds: %%%%v" maxlen) (symbol-name (car col-val)))
+ :keymap field-keymap
+ (or (cdr col-val) "")))
+ org-index--edit-widgets)))
+
+ (widget-setup)
+ (goto-char keywords-pos)
+ (beginning-of-line)
+ (forward-char (+ maxlen 2))
+ (use-local-map buffer-keymap)
+ "Editing a single line from index"))
+
+
+(defun org-index--edit-c-c-c-c ()
+ "Function to invoked on C-c C-c in Edit buffer."
+ (interactive)
+
+ (let ((obuf (get-buffer org-index--occur-buffer-name))
+ val line)
+
+ ;; Time might have passed
+ (org-index--refresh-parse-table)
+
+ (with-current-buffer org-index--buffer
+
+ ;; check, if buffer has become stale
+ (save-excursion
+ (goto-char (car org-index--context-index))
+ (unless (string= (cdr org-index--context-index)
+ (org-index--line-in-canonical-form))
+ (switch-to-buffer org-index--edit-buffer-name)
+ (error "Index table has changed: Cannot find line, that this buffer is editing")))
+
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char (car org-index--context-index))
+
+ ;; write back line to index
+ (dolist (col-widget org-index--edit-widgets)
+ (setq val (widget-value (cdr col-widget)))
+ (if (eq (car col-widget) 'yank) (setq val (replace-regexp-in-string "|" (regexp-quote "\\vert") val)))
+ (org-index--get-or-set-field (car col-widget) val))
+
+ (setq line (org-index--align-and-fontify-current-line))
+ (beginning-of-line))
+
+ ;; write line to occur if appropriate
+ (if org-index--context-occur
+ (if obuf
+ (if (string= (cdr org-index--context-index)
+ (cdr org-index--context-occur))
+ (progn
+ (pop-to-buffer-same-window obuf)
+ (goto-char (car org-index--context-occur))
+ (beginning-of-line)
+ (let ((inhibit-read-only t))
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert line)
+ (put-text-property (line-beginning-position) (line-end-position)
+ 'org-index-lbp (cdr org-index--context-index))))
+ (error "Occur buffer and index buffer do not match any longer"))
+ (message "Occur buffer has gone, cannot switch back."))
+ (setq org-index--context-occur nil))
+
+ ;; return to node, if invoked from there
+ (when org-index--context-node
+ (pop-to-buffer-same-window (car org-index--context-node))
+ (goto-char (cdr org-index--context-node)))
+
+ ;; clean up
+ (kill-buffer org-index--edit-buffer-name)
+ (setq org-index--context-index nil)
+ (setq org-index--edit-widgets nil)
+ (beginning-of-line)
+ (message "Index line has been edited.")))
+
+
+(defun org-index--edit-c-c-c-k ()
+ "Function to invoked on C-c C-k in Edit buffer."
+ (interactive)
+ (kill-buffer org-index--edit-buffer-name)
+ (setq org-index--context-index nil)
+ (setq org-index--edit-widgets nil)
+ (beginning-of-line)
+ (message "Edit aborted."))
+
+
+(defun org-index--do-new-line (&rest keys-values)
+ "Do the work for `org-index-new-line'.
+Optional argument KEYS-VALUES specifies content of new line."
+
+ (save-excursion
+ (org-index--retrieve-context)
+ (with-current-buffer org-index--buffer
+ (goto-char org-index--point)
+
+ ;; check arguments early; they might come from userland
+ (let ((kvs keys-values)
+ k v)
+ (while kvs
+ (setq k (car kvs))
+ (setq v (cadr kvs))
+ (if (or (not (symbolp k))
+ (and (symbolp v) (not (eq v t)) (not (eq v nil))))
+ (error "Arguments must be alternation of key and value"))
+ (unless (org-index--column-num k)
+ (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
+ (setq kvs (cddr kvs))))
+
+ (let (yank)
+ ;; create new line
+ (org-index--create-new-line)
+
+ ;; fill columns
+ (let ((kvs keys-values)
+ k v n)
(while kvs
(setq k (car kvs))
(setq v (cadr kvs))
- (if (eq k :ref)
- (unless (memq v '(t nil))
- (error "Argument :ref accepts only t or nil"))
- (if (or (not (symbolp k))
- (symbolp v))
- (error "Arguments must be alternation of key and value")))
- (unless (> (org-index--column-num k) 0)
- (error "Unknown column or column not defined in table: '%s'" (symbol-name k)))
+ (org-table-goto-column (org-index--column-num k))
+ (insert (org-trim (or v "")))
(setq kvs (cddr kvs))))
- (if (and (not (plist-get keys-values :ref))
- (not (stringp (plist-get keys-values :link))))
- (error "Need a link when not creating a ref"))
-
- (let (new)
- ;; create new line
- (setq new (org-index--do-new-line (plist-get keys-values :ref)))
- (plist-put keys-values :ref (or new ""))
-
- ;; fill columns
- (let ((kvs keys-values)
- k v n)
- (while kvs
- (setq k (car kvs))
- (setq v (cadr kvs))
- (setq n (org-index--column-num k))
- (org-table-goto-column n)
- (insert v)
- (setq kvs (cddr kvs))))
-
- (org-index--sort)
- new)))))
+ ;; align and fontify line
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line)
+ ;; remember fingerprint to be able to return
+ (setq org-index--last-fingerprint (org-index--get-or-set-field 'fingerprint))
+
+ ;; get column to yank
+ (setq yank (org-index--get-or-set-field org-index-yank-after-add))
+
+ yank))))
-(defun org-index-get-line (what value)
- "Retrieve an existing line within the index table by ref or
-link and return its contents as a property list.
-The function `plist-get' may be used to retrieve specific values.
+(defun org-index-get-line (column value)
+ "Retrieve an existing line within the index table by ref or id.
+Return its contents as a property list.
+
+The function `plist-get' may be used to retrieve specific elements
+from the result.
Example:
- (plist-get (org-index-get-line \"12\") :count)
+ (plist-get (org-index-get-line 'ref \"R12\") 'count)
-retrieves the value of the count-column for reference 12.
+retrieves the value of the count-column for reference number 12.
-"
- (interactive)
- (let ((org-index--silent t)
- found)
+Argument COLUMN is a symbol, either ref or id,
+argument VALUE specifies the value to search for."
+ ;; check arguments
+ (unless (memq column '(ref id))
+ (error "Argument column can only be 'ref' or 'id'"))
- ;; check arguments
- (unless (memq what '(:ref :link))
- (error "Argument what can only be :ref or :link"))
+ (unless value
+ (error "Need a value to search for"))
+
+ (org-index--verify-id)
+ (org-index--parse-table)
- (save-excursion
- (org-index--retrieve-context)
- (with-current-buffer org-index--buffer
- (goto-char org-index--point)
- (org-index--parse-table)
+ (org-index--get-line column value))
- (goto-char org-index--below-hline)
- (while (and (not found)
- (org-at-table-p))
- (when (string= (org-index--get-field what)
- value)
- (mapc (lambda (x)
- (if (and (numberp (cdr x))
- (> (cdr x) 0))
- (setq found (cons (car x) (cons (or (org-index--get-field (car x)) "") found)))
- )) (reverse org-index--columns)))
- (forward-line))
- found))))
+(defun org-index--get-line (column value)
+ "Find a line by ID, return its contents.
+Argument COLUMN and VALUE specify line to get."
+ (let (content)
+ (org-index--on
+ column value
+ (mapc (lambda (x)
+ (if (and (numberp (cdr x))
+ (> (cdr x) 0))
+ (setq content (cons (car x) (cons (or (org-index--get-or-set-field (car x)) "") content)))))
+ (reverse org-index--columns)))
+ content))
-(defun org-index--read-what (what)
- "Find out, what we are supposed to do"
- (let (commands ; currently active set of selectable commands
- trailing-digits ; any digits, that are are appended to what-input
- reorder-once ; Column to use for single time sorting
- what-input) ; Input on what question (need not necessary be "what")
-
- ;; Set preferred action, that will be the default choice
- (setq org-index--preferred-command
- (if org-index--within-node
- (if (memq org-index--last-action '(ref link))
- 'leave
- 'goto)
- (if org-index--active-region
- 'ref
- (if (and org-index--below-cursor (string-match org-index--ref-regex org-index--below-cursor))
- 'occur
- nil))))
-
- ;; Ask user, what to do
- (if what
- (setq what-input (symbol-name what))
- ;; subset of most common commands for initial selection, ie. up to first plus
- (setq commands (copy-list org-index--commands))
- (let ((c commands))
- (while (and c (not (eq (car c) '+)))
- (setq c (cdr c)))
- (setcdr c nil))
-
- (while (let (completions starts-with-plus is-only-plus)
-
- (setq what-input
- (org-completing-read
- "Please choose: "
- (mapcar 'symbol-name
- ;; Construct unique list of commands with
- ;; preferred one at front
- (delq nil (delete-dups
- (append
- (list org-index--preferred-command)
- (copy-list commands)))))
- nil nil))
-
- ;; if input ends in digits, save them away and do completions on head of input
- ;; this allows input like "h224" to be accepted
- (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input)
- ;; remember digits
- (setq trailing-digits (string-to-number (match-string 2 what-input)))
- ;; and use non-digits-part to find match
- (setq what-input (match-string 1 what-input)))
-
- ;; if input starts with "+", any command (not only some) may follow
- ;; this allows input like "+sort" to be accepted
- (when (and (> (length what-input) 0)
- (string= (substring what-input 0 1) "+"))
- ;; make all commands available for selection
- (setq commands (copy-list org-index--commands))
- (setq what-input (substring what-input 1))
- (setq starts-with-plus (> (length what-input) 0))
- (setq is-only-plus (not starts-with-plus)))
-
- ;; get list of possible completions for what-input; i.e.
- ;; all commands, that start with what-input
- (setq completions (delq nil (mapcar
- (lambda (x)
- (let ((where (search what-input (symbol-name x))))
- (if (and where
- (= where 0))
- x
- nil))) commands)))
-
- ;; if input starts with "+" and not just "+"
- (when starts-with-plus
- ;; use first completion, if unambigously
- (if (= (length completions) 1)
- (setq what-input (symbol-name (car completions)))
- (if completions
- (error "Input \"+%s\" matches multiple commands: %s"
- what-input
- (mapconcat 'symbol-name completions ", "))
- (error "Input \"+%s\" matches no commands" what-input))))
-
- ;; if input ends in digits, use first completion, even if ambigous
- ;; this allows input like "h224" to be accepted
- (when (and trailing-digits completions)
- ;; use first match as input, even if ambigously
- (setq org-index--preferred-command (first completions))
- (setq what-input (number-to-string trailing-digits)))
-
- ;; convert to symbol
- (setq what (intern what-input))
- (if is-only-plus (setq what '+))
-
- ;; user is not required to input one of the commands; if
- ;; not, take the first one and use the original input for
- ;; next question
- (if (memq what commands)
- ;; input matched one element of list, dont need original
- ;; input any more
- (setq what-input nil)
- ;; what-input will be used for next question, use first
- ;; command for what
- (setq what (or org-index--preferred-command
- (first commands)))
- ;; remove any trailing dot, that user might have added to
- ;; disambiguate his input
- (if (and (> (length what-input) 0)
- (equal (substring what-input -1) "."))
- ;; but do this only, if dot was really necessary to
- ;; disambiguate
- (let ((shortened-what-input (substring what-input 0 -1)))
- (unless (test-completion shortened-what-input
- (mapcar 'symbol-name
- commands))
- (setq what-input shortened-what-input)))))
-
- ;; ask for reorder in loop, because we have to ask for
- ;; what right again
- (if (eq what 'reorder)
- (setq reorder-once
- (intern
- (org-icompleting-read
- "Please choose column to reorder index table once: "
- (mapcar 'symbol-name
- (append '(:ref :count :first :last)
- (delq nil (mapcar (lambda (x) (if (> (cdr (assoc x org-index--columns)) 0) x nil))
- '(:x1 :x2 :x3)))))
- nil t))))
-
- ;; maybe ask initial question again
- (memq what '(reorder +)))))
- (list what what-input reorder-once)))
-
-
-(defun org-index--get-or-read-search (search what what-input)
- "Get search string, maybe read from user"
-
- (let (search-from-table
- search-from-cursor)
-
- (unless search
- ;; Search string can come from several sources:
- ;; From link or ref columns of table
- (when org-index--within-node
- (setq search-from-table (or (org-index--get-field :link)
- (org-index--get-field :ref))))
-
- ;; From string below cursor
- (when (and (not org-index--within-node)
- org-index--below-cursor
- (string-match (concat "\\(" org-index--ref-regex "\\)")
- org-index--below-cursor))
- (setq search-from-cursor (match-string 1 org-index--below-cursor)))
-
- ;; Depending on requested action, get search from one of the sources above
- (cond ((eq what 'goto)
- (setq search (or what-input search-from-cursor)))
- ((memq what '(head occur))
- (setq search (or what-input search-from-table search-from-cursor)))))
+(defun org-index--ref-from-id (id)
+ "Get reference from line ID."
+ (org-index--on 'id id (org-index--get-or-set-field 'ref)))
- ;; If we still do not have a search string, ask user explicitly
- (unless search
-
- (if org-index--silent (error "Need to specify search, if silence is required"))
+(defun org-index--id-from-ref (ref)
+ "Get id from line REF."
+ (org-index--on 'ref ref (org-index--get-or-set-field 'id)))
- (unless (eq what 'occur)
-
- (if what-input
- (setq search what-input)
- (setq search (read-from-minibuffer
- (cond ((eq what 'head)
- "Text or reference number to search for: ")
- ((eq what 'goto)
- "Reference number to search for, or enter \".\" for id of current node: ")
- ((eq what 'update)
- "Reference number to update: ")))))
-
- (if (string-match "^\\s *[0-9]+\\s *$" search)
- (setq search (format "%s%s%s" org-index--head search org-index--tail)))))
-
-
- ;; Clean up and examine search string
- (when search
- (setq search (org-trim search))
- (if (string= search "") (setq search nil))
- (when search
- (if (string-match "^[0-9]+$" search)
- (setq search (concat org-index--head search org-index--tail)))))
+
+(defun org-index--get-fingerprint ()
+ "Get fingerprint of current line."
+ (replace-regexp-in-string
+ "\\s " ""
+ (mapconcat (lambda (x) (org-index--get-or-set-field x)) '(id ref yank keywords created) "")))
+
+
+(defun org-index--read-search-for-index ()
+ "Special input routine for command index."
+
+ ;; Accept single char commands or switch to reading a sequence of digits
+ (let (char prompt search-ref search-id search-fingerprint)
- ;; Check for special case
- (when (and (memq what '(head goto))
- (string= search "."))
- (setq search (org-id-get)))
+ ;; start with short prompt but give more help on next iteration
+ (setq prompt "Please specify, where to go in index (0-9.,space,backspace,return or ? for help): ")
- search))
+ ;; read one character
+ (while (not (memq char (append (number-sequence ?0 ?9) (list ?\d ?\b ?\r ?\j ?\s ?.))))
+ (setq char (read-char prompt))
+ (setq prompt "Go to index table and specific position. Digits specify a reference number to got to, <space> goes to top of index, <backspace> or <delete> to last line created and <return> or `.' to index line of current node. Please choose: "))
+
+ (if (memq char (number-sequence ?0 ?9))
+ ;; read rest of digits
+ (setq search-ref (read-from-minibuffer "Search reference number: " (char-to-string char))))
+ ;; decode single chars
+ (if (memq char '(?\r ?\n ?.)) (setq search-id (org-id-get)))
+ (if (memq char '(?\d ?\b)) (setq search-fingerprint org-index--last-fingerprint))
+
+ (list search-ref search-id search-fingerprint)))
(defun org-index--verify-id ()
+ "Check, that we have a valid id."
;; Check id
(unless org-index-id
- (setq org-index-id (org-index--create-new-index
- t
- (format "No index table has been created yet." org-index-id))))
+ (let ((answer (org-completing-read "Cannot find an index (org-index-id is not set). You may:\n - read-help : to learn more about org-index\n - create-index : invoke an assistant to create an initial index\nPlease choose: " (list "read-help" "create-index") nil t nil nil "read-help")))
+ (if (string= answer "create-index")
+ (org-index--create-missing-index "Variable org-index-id is not set, so probably no index table has been created yet.")
+ (describe-function 'org-index))))
;; Find node
- (let (marker)
+ (let (marker)
(setq marker (org-id-find org-index-id 'marker))
- (unless marker (setq org-index-id (org-index--create-new-index
- t
- (format "Cannot find node with id \"%s\"" org-index-id))))
+ (unless marker (org-index--create-missing-index "Cannot find the node with id \"%s\" (as specified by variable org-index-id)." org-index-id))
; Try again with new node
- (setq marker (org-id-find org-index-id 'marker))
+ (setq marker (org-id-find org-index-id 'marker))
(unless marker (error "Could not create node"))
- (setq org-index--buffer (marker-buffer marker)
+ (setq org-index--buffer (marker-buffer marker)
org-index--point (marker-position marker))
(move-marker marker nil)))
(defun org-index--retrieve-context ()
+ "Collect context information before starting with command."
;; Get the content of the active region or the word under cursor
- (setq org-index--active-region
+ (setq org-index--active-region
(if (and transient-mark-mode mark-active)
(buffer-substring (region-beginning) (region-end))
nil))
(setq org-index--below-cursor (thing-at-point 'symbol))
-
- ;; Find out, if we are within favable or not
- (setq org-index--within-node (string= (org-id-get) org-index-id))
-
- ;; Check and remember, if active window contains buffer with index table
- (if (eq (window-buffer) org-index--buffer)
- (setq org-index--active-window-index (selected-window)))
- ;; get current position in index-buffer
- (with-current-buffer org-index--buffer
- (unless (string= (org-id-get) org-index-id)
- (unless org-index--point-before
- (setq org-index--point-before (point))))))
+ ;; get category of current node
+ (setq org-index--category-before
+ (save-excursion ; workaround: org-get-category does not give category when at end of buffer
+ (beginning-of-line)
+ (org-get-category (point) t)))
+
+ ;; Find out, if we are within index table or occur buffer
+ (setq org-index--within-node (string= (org-id-get) org-index-id))
+ (setq org-index--within-occur (string= (buffer-name) org-index--occur-buffer-name)))
(defun org-index--parse-table ()
+ "Parse content of index table."
(let (ref-field
- link-field
+ id-field
initial-point
- end-of-heading)
+ end-of-headings
+ start-of-headings)
(with-current-buffer org-index--buffer
- (setq org-index--maxref 0)
+ (setq org-index--maxrefnum 0)
(setq initial-point (point))
+
+ (org-index--go-below-hline)
+
+ ;; align and fontify table once for this emacs session
+ (unless org-index--aligned
+ (org-table-align) ; needs to happen before fontification to be effective ?
+ (let ((is-modified (buffer-modified-p))
+ (below (point)))
+ (while (org-at-table-p)
+ (forward-line))
+ (font-lock-fontify-region below (point))
+ (org-index--go-below-hline)
+ (setq org-index--aligned t)
+ (set-buffer-modified-p is-modified)))
+
(org-index--go-below-hline)
- (setq org-index--below-hline (point))
(beginning-of-line)
- (setq end-of-heading (point))
+
+ ;; get headings to display during occur
+ (setq end-of-headings (point))
(while (org-at-table-p) (forward-line -1))
(forward-line)
- (setq org-index--headings (buffer-substring (point) end-of-heading))
- (goto-char org-index--below-hline)
-
-
+ (setq start-of-headings (point))
+ (setq org-index--headings-visible (substring-no-properties (org-index--copy-visible start-of-headings end-of-headings)))
+ (setq org-index--headings (buffer-substring start-of-headings end-of-headings))
+
;; count columns
(org-table-goto-column 100)
(setq org-index--numcols (- (org-table-current-column) 1))
-
- ;; get contents of columns
- (forward-line -2)
- (unless (org-at-table-p)
- (org-index--create-new-index
- nil
- "Index table starts with a hline"))
-
- ;; check for optional line consisting solely of width specifications
- (beginning-of-line)
- (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$")
- (forward-line -1))
- (org-table-goto-column 1)
+ ;; go to top of table
+ (while (org-at-table-p)
+ (forward-line -1))
+ (forward-line)
+
+ ;; parse line of headings
(org-index--parse-headings)
-
- ;; Go beyond end of table
- (while (org-at-table-p) (forward-line 1))
-
+
+ ;; parse list of flags
+ (goto-char org-index--point)
+
;; Retrieve any decorations around the number within the first nonempty ref-field
(goto-char org-index--below-hline)
(while (and (org-at-table-p)
- (not (setq ref-field (org-index--get-field :ref))))
+ (not (setq ref-field (org-index--get-or-set-field 'ref))))
(forward-line))
;; Some Checking
(unless ref-field
- (org-index--create-new-index
- nil
- "Reference column is empty"))
-
+ (org-index--report-index-error "Reference column is empty"))
+
(unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field)
- (org-index--create-new-index
- nil
- (format "First reference in index table ('%s') does not contain a number" ref-field)))
-
+ (org-index--report-index-error
+ "First reference in index table ('%s') does not contain a number" ref-field))
;; These are the decorations used within the first ref of index
(setq org-index--head (match-string 1 ref-field))
(setq org-index--tail (match-string 3 ref-field))
(setq org-index--ref-regex (concat (regexp-quote org-index--head)
- "\\([0-9]+\\)"
+ "\\([0-9]+\\)"
(regexp-quote org-index--tail)))
(setq org-index--ref-format (concat org-index--head "%d" org-index--tail))
-
+ ;; check if the table still seems to be sorted mixed
+ (goto-char org-index--below-hline)
+ (when (eq org-index-sort-by 'mixed)
+ (org-index--go-below-hline)
+ (if (string< (org-index--get-or-set-field 'last-accessed)
+ (org-index--get-mixed-time))
+ (org-index--do-sort-index org-index-sort-by)))
+
;; Go through table to find maximum number and do some checking
- (let ((ref 0))
-
- (while (org-at-table-p)
+ (let ((refnum 0))
- (setq ref-field (org-index--get-field :ref))
- (setq link-field (org-index--get-field :link))
+ (while (org-at-table-p)
- (when (and (not ref-field)
- (not link-field))
- (org-pop-to-buffer-same-window org-index--buffer)
- (org-reveal)
- (error "Columns ref and link are both empty in this line"))
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (setq id-field (org-index--get-or-set-field 'id))
(if ref-field
(if (string-match org-index--ref-regex ref-field)
;; grab number
- (setq ref (string-to-number (match-string 1 ref-field)))
- (org-pop-to-buffer-same-window org-index--buffer)
- (org-reveal)
- (error "Column ref does not contain a number")))
+ (setq refnum (string-to-number (match-string 1 ref-field)))
+ (kill-whole-line)
+ (message "Removing line from index-table whose ref does not contain a number")))
;; check, if higher ref
- (if (> ref org-index--maxref) (setq org-index--maxref ref))
-
- ;; check if ref is ment for reuse
- (if (string= (org-index--get-field :count) ":reuse:")
- (setq org-index--has-reuse t))
+ (if (> refnum org-index--maxrefnum) (setq org-index--maxrefnum refnum))
(forward-line 1)))
-
+
+ (setq org-index--nextref (format "%s%d%s" org-index--head (1+ org-index--maxrefnum) org-index--tail))
;; go back to initial position
(goto-char initial-point))))
-(defun org-index--sort (&optional sort-column)
+(defun org-index--refresh-parse-table ()
+ "Fast refresh of selected results of parsing of index table."
+
+ (setq org-index--point (marker-position (org-id-find org-index-id 'marker)))
+ (with-current-buffer org-index--buffer
+ (save-excursion
+ (org-index--go-below-hline))))
+
+
+(defun org-index--do-maintain ()
+ "Choose among and perform some tasks to maintain index."
+ (let ((check-what) (max-mini-window-height 1.0) message-text)
+ (setq check-what (intern (org-completing-read "These checks and fixes are available:\n - statistics : compute statistics about index table\n - check : check ids by visiting their nodes\n - duplicates : check index for duplicate rows (ref or id)\n - clean : remove obsolete property org-index-id\n - update : update content of index lines, with an id \nPlease choose: " (list "statistics" "check" "duplicates" "clean" "update") nil t nil nil "statistics")))
+ (message nil)
+
+ (cond
+ ((eq check-what 'check)
+ (setq message-text (or (org-index--check-ids)
+ "No problems found")))
+
+ ((eq check-what 'statistics)
+ (setq message-text (org-index--do-statistics)))
+
+ ((eq check-what 'duplicates)
+ (setq message-text (org-index--find-duplicates)))
+
+ ((eq check-what 'clean)
+ (let ((lines 0))
+ (org-map-entries
+ (lambda ()
+ (when (org-entry-get (point) "org-index-ref")
+ (cl-incf lines)
+ (org-entry-delete (point) "org-index-ref")))
+ nil 'agenda)
+ (setq message-text (format "Removed property 'org-index-ref' from %d lines" lines))))
+
+ ((eq check-what 'update)
+ (if (y-or-n-p "Updating your index will overwrite certain columns with content from the associated heading and category. If unsure, you may try this for a single, already existing line of your index by invoking `add'. Are you SURE to proceed for ALL INDEX LINES ? ")
+ (setq message-text (org-index--update-all-lines))
+ (setq message-text "Canceled."))))
+ message-text))
+
- (unless sort-column (setq sort-column (org-index--special-column :sort)))
+(defun org-index--get-mixed-time ()
+ "Get timestamp for sorting order mixed."
+ (format-time-string
+ (org-time-stamp-format t t)
+ (apply 'encode-time (append '(0 0 0) (nthcdr 3 (decode-time))))))
- (let (top
+
+(defun org-index--do-sort-index (sort)
+ "Sort index table according to SORT."
+
+ (let ((is-modified (buffer-modified-p))
+ top
bottom
ref-field
count-field
- count-special)
+ mixed-time)
- (unless buffer-read-only
+ (unless buffer-read-only
- ;; get boundaries of table
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq top (point))
- (while (org-at-table-p) (forward-line))
-
- ;; Kill all empty rows at bottom
- (while (progn
- (forward-line -1)
- (org-table-goto-column 1)
- (and
- (not (org-index--get-field :ref))
- (not (org-index--get-field :link))))
- (org-table-kill-row))
- (forward-line 1)
- (setq bottom (point))
-
- (save-restriction
- (narrow-to-region top bottom)
- (goto-char top)
- (sort-subr t
- 'forward-line
- 'end-of-line
- (lambda ()
- (let (ref
- (ref-field (or (org-index--get-field :ref) ""))
- (count-field (or (org-index--get-field :count) ""))
- (count-special 0))
-
- ;; get reference with leading zeroes, so it can be
- ;; sorted as text
- (string-match org-index--ref-regex ref-field)
- (setq ref (format
- "%06d"
- (string-to-number
- (or (match-string 1 ref-field)
- "0"))))
-
- ;; find out, if special token in count-column
- (setq count-special (format "%d"
- (- 2
- (length (member count-field '(":missing:" ":reuse:"))))))
-
- ;; Construct different sort-keys according to
- ;; requested sort column; prepend count-special to
- ;; sort special entries at bottom of table, append ref
- ;; as a secondary sort key
- (cond
-
- ((eq sort-column :count)
- (concat count-special
- (format
- "%08d"
- (string-to-number (or (org-index--get-field :count)
- "")))
- ref))
-
- ((eq sort-column :ref)
- (concat count-special
- ref))
-
- ((memq sort-column '(:last :x1 :x2 :x3))
- (concat count-special
- (org-index--get-field sort-column)
- " "
- ref))
-
- (t (error "This is a bug: unmatched case '%s'" sort-column)))))
-
- nil 'string<))
-
- ;; sorting has moved point below hline
- (org-index--go-below-hline)
- (setq org-index--below-hline (point)))))
+ (message "Sorting index table for %s..." (symbol-name sort))
+ (undo-boundary)
+
+ (let ((message-log-max nil)) ; we have just issued a message, dont need those of sort-subr
+
+ ;; if needed for mixed sort
+ (if (eq sort 'mixed)
+ (setq mixed-time (org-index--get-mixed-time)))
+
+ ;; get boundaries of table
+ (org-index--go-below-hline)
+ (forward-line 0)
+ (setq top (point))
+ (while (org-at-table-p) (forward-line))
+
+ ;; kill all empty rows at bottom
+ (while (progn
+ (forward-line -1)
+ (org-table-goto-column 1)
+ (and
+ (not (org-index--get-or-set-field 'ref))
+ (not (org-index--get-or-set-field 'id))
+ (not (org-index--get-or-set-field 'yank))))
+ (org-table-kill-row))
+ (forward-line 1)
+ (setq bottom (point))
+
+ ;; sort lines
+ (save-restriction
+ (narrow-to-region top bottom)
+ (goto-char top)
+ (sort-subr t
+ 'forward-line
+ 'end-of-line
+ (lambda ()
+ (org-index--get-sort-key sort t mixed-time))
+ nil
+ 'string<)
+ (goto-char (point-min))
+
+ ;; restore modification state
+ (set-buffer-modified-p is-modified)))
+
+ (setq org-index--last-sort sort))))
+
+
+(defun org-index--do-sort-lines (what)
+ "Sort lines in WHAT according to contained reference."
+ (save-restriction
+ (cond
+ ((eq what 'region)
+ (if (region-active-p)
+ (narrow-to-region (region-beginning) (region-end))
+ (error "No active region, cannot sort")))
+ ((eq what 'buffer)
+ (unless (y-or-n-p "Sort whole current buffer ? ")
+ (error "Canceled"))
+ (narrow-to-region (point-min) (point-max))))
+
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line
+ (lambda ()
+ (if (looking-at (concat ".*"
+ (org-index--make-guarded-search org-index--ref-regex 'dont-quote)))
+ (string-to-number (match-string 1))
+ 0)))))
(defun org-index--go-below-hline ()
+ "Move below hline in index-table."
- (goto-char org-index--point)
- ;; go to heading of node
- (while (not (org-at-heading-p)) (forward-line -1))
- (forward-line 1)
- ;; go to table within node, but make sure we do not get into another node
- (while (and (not (org-at-heading-p))
- (not (org-at-table-p))
- (not (eq (point) (point-max))))
- (forward-line 1))
-
- ;; check, if there really is a table
- (unless (org-at-table-p)
- (org-index--create-new-index
- t
- (format "Cannot find index table within node %s" org-index-id)))
-
- ;; go to first hline
- (while (and (not (org-at-table-hline-p))
- (org-at-table-p))
- (forward-line 1))
-
- ;; and check
- (unless (org-at-table-hline-p)
- (org-index--create-new-index
- nil
- "Cannot find hline within index table"))
+ (let ((count 0)
+ (errstring (format "index table within node %s" org-index-id)))
- (forward-line 1)
- (org-table-goto-column 1))
+ (goto-char org-index--point)
+ ;; go to heading of node
+ (while (not (org-at-heading-p)) (forward-line -1))
+ (forward-line 1)
-(defun org-index--align ()
- (unless buffer-read-only (org-table-align))
- (org-index--go-below-hline)
- (setq org-index--below-hline (point)))
+ ;; go to first table, but make sure we do not get into another node
+ (while (and (not (org-at-table-p))
+ (not (org-at-heading-p))
+ (not (eobp)))
+ (forward-line))
+
+ ;; check, if there really is a table
+ (unless (org-at-table-p)
+ (org-index--create-missing-index "Cannot find %s." errstring))
+
+ ;; go just after hline
+ (while (and (not (org-at-table-hline-p))
+ (org-at-table-p))
+ (forward-line))
+ (forward-line)
+
+ ;; and check
+ (unless (org-at-table-p)
+ (org-index--report-index-error "Cannot find a hline within %s" errstring))
+
+ (org-table-goto-column 1)
+ (setq org-index--below-hline (point))))
(defun org-index--parse-headings ()
+ "Parse headings of index table."
- ;; Associate names of special columns with column-numbers
- (setq org-index--columns (copy-tree '((:ref . 0) (:link . 0) (:first . 0) (:last . 0)
- (:count . 0) (:x1 . 0) (:x2 . 0) (:x3 . 0))))
-
- ;; Associate names of special columns with names of columns
- (setq org-index--special-columns (copy-tree '((:sort . nil) (:copy . nil) (:point . nil))))
-
- ;; For each column
- (dotimes (col org-index--numcols)
- (let* (field-flags ;; raw heading, consisting of file name and maybe
- ;; flags (seperated by ";")
- field ;; field name only
- field-symbol ;; and as a symbol
- flags ;; flags from field-flags
- found)
-
- ;; parse field-flags into field and flags
- (setq field-flags (org-trim (org-table-get-field (+ col 1))))
- (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags)
- (progn
- (setq field (downcase (or (match-string 1 field-flags) "")))
- ;; get flags as list of characters
- (setq flags (mapcar 'string-to-char
- (split-string
- (downcase (match-string 2 field-flags))
- "" t))))
- ;; no flags
- (setq field field-flags))
-
- (unless (string= field "") (setq field-symbol (intern (concat ":" (downcase field)))))
- ;; aliases for backward compatability
- (if (eq field-symbol :last-accessed) (setq field-symbol :last))
- (if (eq field-symbol :created) (setq field-symbol :first))
-
- (if (and field-symbol
- (not (assoc field-symbol org-index--columns)))
- (error "Column %s is not a valid heading" (symbol-name field-symbol)))
-
- ;; Check, that no flags appear twice
- (mapc (lambda (x)
- (when (memq (car x) flags)
- (if (cdr (assoc (cdr x) org-index--columns))
- (org-index--create-new-index
- nil
- (format "More than one heading is marked with flag '%c'" (car x))))))
- '((?s . sort)
- (?c . copy)))
-
- ;; Process flags
- (if (memq ?s flags)
- (setcdr (assoc :sort org-index--special-columns) (or field-symbol (+ col 1))))
- (if (memq ?c flags)
- (setcdr (assoc :copy org-index--special-columns) (or field-symbol (+ col 1))))
- (if (memq ?p flags)
- (setcdr (assoc :point org-index--special-columns) (or field-symbol (+ col 1))))
-
- ;; Store columns in alist
- (setq found (assoc field-symbol org-index--columns))
- (when found
- (if (> (cdr found) 0)
- (org-index--create-new-index
- nil
- (format "'%s' appears two times as column heading" (downcase field))))
- (setcdr found (+ col 1)))))
-
- ;; check if all necessary informations have been specified
- (mapc (lambda (col)
- (unless (> (cdr (assoc col org-index--columns)) 0)
- (org-index--create-new-index
- nil
- (format "column '%s' has not been set" col))))
- (list :ref :link :count :first :last))
-
- ;; use count as a default sort-column
- (unless (cdr (assoc :sort org-index--special-columns))
- (setcdr (assoc :sort org-index--special-columns) :count)))
-
-
-(defun org-index--create-new-index (create-new-index reason)
- "Create a new empty index table with detailed explanation."
- (let (prompt buffer-name title firstref id)
-
- ;; cannot proceed without querying user
- (if org-index--silent (error "No valid index: %s" reason))
-
- (setq prompt
- (if create-new-index
- (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?")
- (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before trying again. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?")))
- (unless (y-or-n-p prompt)
- (error "Cannot proceed without a valid index table: %s" reason))
-
- (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil))
+ (let (field ;; field content
+ field-symbol ;; and as a symbol
+ found)
+
+ (setq org-index--columns nil)
+
+ ;; For each column
+ (dotimes (col org-index--numcols)
+
+ (setq field (substring-no-properties (downcase (org-trim (org-table-get-field (+ col 1))))))
+
+ (if (string= field "")
+ (error "Heading of column cannot be empty"))
+ (if (and (not (string= (substring field 0 1) "."))
+ (not (member (intern field) org-index--valid-headings)))
+ (error "Column name '%s' is not a valid heading (custom headings may start with a dot, e.g. '.foo')" field))
+
+ (setq field-symbol (intern field))
+
+ ;; check if heading has already appeared
+ (if (assoc field-symbol org-index--columns)
+ (org-index--report-index-error
+ "'%s' appears two times as column heading" (downcase field))
+ ;; add it to list at front, reverse later
+ (setq org-index--columns (cons (cons field-symbol (+ col 1)) org-index--columns)))))
+
+ (setq org-index--columns (reverse org-index--columns))
+
+ ;; check if all necessary headings have appeared
+ (mapc (lambda (head)
+ (unless (cdr (assoc head org-index--columns))
+ (org-index--report-index-error "No column has heading '%s'" head)))
+ org-index--valid-headings))
+
+
+(defun org-index--create-missing-index (&rest reasons)
+ "Create a new empty index table with detailed explanation. Argument REASONS explains why."
+
+ (org-index--ask-before-create-index "Cannot find index table: "
+ "new permanent" "."
+ reasons)
+ (org-index--create-index))
+
+
+(defun org-index--report-index-error (&rest reasons)
+ "Report an error (explained by REASONS) with the existing index and offer to create a valid one to compare with."
+
+ (when org-index--buffer
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--below-hline)
+ (org-reveal t))
+ (org-index--ask-before-create-index "The existing index contains this error: "
+ "temporary" ", to compare with."
+ reasons)
+ (org-index--create-index t t))
+
+
+(defun org-index--ask-before-create-index (explanation type for-what reasons)
+ ; checkdoc-params: (explanation type for-what reasons)
+ "Ask the user before creating an index or throw error. Arguments specify bits of issued message."
+ (let (reason prompt)
+
+ (setq reason (apply 'format reasons))
+
+ (setq prompt (concat explanation reason "\n\n"
+ "However, this assistant can help you to create a "
+ type " index with detailed comments" for-what "\n\n"
+ "Do you want to proceed ?"))
+
+ (unless (let ((max-mini-window-height 1.0))
+ (y-or-n-p prompt))
+ (error (concat explanation reason)))))
+
+
+(defun org-index--create-index (&optional temporary compare)
+ "Create a new empty index table with detailed explanation.
+specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existing index."
+ (let (buffer
+ title
+ firstref
+ id
+ with-explanation)
+
+ (if temporary
+ (let ((file-name (concat temporary-file-directory "org-index--example-index.org"))
+ (buffer-name "*org-index-example-index*"))
+ (setq buffer (get-buffer-create buffer-name))
+ (with-current-buffer buffer
+ ;; but it needs a file for its index to be found
+ (unless (string= (buffer-file-name) file-name)
+ (set-visited-file-name file-name))
+ (rename-buffer buffer-name) ; name is change by line above
+
+ (erase-buffer)
+ (org-mode)))
+
+ (setq buffer (get-buffer (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list))))))
(setq title (read-from-minibuffer "Please enter the title of the index node: "))
(while (progn
- (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
+ (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: "))
(let (desc)
- (unless (equal '(95 119) (sort (delete-dups (mapcar (lambda (x) (char-syntax x)) (concat "-1" firstref))) '<))
- (setq desc "Contains other characters than those allowed in symbols"))
+ (when (string-match "[[:blank:]]" firstref)
+ (setq desc "Contains whitespace"))
+ (when (string-match "[[:cntrl:]]" firstref)
+ (setq desc "Contains control characters"))
(unless (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)
;; firstref not okay, report details
(setq desc
- (cond ((string= firstref "") "is empty")
+ (cond ((string= firstref "") "is empty")
((not (string-match "^[^0-9]+" firstref)) "starts with a digit")
((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number")
((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits")
@@ -1472,738 +1580,1278 @@ retrieves the value of the count-column for reference 12.
)))
(if desc
(progn
- (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again" firstref desc))
+ (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s.\nPlease hit RET and try again: " firstref desc))
t)
nil))))
- (with-current-buffer buffer-name
+ (setq with-explanation (y-or-n-p "Do you want an explanation within your index-table (can later be removed easily) ? "))
+
+ (with-current-buffer buffer
(goto-char (point-max))
- (insert (format "\n\n* %s %s\n" firstref title))
- (insert "\n\n Below you find your initial index table, which will grow over time.\n"
- " Following that your may read its detailed explanation, which will help you,\n"
- " to adjust org-index to your needs. This however is optional reading and not\n"
- " required to start using org-index.\n")
+ (insert (format "* %s %s\n" firstref title))
+ (when with-explanation
+ (if temporary
+ (insert "
+ Below you find your temporary index table, which WILL NOT LAST LONGER
+ THAN YOUR CURRENT EMACS SESSION; please use it only for evaluation.
+")
+ (insert "
+ Below you find your initial index table, which will grow over time.
+"))
+ (insert " You may start using it by adding some lines. Just
+ move to another heading within org, invoke `org-index' and
+ choose the command 'add'. After adding a few nodes, try the
+ command 'occur' to search among them.
+
+ To gain further insight you may invoke the subcommand 'help', or
+ (same content) read the help of `org-index'.
+
+ Within the index table below, the sequence of columns does not
+ matter. You may reorder them in any way you like. You may also
+ add your own columns, which should start with a dot
+ (e.g. '.my-column').
+
+ Invoke `org-customize' to tweak the behaviour of org-index
+ (see the group org-index).
+
+ This node needs not be a top level node; its name is completely
+ at your choice; it is found through its ID only.
+")
+ (unless temporary
+ (insert "
+ Remark: These lines of explanation can be removed at any time.
+")))
(setq id (org-id-get-create))
(insert (format "
- | | | | | | comment |
- | ref | link | first | count;s | last | ;c |
- | | <4> | | | | |
- |-----+------+-------+---------+------+---------|
- | %s | %s | %s | | | %s |
+ | ref | category | keywords | tags | count | level | last-accessed | created | id | yank |
+ | | | | | | | | | <4> | <4> |
+ |-----+----------+----------+------+-------+-------+---------------+---------+-----+------|
+ | %s | | %s | | | | | %s | %s | |
-"
+"
firstref
- id
+ title
(with-temp-buffer (org-insert-time-stamp nil nil t))
- "This node"))
+ id))
+ ;; make sure, that node can be found
+ (org-id-add-location id (buffer-file-name))
+ (setq buffer-save-without-query t)
+ (basic-save-buffer)
- (insert "
+ (while (not (org-at-table-p)) (forward-line -1))
+ (unless buffer-read-only (org-table-align))
+ (while (not (org-at-heading-p)) (forward-line -1))
- Detailed explanation:
+ ;; read back some info about new index
+ (let ((org-index-id id))
+ (org-index--verify-id))
+ ;; remember at least for this session
+ (setq org-index-id id)
- The index table above has three lines of headings above the first
- hline:
+ ;; present results to user
+ (if temporary
+ (progn
+ ;; Present existing and temporary index together
+ (when compare
+ (pop-to-buffer-same-window org-index--buffer)
+ (goto-char org-index--point)
+ (org-index--unfold-buffer)
+ (delete-other-windows)
+ (select-window (split-window-vertically)))
+ ;; show new index
+ (pop-to-buffer-same-window buffer)
+ (org-id-goto id)
+ (org-index--unfold-buffer)
+ (if compare
+ (progn
+ (message "Please compare your existing index (upper window) and a temporary new one (lower window) to fix your index")
+ (throw 'new-index nil))
+ (message "This is your new temporary index, use command add to populate, occur to search.")))
+ (progn
+ ;; Only show the new index
+ (pop-to-buffer-same-window buffer)
+ (delete-other-windows)
+ (org-id-goto id)
+ (org-index--unfold-buffer)
+ (if (y-or-n-p "This is your new index table. It is already set for this Emacs session, so you may try it out. Do you want to save its id to make it available for future Emacs sessions too ? ")
+ (progn
+ (customize-save-variable 'org-index-id id)
+ (message "Saved org-index-id '%s' to %s" id (or custom-file
+ user-init-file))
+ (throw 'new-index nil))
+ (let (sq)
+ (setq sq (format "(setq org-index-id \"%s\")" id))
+ (kill-new sq)
+ (message "Did not make the id of this new index permanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it" sq)
+ (throw 'new-index nil))))))))
+
+
+(defun org-index--unfold-buffer ()
+ "Helper function to unfold buffer."
+ (org-show-context)
+ (org-show-subtree)
+ (recenter 1)
+ (save-excursion
+ (org-back-to-heading)
+ (forward-line) ;; on property drawer
+ (org-cycle)))
- - The first one is ignored by org-index, and you can use it to
- give meaningful names to columns. In the table above only one
- column has a name (\"comment\"). This line is optional.
- - The second line is the most important one, because it
- contains the configuration information for org-index; please
- read further below for its format.
+(defun org-index--update-line (&optional ref-or-id-or-pos)
+ "Update columns count and last-accessed in line REF-OR-ID-OR-POS."
- - The third line is again optional; it may only specify the
- widths of the individual columns (e.g. <4>).
+ (let ((newcount 0)
+ initial)
- The columns get their meaning by the second line of headings;
- specifically by one of the keywords (e.g. \"ref\") or a flag
- seperated by a semicolon (e.g. \";s\").
+ (with-current-buffer org-index--buffer
+ (unless buffer-read-only
+ ;; search reference or id, if given (or assume, that we are already positioned right)
+ (when ref-or-id-or-pos
+ (setq initial (point))
+ (goto-char org-index--below-hline)
+ (while (and (org-at-table-p)
+ (not (if (integerp ref-or-id-or-pos)
+ (and (>= ref-or-id-or-pos (line-beginning-position))
+ (< ref-or-id-or-pos (line-end-position)))
+ (or (string= ref-or-id-or-pos (org-index--get-or-set-field 'ref))
+ (string= ref-or-id-or-pos (org-index--get-or-set-field 'id))))))
+ (forward-line)))
+ (if (not (org-at-table-p))
+ (error "Did not find reference or id '%s'" ref-or-id-or-pos)
+ (org-index--update-current-line))
+
+ (if initial (goto-char initial))))))
+
+
+(defun org-index--update-current-line ()
+ "Update current lines columns count and last-accessed."
+ (let (newcount (count-field (org-index--get-or-set-field 'count)))
+
+ ;; update count field only if number or empty
+ (when (or (not count-field)
+ (string-match "^[0-9]+$" count-field))
+ (setq newcount (+ 1 (string-to-number (or count-field "0"))))
+ (org-index--get-or-set-field 'count
+ (number-to-string newcount)))
+
+ ;; update timestamp
+ (org-table-goto-column (org-index--column-num 'last-accessed))
+ (org-table-blank-field)
+ (org-insert-time-stamp nil t t)
+
+ ;; move line according to new content
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line)))
+
+
+(defun org-index--align-and-fontify-current-line (&optional num)
+ "Make current line (or NUM lines) blend well among others."
+ (let (lines)
+ ;; get current content
+ (unless num (setq num 1))
+ (setq lines (delete-and-extract-region (line-beginning-position) (line-end-position num)))
+ ;; create minimum table with fixed-width columns to align and fontify new line
+ (insert (with-temp-buffer
+ (org-set-font-lock-defaults)
+ (insert org-index--headings-visible)
+ ;; fill columns, so that aligning cannot shrink them
+ (goto-char (point-min))
+ (search-forward "|")
+ (while (search-forward " " (line-end-position) t)
+ (replace-match "." nil t))
+ (goto-char (point-min))
+ (while (search-forward ".|." (line-end-position) t)
+ (replace-match " | " nil t))
+ (goto-char (point-min))
+ (while (search-forward "|." (line-end-position) t)
+ (replace-match "| " nil t))
+ (goto-char (point-max))
+ (insert lines)
+ (forward-line 0)
+ (let ((start (point)))
+ (while (re-search-forward "^\s +|-" nil t)
+ (replace-match "| -"))
+ (goto-char start))
+ (org-mode)
+ (org-table-align)
+ (font-lock-fontify-region (point-min) (point-max))
+ (goto-char (point-max))
+ (if (eq -1 (skip-chars-backward "\n"))
+ (delete-char 1))
+ (forward-line (- 1 num))
+ (buffer-substring (line-beginning-position) (line-end-position num))))
+ lines))
+
+
+(defun org-index--promote-current-line ()
+ "Move current line up in table according to changed sort fields."
+ (let (begin end key
+ (to-skip 0))
+
+ (forward-line 0) ; stay at beginning of line
+
+ (setq key (org-index--get-sort-key))
+ (setq begin (point))
+ (setq end (line-beginning-position 2))
- The keywords and flags are:
+ (forward-line -1)
+ (while (and (org-at-table-p)
+ (not (org-at-table-hline-p))
+ (string< (org-index--get-sort-key) key))
+ (cl-incf to-skip)
+ (forward-line -1))
+ (forward-line 1)
- - ref: This contains the reference, which consists of a decorated
- number, which is incremented for each new line. References are
- meant to be used in org-mode headlines or outside of org,
- e.g. within folder names.
+ ;; insert line at new position
+ (when (> to-skip 0)
+ (insert (delete-and-extract-region begin end))
+ (forward-line -1))))
- - link: org-mode link pointing to the matching location within org.
- - first: When has this line been first accessed (i.e. created) ?
+(defun org-index--get-sort-key (&optional sort with-ref mixed-time)
+ "Get value for sorting from column SORT, optional WITH-REF; if mixes use MIXED-TIME."
+ (let (ref
+ ref-field
+ key)
- - count: How many times has this line been accessed ? The
- trailing flag \"s\" makes the table beeing sorted after this
- column this column, so that often used entries appear at the
- top of the table.
+ (unless sort (setq sort org-index--last-sort)) ; use default value
- - last: When has this line been accessed last ?
+ (when (or with-ref
+ (eq sort 'ref))
+ ;; get reference with leading zeroes, so it can be
+ ;; sorted as text
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (if ref-field
+ (progn
+ (string-match org-index--ref-regex ref-field)
+ (setq ref (format
+ "%06d"
+ (string-to-number
+ (match-string 1 ref-field)))))
+ (setq ref "000000")))
+
+ (setq key
+ (cond
+ ((eq sort 'count)
+ (format "%08d" (string-to-number (or (org-index--get-or-set-field 'count) ""))))
+ ((eq sort 'mixed)
+ (let ((last-accessed (org-index--get-or-set-field 'last-accessed)))
+ (unless mixed-time (setq mixed-time (org-index--get-mixed-time)))
+ (concat
+ (if (string< mixed-time last-accessed) last-accessed mixed-time)
+ (format "%08d" (string-to-number (or (org-index--get-or-set-field 'count) ""))))))
+ ((eq sort 'ref)
+ ref)
+ ((memq sort '(id last-accessed created))
+ (org-index--get-or-set-field sort))
+ (t (error "This is a bug: unmatched case '%s'" sort))))
+
+ (if with-ref (setq key (concat key ref)))
+
+ key))
+
+
+(defun org-index--get-or-set-field (key &optional value)
+ "Retrieve field KEY from index table or set it to VALUE."
+ (let (field)
+ (save-excursion
+ (if (eq key 'fingerprint)
+ (progn
+ (if value (error "Internal error, pseudo-column fingerprint cannot be set"))
+ (setq field (org-index--get-fingerprint)))
+ (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value))))
+ (if (string= field "") (setq field nil))
- - The last column above has no keyword, only the flag \"c\",
- which makes its content beeing copied under certain
- conditions. It is typically used for comments.
+ (org-no-properties field))))
- The sequence of columns does not matter. You may reorder them any
- way you like. Columns are found by their name, which appears in
- the second line of headings.
- You can add further columns or even remove the last column. All
- other columns are required.
+(defun org-index--column-num (key)
+ "Return number of column KEY."
+ (if (numberp key)
+ key
+ (cdr (assoc key org-index--columns))))
- Finally: This node needs not be a top level node; its name is
- completely at you choice; it is found through its ID only.
+(defun org-index--make-guarded-search (ref &optional dont-quote)
+ "Make robust search string from REF; DONT-QUOTE it, if requested."
+ (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
-")
+(defun org-index--find-duplicates ()
+ "Find duplicate references or ids in index table."
+ (let (ref-duplicates id-duplicates message)
- (while (not (org-at-table-p)) (forward-line -1))
- (unless buffer-read-only (org-table-align))
- (while (not (org-at-heading-p)) (forward-line -1))
-
- ;; present results to user
- (if create-new-index
- (progn
- ;; Only show the new index
- (org-pop-to-buffer-same-window buffer-name)
- (delete-other-windows)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ")
- (progn
- (customize-save-variable 'org-index-id id)
- (message "Saved org-index-id '%s' to %s" org-index-id custom-file))
- (let (sq)
- (setq sq (format "(setq org-index-id \"%s\")" org-index-id))
- (kill-new sq)
- (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))
- id))
- ;; we had an error with the existing index table, so present old
- ;; and new one together
- ;; show existing index
- (org-pop-to-buffer-same-window org-index--buffer)
- (goto-char org-index--point)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (delete-other-windows)
- ;; show new index
- (select-window (split-window-vertically))
- (org-pop-to-buffer-same-window buffer-name)
- (org-id-goto id)
- (org-show-context)
- (show-subtree)
- (recenter 1)
- (error "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)))))
-
-
-(defun org-index--update-line (ref-or-link)
-
- (let (initial
- found
- count-field)
+ (setq ref-duplicates (org-index--find-duplicates-helper 'ref))
+ (setq id-duplicates (org-index--find-duplicates-helper 'id))
+ (goto-char org-index--below-hline)
+ (if (or ref-duplicates id-duplicates)
+ (progn
+ ;; show results
+ (pop-to-buffer-same-window
+ (get-buffer-create "*org-index-duplicates*"))
+ (when ref-duplicates
+ (insert "These references appear more than once:\n")
+ (mapc (lambda (x) (insert " " x "\n")) ref-duplicates)
+ (insert "\n\n"))
+ (when id-duplicates
+ (insert "These ids appear more than once:\n")
+ (mapc (lambda (x) (insert " " x "\n")) id-duplicates))
+
+ "Some references or ids are duplicates")
+ "No duplicate references or ids found")))
+
+
+(defun org-index--find-duplicates-helper (column)
+ "Helper for `org-index--find-duplicates': Go through table and count given COLUMN."
+ (let (counts duplicates field found)
+
+ ;; go through table
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
- (with-current-buffer org-index--buffer
- (unless buffer-read-only
+ ;; get column
+ (setq field (org-index--get-or-set-field column))
- ;; search reference or link, if given (or assume, that we are already positioned right)
- (when ref-or-link
- (setq initial (point))
- (goto-char org-index--below-hline)
- (while (and (org-at-table-p)
- (not (or (string= ref-or-link (org-index--get-field :ref))
- (string= ref-or-link (org-index--get-field :link)))))
- (forward-line)))
-
- (if (not (org-at-table-p))
- (error "Did not find reference or link '%s'" ref-or-link)
- (setq count-field (org-index--get-field :count))
-
- ;; update count field only if number or empty; leave :missing: and :reuse: as is
- (if (or (not count-field)
- (string-match "^[0-9]+$" count-field))
- (org-index--get-field :count
- (number-to-string
- (+ 1 (string-to-number (or count-field "0"))))))
-
- ;; update timestamp
- (org-table-goto-column (org-index--column-num :last))
- (org-table-blank-field)
- (org-insert-time-stamp nil t t)
-
- (setq found t))
-
- (if initial (goto-char initial))
-
- found))))
+ ;; and increment
+ (setq found (assoc field counts))
+ (if found
+ (cl-incf (cdr found))
+ (setq counts (cons (cons field 1) counts)))
+ (forward-line))
-(defun org-index--get-field (key &optional value)
- (let (field)
- (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value)))
- (if (string= field "") (setq field nil))
+ (mapc (lambda (x) (if (and (> (cdr x) 1)
+ (car x))
+ (setq duplicates (cons (car x) duplicates)))) counts)
- (org-no-properties field)))
+ duplicates))
-(defun org-index--column-num (key)
- (if (numberp key)
- key
- (cdr (assoc key org-index--columns))))
+(defun org-index--do-statistics ()
+ "Compute statistics about index table."
+ (let ((total-lines 0) (total-refs 0)
+ ref ref-field min max message)
+ ;; go through table
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
-(defun org-index--special-column (key)
- (cdr (assoc key org-index--special-columns)))
+ ;; get ref
+ (setq ref-field (org-index--get-or-set-field 'ref))
+ (when ref-field
+ (string-match org-index--ref-regex ref-field)
+ (setq ref (string-to-number (match-string 1 ref-field)))
-(defun org-index--make-guarded-search (ref &optional dont-quote)
- (concat "\\_<" (if dont-quote ref (regexp-quote ref)) "\\_>"))
+ ;; record min and max
+ (if (or (not min) (< ref min)) (setq min ref))
+ (if (or (not max) (> ref max)) (setq max ref))
+ (setq total-refs (1+ total-refs)))
-(defun org-index--do-statistics (what)
- (let ((total 0)
- missing
- ref-field
- ref
- min
- max
- message-text)
+ ;; count
+ (setq total-lines (1+ total-lines))
-
- ;; start with list of all references
- (setq missing (mapcar (lambda (x) (format "%s%d%s" org-index--head x org-index--tail))
- (number-sequence 1 org-index--maxref)))
+ (forward-line))
+
+ (setq message (format "%d Lines in index table. First reference is %s, last %s; %d of them are used (%d percent)"
+ total-lines
+ (format org-index--ref-format min)
+ (format org-index--ref-format max)
+ total-refs
+ (truncate (* 100 (/ (float total-refs) (1+ (- max min)))))))
- ;; go through table and remove all refs, that we see
(goto-char org-index--below-hline)
- (while (org-at-table-p)
+ message))
- ;; get ref-field and number
- (setq ref-field (org-index--get-field :ref))
- (if (and ref-field
- (string-match org-index--ref-regex ref-field))
- (setq ref (string-to-number (match-string 1 ref-field))))
- ;; remove existing refs from list
- (if ref-field (setq missing (delete ref-field missing)))
+(defun org-index--do-add-or-update (&optional create-ref tag-with-ref)
+ "For current node or current line in index, add or update in index table.
+CREATE-REF and TAG-WITH-REF if given."
- ;; record min and max
- (if (or (not min) (< ref min)) (setq min ref))
- (if (or (not max) (> ref max)) (setq max ref))
+ (let* (id id-from-index ref args yank)
+
+ ;; do the same things from within index and from outside
+ (if org-index--within-node
+
+ (progn
+ (unless (org-at-table-p)
+ (error "Within index node but not on table"))
+
+ (setq id (org-index--get-or-set-field 'id))
+ (setq ref (org-index--get-or-set-field 'ref))
+ (setq args (org-index--collect-values-for-add-update-remote id))
+ (org-index--write-fields args)
+ (setq yank (org-index--get-or-set-field org-index-yank-after-add))
+
+ (if ref
+ (cons (format "Updated index line %s" ref) yank)
+ (cons "Updated index line" nil)))
+
+ (unless (org-at-heading-p)
+ (error "Not at headline"))
+
+ (setq id (org-id-get-create))
+ (org-index--refresh-parse-table)
+ (setq id-from-index (org-index--on 'id id id))
+ (setq ref (org-index--on 'id id (org-index--get-or-set-field 'ref)))
+
+ (if tag-with-ref
+ (org-toggle-tag (format "%s%d%s" org-index--head tag-with-ref org-index--tail) 'on))
+ (setq args (org-index--collect-values-for-add-update id))
+
+ (when (and create-ref
+ (not ref))
+ (setq ref org-index--nextref)
+ (setq args (plist-put args 'ref ref)))
- ;; count
- (setq total (1+ total))
- (forward-line))
+ (if id-from-index
+ ;; already have an id in index, find it and update fields
+ (let (found-and-message)
+
+ (org-index--on
+ 'id id
+ (org-index--write-fields args)
+ (setq yank (org-index--get-or-set-field org-index-yank-after-add)))
+
+ (if ref
+ (cons (format "Updated index line %s" ref) yank)
+ (cons "Updated index line" nil)))
- ;; insert them, if requested
- (forward-line -1)
- (if (eq what 'statistics)
-
- (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. "
- total
- (format org-index--ref-format min)
- (format org-index--ref-format max)
- (length missing)))
-
- (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table"
- (length missing)))
- (let (type)
- (setq type (org-icompleting-read
- "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing")))
- (mapc (lambda (x)
- (let (org-table-may-need-update) (org-table-insert-row t))
- (org-index--get-field :ref x)
- (org-index--get-field :count (format ":%s:" type)))
- missing)
- (org-index--align)
-
- (setq message-text (format "Inserted %d new lines for missing refernces" (length missing))))
- (setq message-text (format "%d missing references." (length missing)))))
- message-text))
-
-
-(defun org-index--do-head (ref link &optional other)
+ ;; no id here, create new line in index
+ (if ref (setq ref (plist-put args 'ref org-index--nextref)))
+ (setq yank (apply 'org-index--do-new-line args))
+
+ (if ref
+ (cons
+ (format "Added new index line %s" ref)
+ (concat yank " "))
+ (cons
+ "Added new index line"
+ nil))))))
+
+
+(defun org-index--check-ids ()
+ "Check, that ids really point to a node."
+
+ (let ((lines 0)
+ id ids marker)
- (if ref (setq org-index--last-ref ref))
+ (goto-char org-index--below-hline)
- (let (message-text)
- ;; Use link if available
- (if link
- (progn
- (org-index--update-line link)
- (org-id-goto link)
- (org-reveal)
- (if (eq (current-buffer) org-index--buffer)
- (setq org-index--point-before nil))
- (setq message-text "Followed link"))
+ (catch 'problem
+ (while (org-at-table-p)
+
+ (when (setq id (org-index--get-or-set-field 'id))
+
+ ;; check for double ids
+ (when (member id ids)
+ (org-table-goto-column (org-index--column-num 'id))
+ (throw 'problem "This id appears twice in index; please use command 'maintain' to check for duplicate ids"))
+ (cl-incf lines)
+ (setq ids (cons id ids))
+
+ ;; check, if id is valid
+ (setq marker (org-id-find id t))
+ (unless marker
+ (org-table-goto-column (org-index--column-num 'id))
+ (throw 'problem "This id cannot be found")))
+
+ (forward-line))
- (message (format "Scanning headlines for '%s' ..." ref))
- (org-index--update-line ref)
- (let ((search (concat ".*" (org-index--make-guarded-search ref)))
- (org-trust-scanner-tags t)
- buffer point)
- (if (catch 'found
- (progn
- ;; loop over all headlines, stop on first match
- (org-map-entries
- (lambda ()
- (when (or (looking-at search)
- (eq ref (org-entry-get (point) "org-index-ref")))
- ;; If this is not an inlinetask ...
- (when (< (org-element-property :level (org-element-at-point))
- org-inlinetask-min-level)
- ;; ... remember location and bail out
- (setq buffer (current-buffer))
- (setq point (point))
- (throw 'found t))))
- nil 'agenda)
- nil))
+ (goto-char org-index--below-hline)
+ nil)))
- (progn
- (if (eq buffer org-index--buffer)
- (setq org-index--point-before nil))
- (setq message-text (format "Found '%s'" (or ref link)))
- (if other
- (progn
- (pop-to-buffer buffer)
- (goto-char point)
- (org-reveal t)
- (recenter)
- (pop-to-buffer "*org-index-occur*"))
- (org-pop-to-buffer-same-window buffer)
- (goto-char point)
- (org-reveal t)
- (recenter)))
- (setq message-text (format "Did not find '%s'" (or ref link))))))
- message-text))
+
+(defun org-index--update-all-lines ()
+ "Update all lines of index at once."
+ (let ((lines 0)
+ id ref kvs)
+
+ ;; check for double ids
+ (or
+ (org-index--check-ids)
+
+ (progn
+ (goto-char org-index--below-hline)
+ (while (org-at-table-p)
+
+ ;; update single line
+ (when (setq id (org-index--get-or-set-field 'id))
+ (setq ref (org-index--get-or-set-field 'ref))
+ (setq kvs (org-index--collect-values-for-add-update-remote id))
+ (org-index--write-fields kvs)
+ (cl-incf lines))
+ (forward-line))
+
+ (goto-char org-index--below-hline)
+ (org-table-align)
+ (format "Updated %d lines" lines)))))
+
+
+(defun org-index--collect-values-for-add-update (id &optional silent category)
+ "Collect values for adding or updating line specified by ID, do not ask if SILENT, use CATEGORY, if given."
+
+ (let ((args (list 'id id))
+ content)
+
+ (dolist (col (mapcar 'car org-index--columns))
+
+ (setq content "")
-(defun org-index--do-occur (initial-search)
- (let ((occur-buffer-name "*org-index-occur*")
- (word "") ; last word to search for growing and shrinking on keystrokes
- (prompt "Search for: ")
- (hint "")
- words ; list of other words that must match too
- occur-buffer
- lines-to-show ; number of lines to show in window
- start-of-lines ; position, where lines begin
- start-of-help ; start of displayed help (if any)
- left-off-at ; stack of last positions in index table
- after-inserted ; in occur-buffer
- at-end ; in occur-buffer
- lines-visible ; in occur-buffer
- below-hline-bol ; below-hline and at bol
- exit-gracefully ; true if normal exit
- in-c-backspace ; true while processing C-backspace
- show-headings ; true, if headings should be shown
- fun-on-ret ; function to be executed, if return is pressed
- fun-on-tab ; function to be executed, if letter TAB is pressed
- ret from to key)
+ (cond
+ ((eq col 'keywords)
+ (if org-index-copy-heading-to-keywords
+ (setq content (nth 4 (org-heading-components))))
- ;; clear buffer
- (if (get-buffer "*org-index-occur*")
- (kill-buffer occur-buffer-name))
- (setq occur-buffer (get-buffer-create "*org-index-occur*"))
-
- ;; install keyboard-shortcuts within occur-buffer
- (with-current-buffer occur-buffer
- (let ((keymap (make-sparse-keymap)))
-
- (set-keymap-parent keymap org-mode-map)
- (setq fun-on-ret (lambda () (interactive) (org-index--occur-find-heading nil)))
- (define-key keymap (kbd "RET") fun-on-ret)
- (setq fun-on-tab (lambda () (interactive)
- (org-index--occur-find-heading t)
- (setq org-index--occur-follow-mode (not org-index--occur-follow-mode))))
- (define-key keymap (kbd "<tab>") fun-on-tab)
- (define-key keymap [(control ?i)] fun-on-tab)
- (define-key keymap (kbd "<up>") (lambda () (interactive)
- (forward-line -1)
- (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
- (define-key keymap (kbd "<down>") (lambda () (interactive)
- (forward-line 1)
- (if org-index--occur-follow-mode (org-index--occur-find-heading t))))
- (use-local-map keymap)))
+ ;; Shift ref and timestamp ?
+ (if org-index-strip-ref-and-date-from-heading
+ (dotimes (i 2)
+ (if (or (string-match (concat "^\\s-*" org-index--ref-regex) content)
+ (string-match (concat org-ts-regexp-both) content))
+ (setq content (substring content (match-end 0)))))))
+
+ ((eq col 'category)
+ (setq content (or category org-index--category-before)))
+
+ ((eq col 'level)
+ (setq content (number-to-string (org-outline-level))))
+
+ ((eq col 'tags)
+ (setq content (org-get-tags-string))))
+
+ (unless (string= content "")
+ (setq args (plist-put args col content))))
- (with-current-buffer org-index--buffer
- (let ((initial (point)))
- (goto-char org-index--below-hline)
- (forward-line 0)
- (setq below-hline-bol (point))
- (goto-char initial)))
+ (if (not silent)
+ (let ((args-edited (org-index--collect-values-from-user org-index-edit-on-add args)))
+ (setq args (append args-edited args))))
- (org-pop-to-buffer-same-window occur-buffer)
- (toggle-truncate-lines 1)
+ args))
- (unwind-protect ; to reset cursor-shape even in case of errors
- (progn
-
- ;; fill in header
- (erase-buffer)
- (insert (concat "Incremental search, showing one window of matches. '?' toggles help.\n\n"))
- (setq start-of-lines (point))
- (setq start-of-help start-of-lines)
- (setq cursor-type 'hollow)
-
- ;; get window size of occur-buffer as number of lines to be searched
- (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1))
-
- ;; fill initially
- (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol))
- (when (nth 0 ret)
- (insert (nth 1 ret))
- (setq left-off-at (cons (nth 0 ret) nil))
- (setq after-inserted (cons (point) nil)))
+(defun org-index--collect-values-for-add-update-remote (id)
+ "Wrap `org-index--collect-values-for-add-update' by prior moving to remote node identified by ID."
+
+ (let (marker point args)
- ;; read keys
- (while
- (progn
- (goto-char start-of-lines)
- (setq lines-visible 0)
-
- ;; use initial-search (if present) to simulate keyboard input
- (if (and initial-search
- (> (length initial-search) 0))
- (progn
- (setq key (string-to-char (substring initial-search 0 1)))
- (if (length initial-search)
- (setq initial-search (substring initial-search 1))))
- (if in-c-backspace
- (setq key 'backspace)
- (let ((search-text (mapconcat 'identity (reverse (cons word words)) ",")))
- (setq key (read-key
- (format "%s%s%s%s"
- prompt
- search-text
- (if (string= search-text "") "" " ")
- hint))))
- (setq hint "")
- (setq exit-gracefully (member key (list 'up 'down 'left 'right 'RET ?\C-g ?\C-m 'C-return ?\C-i 'TAB)))))
-
- (not exit-gracefully))
-
- (cond
+ (setq marker (org-id-find id t))
+ ;; enter buffer and collect information
+ (with-current-buffer (marker-buffer marker)
+ (setq point (point))
+ (goto-char marker)
+ (setq args (org-index--collect-values-for-add-update id t (org-get-category (point) t)))
+ (goto-char point))
- ((eq key 'C-backspace)
+ args))
- (setq in-c-backspace t))
- ((member key (list 'backspace 'deletechar ?\C-?)) ; erase last char
+(defun org-index--collect-values-from-user (list-of-columns-to-edit &optional default-values)
+ "Collect values for adding a new yank-line."
+
+ (let (content args)
+
+ (dolist (col list-of-columns-to-edit)
+
+ (setq content "")
- (if (= (length word) 0)
+ (setq content (read-from-minibuffer
+ (format "Enter text for column '%s': " (symbol-name col))
+ (plist-get col default-values)))
+
+ (unless (string= content "")
+ (setq args (plist-put args col content))))
+ args))
- ;; nothing more to delete from current word; try next
- (progn
- (setq word (car words))
- (setq words (cdr words))
- (setq in-c-backspace nil))
-
- ;; unhighlight longer match
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word)))
-
- ;; some chars are left; shorten word
- (setq word (substring word 0 -1))
- (when (= (length word) 0) ; when nothing left, use next word from list
- (setq word (car words))
- (setq words (cdr words))
- (setq in-c-backspace nil))
-
- ;; remove everything, that has been added for char just deleted
- (when (cdr after-inserted)
- (setq after-inserted (cdr after-inserted))
- (goto-char (car after-inserted))
- (delete-region (point) (point-max)))
-
- ;; back up last position in index table too
- (when (cdr left-off-at)
- (setq left-off-at (cdr left-off-at)))
-
- ;; go through buffer and check, if any invisible line should now be shown
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (progn
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
- ;; check for matches
- (when (org-index--test-words (cons word words) (buffer-substring from to))
- (when (<= lines-visible lines-to-show) ; show, if more lines required
- (outline-flag-region from to nil)
- (incf lines-visible))))
+(defun org-index--write-fields (kvs)
+ "Update current line with values from KVS (keys-values)."
+ (while kvs
+ (org-index--get-or-set-field (car kvs) (org-trim (cadr kvs)))
+ (setq kvs (cddr kvs))))
- ;; already visible, just count
- (incf lines-visible))
- (forward-line 1))
+(defun org-index--do-kill ()
+ "Perform command kill from within occur, index or node."
- ;; highlight shorter word
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))))
+ (let (id ref pos chars-deleted-index text-deleted-from pos-in-index)
+ (org-index--check-can-edit-or-kill "kill")
+ (setq pos (org-index--save-positions))
- ((member key (list ?\s ?,)) ; space or comma: enter an additional search word
+
+ ;; Collect information: What should be deleted ?
+ (if (or org-index--within-occur
+ org-index--within-node)
- ;; push current word and clear, no need to change display
- (setq words (cons word words))
- (setq word ""))
+ (progn
+ (if org-index--within-node
+ ;; In index
+ (setq pos-in-index (point))
+ ;; In occur
+ (setq pos-in-index (get-text-property (point) 'org-index-lbp))
+ (org-index--occur-test-stale pos-in-index)
+ (set-buffer org-index--buffer)
+ (goto-char pos-in-index))
+ ;; In Index (maybe moved there)
+ (setq id (org-index--get-or-set-field 'id))
+ (setq ref (org-index--get-or-set-field 'ref)))
+
+ ;; At a headline
+ (setq id (org-entry-get (point) "ID"))
+ (setq ref (org-index--ref-from-id id))
+ (setq pos-in-index (org-index--on 'id id (point)))
+ (unless pos-in-index (error "This node is not in index")))
+
+ ;; Remark: Current buffer is not certain here, but we have all the information to delete
+
+ ;; Delete from node
+ (when id
+ (let ((m (org-id-find id 'marker)))
+ (set-buffer (marker-buffer m))
+ (goto-char m)
+ (move-marker m nil)
+ (unless (string= (org-id-get) id)
+ (error "Could not find node with id %s" id)))
+
+ (org-index--delete-any-ref-from-tags)
+ (if ref (org-index--delete-ref-from-heading ref))
+ (setq text-deleted-from (cons "node" text-deleted-from)))
+
+ ;; Delete from index
+ (set-buffer org-index--buffer)
+ (unless pos-in-index "Internal error, pos-in-index should be defined here")
+ (goto-char pos-in-index)
+ (setq chars-deleted-index (length (delete-and-extract-region (line-beginning-position) (line-beginning-position 2))))
+ (setq text-deleted-from (cons "index" text-deleted-from))
+
+ ;; Delete from occur only if we started there, accept that it will be stale otherwise
+ (if org-index--within-occur
+ (let ((inhibit-read-only t))
+ (set-buffer org-index--occur-buffer-name)
+ (delete-region (line-beginning-position) (line-beginning-position 2))
+ ;; correct positions
+ (while (org-at-table-p)
+ (put-text-property (line-beginning-position) (line-end-position) 'org-index-lbp
+ (- (get-text-property (point) 'org-index-lbp) chars-deleted-index))
+ (forward-line))
+ (setq text-deleted-from (cons "occur" text-deleted-from))))
+
+ (org-index--restore-positions pos)
+ (concat "Deleted from: " (mapconcat 'identity (sort text-deleted-from 'string<) ","))))
+
+
+(defun org-index--save-positions ()
+ "Save current buffer and positions in index and node; not occur."
+ (let (buf pn pi)
+ (setq buf (current-buffer))
+ (setq pn (point)) ; not guaranteed to be on node
+ (set-buffer org-index--buffer)
+ (setq pi (point))
+ (set-buffer buf)
+ (list buf pn pi)))
+
+
+(defun org-index--restore-positions (pos)
+ "Restore positions as saved by `org-index--save-positions'."
+ (let (buf)
+ (setq buf (current-buffer))
+ (set-buffer (first pos))
+ (goto-char (second pos))
+ (set-buffer org-index--buffer)
+ (goto-char (third pos))
+ (set-buffer buf)))
+
+
+(defun org-index--check-can-edit-or-kill (what)
+ "Check, if edit or kill can be performed for current position."
+
+ (when (not (or (org-at-heading-p)
+ (and (org-at-table-p)
+ (or org-index--within-occur
+ org-index--within-node))))
+ (if (not (org-at-table-p)) (error "Cannot %s: Not at table" what))
+ (if (not (org-at-heading-p)) (error "Cannot %s: Not at headline" what))
+ (error "Cannot %s: Neither in index nor in occur buffer" what)))
+
+
+(defun org-index--delete-ref-from-heading (ref)
+ "Delete given REF from current heading."
+ (save-excursion
+ (end-of-line)
+ (let ((end (point)))
+ (beginning-of-line)
+ (when (search-forward ref end t)
+ (delete-char (- (length ref)))
+ (just-one-space)))))
- ((eq key ??) ; tab: toggle display of headlines and help
- (setq show-headings (not show-headings))
- (goto-char start-of-lines)
- (if show-headings
- (progn
- (forward-line -1)
- (kill-line)
- (setq start-of-help (point))
- (if (display-graphic-p)
- (insert "<backspace> and <c-backspace> erase, cursor keys move. RET finds node, C-RET all matches.\nTAB finds in other window. Comma seperates words, any other key adds to search word.\n\n")
- (insert "BACKSPACE to erase, to finish. Then cursor keys and RET to find node.\n\n"))
- (insert org-index--headings))
- (delete-region start-of-help start-of-lines)
- (insert "\n"))
- (setq start-of-lines (point)))
-
-
- ((and (integerp key)
- (aref printable-chars key)) ; any printable char: add to current search word
-
- ;; unhighlight short word
- (unless (= (length word) 0)
- (let ((case-fold-search t))
- (unhighlight-regexp (regexp-quote word))))
-
- ;; add to word
- (setq word (concat word (char-to-string key)))
-
- ;; hide lines, that do not match longer word any more
- (while (< (point) (point-max))
- (unless (outline-invisible-p)
- (setq from (line-beginning-position)
- to (line-beginning-position 2))
-
- ;; check for matches
- (if (org-index--test-words (list word) (buffer-substring from to))
- (incf lines-visible) ; count as visible
- (outline-flag-region from to t))) ; hide
-
- (forward-line 1))
-
- ;; duplicate top of stacks; eventually overwritten below
- (setq left-off-at (cons (car left-off-at) left-off-at))
- (setq after-inserted (cons (car after-inserted) after-inserted))
-
- ;; get new lines from index table
- (when (< lines-visible lines-to-show)
- (setq ret (org-index--get-matching-lines (cons word words)
- (- lines-to-show lines-visible)
- (car left-off-at)))
-
- (when (nth 0 ret)
- (insert (nth 1 ret))
- (setq at-end (nth 2 ret))
- (setcar left-off-at (nth 0 ret))
- (setcar after-inserted (point))))
-
- ;; highlight longer word
- (let ((case-fold-search t))
- (highlight-regexp (regexp-quote word) 'isearch)))
-
-
- (t ; non-printable chars
- (setq hint (format "(cannot search for key '%s', use %s to quit)"
- (if (symbolp key)
- key
- (key-description (char-to-string key)))
- (substitute-command-keys "\\[keyboard-quit]"))))))
-
- ;; search is done collect and brush up results
- ;; remove any lines, that are still invisible
- (goto-char start-of-lines)
- (while (< (point) (point-max))
- (if (outline-invisible-p)
- (delete-region (line-beginning-position) (line-beginning-position 2))
- (forward-line 1)))
-
- ;; get all the rest
- (when (eq key (kbd "<c-return>"))
- (message "Getting all matches ...")
- (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at)))
- (message "done.")
- (insert (nth 1 ret))))
-
- ;; postprocessing even for non graceful exit
- (setq cursor-type t)
- ;; replace previous heading
- (let ((numlines (count-lines (point) start-of-lines)))
- (goto-char start-of-lines)
- (delete-region (point-min) (point))
- (insert (format (concat (if exit-gracefully "Search is done;" "Search aborted;")
- (if (or at-end (eq key 'C-return))
- " showing all %d matches."
- " showing only some matches.")
- " Use cursor keys to move, press RET or TAB to find node.\n\n")
- numlines))
- (if show-headings (insert "\n\n" org-index--headings)))
- (forward-line))
+(defun org-index--delete-any-ref-from-tags ()
+ "Delete any reference from list of tags."
+ (let (new-tags)
+ (mapc (lambda (tag)
+ (unless (string-match org-index--ref-regex tag)
+ (setq new-tags (cons tag new-tags) )))
+ (org-get-tags))
+ (org-set-tags-to new-tags)))
+
+
+(defun org-index--go (&optional column value)
+ "Position cursor on index line where COLUMN equals VALUE.
+Return t or nil, leave point on line or at top of table, needs to be in buffer initially."
+ (let (found text)
+
+ (unless (eq (current-buffer) org-index--buffer)
+ (error "This is a bug: Not in index buffer"))
+
+ ;; loop over lines
+ (goto-char org-index--below-hline)
+ (if column
+ (progn
+ (forward-line -1)
+ (while (and (not found)
+ (forward-line)
+ (org-at-table-p))
+ (setq found (string= value (org-index--get-or-set-field column)))))
+ (setq found t))
+
+ ;; return value
+ (if found
+ t
+ (goto-char org-index--below-hline)
+ nil)))
+
+
+(defun org-index--find-id (id &optional other)
+ "Perform command head: Find node with REF or ID and present it.
+If OTHER in separate window."
+
+ (let (message marker)
+
+ (setq marker (org-id-find id t))
+
+ (if marker
+ (progn
+ (org-index--update-line id)
+ (if other
+ (progn
+ (pop-to-buffer (marker-buffer marker)))
+ (pop-to-buffer-same-window (marker-buffer marker)))
+
+ (goto-char marker)
+ (org-reveal t)
+ (org-show-entry)
+ (recenter)
+ (unless (string= (org-id-get) id)
+ (setq message (format "Could not go to node with id %s (narrowed ?)" id)))
+ (setq message "Found headline"))
+ (setq message (format "Did not find node with %s" id)))
+ message))
+
+
+(defun org-index--do-occur ()
+ "Perform command occur."
+ (let ((word "") ; last word to search for growing and shrinking on keystrokes
+ (prompt "Search for: ")
+ (these-commands "These commands of org-index, if invoked from the occur buffer, update it accordingly: edit, kill.")
+ (lines-wanted (window-body-height))
+ (lines-found 0) ; number of lines found
+ words ; list words that should match
+ occur-buffer
+ begin ; position of first line
+ narrow ; start of narrowed buffer
+ help-text ; cons with help text short and long
+ key-help ; for keys with special function
+ search-text ; description of text to search for
+ done ; true, if loop is done
+ in-c-backspace ; true, while processing C-backspace
+ show-headings ; true, if headings should be shown
+ help-overlay ; Overlay with help text
+ last-point ; Last position before end of search
+ initial-frame ; Frame when starting occur
+ key ; input from user in various forms
+ key-sequence
+ key-sequence-raw)
+
+ ;; make and show buffer
+ (if (get-buffer org-index--occur-buffer-name)
+ (kill-buffer org-index--occur-buffer-name))
+ (setq occur-buffer (make-indirect-buffer org-index--buffer org-index--occur-buffer-name))
+ (pop-to-buffer-same-window occur-buffer)
+ (setq initial-frame (selected-frame))
+
+ ;; avoid modifying direct buffer
(setq buffer-read-only t)
+ (toggle-truncate-lines 1)
+ (setq font-lock-keywords-case-fold-search t)
+ (setq case-fold-search t)
- ;; perform action according to last char
+ ;; reset stack and overlays
+ (setq org-index--occur-stack nil)
+ (setq org-index--occur-tail-overlay nil)
+
+ ;; narrow to table rows and one line before
+ (goto-char org-index--below-hline)
+ (forward-line 0)
+ (setq begin (point))
(forward-line -1)
- (cond
+ (setq narrow (point))
+ (while (org-at-table-p)
+ (forward-line))
+ (narrow-to-region narrow (point))
+ (goto-char (point-min))
+ (forward-line)
+
+ ;; initialize help text
+ (setq help-text (cons
+ (concat
+ (propertize "Incremental occur" 'face 'org-todo)
+ (propertize "; `?' toggles help and headlines.\n" 'face 'org-agenda-dimmed-todo-face))
+ (concat
+ (propertize
+ (org-index--wrap
+ (concat
+ "Normal keys add to search word; <space> or <comma> start additional word; <backspace> erases last char, <C-backspace> last word; <return> jumps to heading, <tab> jumps to heading in other window, <S-return> jumps to matching line in index; all other keys end search." these-commands "\n"))
+ 'face 'org-agenda-dimmed-todo-face)
+ org-index--headings)))
+
+ ;; insert overlays for help text and to cover unsearched lines
+ (setq help-overlay (make-overlay (point-min) begin))
+ (overlay-put help-overlay 'display (car help-text))
+ (setq org-index--occur-tail-overlay (make-overlay (point-max) (point-max)))
+ (overlay-put org-index--occur-tail-overlay 'invisible t)
- ((member key (list 'RET ?\C-m))
- (funcall fun-on-ret))
+ (while (not done)
- ((member key (list 'TAB ?\C-i))
- (funcall fun-on-tab))
+ (if in-c-backspace
+ (setq key "<backspace>")
+ (setq search-text (mapconcat 'identity (reverse (cons word words)) ","))
+ (message "foo")
- ((eq key 'up)
- (forward-line -1))
+ ;; read key, if selected frame has not changed
+ (if (eq initial-frame (selected-frame))
+ (progn
+ (setq key-sequence
+ (let ((echo-keystrokes 0)
+ (full-prompt (format "%s%s%s"
+ prompt
+ search-text
+ (if (string= search-text "") "" " "))))
+ (read-key-sequence full-prompt nil nil t t)))
+ (setq key (key-description key-sequence))
+ (setq key-sequence-raw (this-single-command-raw-keys)))
+ (setq done t)
+ (setq key-sequence nil)
+ (setq key nil)
+ (setq key-sequence-raw nil)))
+
- ((eq key 'down)
- (forward-line 1))
+ (cond
- ((eq key 'left)
- (forward-char -1))
- ((eq key 'right)
- (forward-char 1)))))
+ ((string= key "<C-backspace>")
+ (setq in-c-backspace t))
-(defun org-index--occur-find-heading (x)
- "helper for keymap of occur"
- (interactive)
- (save-excursion
- (let ((ref (org-index--get-field :ref))
- (link (org-index--get-field :link)))
- (message (org-index--do-head ref link x)))))
+ ((member key (list "<backspace>" "DEL")) ; erase last char
-(defun org-index--do-new-line (create-ref)
- "Do the common work for org-index-new-line and org-index"
+ (if (= (length word) 0)
- (let (new)
+ ;; nothing more to delete from current word; try next
+ (progn
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; unhighlight longer match
+ (unhighlight-regexp (regexp-quote word))
+
+ ;; some chars are left; shorten word
+ (setq word (substring word 0 -1))
+ (when (= (length word) 0) ; when nothing left, use next word from list
+ (setq word (car words))
+ (setq words (cdr words))
+ (setq in-c-backspace nil))
+
+ ;; free top list of overlays and remove list
+ (setq lines-found (or (org-index--unhide) lines-wanted))
+ (move-overlay org-index--occur-tail-overlay
+ (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
+ (point-max))
+ (point-max))
+
+
+ ;; highlight shorter word
+ (unless (= (length word) 0)
+ (highlight-regexp (regexp-quote word) 'isearch))
- (when create-ref
- ;; go through table to find first entry to be reused
- (when org-index--has-reuse
- (goto-char org-index--below-hline)
- ;; go through table
- (while (and (org-at-table-p)
- (not new))
- (when (string=
- (org-index--get-field :count)
- ":reuse:")
- (setq new (org-index--get-field :ref))
- (if new (org-table-kill-row)))
- (forward-line)))
-
- ;; no ref to reuse; construct new reference
- (unless new
- (setq new (format "%s%d%s" org-index--head (1+ org-index--maxref) org-index--tail)))
+ ;; make sure, point is still visible
+ (goto-char begin)))
+
+
+ ((member key (list "SPC" ",")) ; space or comma: enter an additional search word
+
+ ;; push current word and clear, no need to change display
+ (unless (string= word "")
+ (setq words (cons word words))
+ (setq word "")))
- ;; remember for org-mark-ring-goto
- (setq org-index--text-to-yank new))
-
- ;; insert ref or link as very first row
- (goto-char org-index--below-hline)
- (org-table-insert-row)
- ;; insert some of the standard values
- (org-table-goto-column (org-index--column-num :first))
- (org-insert-time-stamp nil nil t)
- (org-table-goto-column (org-index--column-num :count))
- (insert "1")
+ ((string= key "?") ; question mark: toggle display of headlines and help
+ (setq help-text (cons (cdr help-text) (car help-text)))
+ (overlay-put help-overlay 'display (car help-text)))
- new))
+ ((and (= (length key) 1)
+ (aref printable-chars (elt key 0))) ; any printable char: add to current search word
+ ;; unhighlight short word
+ (unless (= (length word) 0)
+ (unhighlight-regexp (regexp-quote word)))
+
+ ;; add to word
+ (setq word (concat word key))
+
+ ;; make overlays to hide lines, that do not match longer word any more
+ (goto-char begin)
+ (setq lines-found (org-index--hide-with-overlays (cons word words) lines-wanted))
+ (move-overlay org-index--occur-tail-overlay
+ (if org-index--occur-stack (cdr (assoc :end-of-visible (car org-index--occur-stack)))
+ (point-max))
+ (point-max))
+
+ (goto-char begin)
+
+ ;; highlight longer word
+ (highlight-regexp (regexp-quote word) 'isearch)
-(defun org-index--get-matching-lines (words numlines start-from)
- (let ((numfound 0)
- pos
- initial line lines at-end)
+ ;; make sure, point is on a visible line
+ (line-move -1 t)
+ (line-move 1 t))
+
+ ;; anything else terminates loop
+ (t (setq done t))))
+
+ ;; put back input event, that caused the loop to end
+ (unless (string= key "C-g")
+ (setq unread-command-events (listify-key-sequence key-sequence-raw))
+ (message key))
- (with-current-buffer org-index--buffer
+ ;; postprocessing
+ (setq last-point (point))
+
+ ;; For performance reasons do not show matching lines for rest of table. So no code here.
+
+ ;; make permanent copy
+ ;; copy visible lines
+ (let ((lines-collected 0)
+ keymap line all-lines all-lines-lbp header-lines lbp)
- ;; remember initial pos and start at requested
- (setq initial (point))
- (goto-char start-from)
+ (setq cursor-type t)
+ (goto-char begin)
+
+ ;; collect all visible lines
+ (while (and (not (eobp))
+ (< lines-collected lines-wanted))
+ ;; skip over invisible lines
+ (while (and (invisible-p (point))
+ (not (eobp)))
+ (goto-char (1+ (overlay-end (car (overlays-at (point)))))))
+ (setq lbp (line-beginning-position))
+ (setq line (buffer-substring-no-properties lbp (line-end-position)))
+ (unless (string= line "")
+ (cl-incf lines-collected)
+ (setq all-lines (cons (concat line
+ "\n")
+ all-lines))
+ (setq all-lines-lbp (cons lbp all-lines-lbp)))
+ (forward-line 1))
+
+ (kill-buffer org-index--occur-buffer-name) ; cannot keep this buffer; might become stale soon
+
+ ;; create new buffer
+ (setq occur-buffer (get-buffer-create org-index--occur-buffer-name))
+ (pop-to-buffer-same-window occur-buffer)
+ (insert org-index--headings)
+ (setq header-lines (line-number-at-pos))
+
+ ;; insert into new buffer
+ (save-excursion
+ (apply 'insert (reverse all-lines))
+ (if (= lines-collected lines-wanted)
+ (insert "\n(more lines omitted)\n")))
+ (setq org-index--occur-lines-collected lines-collected)
- ;; loop over buffer until we have found enough lines
- (while (and (or (< numfound numlines)
- (= numlines 0))
- (org-at-table-p))
-
- ;; check each word
- (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2)))
- (when (org-index--test-words words line)
- (setq lines (concat lines line))
- (incf numfound))
- (forward-line 1)
- (setq pos (point)))
+ (org-mode)
+ (setq truncate-lines t)
+ (if all-lines (org-index--align-and-fontify-current-line (length all-lines)))
+ (font-lock-fontify-buffer)
+ (when all-lines-lbp
+ (while (not (org-at-table-p))
+ (forward-line -1))
+ (while all-lines-lbp
+ (put-text-property (line-beginning-position) (line-end-position) 'org-index-lbp (car all-lines-lbp))
+ (setq all-lines-lbp (cdr all-lines-lbp))
+ (forward-line -1)))
+
+ ;; prepare help text
+ (goto-char (point-min))
+ (forward-line (1- header-lines))
+ (setq org-index--occur-help-overlay (make-overlay (point-min) (point)))
+ (setq org-index--occur-help-text
+ (cons
+ (org-index--wrap
+ (propertize "Search is done; `?' toggles help and headlines.\n" 'face 'org-agenda-dimmed-todo-face))
+ (concat
+ (org-index--wrap
+ (propertize
+ (format
+ (concat "Search is done."
+ (if (< lines-collected lines-wanted)
+ " Showing all %d matches for "
+ " Showing one window of matches for ")
+ "\"" search-text
+ "\". <return> jumps to heading, <tab> jumps to heading in other window, <S-return> jumps to matching line in index, <space> increments count." these-commands "\n")
+ (length all-lines))
+ 'face 'org-agenda-dimmed-todo-face))
+ org-index--headings)))
+
+ (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))
- (setq at-end (not (org-at-table-p)))
+ ;; highlight words
+ (setq case-fold-search t)
+ (setq font-lock-keywords-case-fold-search t)
+ (mapc (lambda (w) (unless (or (not w) (string= w "")) (highlight-regexp (regexp-quote w) 'isearch)))
+ (cons word words))
- ;; return to initial position
- (goto-char initial))
+ (setq buffer-read-only t)
- (unless lines (setq lines ""))
- (list pos lines at-end)))
+ ;; install keyboard-shortcuts
+ (setq keymap (make-sparse-keymap))
+ (set-keymap-parent keymap org-mode-map)
+ (mapc (lambda (x) (define-key keymap (kbd x)
+ (lambda () (interactive)
+ (message "%s" (org-index--occur-action)))))
+ (list "<return>" "RET"))
-(defun org-index--test-words (words line)
- (let ((found-all t))
- (setq line (downcase line))
+ (define-key keymap (kbd "<tab>")
+ (lambda () (interactive)
+ (message (org-index--occur-action t))))
+
+ (define-key keymap (kbd "SPC")
+ (lambda () (interactive)
+ (org-index--refresh-parse-table)
+ ;; increment in index
+ (let ((ref (org-index--get-or-set-field 'ref))
+ count)
+ (org-index--on
+ 'ref ref
+ (setq count (+ 1 (string-to-number (org-index--get-or-set-field 'count))))
+ (org-index--get-or-set-field 'count (number-to-string count))
+ (org-index--promote-current-line)
+ (org-index--align-and-fontify-current-line))
+ ;; increment in this buffer
+ (let ((inhibit-read-only t))
+ (org-index--get-or-set-field 'count (number-to-string count)))
+ (message "Incremented count to %d" count))))
+
+ (define-key keymap (kbd "<S-return>")
+ (lambda () (interactive)
+ (let ((pos (get-text-property (point) 'org-index-lbp)))
+ (org-index--refresh-parse-table)
+ (org-index--occur-test-stale pos)
+ (pop-to-buffer org-index--buffer)
+ (goto-char pos)
+ (beginning-of-line)
+ (org-index--update-current-line))))
+
+ (define-key keymap (kbd "?")
+ (lambda () (interactive)
+ (org-index--refresh-parse-table)
+ (setq-local org-index--occur-help-text (cons (cdr org-index--occur-help-text) (car org-index--occur-help-text)))
+ (overlay-put org-index--occur-help-overlay 'display (car org-index--occur-help-text))))
+
+ (use-local-map keymap))))
+
+
+(defun org-index--occur-test-stale (pos)
+ "Test, if current line in occur buffer has become stale at POS."
+ (let (here there)
+ (org-index--refresh-parse-table)
+ (setq here (org-index--line-in-canonical-form))
+ (with-current-buffer org-index--buffer
+ (goto-char pos)
+ (setq there (org-index--line-in-canonical-form)))
+ (unless (string= here there)
+ (error "Occur buffer has become stale"))))
+
+
+(defun org-index--line-in-canonical-form ()
+ "Return current line in its canonical form."
+ (org-trim (substring-no-properties (replace-regexp-in-string "\s +" " " (buffer-substring (line-beginning-position) (line-beginning-position 2))))))
+
+
+(defun org-index--wrap (text)
+ "Wrap TEXT at fill column."
+ (with-temp-buffer
+ (insert text)
+ (fill-region (point-min) (point-max) nil t)
+ (buffer-string)))
+
+
+(defun org-index--occur-action (&optional other)
+ "Helper for `org-index--occur', find heading with ref or id; if OTHER, in other window; or copy yank column."
+ (if (org-at-table-p)
+ (let ((id (org-index--get-or-set-field 'id))
+ (ref (org-index--get-or-set-field 'ref))
+ (yank (org-index--get-or-set-field 'yank)))
+ (if id
+ (org-index--find-id id other)
+ (if ref
+ (progn
+ (org-mark-ring-goto)
+ (format "Found reference %s" ref))
+ (if yank
+ (progn
+ (org-index--update-line (get-text-property (point) 'org-index-lbp))
+ (setq yank (replace-regexp-in-string (regexp-quote "\\vert") "|" yank nil 'literal))
+ (kill-new yank)
+ (org-mark-ring-goto)
+ (format "Copied '%s'" yank))
+ (error "Internal error, this line contains neither id, nor reference, nor text to yank")))))
+ (message "Not at table")))
+
+
+(defun org-index--hide-with-overlays (words lines-wanted)
+ "Hide text that is currently visible and does not match WORDS by creating overlays; leave LINES-WANTED lines visible."
+ (let ((lines-found 0)
+ (end-of-visible (point))
+ overlay overlays start matched)
+
+ ;; main loop
+ (while (and (not (eobp))
+ (< lines-found lines-wanted))
+
+ ;; skip invisible lines
+ (while (and (not (eobp))
+ (and
+ (invisible-p (point))
+ (< (point) (overlay-start org-index--occur-tail-overlay))))
+ (goto-char (overlay-end (car (overlays-at (point))))))
+
+ ;; find stretch of lines, that are currently visible but should be invisible now
+ (setq matched nil)
+ (setq start (point))
+ (while (and (not (eobp))
+ (not
+ (and
+ (invisible-p (point))
+ (< (point) (overlay-start org-index--occur-tail-overlay))))
+ (not (and (org-index--test-words words)
+ (setq matched t)))) ; for its side effect
+ (forward-line 1))
+
+ ;; create overlay to hide this stretch
+ (when (< start (point)) ; avoid creating an empty overlay
+ (setq overlay (make-overlay start (point)))
+ (overlay-put overlay 'invisible t)
+ (setq overlays (cons overlay overlays)))
+
+ ;; skip and count line, that matched
+ (when matched
+ (forward-line 1)
+ (setq end-of-visible (point))
+ (cl-incf lines-found)))
+
+ ;; put new list on top of stack
+ (setq org-index--occur-stack
+ (cons (list (cons :overlays overlays)
+ (cons :end-of-visible end-of-visible)
+ (cons :lines lines-found))
+ org-index--occur-stack))
+
+ lines-found))
+
+
+(defun org-index--unhide ()
+ "Unhide text that does has been hidden by `org-index--hide-with-overlays'."
+ (when org-index--occur-stack
+ ;; delete overlays and make visible again
+ (mapc (lambda (y)
+ (delete-overlay y))
+ (cdr (assoc :overlays (car org-index--occur-stack))))
+ ;; remove from stack
+ (setq org-index--occur-stack (cdr org-index--occur-stack))
+ ;; return number of lines, that are now visible
+ (if org-index--occur-stack (cdr (assoc :lines (car org-index--occur-stack))))))
+
+
+(defun org-index--test-words (words)
+ "Test current line for match against WORDS."
+ (let (line)
+ (setq line (downcase (buffer-substring (line-beginning-position) (line-beginning-position 2))))
(catch 'not-found
- (dolist (w words)
- (or (search w line)
- (throw 'not-found nil)))
- t)))
+ (dolist (w words)
+ (or (cl-search w line)
+ (throw 'not-found nil)))
+ t)))
-(defun org-index--dump-variables ()
- "Dump variables of org-index; mostly for debugging"
- (interactive)
- "Dump all variables of org-index for debugging"
- (let ((buff (get-buffer-create "*org-index-dump-variables*"))
- (maxlen 0)
- vars name value)
-
- (with-current-buffer buff
- (erase-buffer)
- (mapatoms (lambda (s) (when (and (boundp s)
- (string-prefix-p "org-index-" (symbol-name s)))
-
- (setq name (symbol-name s))
- (setq value (symbol-value s))
- (setq vars (cons (cons name value) vars))
- (if (> (length name) maxlen)
- (setq maxlen (length name))))))
- (setq vars (sort vars (lambda (x y) (string< (car x) (car y)))))
- (mapc (lambda (x) (insert (format (format "%%-%ds: %%s\n" (+ maxlen 1)) (car x) (cdr x))))
- vars)
- (pop-to-buffer buff))))
-
-
-(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate)
- "Make text from org-index available for yank."
- (when org-index--text-to-yank
- (kill-new org-index--text-to-yank)
- (message (format "Ready to yank '%s'" org-index--text-to-yank))
- (setq org-index--text-to-yank nil)))
+(defun org-index--create-new-line (&optional args)
+ "Do the common work for `org-index-new-line' and `org-index'."
+
+ ;; insert ref or id as last or first line, depending on sort-column
+ (goto-char org-index--below-hline)
+ (if (eq org-index-sort-by 'count)
+ (progn
+ (while (org-at-table-p)
+ (forward-line))
+ (forward-line -1)
+ (org-table-insert-row t))
+ (org-table-insert-row))
+
+ ;; insert some of the standard values
+ (org-table-goto-column (org-index--column-num 'created))
+ (org-insert-time-stamp nil nil t)
+ (org-table-goto-column (org-index--column-num 'count))
+ (insert "1")
+
+ (if args (org-index--write-fields args)))
+
+
+(defun org-index--sort-silent ()
+ "Sort index for default column to remove any effects of temporary sorting."
+ (save-excursion
+ (org-index--verify-id)
+ (org-index--parse-table)
+ (org-index--on nil nil
+ (org-index--do-sort-index org-index-sort-by)
+ (org-table-align)
+ (remove-hook 'before-save-hook 'org-index--sort-silent))))
+
+
+(defun org-index--copy-visible (beg end)
+ "Copy the visible parts of the region between BEG and END without adding it to `kill-ring'; copy of `org-copy-visible'."
+ (let (snippets s)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (setq s (goto-char (point-min)))
+ (while (not (= (point) (point-max)))
+ (goto-char (org-find-invisible))
+ (push (buffer-substring s (point)) snippets)
+ (setq s (goto-char (org-find-visible))))))
+ (apply 'concat (nreverse snippets))))
(provide 'org-index)
@@ -2214,4 +2862,3 @@ retrieves the value of the count-column for reference 12.
;; End:
;;; org-index.el ends here
-
diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el
index 644132c..928c801 100644
--- a/contrib/lisp/org-interactive-query.el
+++ b/contrib/lisp/org-interactive-query.el
@@ -1,6 +1,6 @@
;;; org-interactive-query.el --- Interactive modification of agenda query
;;
-;; Copyright 2007-2014 Free Software Foundation, Inc.
+;; Copyright 2007-2016 Free Software Foundation, Inc.
;;
;; Author: Christopher League <league at contrapunctus dot net>
;; Version: 1.0
@@ -81,7 +81,7 @@ not change the current one."
(split-window-vertically)
(org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
(erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
+ (setq-local org-done-keywords done-keywords)
(insert "Query: " current "\n")
(org-agenda-query-op-line op)
(insert "\n\n")
diff --git a/contrib/lisp/org-jira.el b/contrib/lisp/org-jira.el
deleted file mode 100644
index 43edd08..0000000
--- a/contrib/lisp/org-jira.el
+++ b/dev/null
@@ -1,64 +0,0 @@
-;;; org-jira.el --- add a jira:ticket protocol to Org
-(defconst org-jira-version "0.1")
-;; Copyright (C) 2008-2014 Jonathan Arkell.
-;; 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.
-
-;; 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:
-;; 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/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el
index 1755e71..e47c8f8 100644
--- a/contrib/lisp/org-learn.el
+++ b/contrib/lisp/org-learn.el
@@ -1,6 +1,6 @@
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el
index 44a1ea7..dc1d797 100644
--- a/contrib/lisp/org-license.el
+++ b/contrib/lisp/org-license.el
@@ -1,6 +1,6 @@
;;; org-license.el --- Add a license to your org files
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
;; Keywords: licenses, creative commons
@@ -45,15 +45,15 @@
(defun org-license-cc-by (language)
(interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language)
(cond ((equal language "br")
- (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/br/deed.pt_BR")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Brasil]]\n")))
((equal language "ca")
- (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement 3.0 Espanya]]\n")))
((equal language "de")
- (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/de/deed.de")
+ (setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Lizenz Creative Commons Namensnennung 3.0 Deutschland]]\n")))
((equal language "eo")
@@ -96,8 +96,10 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n")))
- (t (concat (insert "* License
-This document is under a [[" org-license-cc-url "][Creative Commons Attribution 3.0]]\n"))))
+ (t
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by/4.0/deed")
+ (concat (insert "* License
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n"))))
@@ -153,9 +155,9 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição-CompartilhaIgual 3.0 Portugal]]\n")))
(t
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/deed")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/4.0/deed")
(insert (concat "* License
-This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike Unported 3.0]]\n"))))
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n"))))
@@ -179,11 +181,11 @@ Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennun
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución-SinDerivadas 3.0]]\n")))
((equal language "eu")
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.eu")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
(insert (concat "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
((equal language "fi")
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
@@ -211,9 +213,9 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Sem Derivados 3.0 Portugal]]\n")))
(t
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/deed")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/4.0/deed")
(insert (concat "* License
-This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives Unported 3.0]]\n"))))
+This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n"))))
@@ -270,9 +272,9 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Portugal]]\n")))
(t
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/deed")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/4.0/deed")
(insert (concat "* License
-This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 3.0 Unported]]\n"))))
+This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n"))))
@@ -328,9 +330,9 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição NãoComercial Compartil ha Igual 3.0 Portugal]]\n")))
(t
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/deed")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/4.0/deed")
(insert (concat "* License
-This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 3.0 Unported]]\n"))))
+This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n"))))
@@ -386,10 +388,9 @@ Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsverme
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Portugal]]\n")))
(t
- (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/deed")
+ (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/4.0/deed")
(insert (concat "* License
-This document is under a [[" org-license-cc-url "][License Creative Commons
-Reconocimiento-NoComercial-SinObraDerivada 3.0 Unported]]\n"))))
+This document is under a [[" org-license-cc-url "][License Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n"))))
@@ -398,14 +399,14 @@ Reconocimiento-NoComercial-SinObraDerivada 3.0 Unported]]\n"))))
(interactive "MLanguage (es | en): " language)
(cond ((equal language "es")
(insert "* Licencia
-Copyright (C) 2013 " user-full-name
+Copyright (C) " (format-time-string "%Y") " " user-full-name
"\n Se permite copiar, distribuir y/o modificar este documento
bajo los términos de la GNU Free Documentation License, Version 1.3
o cualquier versión publicada por la Free Software Foundation;
sin Secciones Invariantes y sin Textos de Portada o Contraportada.
Una copia de la licencia está incluida en [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n"))
(t (insert (concat "* License
-Copyright (C) 2013 " user-full-name
+Copyright (C) " (format-time-string "%Y") " " user-full-name
"\n Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3
or any later version published by the Free Software Foundation;
diff --git a/contrib/lisp/org-link-edit.el b/contrib/lisp/org-link-edit.el
new file mode 100644
index 0000000..431c934
--- a/dev/null
+++ b/contrib/lisp/org-link-edit.el
@@ -0,0 +1,327 @@
+;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Kyle Meyer <kyle@kyleam.com>
+
+;; Author: Kyle Meyer <kyle@kyleam.com>
+;; URL: https://github.com/kyleam/org-link-edit
+;; Keywords: convenience
+;; Version: 1.0.1
+;; Package-Requires: ((cl-lib "0.5") (org "8.2"))
+
+;; 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:
+
+;; Org Link Edit provides Paredit-inspired slurping and barfing
+;; commands for Org link descriptions.
+;;
+;; There are four commands, all which operate when point is on an Org
+;; link.
+;;
+;; - org-link-edit-forward-slurp
+;; - org-link-edit-backward-slurp
+;; - org-link-edit-forward-barf
+;; - org-link-edit-backward-barf
+;;
+;; Org Link Edit doesn't bind these commands to any keys. Finding
+;; good keys for these commands is difficult because, while it's
+;; convenient to be able to quickly repeat these commands, they won't
+;; be used frequently enough to be worthy of a short, repeat-friendly
+;; binding. Using Hydra [1] provides a nice solution to this. After
+;; an initial key sequence, any of the commands will be repeatable
+;; with a single key. (Plus, you get a nice interface that displays
+;; the key for each command.) Below is one example of how you could
+;; configure this.
+;;
+;; (define-key org-mode-map YOUR-KEY
+;; (defhydra hydra-org-link-edit ()
+;; "Org Link Edit"
+;; ("j" org-link-edit-forward-slurp "forward slurp")
+;; ("k" org-link-edit-forward-barf "forward barf")
+;; ("u" org-link-edit-backward-slurp "backward slurp")
+;; ("i" org-link-edit-backward-barf "backward barf")
+;; ("q" nil "cancel")))
+;;
+;; [1] https://github.com/abo-abo/hydra
+
+;;; Code:
+
+(require 'org)
+(require 'org-element)
+(require 'cl-lib)
+
+(defun org-link-edit--get-link-data ()
+ "Return list with information about the link at point.
+The list includes
+- the position at the start of the link
+- the position at the end of the link
+- the link text
+- the link description (nil when on a plain link)"
+ (let ((el (org-element-context)))
+ ;; Don't use `org-element-lineage' because it isn't available
+ ;; until Org version 8.3.
+ (while (and el (not (memq (car el) '(link))))
+ (setq el (org-element-property :parent el)))
+ (unless (eq (car el) 'link)
+ (user-error "Point is not on a link"))
+ (save-excursion
+ (goto-char (org-element-property :begin el))
+ (cond
+ ;; Use match-{beginning,end} because match-end is consistently
+ ;; positioned after ]], while the :end property is positioned
+ ;; at the next word on the line, if one is present.
+ ((looking-at org-bracket-link-regexp)
+ (list (match-beginning 0)
+ (match-end 0)
+ (org-link-unescape (match-string-no-properties 1))
+ (or (and (match-end 3)
+ (match-string-no-properties 3))
+ "")))
+ ((looking-at org-plain-link-re)
+ (list (match-beginning 0)
+ (match-end 0)
+ (org-link-unescape (match-string-no-properties 0))
+ nil))
+ (t
+ (error "What am I looking at?"))))))
+
+(defun org-link-edit--forward-blob (n &optional no-punctuation)
+ "Move forward N blobs (backward if N is negative).
+
+A block of non-whitespace characters is a blob. If
+NO-PUNCTUATION is non-nil, trailing punctuation characters are
+not considered part of the blob when going in the forward
+direction.
+
+If the edge of the buffer is reached before completing the
+movement, return nil. Otherwise, return t."
+ (let* ((forward-p (> n 0))
+ (nblobs (abs n))
+ (skip-func (if forward-p 'skip-syntax-forward 'skip-syntax-backward))
+ skip-func-retval)
+ (while (/= nblobs 0)
+ (funcall skip-func " ")
+ (setq skip-func-retval (funcall skip-func "^ "))
+ (setq nblobs (1- nblobs)))
+ (when (and forward-p no-punctuation)
+ (let ((punc-tail-offset (save-excursion (skip-syntax-backward "."))))
+ ;; Don't consider trailing punctuation as part of the blob
+ ;; unless the whole blob consists of punctuation.
+ (unless (= skip-func-retval (- punc-tail-offset))
+ (goto-char (+ (point) punc-tail-offset)))))
+ (/= skip-func-retval 0)))
+
+;;;###autoload
+(defun org-link-edit-forward-slurp (&optional n)
+ "Slurp N trailing blobs into link's description.
+
+ The \[\[http://orgmode.org/\]\[Org mode\]\] site
+
+ |
+ v
+
+ The \[\[http://orgmode.org/\]\[Org mode site\]\]
+
+A blob is a block of non-whitespace characters. When slurping
+forward, trailing punctuation characters are not considered part
+of a blob.
+
+After slurping, return the slurped text and move point to the
+beginning of the link.
+
+If N is negative, slurp leading blobs instead of trailing blobs."
+ (interactive "p")
+ (setq n (or n 1))
+ (cond
+ ((= n 0))
+ ((< n 0)
+ (org-link-edit-backward-slurp (- n)))
+ (t
+ (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
+ (goto-char (save-excursion
+ (goto-char end)
+ (or (org-link-edit--forward-blob n 'no-punctuation)
+ (user-error "Not enough blobs after the link"))
+ (point)))
+ (let ((slurped (buffer-substring-no-properties end (point))))
+ (setq slurped (replace-regexp-in-string "\n+" " " slurped))
+ (when (and (= (length desc) 0)
+ (string-match "^\\s-+\\(.*\\)" slurped))
+ (setq slurped (match-string 1 slurped)))
+ (setq desc (concat desc slurped)
+ end (+ end (length slurped)))
+ (delete-region beg (point))
+ (insert (org-make-link-string link desc))
+ (goto-char beg)
+ slurped)))))
+
+;;;###autoload
+(defun org-link-edit-backward-slurp (&optional n)
+ "Slurp N leading blobs into link's description.
+
+ The \[\[http://orgmode.org/\]\[Org mode\]\] site
+
+ |
+ v
+
+ \[\[http://orgmode.org/\]\[The Org mode\]\] site
+
+A blob is a block of non-whitespace characters.
+
+After slurping, return the slurped text and move point to the
+beginning of the link.
+
+If N is negative, slurp trailing blobs instead of leading blobs."
+ (interactive "p")
+ (setq n (or n 1))
+ (cond
+ ((= n 0))
+ ((< n 0)
+ (org-link-edit-forward-slurp (- n)))
+ (t
+ (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
+ (goto-char (save-excursion
+ (goto-char beg)
+ (or (org-link-edit--forward-blob (- n))
+ (user-error "Not enough blobs before the link"))
+ (point)))
+ (let ((slurped (buffer-substring-no-properties (point) beg)))
+ (when (and (= (length desc) 0)
+ (string-match "\\(.*\\)\\s-+$" slurped))
+ (setq slurped (match-string 1 slurped)))
+ (setq slurped (replace-regexp-in-string "\n+" " " slurped))
+ (setq desc (concat slurped desc)
+ beg (- beg (length slurped)))
+ (delete-region (point) end)
+ (insert (org-make-link-string link desc))
+ (goto-char beg)
+ slurped)))))
+
+(defun org-link-edit--split-first-blobs (string n)
+ "Split STRING into (N first blobs . other) cons cell.
+'N first blobs' contains all text from the start of STRING up to
+the start of the N+1 blob. 'other' includes the remaining text
+of STRING. If the number of blobs in STRING is fewer than N,
+'other' is nil."
+ (when (< n 0) (user-error "N cannot be negative"))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (with-syntax-table org-mode-syntax-table
+ (let ((within-bound (org-link-edit--forward-blob n)))
+ (skip-syntax-forward " ")
+ (cons (buffer-substring 1 (point))
+ (and within-bound
+ (buffer-substring (point) (point-max))))))))
+
+(defun org-link-edit--split-last-blobs (string n)
+ "Split STRING into (other . N last blobs) cons cell.
+'N last blobs' contains all text from the end of STRING back to
+the end of the N+1 last blob. 'other' includes the remaining
+text of STRING. If the number of blobs in STRING is fewer than
+N, 'other' is nil."
+ (when (< n 0) (user-error "N cannot be negative"))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-max))
+ (with-syntax-table org-mode-syntax-table
+ (let ((within-bound (org-link-edit--forward-blob (- n))))
+ (skip-syntax-backward " ")
+ (cons (and within-bound
+ (buffer-substring 1 (point)))
+ (buffer-substring (point) (point-max)))))))
+
+;;;###autoload
+(defun org-link-edit-forward-barf (&optional n)
+ "Barf N trailing blobs from link's description.
+
+ The \[\[http://orgmode.org/\]\[Org mode\]\] site
+
+ |
+ v
+
+ The \[\[http://orgmode.org/\]\[Org\]\] mode site
+
+A blob is a block of non-whitespace characters.
+
+After barfing, return the barfed text and move point to the
+beginning of the link.
+
+If N is negative, barf leading blobs instead of trailing blobs."
+ (interactive "p")
+ (setq n (or n 1))
+ (cond
+ ((= n 0))
+ ((< n 0)
+ (org-link-edit-backward-barf (- n)))
+ (t
+ (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
+ (when (= (length desc) 0)
+ (user-error "Link has no description"))
+ (pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs
+ desc n)))
+ (unless new-desc (user-error "Not enough blobs in description"))
+ (delete-region beg end)
+ (insert (org-make-link-string link new-desc))
+ (if (string= new-desc "")
+ ;; Two brackets are dropped when an empty description is
+ ;; passed to `org-make-link-string'.
+ (progn (goto-char (- end (+ 2 (length desc))))
+ (setq barfed (concat " " barfed)))
+ (goto-char (- end (- (length desc) (length new-desc)))))
+ (insert barfed)
+ (goto-char beg)
+ barfed)))))
+
+;;;###autoload
+(defun org-link-edit-backward-barf (&optional n)
+ "Barf N leading blobs from link's description.
+
+ The \[\[http://orgmode.org/\]\[Org mode\]\] site
+
+ |
+ v
+
+ The Org \[\[http://orgmode.org/\]\[mode\]\] site
+
+A blob is a block of non-whitespace characters.
+
+After barfing, return the barfed text and move point to the
+beginning of the link.
+
+If N is negative, barf trailing blobs instead of leading blobs."
+ (interactive "p")
+ (setq n (or n 1))
+ (cond
+ ((= n 0))
+ ((< n 0)
+ (org-link-edit-forward-barf (- n)))
+ (t
+ (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data)
+ (when (= (length desc) 0)
+ (user-error "Link has no description"))
+ (pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs
+ desc n)))
+ (unless new-desc (user-error "Not enough blobs in description"))
+ (delete-region beg end)
+ (insert (org-make-link-string link new-desc))
+ (when (string= new-desc "")
+ (setq barfed (concat barfed " ")))
+ (goto-char beg)
+ (insert barfed)
+ (goto-char (+ beg (length barfed)))
+ barfed)))))
+
+(provide 'org-link-edit)
+;;; org-link-edit.el ends here
diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el
index d1687e0..076483c 100644
--- a/contrib/lisp/org-mac-link.el
+++ b/contrib/lisp/org-mac-link.el
@@ -1,13 +1,13 @@
-;;; org-mac-link.el --- Grab links and url from various mac
-;; Application and insert them as links into org-mode documents
+;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac apps
;;
-;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (c) 2010-2016 Free Software Foundation, Inc.
;;
-;; Authors:
-;; Anthony Lander <anthony.lander@gmail.com>
-;; John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
-;; Daniil Frumin <difrumin@gmail.com>
+;; Author: Anthony Lander <anthony.lander@gmail.com>
+;; John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
+;; Daniil Frumin <difrumin@gmail.com>
+;; Alan Schmitt <alan.schmitt@polytechnique.org>
+;; Mike McLean <mike.mclean@pobox.com>
;;
;;
;; Version: 1.1
@@ -18,6 +18,18 @@
;; Author: Mike McLean <mike.mclean@pobox.com>
;; Add support for Microsoft Outlook for Mac as Org mode links
;;
+;; Version: 1.3
+;; Author: Alan Schmitt <alan.schmitt@polytechnique.org>
+;; Consistently use `org-mac-paste-applescript-links'
+;;
+;; Version 1.4
+;; Author: Mike McLean <mike.mclean@pobox.com>
+;; Make the path to Microsoft Outlook a `defcustom'
+;;
+;; Version 1.5
+;; Author: Mike McLean <mike.mclean@pobox.com>
+;; Add Support for Evernote
+;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify
@@ -57,6 +69,8 @@
;; Together.app - Grab links to the selected items in the library list
;; Skim.app - Grab a link to the selected page in the topmost pdf document
;; Microsoft Outlook.app - Grab a link to the selected message in the message list
+;; DEVONthink Pro Office.app - Grab a link to the selected DEVONthink item(s); open DEVONthink item by reference
+;; Evernote.app - Grab a link to the selected Evernote item(s); open Evernote item by ID
;;
;;
;; Installation:
@@ -86,61 +100,72 @@
(require 'org)
(defgroup org-mac-link nil
- "Options concerning grabbing links from external Mac
-applications and inserting them in org documents"
+ "Options for grabbing links from Mac applications."
:tag "Org Mac link"
:group 'org-link)
(defcustom org-mac-grab-Finder-app-p t
- "Enable menu option [F]inder to grab links from the Finder"
+ "Add menu option [F]inder to grab links from the Finder."
:tag "Grab Finder.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Mail-app-p t
- "Enable menu option [m]ail to grab links from Mail.app"
+ "Add menu option [m]ail to grab links from Mail.app."
:tag "Grab Mail.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Outlook-app-p t
- "Enable menu option [o]utlook to grab links from Microsoft Outlook.app"
+ "Add menu option [o]utlook to grab links from Microsoft Outlook.app."
:tag "Grab Microsoft Outlook.app links"
:group 'org-mac-link
:type 'boolean)
+(defcustom org-mac-outlook-path "/Applications/Microsoft Outlook.app"
+ "The path to the installed copy of Microsoft Outlook.app. Do not escape spaces as the AppleScript call will quote this string."
+ :tag "Path to Microsoft Outlook"
+ :group 'org-mac-link
+ :type 'string)
+
+(defcustom org-mac-grab-devonthink-app-p t
+ "Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app."
+ :tag "Grab DEVONthink Pro Office.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
(defcustom org-mac-grab-Addressbook-app-p t
- "Enable menu option [a]ddressbook to grab links from AddressBook.app"
+ "Add menu option [a]ddressbook to grab links from AddressBook.app."
:tag "Grab AddressBook.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Safari-app-p t
- "Enable menu option [s]afari to grab links from Safari.app"
+ "Add menu option [s]afari to grab links from Safari.app."
:tag "Grab Safari.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Firefox-app-p t
- "Enable menu option [f]irefox to grab links from Firefox.app"
+ "Add menu option [f]irefox to grab links from Firefox.app."
:tag "Grab Firefox.app links"
:group 'org-mac-link
: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"
+ "Add menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin."
:tag "Grab Vimperator/Firefox.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [c]hrome to grab links from Google Chrome.app"
+ "Add menu option [c]hrome to grab links from Google Chrome.app."
:tag "Grab Google Chrome.app links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-grab-Together-app-p nil
- "Enable menu option [t]ogether to grab links from Together.app"
+ "Add menu option [t]ogether to grab links from Together.app."
:tag "Grab Together.app links"
:group 'org-mac-link
:type 'boolean)
@@ -148,27 +173,50 @@ applications and inserting them in org documents"
(defcustom org-mac-grab-Skim-app-p
(< 0 (length (shell-command-to-string
"mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
- "Enable menu option [S]kim to grab page links from Skim.app"
+ "Add menu option [S]kim to grab page links from Skim.app."
:tag "Grab Skim.app page links"
:group 'org-mac-link
:type 'boolean)
(defcustom org-mac-Skim-highlight-selection-p nil
- "Highlight (using notes) the selection (if present) when grabbing the a link from Skim.app"
+ "Highlight the active selection when grabbing a link from Skim.app."
:tag "Highlight selection in Skim.app"
:group 'org-mac-link
:type 'boolean)
+(defcustom org-mac-grab-Acrobat-app-p t
+ "Add menu option [A]crobat to grab page links from Acrobat.app."
+ :tag "Grab Acrobat.app page links"
+ :group 'org-mac-link
+ :type 'boolean)
+
(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages."
+ "Options foring linking to flagged Mail.app messages."
:tag "Org Mail.app"
:group 'org-link)
-(defcustom org-mac-mail-account "customize"
+(defcustom org-mac-mail-account nil
"The Mail.app account in which to search for flagged messages."
:group 'org-mac-flagged-mail
:type 'string)
+(defcustom org-mac-grab-Evernote-app-p
+ (< 0 (length (shell-command-to-string
+ "mdfind kMDItemCFBundleIdentifier == 'com.evernote.Evernote'")))
+ "Add menu option [e]vernote to grab note links from Evernote.app."
+ :tag "Grab Evernote.app note links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-evernote-path (replace-regexp-in-string (rx (* (any " \t\n")) eos)
+ ""
+ (shell-command-to-string
+ "mdfind kMDItemCFBundleIdentifier == 'com.evernote.Evernote'"))
+ "The path to the installed copy of Evernote.app. Do not escape spaces as the AppleScript call will quote this string."
+ :tag "Path to Evernote"
+ :group 'org-mac-link
+ :type 'string)
+
;; In mac.c, removed in Emacs 23.
(declare-function do-applescript "org-mac-message" (script))
@@ -185,34 +233,41 @@ applications and inserting them in org documents"
(setq return (shell-command-to-string cmd))
(concat "\"" (org-trim return) "\""))))
-
(defun org-mac-grab-link ()
- "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
+ "Prompt for an application to grab a link from.
+When done, 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)
- ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-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)
- ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
+ (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)
+ ("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected
+ ,org-mac-grab-devonthink-app-p)
+ ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-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)
+ ("e" "evernote" org-mac-evernote-note-insert-selected ,org-mac-grab-Evernote-app-p)
+ ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
+ ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)
+ ("A" "crobat" org-mac-acrobat-insert-page ,org-mac-grab-Acrobat-app-p)))
(menu-string (make-string 0 ?x))
input)
;; Create the menu string for the keymap
- (mapc '(lambda (descriptor)
+ (mapc (lambda (descriptor)
(when (elt descriptor 3)
- (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
+ (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)
+ (mapc (lambda (descriptor)
(let ((key (elt (elt descriptor 0) 0))
(active (elt descriptor 3))
(grab-function (elt descriptor 2)))
@@ -221,12 +276,17 @@ applications and inserting them in org documents"
descriptors)))
(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]+")))
+ "Paste in a list of links from an applescript handler.
+The links are of the form <link>::split::<name>."
+ (let* ((noquote-as-link-list
+ (if (string-prefix-p "\"" as-link-list)
+ (substring as-link-list 1 -1)
+ as-link-list))
+ (link-list
+ (mapcar (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x)
+ (setq x (match-string 1 x)))
+ x)
+ (split-string noquote-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::"))
@@ -240,7 +300,6 @@ applications and inserting them in org documents"
rtn))
-
;; Handle links from Firefox.app
;;
;; This code allows you to grab the current active url from the main
@@ -257,41 +316,34 @@ applications and inserting them in org documents"
;; seems that it is always the last active window).
(defun org-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 \"a\" 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"))))
+ (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 \"a\" 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 (org-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))
+ (org-mac-paste-applescript-links (org-as-mac-firefox-get-frontmost-url)))
(defun org-mac-firefox-insert-frontmost-url ()
(interactive)
@@ -303,40 +355,33 @@ applications and inserting them in org documents"
;; Firefox
(defun org-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)))))
-
+ (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 (org-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))
+ (org-mac-paste-applescript-links (org-as-mac-vimperator-get-frontmost-url)))
(defun org-mac-vimperator-insert-frontmost-url ()
(interactive)
@@ -348,32 +393,25 @@ applications and inserting them in org documents"
;; Firefox because Chrome doesn't publish an Applescript dictionary
(defun org-as-mac-chrome-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Google Chrome\"\n"
- " set theUrl to get URL of active tab of first window\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 "^\"\\|\"$" ""
- (car (split-string result "[\r\n]+" t)))))
+ (let ((result
+ (do-applescript
+ (concat
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Google Chrome\"\n"
+ " set theUrl to get URL of active tab of first window\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
+ "^\"\\|\"$" "" (car (split-string result "[\r\n]+" t)))))
(defun org-mac-chrome-get-frontmost-url ()
(interactive)
(message "Applescript: Getting Chrome url...")
- (let* ((url-and-title (org-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))
+ (org-mac-paste-applescript-links (org-as-mac-chrome-get-frontmost-url)))
(defun org-mac-chrome-insert-frontmost-url ()
(interactive)
@@ -384,57 +422,45 @@ applications and inserting them in org documents"
;; Grab the frontmost url from Safari.
(defun org-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))))
+ (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")))
(defun org-mac-safari-get-frontmost-url ()
(interactive)
(message "Applescript: Getting Safari url...")
- (let* ((url-and-title (org-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))
+ (org-mac-paste-applescript-links
+ (org-as-mac-safari-get-frontmost-url)))
(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"
+ "Open 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")))
+ (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)
@@ -444,26 +470,22 @@ applications and inserting them in org documents"
(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")))
+ (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)
@@ -475,30 +497,26 @@ applications and inserting them in org documents"
(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"
+ "Open UID, which is a reference to an item in the addressbook."
(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")))
+ (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)
@@ -509,8 +527,7 @@ applications and inserting them in org documents"
(interactive)
(insert (org-mac-addressbook-item-get-selected)))
-;;
-;;
+
;; Handle links from Skim.app
;;
;; Original code & idea by Christopher Suckling (org-mac-protocol)
@@ -523,64 +540,102 @@ applications and inserting them in org documents"
(match-string 1 uri)))
(document (substring uri 0 (match-beginning 0))))
(do-applescript
- (concat
- "tell application \"Skim\"\n"
- "activate\n"
- "set theDoc to \"" document "\"\n"
- "set thePage to " page "\n"
- "open theDoc\n"
- "go document 1 to page thePage of document 1\n"
- "end tell"))))
-
+ (concat
+ "tell application \"Skim\"\n"
+ "activate\n"
+ "set theDoc to \"" document "\"\n"
+ "set thePage to " page "\n"
+ "open theDoc\n"
+ "go document 1 to page thePage of document 1\n"
+ "end tell"))))
(defun as-get-skim-page-link ()
(do-applescript
+ (concat
+ "tell application \"Skim\"\n"
+ "set theDoc to front document\n"
+ "set theTitle to (name of theDoc)\n"
+ "set thePath to (path of theDoc)\n"
+ "set thePage to (get index for current page of theDoc)\n"
+ "set theSelection to selection of theDoc\n"
+ "set theContent to contents of (get text for theSelection)\n"
+ "if theContent is missing value then\n"
+ " set theContent to theTitle & \", p. \" & thePage\n"
+ (when org-mac-Skim-highlight-selection-p
(concat
- "tell application \"Skim\"\n"
- "set theDoc to front document\n"
- "set theTitle to (name of theDoc)\n"
- "set thePath to (path of theDoc)\n"
- "set thePage to (get index for current page of theDoc)\n"
- "set theSelection to selection of theDoc\n"
- "set theContent to contents of (get text for theSelection)\n"
- "if theContent is missing value then\n"
- " set theContent to theTitle & \", p. \" & thePage\n"
- (when org-mac-Skim-highlight-selection-p
- (concat
- "else\n"
- " tell theDoc\n"
- " set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
- " set text of theNote to (get text for theSelection)\n"
- " end tell\n"))
- "end if\n"
- "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
- "\"::split::\" & theContent\n"
- "end tell\n"
- "return theLink as string\n")))
+ "else\n"
+ " tell theDoc\n"
+ " set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
+ " set text of theNote to (get text for theSelection)\n"
+ " end tell\n"))
+ "end if\n"
+ "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
+ "\"::split::\" & theContent\n"
+ "end tell\n"
+ "return theLink as string\n")))
(defun org-mac-skim-get-page ()
(interactive)
(message "Applescript: Getting Skim page link...")
- (let* ((link-and-descr (as-get-skim-page-link))
- (split-link (split-string link-and-descr "::split::"))
- (link (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= link ""))
- (setq org-link (org-make-link-string link description)))
- (kill-new org-link)
- org-link))
+ (org-mac-paste-applescript-links (as-get-skim-page-link)))
(defun org-mac-skim-insert-page ()
(interactive)
(insert (org-mac-skim-get-page)))
-
-
+;; Handle links from Adobe Acrobat Pro.app
;;
+;; Original code & idea by Christopher Suckling (org-mac-protocol)
;;
+;; The URI format is path_to_pdf_file::page_number
+
+(org-add-link-type "acrobat" 'org-mac-acrobat-open)
+
+(defun org-mac-acrobat-open (uri)
+ "Visit page of pdf in Acrobat"
+ (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
+ (match-string 1 uri)))
+ (document (substring uri 0 (match-beginning 0))))
+ (do-applescript
+ (concat
+ "tell application \"Adobe Acrobat Pro\"\n"
+ " activate\n"
+ " set theDoc to \"" document "\"\n"
+ " set thePage to " page "\n"
+ " open theDoc\n"
+ " tell PDF Window 1\n"
+ " goto page thePage\n"
+ " end tell\n"
+ "end tell"))))
+
+;; The applescript returns link in the format
+;; "adobe:path_to_pdf_file::page_number::split::document_title, p.page_label"
+
+(defun org-mac-as-get-acrobat-page-link ()
+ (do-applescript
+ (concat
+ "tell application \"Adobe Acrobat Pro\"\n"
+ " set theDoc to active doc\n"
+ " set theWindow to (PDF Window 1 of theDoc)\n"
+ " set thePath to (file alias of theDoc)\n"
+ " set theTitle to (name of theWindow)\n"
+ " set thePage to (page number of theWindow)\n"
+ " set theLabel to (label text of (page thePage of theWindow))\n"
+ "end tell\n"
+ "set theResult to \"acrobat:\" & thePath & \"::\" & thePage & \"::split::\" & theTitle & \", p.\" & theLabel\n"
+ "return theResult as string\n")))
+
+(defun org-mac-acrobat-get-page ()
+ (interactive)
+ (message "Applescript: Getting Acrobat page link...")
+ (org-mac-paste-applescript-links (org-mac-as-get-acrobat-page-link)))
+
+(defun org-mac-acrobat-insert-page ()
+ (interactive)
+ (insert (org-mac-acrobat-get-page)))
+
+
;; Handle links from Microsoft Outlook.app
-;;
(org-add-link-type "mac-outlook" 'org-mac-outlook-message-open)
@@ -588,16 +643,16 @@ applications and inserting them in org documents"
"Open a message in Outlook"
(do-applescript
(concat
- "tell application \"Microsoft Outlook\"\n"
- (format "open message id %s\n" (substring-no-properties msgid))
- "activate\n"
- "end tell")))
+ "tell application \"" org-mac-outlook-path "\"\n"
+ (format "open message id %s\n" (substring-no-properties msgid))
+ "activate\n"
+ "end tell")))
(defun org-as-get-selected-outlook-mail ()
"AppleScript to create links to selected messages in Microsoft Outlook.app."
(do-applescript
(concat
- "tell application \"Microsoft Outlook\"\n"
+ "tell application \"" org-mac-outlook-path "\"\n"
"set msgCount to count current messages\n"
"if (msgCount < 1) then\n"
"return\n"
@@ -648,40 +703,27 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(interactive "sLink to (s)elected or (f)lagged messages: ")
(setq select-or-flag (or select-or-flag "s"))
(message "Org Mac Outlook: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (org-as-get-selected-outlook-mail)
- (if (string= select-or-flag "f")
- (org-sh-get-flagged-outlook-mail)
- (error "Please select \"s\" or \"f\""))))
- (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))
+ (org-mac-paste-applescript-links
+ (if (string= select-or-flag "s")
+ (org-as-get-selected-outlook-mail)
+ (if (string= select-or-flag "f")
+ (org-sh-get-flagged-outlook-mail)
+ (error "Please select \"s\" or \"f\"")))))
(defun org-mac-outlook-message-insert-selected ()
"Insert a link to the messages currently selected in Microsoft Outlook.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Microsoft Outlook.app and make a link out of it."
+This will use AppleScript to get the message-id and the subject
+of the active mail in Microsoft Outlook.app and make a link out
+of it."
(interactive)
(insert (org-mac-outlook-message-get-links "s")))
(defun org-mac-outlook-message-insert-flagged (org-buffer org-heading)
"Asks for an org buffer and a heading within it, and replace message links.
-If heading exists, delete all mac-outlook:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of mac-outlook:// links to flagged mail after heading."
+If heading exists, delete all mac-outlook:// links within
+heading's first level. If heading doesn't exist, create it at
+point-max. Insert list of mac-outlook:// links to flagged mail
+after heading."
(interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
(with-current-buffer org-buffer
(goto-char (point-min))
@@ -701,18 +743,110 @@ list of mac-outlook:// links to flagged mail after heading."
(insert "\n")
(org-insert-heading nil t)
(insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
+
+;; Handle links from Evernote.app
+(org-add-link-type "mac-evernote" 'org-mac-evernote-note-open)
+
+(defun org-mac-evernote-note-open (noteid)
+ "Open a note in Evernote"
+ (do-applescript
+ (concat
+ "tell application \"" org-mac-evernote-path "\"\n"
+ " set theNotes to get every note of every notebook where its local id is \"" (substring-no-properties noteid) "\"\n"
+ " repeat with _note in theNotes\n"
+ " if length of _note is not 0 then\n"
+ " set _selectedNote to _note\n"
+ " end if\n"
+ " end repeat\n"
+ " open note window with item 1 of _selectedNote\n"
+ " activate\n"
+ "end tell")))
+
+(defun org-as-get-selected-evernote-notes ()
+ "AppleScript to create links to selected notes in Evernote.app."
+ (do-applescript
+ (concat
+ "tell application \"" org-mac-evernote-path "\"\n"
+ " set noteCount to count selection\n"
+ " if (noteCount < 1) then\n"
+ " return\n"
+ " end if\n"
+ " set theLinkList to {}\n"
+ " set theSelection to selection\n"
+ " repeat with theNote in theSelection\n"
+ " set theTitle to title of theNote\n"
+ " set theID to local id of theNote\n"
+ " set theURL to \"mac-evernote:\" & theID\n"
+ " set theLink to theURL & \"::split::\" & theTitle & \"\n\"\n"
+ " copy theLink to end of theLinkList\n"
+ " end repeat\n"
+ " return theLinkList as string\n"
+ "end tell\n")))
+
+(defun org-mac-evernote-note-insert-selected ()
+ "Insert a link to the notes currently selected in Evernote.app.
+This will use AppleScript to get the note id and the title of the
+note(s) in Evernote.app and make a link out of it/them."
+ (interactive)
+ (message "Org Mac Evernote: searching notes...")
+(insert (org-mac-paste-applescript-links
+ (org-as-get-selected-evernote-notes))))
+
+
+;; Handle links from DEVONthink Pro Office.app
+
+(org-add-link-type "x-devonthink-item" 'org-devonthink-item-open)
+
+(defun org-devonthink-item-open (uid)
+ "Open UID, which is a reference to an item in DEVONthink Pro Office."
+ (shell-command (concat "open \"x-devonthink-item:" uid "\"")))
+
+(defun org-as-get-selected-devonthink-item ()
+ "AppleScript to create links to selected items in DEVONthink Pro Office.app."
+ (do-applescript
+ (concat
+ "set theLinkList to {}\n"
+ "tell application \"DEVONthink Pro\"\n"
+ "set selectedRecords to selection\n"
+ "set selectionCount to count of selectedRecords\n"
+ "if (selectionCount < 1) then\n"
+ "return\n"
+ "end if\n"
+ "repeat with theRecord in selectedRecords\n"
+ "set theID to uuid of theRecord\n"
+ "set theURL to \"x-devonthink-item:\" & theID\n"
+ "set theSubject to name of theRecord\n"
+ "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "end tell\n"
+ "return theLinkList as string"
+ )))
+
+(defun org-mac-devonthink-get-links ()
+ "Create links to the item(s) currently selected in DEVONthink Pro Office.
+This will use AppleScript to get the `uuid' and the `name' of the
+selected items in DEVONthink Pro Office.app and make links out of
+it/them. This function will push the Org-syntax text to the kill
+ring, and also return it."
+ (message "Org Mac DEVONthink: looking for selected items...")
+ (org-mac-paste-applescript-links (org-as-get-selected-devonthink-item)))
+
+(defun org-mac-devonthink-item-insert-selected ()
+ "Insert a link to the item(s) currently selected in DEVONthink Pro Office.
+This will use AppleScript to get the `uuid'(s) and the name(s) of the
+selected items in DEVONthink Pro Office and make link(s) out of it/them."
+ (interactive)
+ (insert (org-mac-devonthink-get-links)))
-;;
-;;
;; Handle links from Mail.app
-;;
(org-add-link-type "message" 'org-mac-message-open)
(defun org-mac-message-open (message-id)
- "Visit the message with the given MESSAGE-ID.
+ "Visit the message with MESSAGE-ID.
This will use the command `open' with the message URL."
(start-process (concat "open message:" message-id) nil
"open" (concat "message://<" (substring message-id 2) ">")))
@@ -720,67 +854,43 @@ This will use the command `open' with the message URL."
(defun org-as-get-selected-mail ()
"AppleScript to create links to selected messages in Mail.app."
(do-applescript
- (concat
- "tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
+ (concat
+ "tell application \"Mail\"\n"
+ "set theLinkList to {}\n"
+ "set theSelection to selection\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject\n"
+ "if (theLinkList is not equal to {}) then\n"
+ "set theLink to \"\n\" & theLink\n"
+ "end if\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
(defun org-as-get-flagged-mail ()
"AppleScript to create links to flagged messages in Mail.app."
+ (unless org-mac-mail-account
+ (error "You must set org-mac-mail-account"))
(do-applescript
- (concat
- ;; Is Growl installed?
- "tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
- "end tell\n"
-
- ;; Get links
- "tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
+ (concat
+ ;; Get links
+ "tell application \"Mail\"\n"
+ "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
+ "set theLinkList to {}\n"
+ "repeat with aMailbox in theMailboxes\n"
+ "set theSelection to (every message in aMailbox whose flagged status = true)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
(defun org-mac-message-get-links (&optional select-or-flag)
"Create links to the messages currently selected or flagged in Mail.app.
@@ -792,27 +902,11 @@ The Org-syntax text will be pushed to the kill ring, and also returned."
(interactive "sLink to (s)elected or (f)lagged messages: ")
(setq select-or-flag (or select-or-flag "s"))
(message "AppleScript: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (org-as-get-selected-mail)
- (if (string= select-or-flag "f")
- (org-as-get-flagged-mail)
- (error "Please select \"s\" or \"f\""))))
- (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))
+ (org-mac-paste-applescript-links
+ (cond
+ ((string= select-or-flag "s") (org-as-get-selected-mail))
+ ((string= select-or-flag "f") (org-as-get-flagged-mail))
+ (t (error "Please select \"s\" or \"f\"")))))
(defun org-mac-message-insert-selected ()
"Insert a link to the messages currently selected in Mail.app.
@@ -843,11 +937,11 @@ list of message:// links to flagged mail after heading."
(delete-region (match-beginning 0) (match-end 0)))
(insert "\n" (org-mac-message-get-links "f")))
(flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-message-get-links "f"))))))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (goto-char (point-max))
+ (insert "\n")
+ (org-insert-heading nil t)
+ (insert org-heading "\n" (org-mac-message-get-links "f"))))))
(provide 'org-mac-link)
diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el
index 4482375..4f2559b 100644
--- a/contrib/lisp/org-mew.el
+++ b/contrib/lisp/org-mew.el
@@ -1,6 +1,6 @@
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
-;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -167,19 +167,10 @@ with \"t\" key."
(from (mew-header-get-value "From:"))
(to (mew-header-get-value "To:"))
(date (mew-header-get-value "Date:"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
(subject (mew-header-get-value "Subject:"))
desc link)
- (org-store-link-props :type "mew" :from from :to to
+ (org-store-link-props :type "mew" :from from :to to :date date
:subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq message-id (org-remove-angle-brackets message-id))
(setq desc (org-email-link-description))
(setq link (concat "mew:" folder-name "#" message-id))
@@ -308,7 +299,7 @@ the subject and the group number to extract. You can get rid of
org-mew-subject-alist))
(setq id-list (cons subject id-list)))
(cond ((null id-list)
- (error "No message ID to search."))
+ (error "No message ID to search"))
((equal (length id-list) 1)
(org-search-view nil (car id-list)))
(t
@@ -342,7 +333,7 @@ asks you to select the capture template."
(mew-message-goto-summary))
(let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0))))
(mew-summary-refile)))
- (error "No refile folder selected."))
+ (error "No refile folder selected"))
(let* ((org-mew-link-to-refile-destination t)
(folder-name (org-mew-folder-name))
(keys (if arg
diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
index b0007ac..682f635 100644
--- a/contrib/lisp/org-mime.el
+++ b/contrib/lisp/org-mime.el
@@ -1,6 +1,6 @@
;;; org-mime.el --- org html export for text/html MIME emails
-;; Copyright (C) 2010-2014 Eric Schulte
+;; Copyright (C) 2010-2015 Eric Schulte
;; Author: Eric Schulte
;; Keywords: mime, mail, email, html
@@ -111,7 +111,7 @@
;; 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)
+ (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)
@@ -163,10 +163,13 @@ and images in a multipart/related part."
('semi (concat
"--" "<<alternative>>-{\n"
"--" "[[text/plain]]\n" plain
- (when images (concat "--" "<<alternative>>-{\n"))
- "--" "[[text/html]]\n" html
- images
- (when images (concat "--" "}-<<alternative>>\n"))
+ (if (and images (> (length images) 0))
+ (concat "--" "<<related>>-{\n"
+ "--" "[[text/html]]\n" html
+ images
+ "--" "}-<<related>>\n")
+ (concat "--" "[[text/html]]\n" html
+ images))
"--" "}-<<alternative>>\n"))
('vm "?")))
@@ -191,10 +194,10 @@ and images in a multipart/related part."
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."
+(defun org-mime-htmlize (&optional arg)
+ "Export to HTML an email body composed using `mml-mode'.
+If called with an active region only export that region,
+otherwise export the entire body."
(interactive "P")
(require 'ox-org)
(require 'ox-html)
@@ -249,28 +252,30 @@ export that region, otherwise export the entire body."
(save-restriction
(org-narrow-to-subtree)
(run-hooks 'org-mime-send-subtree-hook)
- (flet ((mp (p) (org-entry-get nil p org-mime-use-property-inheritance)))
- (let* ((file (buffer-file-name (current-buffer)))
- (subject (or (mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
- (to (mp "MAIL_TO"))
- (cc (mp "MAIL_CC"))
- (bcc (mp "MAIL_BCC"))
- (body (buffer-substring
- (save-excursion (goto-char (point-min))
- (forward-line 1)
- (when (looking-at "[ \t]*:PROPERTIES:")
- (re-search-forward ":END:" nil)
- (forward-char))
- (point))
- (point-max))))
- (org-mime-compose body (or fmt 'org) file to subject
- `((cc . ,cc) (bcc . ,bcc)))))))
+ (let* ((mp (lambda (p) (org-entry-get nil p org-mime-use-property-inheritance)))
+ (file (buffer-file-name (current-buffer)))
+ (subject (or (funcall mp "MAIL_SUBJECT") (nth 4 (org-heading-components))))
+ (to (funcall mp "MAIL_TO"))
+ (cc (funcall mp "MAIL_CC"))
+ (bcc (funcall mp "MAIL_BCC"))
+ (body (buffer-substring
+ (save-excursion (goto-char (point-min))
+ (forward-line 1)
+ (when (looking-at "[ \t]*:PROPERTIES:")
+ (re-search-forward ":END:" nil)
+ (forward-char))
+ (point))
+ (point-max))))
+ (org-mime-compose body (or fmt 'org) file to subject
+ `((cc . ,cc) (bcc . ,bcc))))))
(defun org-mime-send-buffer (&optional fmt)
(run-hooks 'org-mime-send-buffer-hook)
(let* ((region-p (org-region-active-p))
- (subject (org-export-grab-title-from-buffer))
- (file (buffer-file-name (current-buffer)))
+ (file (buffer-file-name (current-buffer)))
+ (subject (if (not file) (buffer-name (buffer-base-buffer))
+ (file-name-sans-extension
+ (file-name-nondirectory file))))
(body-start (or (and region-p (region-beginning))
(save-excursion (goto-char (point-min)))))
(body-end (or (and region-p (region-end)) (point-max)))
@@ -280,47 +285,48 @@ export that region, otherwise export the entire body."
(defun org-mime-compose (body fmt file &optional to subject headers)
(require 'message)
- (message-mail to subject headers nil)
+ (compose-mail to subject headers nil)
(message-goto-body)
- (flet ((bhook (body fmt)
- (let ((hook (intern (concat "org-mime-pre-"
- (symbol-name fmt)
- "-hook"))))
- (if (> (eval `(length ,hook)) 0)
- (with-temp-buffer
- (insert body)
- (goto-char (point-min))
- (eval `(run-hooks ',hook))
- (buffer-string))
- body))))
- (let ((fmt (if (symbolp fmt) fmt (intern fmt))))
- (cond
- ((eq fmt 'org)
- (require 'ox-org)
- (insert (org-export-string-as
- (org-babel-trim (bhook body 'org)) 'org t)))
- ((eq fmt 'ascii)
- (require 'ox-ascii)
- (insert (org-export-string-as
- (concat "#+Title:\n" (bhook body 'ascii)) 'ascii t)))
- ((or (eq fmt 'html) (eq fmt 'html-ascii))
- (require 'ox-ascii)
- (require 'ox-org)
- (let* ((org-link-file-path-type 'absolute)
- ;; we probably don't want to export a huge style file
- (org-export-htmlize-output-type 'inline-css)
- (html-and-images
- (org-mime-replace-images
- (org-export-string-as (bhook body 'html) 'html t) file))
- (images (cdr html-and-images))
- (html (org-mime-apply-html-hook (car html-and-images))))
- (insert (org-mime-multipart
- (org-export-string-as
- (org-babel-trim
- (bhook body (if (eq fmt 'html) 'org 'ascii)))
- (if (eq fmt 'html) 'org 'ascii) t)
- html)
- (mapconcat 'identity images "\n"))))))))
+ (let ((bhook
+ (lambda (body fmt)
+ (let ((hook (intern (concat "org-mime-pre-"
+ (symbol-name fmt)
+ "-hook"))))
+ (if (> (eval `(length ,hook)) 0)
+ (with-temp-buffer
+ (insert body)
+ (goto-char (point-min))
+ (eval `(run-hooks ',hook))
+ (buffer-string))
+ body))))
+ (fmt (if (symbolp fmt) fmt (intern fmt))))
+ (cond
+ ((eq fmt 'org)
+ (require 'ox-org)
+ (insert (org-export-string-as
+ (org-babel-trim (funcall bhook body 'org)) 'org t)))
+ ((eq fmt 'ascii)
+ (require 'ox-ascii)
+ (insert (org-export-string-as
+ (concat "#+Title:\n" (funcall bhook body 'ascii)) 'ascii t)))
+ ((or (eq fmt 'html) (eq fmt 'html-ascii))
+ (require 'ox-ascii)
+ (require 'ox-org)
+ (let* ((org-link-file-path-type 'absolute)
+ ;; we probably don't want to export a huge style file
+ (org-export-htmlize-output-type 'inline-css)
+ (html-and-images
+ (org-mime-replace-images
+ (org-export-string-as (funcall bhook body 'html) 'html t) file))
+ (images (cdr html-and-images))
+ (html (org-mime-apply-html-hook (car html-and-images))))
+ (insert (org-mime-multipart
+ (org-export-string-as
+ (org-babel-trim
+ (funcall bhook body (if (eq fmt 'html) 'org 'ascii)))
+ (if (eq fmt 'html) 'org 'ascii) t)
+ html)
+ (mapconcat 'identity images "\n")))))))
(defun org-mime-org-buffer-htmlize ()
"Create an email buffer containing the current org-mode file
diff --git a/contrib/lisp/org-mtags.el b/contrib/lisp/org-mtags.el
deleted file mode 100644
index 5342184..0000000
--- a/contrib/lisp/org-mtags.el
+++ b/dev/null
@@ -1,255 +0,0 @@
-;;; org-mtags.el --- Muse-like tags in Org-mode
-
-;; Copyright (C) 2008-2014 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.
-;;
-;; 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. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; 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/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
index da2c96f..91b34d3 100644
--- a/contrib/lisp/org-notify.el
+++ b/contrib/lisp/org-notify.el
@@ -1,6 +1,6 @@
;;; org-notify.el --- Notifications for Org-mode
-;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Peter Münster <pmrb@free.fr>
;; Keywords: notification, todo-list, alarm, reminder, pop-up
@@ -120,7 +120,7 @@ simple timestamp string."
"Create one todo item."
(macrolet ((get (k) `(plist-get list ,k))
(pr (k v) `(setq result (plist-put result ,k ,v))))
- (let* ((list (nth 1 heading)) (notify (or (get :notify) "default"))
+ (let* ((list (nth 1 heading)) (notify (or (get :NOTIFY) "default"))
(deadline (org-notify-convert-deadline (get :deadline)))
(heading (get :raw-value))
result)
@@ -148,7 +148,7 @@ simple timestamp string."
'headline 'org-notify-make-todo)))))
(defun org-notify-maybe-too-late (diff period heading)
- "Print waring message, when notified significantly later than defined by
+ "Print warning message, when notified significantly later than defined by
PERIOD."
(if (> (/ diff period) 1.5)
(message "Warning: notification for \"%s\" behind schedule!" heading))
diff --git a/contrib/lisp/org-notmuch.el b/contrib/lisp/org-notmuch.el
index 2ab5c17..265742e 100644
--- a/contrib/lisp/org-notmuch.el
+++ b/contrib/lisp/org-notmuch.el
@@ -41,6 +41,29 @@
(require 'org)
+;; customisable notmuch open functions
+(defcustom org-notmuch-open-function
+ 'org-notmuch-follow-link
+ "Function used to follow notmuch links.
+
+Should accept a notmuch search string as the sole argument."
+ :group 'org-notmuch
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+(defcustom org-notmuch-search-open-function
+ 'org-notmuch-search-follow-link
+ "Function used to follow notmuch-search links.
+
+Should accept a notmuch search string as the sole argument."
+ :group 'org-notmuch
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'function)
+
+
+
;; Install the link type
(org-add-link-type "notmuch" 'org-notmuch-open)
(add-hook 'org-store-link-functions 'org-notmuch-store-link)
@@ -48,21 +71,22 @@
(defun org-notmuch-store-link ()
"Store a link to a notmuch search or message."
(when (eq major-mode 'notmuch-show-mode)
- (let* ((message-id (notmuch-show-get-prop :id))
+ (let* ((message-id (notmuch-show-get-message-id t))
(subject (notmuch-show-get-subject))
(to (notmuch-show-get-to))
(from (notmuch-show-get-from))
+ (date (org-trim (notmuch-show-get-date)))
desc link)
- (org-store-link-props :type "notmuch" :from from :to to
+ (org-store-link-props :type "notmuch" :from from :to to :date date
:subject subject :message-id message-id)
(setq desc (org-email-link-description))
- (setq link (concat "notmuch:" "id:" message-id))
+ (setq link (concat "notmuch:id:" message-id))
(org-add-link-props :link link :description desc)
link)))
(defun org-notmuch-open (path)
"Follow a notmuch message link specified by PATH."
- (org-notmuch-follow-link path))
+ (funcall org-notmuch-open-function path))
(defun org-notmuch-follow-link (search)
"Follow a notmuch link to SEARCH.
@@ -90,14 +114,21 @@ Can link to more than one message, if so all matching messages are shown."
(defun org-notmuch-search-open (path)
"Follow a notmuch message link specified by PATH."
- (message path)
- (org-notmuch-search-follow-link path))
+ (message "%s" path)
+ (funcall org-notmuch-search-open-function path))
(defun org-notmuch-search-follow-link (search)
"Follow a notmuch link by displaying SEARCH in notmuch-search mode."
(require 'notmuch)
(notmuch-search (org-link-unescape search)))
+
+
+(defun org-notmuch-tree-follow-link (search)
+ "Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
+ (require 'notmuch)
+ (notmuch-tree (org-link-unescape search)))
+
(provide 'org-notmuch)
;;; org-notmuch.el ends here
diff --git a/contrib/lisp/org-passwords.el b/contrib/lisp/org-passwords.el
new file mode 100644
index 0000000..4ebd5a6
--- a/dev/null
+++ b/contrib/lisp/org-passwords.el
@@ -0,0 +1,384 @@
+;;; org-passwords.el --- org derived mode for managing passwords
+
+;; Author: Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu>
+;; Created: December 26, 2012
+;; Keywords: passwords, password
+
+;; 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, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code for managing your passwords with
+;; Org-mode. It is part of org/contrib (see http://orgmode.org/). If
+;; you want to contribute with development, or have a problem, do it
+;; here: https://bitbucket.org/alfaromurillo/org-passwords.el
+
+;; A basic setup needs to indicate a passwords file, and a dictionary
+;; for the random words:
+
+;; (require 'org-passwords)
+;; (setq org-passwords-file "~/documents/passwords.gpg")
+;; (setq org-passwords-random-words-dictionary "/etc/dictionaries-common/words")
+
+;; Basic usage:
+
+;; `M-x org-passwords' opens the passwords file in
+;; `org-passwords-mode'.
+
+;; `M-x org-passwords-generate-password' generates a random string
+;; of numbers, lowercase letters and uppercase letters.
+
+;; `C-u M-x org-passwords-generate-password' generates a random
+;; string of numbers, lowercase letters, uppercase letters and
+;; symbols.
+
+;; `M-x org-passwords-random-words' concatenates random words from
+;; the dictionary defined by `org-passwords-random-words-dictionary'
+;; into a string, each word separated by the string defined in
+;; `org-passwords-random-words-separator'.
+
+;; `C-u M-x org-passwords-random-words' does the same as above, and
+;; also makes substitutions according to
+;; `org-passwords-random-words-substitutions'.
+
+;; It is also useful to set up keybindings for the functions
+;; `org-passwords-copy-username', `org-passwords-copy-password' and
+;; `org-passwords-open-url' in the `org-passwords-mode', to easily
+;; make the passwords and usernames available to the facility for
+;; pasting text of the window system (clipboard on X and MS-Windows,
+;; pasteboard on Nextstep/Mac OS, etc.), without inserting them in the
+;; kill-ring. You can set for example:
+
+;; (eval-after-load "org-passwords"
+;; '(progn
+;; (define-key org-passwords-mode-map
+;; (kbd "C-c u")
+;; 'org-passwords-copy-username)
+;; (define-key org-passwords-mode-map
+;; (kbd "C-c p")
+;; 'org-passwords-copy-password)
+;; (kbd "C-c o")
+;; 'org-passwords-open-url)))
+
+;; Finally, to enter new passwords, you can use `org-capture' and a
+;; minimal template like:
+
+;; ("p" "password" entry (file "~/documents/passwords.gpg")
+;; "* %^{Title}\n %^{URL}p %^{USERNAME}p %^{PASSWORD}p")
+
+;; When asked for the password you can then call either
+;; `org-passwords-generate-password' or `org-passwords-random-words'.
+;; Be sure to enable recursive minibuffers to call those functions
+;; from the minibuffer:
+
+;; (setq enable-recursive-minibuffers t)
+
+;;; Code:
+
+(require 'org)
+
+;;;###autoload
+(define-derived-mode org-passwords-mode org-mode
+ "org-passwords-mode"
+ "Mode for storing passwords"
+ nil)
+
+(defgroup org-passwords nil
+ "Options for password management."
+ :group 'org)
+
+(defcustom org-passwords-password-property "PASSWORD"
+ "Name of the property for password entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-username-property "USERNAME"
+ "Name of the property for user name entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-url-property "URL"
+ "Name of the property for URL entry."
+ :type 'string
+ :group 'org-passwords)
+
+(defcustom org-passwords-file nil
+ "Default file name for the file that contains the passwords."
+ :type 'file
+ :group 'org-passwords)
+
+(defcustom org-passwords-time-opened "1 min"
+ "Time that the password file will remain open. It has to be a
+string, a number followed by units."
+ :type 'str
+ :group 'org-passwords)
+
+(defcustom org-passwords-default-password-size "20"
+ "Default number of characters to use in
+org-passwords-generate-password. It has to be a string."
+ :type 'str
+ :group 'org-passwords)
+
+(defcustom org-passwords-random-words-dictionary nil
+ "Default file name for the file that contains a dictionary of
+words for `org-passwords-random-words'. Each non-empty line in
+the file is considered a word."
+ :type 'file
+ :group 'org-passwords)
+
+(defcustom org-passwords-default-random-words-number "5"
+ "Default number of words to use in org-passwords-random-words.
+It has to be a string."
+ :type 'str
+ :group 'org-passwords)
+
+(defvar org-passwords-random-words-separator "-"
+ "A string to separate words in `org-passwords-random-words'.")
+
+(defvar org-passwords-random-words-substitutions
+ '(("a" . "@")
+ ("e" . "3")
+ ("o" . "0"))
+"A list of substitutions to be made with
+`org-passwords-random-words' if it is called with
+`universal-argument'. Each element is pair of
+strings (SUBSTITUTE-THIS . BY-THIS).")
+
+(defun org-passwords-copy-password ()
+ "Makes the password available to other programs. Puts the
+password of the entry at the location of the cursor in the
+facility for pasting text of the window system (clipboard on X
+and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
+putting it in the kill ring."
+ (interactive)
+ (funcall interprogram-cut-function
+ (org-entry-get (point)
+ org-passwords-password-property)))
+
+(defun org-passwords-copy-username ()
+ "Makes the password available to other programs. Puts the
+username of the entry at the location of the cursor in the
+facility for pasting text of the window system (clipboard on X
+and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without
+putting it in the kill ring."
+ (interactive)
+ (funcall interprogram-cut-function
+ (org-entry-get (point)
+ org-passwords-username-property
+ t)))
+
+(defun org-passwords-open-url ()
+ "Browse the URL associated with the entry at the location of
+the cursor."
+ (interactive)
+ (browse-url (org-entry-get (point)
+ org-passwords-url-property
+ t)))
+
+;;;###autoload
+(defun org-passwords (&optional arg)
+ "Open the password file. Open the password file defined by the
+variable `org-password-file' in read-only mode and kill that
+buffer later according to the value of the variable
+`org-passwords-time-opened'. It also adds the `org-password-file'
+to the auto-mode-alist so that it is opened with its mode being
+`org-passwords-mode'.
+
+With prefix arg ARG, the command does not set up a timer to kill the buffer.
+
+With a double prefix arg \\[universal-argument] \\[universal-argument], open the file for editing.
+"
+ (interactive "P")
+ (if org-passwords-file
+ (progn
+ (add-to-list 'auto-mode-alist
+ (cons
+ (regexp-quote
+ (expand-file-name org-passwords-file))
+ 'org-passwords-mode))
+ (if (equal arg '(4))
+ (find-file-read-only org-passwords-file)
+ (if (equal arg '(16))
+ (find-file org-passwords-file)
+ (progn
+ (find-file-read-only org-passwords-file)
+ (org-passwords-set-up-kill-password-buffer)))))
+ (minibuffer-message "No default password file defined. Set the variable `org-password-file'.")))
+
+(defun org-passwords-set-up-kill-password-buffer ()
+ (run-at-time org-passwords-time-opened
+ nil
+ '(lambda ()
+ (if (get-file-buffer org-passwords-file)
+ (kill-buffer
+ (get-file-buffer org-passwords-file))))))
+
+;;; Password generator
+
+;; Set random number seed from current time and pid. Otherwise
+;; `random' gives the same results every time emacs restarts.
+(random t)
+
+(defun org-passwords-generate-password (arg)
+ "Ask a number of characters and insert a password of that size.
+Password has a random string of numbers, lowercase letters, and
+uppercase letters. Argument ARG include symbols."
+ (interactive "P")
+ (let ((number-of-chars
+ (read-from-minibuffer
+ (concat "Number of characters (default "
+ org-passwords-default-password-size
+ "): ")
+ nil
+ nil
+ t
+ nil
+ org-passwords-default-password-size)))
+ (if arg
+ (insert (org-passwords-generate-password-with-symbols "" number-of-chars))
+ (insert (org-passwords-generate-password-without-symbols "" number-of-chars)))))
+
+(defun org-passwords-generate-password-with-symbols (previous-string nums-of-chars)
+ "Return a string consisting of PREVIOUS-STRING and
+NUMS-OF-CHARS random characters."
+ (if (eq nums-of-chars 0) previous-string
+ (org-passwords-generate-password-with-symbols
+ (concat previous-string
+ (char-to-string
+ ;; symbols, letters, numbers are from 33 to 126
+ (+ (random (- 127 33)) 33)))
+ (1- nums-of-chars))))
+
+(defun org-passwords-generate-password-without-symbols (previous-string nums-of-chars)
+ "Return string consisting of PREVIOUS-STRING and NUMS-OF-CHARS
+random numbers, lowercase letters, and numbers."
+ (if (eq nums-of-chars 0)
+ previous-string
+ ; There are 10 numbers, 26 lowercase letters and 26 uppercase
+ ; letters. 10 + 26 + 26 = 62. The number characters go from 48
+ ; to 57, the uppercase letters from 65 to 90, and the lowercase
+ ; from 97 to 122. The following makes each equally likely.
+ (let ((temp-value (random 62)))
+ (cond ((< temp-value 10)
+ ; If temp-value<10, then add a number
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 48 temp-value)))
+ (1- nums-of-chars)))
+ ((and (> temp-value 9) (< temp-value 36))
+ ; If 9<temp-value<36, then add an uppercase letter
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 65 (- temp-value 10))))
+ (1- nums-of-chars)))
+ ((> temp-value 35)
+ ; If temp-value>35, then add a lowecase letter
+ (org-passwords-generate-password-without-symbols
+ (concat previous-string
+ (char-to-string (+ 97 (- temp-value 36))))
+ (1- nums-of-chars)))))))
+
+;;; Random words
+
+(defun org-passwords-random-words (arg)
+ "Ask for a number of words and inserts a sequence of that many
+random words from the list in the file
+`org-passwords-random-words-dictionary' separated by
+`org-passwords-random-words-separator'. ARG make substitutions in
+the words as defined by
+`org-passwords-random-words-substitutions'."
+ (interactive "P")
+ (if org-passwords-random-words-dictionary
+ (let ((number-of-words
+ (read-from-minibuffer
+ (concat "Number of words (default "
+ org-passwords-default-random-words-number
+ "): ")
+ nil
+ nil
+ t
+ nil
+ org-passwords-default-random-words-number))
+ (list-of-words
+ (with-temp-buffer
+ (insert-file-contents
+ org-passwords-random-words-dictionary)
+ (split-string (buffer-string) "\n" t))))
+ (insert
+ (org-passwords-substitute
+ (org-passwords-random-words-attach-number-of-words
+ (nth (random (length list-of-words))
+ list-of-words)
+ (1- number-of-words)
+ list-of-words
+ org-passwords-random-words-separator)
+ (if arg
+ org-passwords-random-words-substitutions
+ nil))))
+ (minibuffer-message
+ "No default dictionary file defined. Set the variable `org-passwords-random-words-dictionary'.")))
+
+(defun org-passwords-random-words-attach-number-of-words
+ (previous-string number-of-words list-of-words separator)
+ "Returns a string consisting of PREVIOUS-STRING followed by a
+succession of NUMBER-OF-WORDS random words from the list LIST-OF-WORDS
+separated SEPARATOR."
+ (if (eq number-of-words 0)
+ previous-string
+ (org-passwords-random-words-attach-number-of-words
+ (concat previous-string
+ separator
+ (nth (random (length list-of-words)) list-of-words))
+ (1- number-of-words)
+ list-of-words
+ separator)))
+
+(defun org-passwords-substitute (string-to-change list-of-substitutions)
+ "Substitutes each appearence in STRING-TO-CHANGE of the `car' of
+each element of LIST-OF-SUBSTITUTIONS by the `cdr' of that
+element. For example:
+ (org-passwords-substitute \"ab\" \'((\"a\" . \"b\") (\"b\" . \"c\")))
+ => \"bc\"
+Substitutions are made in order of the list, so for example:
+ (org-passwords-substitute \"ab\" \'((\"ab\" . \"c\") (\"b\" . \"d\")))
+ => \"c\""
+ (if list-of-substitutions
+ (concat (org-passwords-concat-this-with-string
+ (cdar list-of-substitutions)
+ (mapcar (lambda (x)
+ (org-passwords-substitute
+ x
+ (cdr list-of-substitutions)))
+ (split-string string-to-change
+ (caar list-of-substitutions)))))
+ string-to-change))
+
+(defun org-passwords-concat-this-with-string (this list-of-strings)
+ "Put the string THIS in between every string in LIST-OF-STRINGS. For example:
+ (org-passwords-concat-this-with-string \"Here\" \'(\"First\" \"Second\" \"Third\"))
+ => \"FirstHereSencondHereThird\""
+ (if (cdr list-of-strings)
+ (concat (car list-of-strings)
+ this
+ (org-passwords-concat-this-with-string
+ this
+ (cdr list-of-strings)))
+ (car list-of-strings)))
+
+(provide 'org-passwords)
+
+;;; org-passwords.el ends here
diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el
index 6d10783..3716020 100644
--- a/contrib/lisp/org-screenshot.el
+++ b/contrib/lisp/org-screenshot.el
@@ -1,7 +1,6 @@
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
;;
-;; Copyright (C) 2009-2014
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
;; Author: Max Mikhanosha <max@openchat.com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -339,8 +338,8 @@ by most recent first"
org-screenshot-rotation-index -1
org-screenshot-file-list
(let ((files (directory-files org-screenshot-image-directory
- t (org-image-file-name-regexp) t)))
- (mapcar 'file-name-nondirectory
+ t (image-file-name-regexp) t)))
+ (mapcar 'file-name-nondirectory
(sort files
(lambda (file1 file2)
(let ((mtime1 (nth 5 (file-attributes file1)))
@@ -365,7 +364,7 @@ other direction"
(link-re
;; taken from `org-display-inline-images'
(concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
+ (substring (image-file-name-regexp) 0 -2)
"\\)\\]"))
newfile oldfile)
(save-excursion
@@ -497,7 +496,7 @@ entered, at which point event will be unread"
(let ((files-in-buffer)
dired-buffer
had-any
- (image-re (org-image-file-name-regexp))
+ (image-re (image-file-name-regexp))
beg end)
(save-excursion
(save-restriction
@@ -505,7 +504,7 @@ entered, at which point event will be unread"
(setq beg (or beg (point-min)) end (or end (point-max)))
(goto-char beg)
(let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
+ (substring (image-file-name-regexp) 0 -2)
"\\)\\]"))
(case-fold-search t)
old file ov img type attrwidth width)
diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el
index 4b4a3ac..c6a64e1 100644
--- a/contrib/lisp/org-sudoku.el
+++ b/contrib/lisp/org-sudoku.el
@@ -1,6 +1,6 @@
;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables
-;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp, games
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
index 255b79e..a692d85 100644
--- a/contrib/lisp/org-toc.el
+++ b/contrib/lisp/org-toc.el
@@ -1,6 +1,6 @@
;;; org-toc.el --- Table of contents for Org-mode buffer
-;; Copyright 2007-2014 Free Software Foundation, Inc.
+;; Copyright 2007-2016 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: Org table of contents
@@ -197,7 +197,7 @@ specified, then make `org-toc-recenter' use this value."
(setq ov (make-overlay beg end)))
;; change the folding status of this headline
(cond ((or (null status) (eq status 'folded))
- (show-children)
+ (org-show-children)
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq status 'children)
@@ -338,7 +338,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(interactive)
(condition-case nil
(outline-forward-same-level 1)
- (error (message "No next headline at this level.")))
+ (error (message "No next headline at this level")))
(if org-toc-info-mode (org-toc-info))
(if org-toc-follow-mode (org-toc-goto)))
@@ -347,7 +347,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(interactive)
(condition-case nil
(outline-backward-same-level 1)
- (error (message "No previous headline at this level.")))
+ (error (message "No previous headline at this level")))
(if org-toc-info-mode (org-toc-info))
(if org-toc-follow-mode (org-toc-goto)))
@@ -441,7 +441,7 @@ current table of contents to it."
(setq ov (make-overlay (match-beginning 0)
(match-end 0))))
(cond ((eq (cdr hlcfg0) 'children)
- (show-children)
+ (org-show-children)
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq (cdr hlcfg0) 'branches)
diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el
index 434060b..50f10cd 100644
--- a/contrib/lisp/org-track.el
+++ b/contrib/lisp/org-track.el
@@ -1,7 +1,6 @@
;;; org-track.el --- Track the most recent Org-mode version available.
;;
-;; Copyright (C) 2009-2014
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg@gnu.org>
;; Eric S Fraga <e.fraga at ucl.ac dot uk>
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index 3631a59..bfc4d6c 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -1,10 +1,10 @@
-;;; org-velocity.el --- something like Notational Velocity for Org.
+;;; org-velocity.el --- something like Notational Velocity for Org. -*- lexical-binding: t -*-
;; Copyright (C) 2010-2014 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
-;; Version: 3.0
+;; Version: 4.1
;; This file is not part of GNU Emacs.
@@ -64,7 +64,7 @@
(require 'button)
(require 'electric)
(require 'dabbrev)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(defgroup org-velocity nil
"Notational Velocity-style interface for Org."
@@ -78,12 +78,6 @@
:group 'org-velocity
:type 'file)
-(defcustom org-velocity-search-is-incremental t
- "Show results incrementally when possible?"
- :group 'org-velocity
- :type 'boolean
- :safe 'booleanp)
-
(defcustom org-velocity-show-previews t
"Show previews of the text of each heading?"
:group 'velocity
@@ -133,9 +127,9 @@ file."
"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)
+ (const :tag "Match whole phrase" phrase)
+ (const :tag "Match any word" any)
+ (const :tag "Match all words" all)
(const :tag "Match a regular expression" regexp))
:safe (lambda (v) (memq v '(phrase any all regexp))))
@@ -152,34 +146,52 @@ See the documentation for `org-capture-templates'."
:group 'org-velocity
:type (or (get 'org-capture-templates 'custom-type) 'list))
+(defcustom org-velocity-heading-level 1
+ "Only match headings at this level or higher.
+0 means to match headings at any level."
+ :group 'org-velocity
+ :type 'integer
+ :safe (lambda (x)
+ (and (integerp x)
+ (>= x 0))))
+
+(defvar crm-separator) ;Ensure dynamic binding.
+
(defsubst org-velocity-grab-preview ()
"Grab preview of a subtree.
The length of the preview is determined by `window-width'.
Replace all contiguous whitespace with single spaces."
- (let ((start (progn
- (forward-line 1)
- (if (looking-at org-property-start-re)
- (re-search-forward org-property-end-re)
- (1- (point))))))
- (mapconcat
- #'identity
- (split-string
- (buffer-substring-no-properties
- start
- (min
- (+ start (window-width))
- (point-max))))
- " ")))
-
-(defstruct org-velocity-heading buffer position name level preview)
+ (let* ((start (progn
+ (forward-line 1)
+ (if (looking-at org-property-start-re)
+ (re-search-forward org-property-end-re)
+ (1- (point)))))
+ (string+props (buffer-substring
+ start
+ (min
+ (+ start (window-width))
+ (point-max)))))
+ ;; We want to preserve the text properties so that, for example,
+ ;; we don't end up with the raw text of links in the preview.
+ (with-temp-buffer
+ (insert string+props)
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward split-string-default-separators
+ (point-max)
+ t)
+ (replace-match " ")))
+ (buffer-string))))
+
+(cl-defstruct org-velocity-heading buffer position name level preview)
(defsubst org-velocity-nearest-heading (position)
"Return last heading at POSITION.
If there is no last heading, return nil."
(save-excursion
(goto-char position)
- (re-search-backward org-velocity-heading-regexp)
+ (re-search-backward (org-velocity-heading-regexp))
(let ((components (org-heading-components)))
(make-org-velocity-heading
:buffer (current-buffer)
@@ -191,15 +203,18 @@ If there is no last heading, return nil."
(defconst org-velocity-index
(eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
+ (nconc (number-sequence 49 57) ;numbers
(number-sequence 97 122) ;lowercase letters
(number-sequence 65 90))) ;uppercase letters
"List of chars for indexing results.")
(defconst org-velocity-match-buffer-name "*Velocity matches*")
-(defconst org-velocity-heading-regexp "^\\* "
- "Regexp to match only top-level headings.")
+(cl-defun org-velocity-heading-regexp (&optional (level org-velocity-heading-level))
+ "Regexp to match headings at LEVEL or deeper."
+ (if (zerop level)
+ "^\\*+ "
+ (format "^\\*\\{1,%d\\} " level)))
(defvar org-velocity-search nil
"Variable to bind to current search.")
@@ -219,15 +234,16 @@ of the base buffer; in the latter, return the file name of
(defun org-velocity-minibuffer-contents ()
"Return the contents of the minibuffer when it is active."
- (if (active-minibuffer-window)
- (with-current-buffer (window-buffer (active-minibuffer-window))
- (minibuffer-contents))))
+ (when (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (minibuffer-contents))))
-(defsubst org-velocity-singlep (object)
- "Return t when OBJECT is a list or sequence of one element."
- (if (consp object)
- (null (cdr object))
- (= (length object) 1)))
+(defun org-velocity-nix-minibuffer ()
+ "Return the contents of the minibuffer and clear it."
+ (when (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (prog1 (minibuffer-contents)
+ (delete-minibuffer-contents)))))
(defun org-velocity-bucket-file ()
"Return the proper file for Org-Velocity to search.
@@ -251,6 +267,7 @@ use it."
(error "No bucket and not an Org file"))))))
(defvar org-velocity-bucket-buffer nil)
+(defvar org-velocity-navigating nil)
(defsubst org-velocity-bucket-buffer ()
(or org-velocity-bucket-buffer
@@ -260,17 +277,19 @@ use it."
"Return the proper buffer for Org-Velocity to display in."
(get-buffer-create org-velocity-match-buffer-name))
+(defsubst org-velocity-match-window ()
+ (get-buffer-window (org-velocity-match-buffer)))
+
(defun org-velocity-beginning-of-headings ()
"Goto the start of the first heading."
(goto-char (point-min))
;; If we are before the first heading we could still be at the
;; first heading.
- (or (looking-at org-velocity-heading-regexp)
- (re-search-forward org-velocity-heading-regexp)))
+ (or (looking-at (org-velocity-heading-regexp))
+ (re-search-forward (org-velocity-heading-regexp))))
(defun org-velocity-make-indirect-buffer (heading)
"Make or switch to an indirect buffer visiting HEADING."
-
(let* ((bucket (org-velocity-heading-buffer heading))
(name (org-velocity-heading-name heading))
(existing (get-buffer name)))
@@ -279,7 +298,8 @@ use it."
existing
(make-indirect-buffer
bucket
- (generate-new-buffer-name (org-velocity-heading-name heading))))))
+ (generate-new-buffer-name (org-velocity-heading-name heading))
+ t))))
(defun org-velocity-capture ()
"Record a note with `org-capture'."
@@ -287,34 +307,56 @@ use it."
org-velocity-capture-templates))
(org-capture nil
;; This is no longer automatically selected.
- (when (org-velocity-singlep org-capture-templates)
+ (when (null (cdr org-capture-templates))
(caar org-capture-templates)))
- (if org-capture-mode (rename-buffer org-velocity-search t))))
+ (when org-capture-mode
+ (rename-buffer org-velocity-search t))))
(defvar org-velocity-saved-winconf nil)
(make-variable-buffer-local 'org-velocity-saved-winconf)
(defun org-velocity-edit-entry (heading)
+ (if org-velocity-navigating
+ (org-velocity-edit-entry/inline heading)
+ (org-velocity-edit-entry/indirect heading)))
+
+(cl-defun org-velocity-goto-entry (heading &key narrow)
+ (goto-char (org-velocity-heading-position heading))
+ (save-excursion
+ (when narrow
+ (org-narrow-to-subtree))
+ (outline-show-all)))
+
+(defun org-velocity-edit-entry/inline (heading)
+ "Edit entry at HEADING in the original buffer."
+ (let ((buffer (org-velocity-heading-buffer heading)))
+ (pop-to-buffer buffer)
+ (with-current-buffer buffer
+ (org-velocity-goto-entry heading))))
+
+(defun org-velocity-format-header-line (control-string &rest args)
+ (set (make-local-variable 'header-line-format)
+ (apply #'format control-string args)))
+
+(defun org-velocity-edit-entry/indirect (heading)
"Edit entry at HEADING in an indirect buffer."
- (let ((winconf (current-window-configuration)))
- (let ((buffer (org-velocity-make-indirect-buffer heading)))
- (with-current-buffer buffer
- (let ((org-inhibit-startup t))
- (org-mode))
- (setq org-velocity-saved-winconf winconf)
- (goto-char (org-velocity-heading-position heading))
- (narrow-to-region (point)
- (save-excursion
- (org-end-of-subtree t)
- (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
- (org-velocity-heading-buffer heading))))))))
+ (let ((winconf (current-window-configuration))
+ (dd default-directory)
+ (buffer (org-velocity-make-indirect-buffer heading))
+ (inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (with-current-buffer buffer
+ (setq default-directory dd) ;Inherit default directory.
+ (setq org-velocity-saved-winconf winconf)
+ (org-velocity-goto-entry heading :narrow t)
+ (goto-char (point-max))
+ (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
+ (pop-to-buffer buffer)
+ (org-velocity-format-header-line
+ "%s Use C-c C-c to finish."
+ (abbreviate-file-name
+ (buffer-file-name
+ (org-velocity-heading-buffer heading))))))
(defun org-velocity-dismiss ()
"Save current entry and close indirect buffer."
@@ -327,14 +369,16 @@ use it."
(defun org-velocity-visit-button (button)
(run-hooks 'mouse-leave-buffer-hook)
- (if org-velocity-use-search-ring
- (add-to-history 'search-ring
- (button-get button 'search)
- search-ring-max))
- (org-velocity-edit-entry (button-get button 'match)))
+ (when org-velocity-use-search-ring
+ (add-to-history 'search-ring
+ (button-get button 'search)
+ search-ring-max))
+ (let ((match (button-get button 'match)))
+ (throw 'org-velocity-done match)))
(define-button-type 'org-velocity-button
- 'action #'org-velocity-visit-button)
+ 'action #'org-velocity-visit-button
+ 'follow-link 'mouse-face)
(defsubst org-velocity-buttonize (heading)
"Insert HEADING as a text button with no hints."
@@ -352,97 +396,163 @@ use it."
(org-velocity-heading-preview heading)
'face 'shadow))))
-(defsubst* org-velocity-present-match (&key hint match)
+(defvar org-velocity-recursive-headings nil)
+(defvar org-velocity-recursive-search nil)
+
+(cl-defun org-velocity-search-with (fun style search
+ &key (headings org-velocity-recursive-headings))
+ (if headings
+ (save-restriction
+ (dolist (heading headings)
+ (widen)
+ (let ((start (org-velocity-heading-position heading)))
+ (goto-char start)
+ (let ((end (save-excursion
+ (org-end-of-subtree)
+ (point))))
+ (narrow-to-region start end)
+ (org-velocity-search-with fun style search
+ :headings nil)))))
+ (cl-ecase style
+ ((phrase any regexp)
+ (cl-block nil
+ (while (re-search-forward search nil t)
+ (let ((match (org-velocity-nearest-heading (point))))
+ (funcall fun match))
+ ;; Skip to the next heading.
+ (unless (re-search-forward (org-velocity-heading-regexp) nil t)
+ (cl-return)))))
+ ((all)
+ (let ((keywords
+ (cl-loop for word in (split-string search)
+ collect (concat "\\<" (regexp-quote word) "\\>"))))
+ (org-map-entries
+ (lambda ()
+ ;; Only search the subtree once.
+ (setq org-map-continue-from
+ (save-excursion
+ (org-end-of-subtree)
+ (point)))
+ (when (cl-loop for word in keywords
+ always (save-excursion
+ (re-search-forward word org-map-continue-from t)))
+ (let ((match (org-velocity-nearest-heading (match-end 0))))
+ (funcall fun match))))))))))
+
+(defun org-velocity-all-results (style search)
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (let (matches)
+ (org-velocity-search-with (lambda (match)
+ (push match matches))
+ style
+ search)
+ (nreverse matches)))))
+
+(defsubst org-velocity-present-match (hint match)
(with-current-buffer (org-velocity-match-buffer)
(when hint (insert "#" hint " "))
(org-velocity-buttonize match)
(org-velocity-insert-preview match)
(newline)))
-(defun org-velocity-generic-search (search &optional hide-hints)
- "Display any entry containing SEARCH."
+(defun org-velocity-present-search (style search hide-hints)
(let ((hints org-velocity-index) matches)
- (block nil
- (while (and hints (re-search-forward search nil t))
- (let ((match (org-velocity-nearest-heading (point))))
- (org-velocity-present-match
- :hint (unless hide-hints (car hints))
- :match match)
- (push match matches))
- (setq hints (cdr hints))
- (unless (re-search-forward org-velocity-heading-regexp nil t)
- (return))))
- (nreverse matches)))
-
-(defun* org-velocity-all-search (search &optional hide-hints max)
- "Display only entries containing every word in SEARCH."
- (let ((keywords (mapcar 'regexp-quote (split-string search)))
- (hints org-velocity-index)
- matches)
- (org-map-entries
- (lambda ()
- ;; Return if we've run out of hints.
- (when (null hints)
- (return-from org-velocity-all-search (nreverse matches)))
- ;; Only search the subtree once.
- (setq org-map-continue-from
- (save-excursion
- (goto-char (line-end-position))
- (if (re-search-forward org-velocity-heading-regexp nil t)
- (line-end-position)
- (point-max))))
- (when (loop for word in keywords
- always (save-excursion
- (re-search-forward
- (concat "\\<" word "\\>")
- org-map-continue-from t)))
- (let ((match (org-velocity-nearest-heading (match-end 0))))
- (org-velocity-present-match
- :hint (unless hide-hints (car hints))
- :match match)
- (push match matches)
- (setq hints (cdr hints))))))
+ (cl-block nil
+ (org-velocity-search-with (lambda (match)
+ (unless hints
+ (cl-return))
+ (let ((hint (if hide-hints
+ nil
+ (car hints))))
+ (org-velocity-present-match hint match))
+ (pop hints)
+ (push match matches))
+ style
+ search))
(nreverse matches)))
-(defun* org-velocity-present (search &key hide-hints)
+(defun org-velocity-restrict-search ()
+ (interactive)
+ (let ((search (org-velocity-nix-minibuffer)))
+ (when (equal search "")
+ (error "No search to restrict to"))
+ (push search org-velocity-recursive-search)
+ (setq org-velocity-recursive-headings
+ (org-velocity-all-results
+ org-velocity-search-method
+ search))
+ ;; TODO We could extend the current search instead of starting
+ ;; over.
+ (org-velocity-update-match-header)
+ (minibuffer-message "Restricting search to %s" search)))
+
+(cl-defun org-velocity-update-match-header (&key (match-buffer (org-velocity-match-buffer))
+ (bucket-buffer (org-velocity-bucket-buffer))
+ (search-method org-velocity-search-method))
+ (let ((navigating? org-velocity-navigating)
+ (recursive? org-velocity-recursive-search))
+ (with-current-buffer match-buffer
+ (org-velocity-format-header-line
+ "%s search in %s%s (%s mode)"
+ (capitalize (symbol-name search-method))
+ (abbreviate-file-name (buffer-file-name bucket-buffer))
+ (if (not recursive?)
+ ""
+ (let ((sep " > "))
+ (concat sep (string-join (reverse recursive?) sep))))
+ (if navigating? "nav" "notes")))))
+
+(cl-defun org-velocity-present (search &key hide-hints)
"Buttonize matches for SEARCH in `org-velocity-match-buffer'.
If HIDE-HINTS is non-nil, display entries without indices. SEARCH
binds `org-velocity-search'.
Return matches."
- (if (and (stringp search) (not (string= "" search)))
- ;; Fold case when the search string is all lowercase.
- (let ((case-fold-search (equal search (downcase search)))
- (truncate-partial-width-windows t))
- (with-current-buffer (org-velocity-match-buffer)
- (erase-buffer)
- ;; Permanent locals.
- (setq cursor-type nil
- truncate-lines t))
- (prog1
- (with-current-buffer (org-velocity-bucket-buffer)
- (let ((inhibit-point-motion-hooks t)
- (inhibit-field-text-motion t))
- (save-excursion
- (org-velocity-beginning-of-headings)
- (case org-velocity-search-method
- (all (org-velocity-all-search search hide-hints))
- (phrase (org-velocity-generic-search
- (concat "\\<" (regexp-quote search))
- hide-hints))
- (any (org-velocity-generic-search
- (concat "\\<"
- (regexp-opt (split-string search)))
- hide-hints))
- (regexp (condition-case lossage
- (org-velocity-generic-search
- search hide-hints)
- (invalid-regexp
- (minibuffer-message "%s" lossage))))))))
- (with-current-buffer (org-velocity-match-buffer)
- (goto-char (point-min)))))
- (with-current-buffer (org-velocity-match-buffer)
- (erase-buffer))))
+ (let ((match-buffer (org-velocity-match-buffer))
+ (bucket-buffer (org-velocity-bucket-buffer))
+ (search-method org-velocity-search-method))
+ (if (and (stringp search) (not (string= "" search)))
+ ;; Fold case when the search string is all lowercase.
+ (let ((case-fold-search (equal search (downcase search)))
+ (truncate-partial-width-windows t))
+ (with-current-buffer match-buffer
+ (erase-buffer)
+ ;; Permanent locals.
+ (setq cursor-type nil
+ truncate-lines t)
+ (org-velocity-update-match-header
+ :match-buffer match-buffer
+ :bucket-buffer bucket-buffer
+ :search-method search-method))
+ (prog1
+ (with-current-buffer bucket-buffer
+ (widen)
+ (let* ((inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t)
+ (anchored? (string-match-p "^\\s-" search))
+ (search
+ (cl-ecase search-method
+ (all search)
+ (phrase
+ (if anchored?
+ (regexp-quote search)
+ ;; Anchor the search to the start of a word.
+ (concat "\\<" (regexp-quote search))))
+ (any
+ (concat "\\<" (regexp-opt (split-string search))))
+ (regexp search))))
+ (save-excursion
+ (org-velocity-beginning-of-headings)
+ (condition-case lossage
+ (org-velocity-present-search search-method search hide-hints)
+ (invalid-regexp
+ (minibuffer-message "%s" lossage))))))
+ (with-current-buffer match-buffer
+ (goto-char (point-min)))))
+ (with-current-buffer match-buffer
+ (erase-buffer)))))
(defun org-velocity-store-link ()
"Function for `org-store-link-functions'."
@@ -452,14 +562,14 @@ Return matches."
(add-hook 'org-store-link-functions 'org-velocity-store-link)
-(defun* org-velocity-create (search &key ask)
+(cl-defun org-velocity-create (search &key ask)
"Create new heading named SEARCH.
If ASK is non-nil, ask first."
(when (or (null ask) (y-or-n-p "No match found, create? "))
(let ((org-velocity-search search)
- (org-default-notes-file (org-velocity-bucket-file))
- ;; save a stored link
- org-store-link-plist)
+ (org-default-notes-file (org-velocity-bucket-file))
+ ;; save a stored link
+ org-store-link-plist)
(org-velocity-capture))
search))
@@ -469,17 +579,18 @@ If ASK is non-nil, ask first."
(unless (or
(not (stringp search))
(string= "" search)) ;exit on empty string
- (case
+ (cl-case
(if (and org-velocity-force-new (eq last-command-event ?\C-j))
:force
- (let ((matches (org-velocity-present search)))
+ (let* ((org-velocity-index (org-velocity-adjust-index))
+ (matches (org-velocity-present search)))
(cond ((null matches) :new)
- ((org-velocity-singlep matches) :follow)
+ ((null (cdr matches)) :follow)
(t :prompt))))
(:prompt (progn
(pop-to-buffer (org-velocity-match-buffer))
(let ((hint (org-velocity-electric-read-hint)))
- (when hint (case hint
+ (when hint (cl-case hint
(:edit (org-velocity-read nil search))
(:force (org-velocity-create search))
(otherwise (org-velocity-activate-button hint)))))))
@@ -493,17 +604,10 @@ If ASK is non-nil, ask first."
(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
- when (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))
+ (forward-line (cl-position char org-velocity-index))
(goto-char
(button-start
(next-button (point))))
@@ -514,8 +618,8 @@ If ASK is non-nil, ask first."
"Complain about an undefined key."
(interactive)
(message "%s"
- (substitute-command-keys
- "\\[org-velocity-electric-new] for new entry,
+ (substitute-command-keys
+ "\\[org-velocity-electric-new] for new entry,
\\[org-velocity-electric-edit] to edit search,
\\[scroll-up] to scroll up,
\\[scroll-down] to scroll down,
@@ -525,20 +629,11 @@ If ASK is non-nil, ask first."
(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)
+ (if (not (> (cl-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)
@@ -552,14 +647,15 @@ If ASK is non-nil, ask first."
(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))
+ (dolist (c org-velocity-index)
+ (define-key map (char-to-string c)
+ 'org-velocity-electric-follow))
(define-key map "0" 'org-velocity-electric-new)
(define-key map "\C-v" 'scroll-up)
(define-key map "\M-v" 'scroll-down)
(define-key map (kbd "RET") '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 [mouse-1] nil)
+ (define-key map [mouse-2] nil)
(define-key map [escape] 'keyboard-quit)
(define-key map "\C-h" 'help-command)
map))
@@ -567,29 +663,19 @@ If ASK is non-nil, ask first."
(defun org-velocity-electric-read-hint ()
"Read index of button electrically."
(with-current-buffer (org-velocity-match-buffer)
+ (when (featurep 'evil)
+ ;; NB Idempotent.
+ (evil-make-overriding-map org-velocity-electric-map))
(use-local-map org-velocity-electric-map)
(catch 'org-velocity-select
(Electric-command-loop 'org-velocity-select "Follow: "))))
(defvar org-velocity-incremental-keymap
(let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-velocity-click-for-incremental)
- (define-key map [mouse-2] 'org-velocity-click-for-incremental)
(define-key map "\C-v" 'scroll-up)
(define-key map "\M-v" 'scroll-down)
map))
-(defun org-velocity-click-for-incremental ()
- "Jump out of search and select hint clicked on."
- (interactive)
- (let ((ev last-command-event))
- (org-velocity-activate-button
- (nth (- (count-lines
- (point-min)
- (posn-point (event-start ev))) 2)
- org-velocity-index)))
- (throw 'click (current-buffer)))
-
(defun org-velocity-displaying-completions-p ()
"Is there a *Completions* buffer showing?"
(get-window-with-predicate
@@ -598,36 +684,38 @@ If ASK is non-nil, ask first."
'completion-list-mode))))
(defun org-velocity-update ()
- "Display results of search without hinting.
-Stop searching once there are more matches than can be displayed."
+ "Display results of search without hinting."
(unless (org-velocity-displaying-completions-p)
(let* ((search (org-velocity-minibuffer-contents))
(matches (org-velocity-present search :hide-hints t)))
(cond ((null matches)
(select-window (active-minibuffer-window))
- (unless (or (null search) (string= "" search))
+ (unless (or (null search) (= (length search) 0))
(minibuffer-message "No match; RET to create")))
- ((and (org-velocity-singlep matches)
+ ((and (null (cdr matches))
org-velocity-exit-on-match)
(throw 'click search))
(t
(with-current-buffer (org-velocity-match-buffer)
(use-local-map org-velocity-incremental-keymap)))))))
-(defvar dabbrev--last-abbrev)
+(defvar dabbrev--last-abbreviation)
(defun org-velocity-dabbrev-completion-list (abbrev)
"Return all dabbrev completions for ABBREV."
;; This is based on `dabbrev-completion'.
(dabbrev--reset-global-variables)
- (setq dabbrev--last-abbrev abbrev)
+ (setq dabbrev--last-abbreviation abbrev)
(dabbrev--find-all-expansions abbrev case-fold-search))
(defvar org-velocity-local-completion-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-completion-map)
(define-key map " " 'self-insert-command)
+ (define-key map "?" 'self-insert-command)
(define-key map [remap minibuffer-complete] 'minibuffer-complete-word)
+ (define-key map [(control ?@)] 'org-velocity-restrict-search)
+ (define-key map [(control ?\s)] 'org-velocity-restrict-search)
map)
"Keymap for completion with `completing-read'.")
@@ -637,53 +725,44 @@ Stop searching once there are more matches than can be displayed."
org-velocity-local-completion-map)
(completion-no-auto-exit t)
(crm-separator " "))
- (funcall
- (case org-velocity-search-method
- (phrase #'completing-read)
- (any #'completing-read-multiple)
- (all #'completing-read-multiple))
- prompt
- (completion-table-dynamic
- 'org-velocity-dabbrev-completion-list))))
-
-(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 (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
- (if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (completing-read prompt
+ (completion-table-dynamic
+ 'org-velocity-dabbrev-completion-list))))
+
+(cl-defun org-velocity-adjust-index
+ (&optional (match-window (org-velocity-match-window)))
+ "Truncate or extend `org-velocity-index' to the lines in
+MATCH-WINDOW."
+ (with-selected-window match-window
+ (let ((lines (window-height))
+ (hints (length org-velocity-index)))
+ (cond ((= lines hints)
+ org-velocity-index)
+ ;; Truncate the index to the size of
+ ;; the buffer to be displayed.
+ ((< lines hints)
+ (cl-subseq org-velocity-index 0 lines))
+ ;; If the window is so tall we run out of indices, at
+ ;; least make the additional results clickable.
+ ((> lines hints)
+ (append org-velocity-index
+ (make-list (- lines hints) nil)))))))
(defun org-velocity-incremental-read (prompt)
- "Read string with PROMPT and display results incrementally."
+ "Read string with PROMPT and display results incrementally.
+Stop searching once there are more matches than can be
+displayed."
(let ((res
(unwind-protect
(let* ((match-window (display-buffer (org-velocity-match-buffer)))
- (org-velocity-index
- ;; Truncate the index to the size of the buffer to be
- ;; displayed.
- (with-selected-window match-window
- (if (> (window-height) (length org-velocity-index))
- ;; (subseq org-velocity-index 0 (window-height))
- (let ((hints (copy-sequence org-velocity-index)))
- (setcdr (nthcdr (window-height) hints) nil)
- hints)
- org-velocity-index))))
+ (org-velocity-index (org-velocity-adjust-index match-window)))
(catch 'click
(add-hook 'post-command-hook 'org-velocity-update)
- (if (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
- (if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (cond ((eq org-velocity-search-method 'regexp)
+ (read-regexp prompt))
+ (org-velocity-use-completion
+ (org-velocity-read-with-completion prompt))
+ (t (read-string prompt)))))
(remove-hook 'post-command-hook 'org-velocity-update))))
(if (bufferp res) (org-pop-to-buffer-same-window res) res)))
@@ -697,24 +776,41 @@ 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."
+file.
+
+Calling with ARG reverses which file – the current file or the
+bucket file – to use. If the bucket file would have been used,
+then the current file is used instead, and vice versa."
(interactive "P")
(let ((org-velocity-always-use-bucket
- (if arg nil org-velocity-always-use-bucket)))
+ (if org-velocity-always-use-bucket
+ (not arg)
+ arg)))
;; complain if inappropriate
- (assert (org-velocity-bucket-file))
- (let ((org-velocity-bucket-buffer
- (find-file-noselect (org-velocity-bucket-file))))
+ (cl-assert (org-velocity-bucket-file))
+ (let* ((starting-buffer (current-buffer))
+ (org-velocity-bucket-buffer
+ (find-file-noselect (org-velocity-bucket-file)))
+ (org-velocity-navigating
+ (eq starting-buffer org-velocity-bucket-buffer))
+ (org-velocity-recursive-headings '())
+ (org-velocity-recursive-search '())
+ (org-velocity-heading-level
+ (if org-velocity-navigating
+ 0
+ org-velocity-heading-level))
+ (dabbrev-search-these-buffers-only
+ (list org-velocity-bucket-buffer)))
(unwind-protect
- (let ((dabbrev-search-these-buffers-only
- (list (org-velocity-bucket-buffer))))
- (org-velocity-engine
- (if org-velocity-search-is-incremental
- (org-velocity-incremental-read "Velocity search: ")
- (org-velocity-read-string "Velocity search: " search))))
- (progn
- (kill-buffer (org-velocity-match-buffer))
- (delete-other-windows))))))
+ (let ((match
+ (catch 'org-velocity-done
+ (org-velocity-engine
+ (or search
+ (org-velocity-incremental-read "Velocity search: ")))
+ nil)))
+ (when (org-velocity-heading-p match)
+ (org-velocity-edit-entry match)))
+ (kill-buffer (org-velocity-match-buffer))))))
(defalias 'org-velocity-read 'org-velocity)
diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el
index 5d30f64..63bfa71 100644
--- a/contrib/lisp/org-vm.el
+++ b/contrib/lisp/org-vm.el
@@ -1,6 +1,6 @@
;;; org-vm.el --- Support for links to VM messages from within Org-mode
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -77,12 +77,6 @@
(message-id (vm-su-message-id message))
(link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
(date (vm-get-header-contents message "Date"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
folder desc link)
(if (vm-imap-folder-p)
(let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
@@ -95,10 +89,7 @@
(setq folder (replace-match "" t t folder)))))
(setq message-id (org-remove-angle-brackets message-id))
(org-store-link-props :type link-type :from from :to to :subject subject
- :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
+ :message-id message-id :date date)
(setq desc (org-email-link-description))
(setq link (concat (concat link-type ":") folder "#" message-id))
(org-add-link-props :link link :description desc)
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
index 7f3e2e3..428cb6c 100644
--- a/contrib/lisp/org-wikinodes.el
+++ b/contrib/lisp/org-wikinodes.el
@@ -1,6 +1,6 @@
;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
-;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2016 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -316,11 +316,10 @@ with working links."
(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'."))))
+ (let ((m (member '(org-activate-plain-links (0 'org-link t))
+ org-font-lock-extra-keywords)))
+ (if m (push '(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)
diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el
index 632c9e3..5fd42d1 100644
--- a/contrib/lisp/org-wl.el
+++ b/contrib/lisp/org-wl.el
@@ -1,6 +1,6 @@
;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
-;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; David Maus <dmaus at ictsoc dot de>
@@ -198,12 +198,6 @@ ENTITY is a message entity."
(xref (org-wl-message-field 'xref wl-message-entity))
(subject (org-wl-message-field 'subject wl-message-entity))
(date (org-wl-message-field 'date wl-message-entity))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
desc link)
;; remove text properties of subject string to avoid possible bug
@@ -243,9 +237,7 @@ ENTITY is a message entity."
(setq desc (org-email-link-description))
(setq link (concat "wl:" folder-name "#" message-id-no-brackets))
(org-add-link-props :link link :description desc)))
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
+ (org-add-link-props :date date)
(or link xref)))))))
(defun org-wl-open-nntp (path)
diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el
index ed8f915..c8a39af 100644
--- a/contrib/lisp/orgtbl-sqlinsert.el
+++ b/contrib/lisp/orgtbl-sqlinsert.el
@@ -1,6 +1,6 @@
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
-;; Copyright (C) 2008-2014 Free Software Foundation
+;; Copyright (C) 2008-2016 Free Software Foundation
;; Author: Jason Riedy <jason@acm.org>
;; Keywords: org, tables, sql
diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el
index d92a1e4..4bf0a4b 100644
--- a/contrib/lisp/ox-bibtex.el
+++ b/contrib/lisp/ox-bibtex.el
@@ -36,7 +36,7 @@
;;
;; The usage is as follows:
;;
-;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
+;; #+BIBLIOGRAPHY: bibfilename stylename optional-options
;;
;; e.g. given foo.bib and using style plain:
;;
@@ -44,6 +44,10 @@
;;
;; "stylename" can also be "nil", in which case no style will be used.
;;
+;; Full filepaths are also possible:
+;;
+;; #+BIBLIOGRAPHY: /home/user/Literature/foo.bib plain option:-d
+;;
;; Optional options are of the form:
;;
;; option:-foobar pass '-foobar' to bibtex2html
@@ -88,9 +92,7 @@
;; Initialization
-(eval-when-compile (require 'cl))
-(let ((jump-fn (car (org-remove-if-not #'fboundp '(ebib obe-goto-citation)))))
- (org-add-link-type "cite" jump-fn))
+(require 'cl-lib)
;;; Internal Functions
@@ -134,7 +136,7 @@ contains a list of strings to be passed as options to
(defun org-bibtex-citation-p (object)
"Non-nil when OBJECT is a citation."
- (case (org-element-type object)
+ (cl-case (org-element-type object)
(link (equal (org-element-property :type object) "cite"))
(latex-fragment
(string-match "\\`\\\\cite{" (org-element-property :value object)))))
@@ -149,6 +151,25 @@ to `org-bibtex-citation-p' predicate."
(and (string-match "\\`\\\\cite{" value)
(substring value (match-end 0) -1)))))
+
+;;; Follow cite: links
+
+(defun org-bibtex-file nil "Org-mode file of bibtex entries.")
+
+(defun org-bibtex-goto-citation (&optional citation)
+ "Visit a citation given its ID."
+ (interactive)
+ (let ((citation (or citation (completing-read "Citation: " (obe-citations)))))
+ (find-file (or org-bibtex-file
+ (error "`org-bibtex-file' has not been configured")))
+ (goto-char (point-min))
+ (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t)
+ (outline-previous-visible-heading 1)
+ t)))
+
+(let ((jump-fn (car (cl-remove-if-not #'fboundp '(ebib org-bibtex-goto-citation)))))
+ (org-add-link-type "cite" jump-fn))
+
;;; Filters
@@ -168,7 +189,17 @@ Return new parse tree."
(when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
(let ((arguments (org-bibtex-get-arguments keyword))
(file (org-bibtex-get-file keyword))
- temp-file)
+ temp-file
+ out-file)
+ ;; Test if filename is given with .bib-extension and strip
+ ;; it off. Filenames with another extensions will be
+ ;; untouched and will finally rise an error in bibtex2html.
+ (setq file (if (equal (file-name-extension file) "bib")
+ (file-name-sans-extension file) file))
+ ;; Outpufiles of bibtex2html will be put into current working directory
+ ;; so define a variable for this.
+ (setq out-file (file-name-sans-extension
+ (file-name-nondirectory file)))
;; limit is set: collect citations throughout the document
;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
;; argument.
@@ -200,7 +231,7 @@ Return new parse tree."
(and temp-file (delete-file temp-file))
;; Open produced HTML file, and collect Bibtex key names
(with-temp-buffer
- (insert-file-contents (concat file ".html"))
+ (insert-file-contents (concat out-file ".html"))
;; Update `org-bibtex-html-entries-alist'.
(goto-char (point-min))
(while (re-search-forward
@@ -212,18 +243,26 @@ Return new parse tree."
(with-temp-buffer
(cond
((org-export-derived-backend-p backend 'html)
- (insert "<div id=\"bibliography\">\n<h2>References</h2>\n")
- (insert-file-contents (concat file ".html"))
+ (insert (format "<div id=\"bibliography\">\n<h2>%s</h2>\n"
+ (org-export-translate "References" :html info)))
+ (insert-file-contents (concat out-file ".html"))
+ (goto-char (point-max))
(insert "\n</div>"))
((org-export-derived-backend-p backend 'ascii)
;; convert HTML references to text w/pandoc
(unless (eq 0 (call-process "pandoc" nil nil nil
- (concat file ".html")
+ (concat out-file ".html")
"-o"
- (concat file ".txt")))
+ (concat out-file ".txt")))
(error "Executing pandoc failed"))
- (insert "References\n==========\n\n")
- (insert-file-contents (concat file ".txt"))
+ (insert
+ (format
+ "%s\n==========\n\n"
+ (org-export-translate
+ "References"
+ (intern (format ":%s" (plist-get info :ascii-charset)))
+ info)))
+ (insert-file-contents (concat out-file ".txt"))
(goto-char (point-min))
(while (re-search-forward
"\\[ \\[bib\\][^ ]+ \\(\\]\\||[\n\r]\\)" nil t)
@@ -243,7 +282,10 @@ Return new parse tree."
(defun org-bibtex-merge-contiguous-citations (tree backend info)
"Merge all contiguous citation in parse tree.
As a side effect, this filter will also turn all \"cite\" links
-into \"\\cite{...}\" LaTeX fragments."
+into \"\\cite{...}\" LaTeX fragments and will extract options.
+Cite options are placed into square brackets at the beginning of
+the \"\\cite\" command for the LaTeX backend, and are removed for
+the HTML and ASCII backends."
(when (org-export-derived-backend-p backend 'html 'latex 'ascii)
(org-element-map tree '(link latex-fragment)
(lambda (object)
@@ -251,7 +293,8 @@ into \"\\cite{...}\" LaTeX fragments."
(let ((new-citation (list 'latex-fragment
(list :value ""
:post-blank (org-element-property
- :post-blank object)))))
+ :post-blank object))))
+ option)
;; Insert NEW-CITATION right before OBJECT.
(org-element-insert-before new-citation object)
;; Remove all subsequent contiguous citations from parse
@@ -266,6 +309,18 @@ into \"\\cite{...}\" LaTeX fragments."
(push (org-bibtex-get-citation-key next) keys))
(org-element-extract-element object)
(setq object next))
+ ;; Find any options in keys, e.g., "(Chapter 2)key" has
+ ;; the option "Chapter 2".
+ (setq keys
+ (mapcar
+ (lambda (k)
+ (if (string-match "^(\\([^)]\+\\))\\(.*\\)" k)
+ (progn
+ (when (org-export-derived-backend-p backend 'latex)
+ (setq option (format "[%s]" (match-string 1 k))))
+ (match-string 2 k))
+ k))
+ keys))
(org-element-extract-element object)
;; Eventually merge all keys within NEW-CITATION. Also
;; ensure NEW-CITATION has the same :post-blank property
@@ -275,7 +330,8 @@ into \"\\cite{...}\" LaTeX fragments."
:post-blank (org-element-property :post-blank object))
(org-element-put-property
new-citation
- :value (format "\\cite{%s}"
+ :value (format "\\cite%s{%s}"
+ (or option "")
(mapconcat 'identity (nreverse keys) ",")))))))))
tree)
diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el
index 9b96d5f..48bc5ea 100644
--- a/contrib/lisp/ox-confluence.el
+++ b/contrib/lisp/ox-confluence.el
@@ -47,6 +47,7 @@
(italic . org-confluence-italic)
(item . org-confluence-item)
(link . org-confluence-link)
+ (paragraph . org-confluence-paragraph)
(property-drawer . org-confluence-property-drawer)
(section . org-confluence-section)
(src-block . org-confluence-src-block)
@@ -57,6 +58,11 @@
(template . org-confluence-template)
(underline . org-confluence-underline)))
+(defcustom org-confluence-lang-alist
+ '(("sh" . "bash"))
+ "Map from org-babel language name to confluence wiki language name"
+ :type '(alist :key-type string :value-type string))
+
;; All the functions we use
(defun org-confluence-bold (bold contents info)
(format "*%s*" contents))
@@ -101,6 +107,12 @@
raw-link))
"]")))
+(defun org-confluence-paragraph (paragraph contents info)
+ "Transcode PARAGRAPH element for Confluence.
+CONTENTS is the paragraph contents. INFO is a plist used as
+a communication channel."
+ contents)
+
(defun org-confluence-property-drawer (property-drawer contents info)
(and (org-string-nw-p contents)
(format "\{\{%s\}\}" contents)))
@@ -111,8 +123,7 @@
(defun org-confluence-src-block (src-block contents info)
;; FIXME: provide a user-controlled variable for theme
(let* ((lang (org-element-property :language src-block))
- (language (if (string= lang "sh") "bash" ;; FIXME: provide a mapping of some sort
- lang))
+ (language (or (cdr (assoc lang org-confluence-lang-alist)) lang))
(content (org-export-format-code-default src-block info)))
(org-confluence--block language "Emacs" content)))
diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el
index ea2d8fe..427c7d7 100644
--- a/contrib/lisp/ox-deck.el
+++ b/contrib/lisp/ox-deck.el
@@ -38,6 +38,12 @@
;; See ox.el and ox-html.el for more details on how this exporter
;; works (it is derived from ox-html.)
+;; TODOs
+;; ------
+;; The title page is formatted using format-spec. This is error prone
+;; when details are missing and may insert empty tags, like <h2></h2>,
+;; for missing values.
+
(require 'ox-html)
(eval-when-compile (require 'cl))
@@ -51,7 +57,9 @@
(if a (org-deck-export-to-html t s v b)
(org-open-file (org-deck-export-to-html nil s v b)))))))
:options-alist
- '((:html-link-home "HTML_LINK_HOME" nil nil)
+ '((:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:html-link-home "HTML_LINK_HOME" nil nil)
(:html-link-up "HTML_LINK_UP" nil nil)
(:deck-postamble "DECK_POSTAMBLE" nil org-deck-postamble newline)
(:deck-preamble "DECK_PREAMBLE" nil org-deck-preamble newline)
@@ -259,6 +267,7 @@ Defaults to styles for the title page."
(defcustom org-deck-title-slide-template
"<h1>%t</h1>
+<h2>%s</h2>
<h2>%a</h2>
<h2>%e</h2>
<h2>%d</h2>"
@@ -373,12 +382,14 @@ the \"slide\" class will be added to the to the list element,
which will make the list into a \"build\"."
(let ((text (org-html-item item contents info)))
(if (org-export-get-node-property :STEP item t)
- (replace-regexp-in-string "^<li>" "<li class='slide'>" text)
+ (progn
+ (replace-regexp-in-string "^<li>" "<li class='slide'>" text)
+ (replace-regexp-in-string "^<li class='checkbox'>" "<li class='checkbox slide'>" text))
text)))
(defun org-deck-link (link desc info)
(replace-regexp-in-string "href=\"#" "href=\"#outline-container-"
- (org-html-link link desc info)))
+ (org-export-with-backend 'html link desc info)))
(defun org-deck-template (contents info)
"Return complete document string after HTML conversion.
diff --git a/contrib/lisp/ox-extra.el b/contrib/lisp/ox-extra.el
new file mode 100644
index 0000000..85dae47
--- a/dev/null
+++ b/contrib/lisp/ox-extra.el
@@ -0,0 +1,190 @@
+;;; ox-extra.el --- Convenience functions for org export
+
+;; Copyright (C) 2014 Aaron Ecay
+
+;; Author: Aaron Ecay <aaronecay@gmail.com>
+
+;; 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:
+
+;; This file contains some convenience functions for org export, which
+;; are not part of org's core. Call `ox-extras-activate' passing a
+;; list of symbols naming extras, which will be installed globally in
+;; your org session.
+;;
+;; For example, you could include the following in your .emacs file:
+;;
+;; (require 'ox-extra)
+;; (ox-extras-activate '(latex-header-blocks ignore-headlines))
+;;
+
+;; Currently available extras:
+
+;; - `latex-header-blocks' -- allow the use of latex blocks, the
+;; contents of which which will be interpreted as #+latex_header lines
+;; for export. These blocks should be tagged with #+header: :header
+;; yes. For example:
+;; #+header: :header yes
+;; #+begin_export latex
+;; ...
+;; #+end_export
+
+;; - `ignore-headlines' -- allow a headline (but not its children) to
+;; be ignored. Any headline tagged with the 'ignore' tag will be
+;; ignored (i.e. will not be included in the export), but any child
+;; headlines will not be ignored (unless explicitly tagged to be
+;; ignored), and will instead have their levels promoted by one.
+
+;; TODO:
+;; - add a function to org-mode-hook that looks for a ox-extras local
+;; variable and activates the specified extras buffer-locally
+;; - allow specification of desired extras to be activated via
+;; customize
+
+;;; Code:
+
+(require 'ox)
+(eval-when-compile (require 'cl))
+
+(defun org-latex-header-blocks-filter (backend)
+ (when (org-export-derived-backend-p backend 'latex)
+ (let ((positions
+ (org-element-map (org-element-parse-buffer 'greater-element nil) 'export-block
+ (lambda (block)
+ (when (and (string= (org-element-property :type block) "LATEX")
+ (string= (org-export-read-attribute
+ :header block :header)
+ "yes"))
+ (list (org-element-property :begin block)
+ (org-element-property :end block)
+ (org-element-property :post-affiliated block)))))))
+ (mapc (lambda (pos)
+ (goto-char (nth 2 pos))
+ (destructuring-bind
+ (beg end &rest ignore)
+ (org-edit-src-find-region-and-lang)
+ (let ((contents-lines (split-string
+ (buffer-substring-no-properties beg end)
+ "\n")))
+ (delete-region (nth 0 pos) (nth 1 pos))
+ (dolist (line contents-lines)
+ (insert (concat "#+latex_header: "
+ (replace-regexp-in-string "\\` *" "" line)
+ "\n"))))))
+ ;; go in reverse, to avoid wrecking the numeric positions
+ ;; earlier in the file
+ (reverse positions)))))
+
+
+;; During export headlines which have the "ignore" tag are removed
+;; from the parse tree. Their contents are retained (leading to a
+;; possibly invalid parse tree, which nevertheless appears to function
+;; correctly with most export backends) all children headlines are
+;; retained and are promoted to the level of the ignored parent
+;; headline.
+;;
+;; This makes it possible to add structure to the original Org-mode
+;; document which does not effect the exported version, such as in the
+;; following examples.
+;;
+;; Wrapping an abstract in a headline
+;;
+;; * Abstract :ignore:
+;; #+LaTeX: \begin{abstract}
+;; #+HTML: <div id="abstract">
+;;
+;; ...
+;;
+;; #+HTML: </div>
+;; #+LaTeX: \end{abstract}
+;;
+;; Placing References under a headline (using ox-bibtex in contrib)
+;;
+;; * References :ignore:
+;; #+BIBLIOGRAPHY: dissertation plain
+;;
+;; Inserting an appendix for LaTeX using the appendix package.
+;;
+;; * Appendix :ignore:
+;; #+LaTeX: \begin{appendices}
+;; ** Reproduction
+;; ...
+;; ** Definitions
+;; #+LaTeX: \end{appendices}
+;;
+(defun org-export-ignore-headlines (data backend info)
+ "Remove headlines tagged \"ignore\" retaining contents and promoting children.
+Each headline tagged \"ignore\" will be removed retaining its
+contents and promoting any children headlines to the level of the
+parent."
+ (org-element-map data 'headline
+ (lambda (object)
+ (when (member "ignore" (org-element-property :tags object))
+ (let ((level-top (org-element-property :level object))
+ level-diff)
+ (mapc (lambda (el)
+ ;; recursively promote all nested headlines
+ (org-element-map el 'headline
+ (lambda (el)
+ (when (equal 'headline (org-element-type el))
+ (unless level-diff
+ (setq level-diff (- (org-element-property :level el)
+ level-top)))
+ (org-element-put-property el
+ :level (- (org-element-property :level el)
+ level-diff)))))
+ ;; insert back into parse tree
+ (org-element-insert-before el object))
+ (org-element-contents object)))
+ (org-element-extract-element object)))
+ info nil)
+ data)
+
+(defconst ox-extras
+ '((latex-header-blocks org-latex-header-blocks-filter org-export-before-parsing-hook)
+ (ignore-headlines org-export-ignore-headlines org-export-filter-parse-tree-functions))
+ "A list of org export extras that can be enabled.
+
+Should be a list of items of the form (NAME FN HOOK). NAME is a
+symbol, which can be passed to `ox-extras-activate'. FN is a
+function which will be added to HOOK.")
+
+(defun ox-extras-activate (extras)
+ "Activate certain org export extras.
+
+EXTRAS should be a list of extras (defined in `ox-extras') which
+should be activated."
+ (dolist (extra extras)
+ (let* ((lst (assq extra ox-extras))
+ (fn (nth 1 lst))
+ (hook (nth 2 lst)))
+ (when (and fn hook)
+ (add-hook hook fn)))))
+
+(defun ox-extras-deactivate (extras)
+ "Deactivate certain org export extras.
+
+This function is the opposite of `ox-extras-activate'. EXTRAS
+should be a list of extras (defined in `ox-extras') which should
+be activated."
+ (dolist (extra extras)
+ (let* ((lst (assq extra ox-extras))
+ (fn (nth 1 lst))
+ (hook (nth 2 lst)))
+ (when (and fn hook)
+ (remove-hook hook fn)))))
+
+(provide 'ox-extra)
+;;; ox-extra.el ends here
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
index 39fb1cc..85323a2 100644
--- a/contrib/lisp/ox-freemind.el
+++ b/contrib/lisp/ox-freemind.el
@@ -1,6 +1,6 @@
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2016 Free Software Foundation, Inc.
;; Author: Jambunathan K <kjambunathan at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -43,7 +43,6 @@
;;; Define Back-End
(org-export-define-derived-backend 'freemind 'html
- :export-block "FREEMIND"
:menu-entry
'(?f "Export to Freemind Mindmap"
((?f "As Freemind Mindmap file" org-freemind-export-to-freemind)
@@ -312,7 +311,7 @@ will result in following node:
(org-element-property :title element))
(org-data
(plist-get info :title))
- (t (error "Shouldn't come here."))))
+ (t (error "Shouldn't come here"))))
(element-contents (org-element-contents element))
(section (assq 'section element-contents))
(section-contents
diff --git a/contrib/lisp/ox-gfm.el b/contrib/lisp/ox-gfm.el
new file mode 100644
index 0000000..f519a35
--- a/dev/null
+++ b/contrib/lisp/ox-gfm.el
@@ -0,0 +1,192 @@
+;;; ox-gfm.el --- Github Flavored Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2014 Lars Tveito
+
+;; Author: Lars Tveito
+;; Keywords: org, wp, markdown, github
+
+;; 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:
+
+;; This library implements a Markdown back-end (github flavor) for Org
+;; exporter, based on the `md' back-end.
+
+;;; Code:
+
+(require 'ox-md)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-gfm nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Github Flavored Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defcustom org-gfm-lang '(("emacs-lisp" . "lisp") ("elisp" . "lisp"))
+ "Alist of languages that are not recognized by Github, to
+ languages that are. Emacs lisp is a good example of this, where
+ we can use lisp as a nice replacement."
+ :group 'org-export-gfm)
+
+
+
+;;; Define Back-End
+
+(org-export-define-derived-backend 'gfm 'md
+ :filters-alist '((:filter-parse-tree . org-md-separate-elements))
+ :menu-entry
+ '(?g "Export to Github Flavored Markdown"
+ ((?G "To temporary buffer"
+ (lambda (a s v b) (org-gfm-export-as-markdown a s v)))
+ (?g "To file" (lambda (a s v b) (org-gfm-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (if a (org-gfm-export-to-markdown t s v)
+ (org-open-file (org-gfm-export-to-markdown nil s v)))))))
+ :translate-alist '((inner-template . org-gfm-inner-template)
+ (strike-through . org-gfm-strike-through)
+ (src-block . org-gfm-src-block)))
+
+
+
+;;; Transcode Functions
+
+;;;; Src Block
+
+(defun org-gfm-src-block (src-block contents info)
+ "Transcode SRC-BLOCK element into Github Flavored Markdown
+format. CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (let* ((lang (org-element-property :language src-block))
+ (lang (or (assoc-default lang org-gfm-lang) lang))
+ (code (org-export-format-code-default src-block info))
+ (prefix (concat "```" lang "\n"))
+ (suffix "```"))
+ (concat prefix code suffix)))
+
+
+;;;; Strike-Through
+
+(defun org-html-strike-through (strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Markdown (GFM).
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (format "~~%s~~" contents))
+
+;;;; Table of contents
+
+(defun org-gfm-format-toc (headline)
+ "Return an appropriate table of contents entry for HEADLINE. INFO is a
+plist used as a communication channel."
+ (let* ((title (org-export-data
+ (org-export-get-alt-title headline info) info))
+ (level (1- (org-element-property :level headline)))
+ (indent (concat (make-string (* level 2) ? )))
+ (ref-str (replace-regexp-in-string " " "-" (downcase title))))
+ (concat indent "- [" title "]" "(#" ref-str ")")))
+
+
+;;;; Template
+
+(defun org-gfm-inner-template (contents info)
+ "Return body of document after converting it to Markdown syntax.
+CONTENTS is the transcoded contents string. INFO is a plist
+holding export options."
+ (let* ((depth (plist-get info :with-toc))
+ (headlines (and depth (org-export-collect-headlines info depth)))
+ (toc-string (or (mapconcat 'org-gfm-format-toc headlines "\n") ""))
+ (toc-tail (if headlines "\n\n" "")))
+ (concat toc-string toc-tail contents)))
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-gfm-export-as-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org GFM Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (org-export-to-buffer 'gfm "*Org GFM Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
+
+
+;;;###autoload
+(defun org-gfm-convert-region-to-md ()
+ "Assume the current region has org-mode syntax, and convert it
+to Github Flavored Markdown. This can be used in any buffer.
+For example, you can write an itemized list in org-mode syntax in
+a Markdown buffer and use this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'gfm))
+
+
+;;;###autoload
+(defun org-gfm-export-to-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Github Flavored Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (org-export-to-file 'gfm outfile async subtreep visible-only)))
+
+(provide 'ox-gfm)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-gfm.el ends here
diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
index f1f0dd1..b49edce 100644
--- a/contrib/lisp/ox-groff.el
+++ b/contrib/lisp/ox-groff.el
@@ -1,6 +1,6 @@
;;; ox-groff.el --- Groff Back-End for Org Export Engine
-;; Copyright (C) 2011-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2016 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
@@ -50,8 +50,6 @@
(center-block . org-groff-center-block)
(clock . org-groff-clock)
(code . org-groff-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-groff-drawer)
(dynamic-block . org-groff-dynamic-block)
(entity . org-groff-entity)
@@ -94,7 +92,6 @@
(underline . org-groff-underline)
(verbatim . org-groff-verbatim)
(verse-block . org-groff-verse-block))
- :export-block "GROFF"
:menu-entry
'(?g "Export to GROFF"
((?g "As GROFF file" org-groff-export-to-groff)
@@ -563,7 +560,8 @@ See `org-groff-text-markup-alist' for details."
(t (format ".AF \"%s\" \n" (or org-groff-organization "")))))
;; 2. Title
- (let ((subtitle1 (plist-get attr :subtitle1))
+ (let ((title (if (plist-get info :with-title) title ""))
+ (subtitle1 (plist-get attr :subtitle1))
(subtitle2 (plist-get attr :subtitle2)))
(cond
@@ -1253,15 +1251,10 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((string= type "file")
- (when (string-match "\\(.+\\)::.+" raw-path)
- (setq raw-path (match-string 1 raw-path)))
- (if (file-name-absolute-p raw-path)
- (concat "file://" (expand-file-name raw-path))
- (concat "file://" raw-path)))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc 'groff))
;; Image file.
(imagep (org-groff-link--inline-image link info))
;; import groff files
@@ -1272,10 +1265,9 @@ INFO is a plist holding contextual information. See
;; description.
((string= type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
- (when destination
+ (if (not destination) desc
(format "\\fI [%s] \\fP"
- (org-export-solidify-link-text
- (org-element-property :value destination))))))
+ (org-export-get-reference destination info)))))
;; Links pointing to a headline: find destination and build
;; appropriate referencing command.
@@ -1307,9 +1299,9 @@ INFO is a plist holding contextual information. See
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
- (let ((path (org-export-solidify-link-text path)))
- (if (not desc) (format "\\fI%s\\fP" path)
- (format "%s \\fBat\\fP \\fI%s\\fP" desc path)))))))
+ (let ((ref (org-export-get-reference destination info)))
+ (if (not desc) (format "\\fI%s\\fP" ref)
+ (format "%s \\fBat\\fP \\fI%s\\fP" desc ref)))))))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
@@ -1463,10 +1455,7 @@ holding contextual information."
"Transcode a RADIO-TARGET object from Org to Groff.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (format "%s - %s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
- text))
+ (format "%s - %s" (org-export-get-reference radio-target info) text))
;;; Section
@@ -1482,7 +1471,7 @@ holding contextual information."
"Transcode a SPECIAL-BLOCK element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block))))
+ (let ((type (org-element-property :type special-block)))
(org-groff--wrap-label
special-block
(format "%s\n" contents))))
@@ -1796,8 +1785,7 @@ a communication channel."
"Transcode a TARGET object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\fI%s\\fP"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\fI%s\\fP" (org-export-get-reference target info)))
;;; Timestamp
@@ -1914,6 +1902,7 @@ Return PDF file name or an error if it couldn't be produced."
(let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
(full-name (file-truename file))
(out-dir (file-name-directory file))
+ (time (current-time))
;; Properly set working directory for compilation.
(default-directory (if (file-name-absolute-p file)
(file-name-directory full-name)
@@ -1948,7 +1937,12 @@ Return PDF file name or an error if it couldn't be produced."
(let ((pdffile (concat out-dir base-name ".pdf")))
;; Check for process failure. Provide collected errors if
;; possible.
- (if (not (file-exists-p pdffile))
+ (if (or (not (file-exists-p pdffile))
+ ;; Only compare times up to whole seconds as some
+ ;; filesystems (e.g. HFS+) do not retain any finer
+ ;; granularity.
+ (time-less-p (cl-subseq (nth 5 (file-attributes pdffile)) 0 2)
+ (cl-subseq time 0 2)))
(error (concat (format "PDF file %s wasn't produced" pdffile)
(when errors (concat ": " errors))))
;; Else remove log files, when specified, and signal end of
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index aa75ab8..801ab7d 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -1,6 +1,6 @@
;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
-;; Copyright (C) 2007-2012, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
@@ -41,13 +41,14 @@
;; - PHONE_NUMBER: see `org-koma-letter-phone-number',
;; - SIGNATURE: see `org-koma-letter-signature',
;; - PLACE: see `org-koma-letter-place',
+;; - LOCATION: see `org-koma-letter-location',
;; - TO_ADDRESS: If unspecified this is set to "\mbox{}".
;;
-;; TO_ADDRESS and FROM_ADDRESS can also be specified using heading
-;; with the special tags specified in
-;; `org-koma-letter-special-tags-in-letter', namely "to" and "from".
-;; LaTeX line breaks are not necessary if using these headings. If
-;; both a headline and a keyword specify a to or from address the
+;; TO_ADDRESS, FROM_ADDRESS, LOCATION, CLOSING, and SIGNATURE can also
+;; be specified using "special headings" with the special tags
+;; specified in `org-koma-letter-special-tags-in-letter'. LaTeX line
+;; breaks are not necessary for TO_ADDRESS, FROM_ADDRESS and LOCATION.
+;; If both a headline and a keyword specify a to or from address the
;; value is determined in accordance with
;; `org-koma-letter-prefer-special-headings'.
;;
@@ -58,6 +59,7 @@
;; - phone (see `org-koma-letter-use-phone')
;; - email (see `org-koma-letter-use-email')
;; - place (see `org-koma-letter-use-place')
+;; - location (see `org-koma-letter-use-location')
;; - subject, a list of format options
;; (see `org-koma-letter-subject-format')
;; - after-closing-order, a list of the ordering of headings with
@@ -80,9 +82,9 @@
;; `org-koma-letter-special-tags-after-closing' used as macros and the
;; content of the headline is the argument.
;;
-;; Headlines with two and from may also be used rather than the
-;; keyword approach described above. If both a keyword and a headline
-;; with information is present precedence is determined by
+;; Headlines with to and from may also be used rather than the keyword
+;; approach described above. If both a keyword and a headline with
+;; information is present precedence is determined by
;; `org-koma-letter-prefer-special-headings'.
;;
;; You need an appropriate association in `org-latex-classes' in order
@@ -188,29 +190,65 @@ This option can also be set with the PLACE keyword."
:group 'org-export-koma-letter
:type 'string)
+(defcustom org-koma-letter-location ""
+ "Sender's extension field, as a string.
+
+This option can also be set with the LOCATION keyword.
+Moreover, when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or there is no LOCATION keyword or the LOCATION keyword is
+ empty;
+ (2) the letter contains a headline with the special
+ tag \"location\";
+then the location will be set as the content of the location
+special heading.
+
+The location field is typically printed right of the address
+field (See Figure 4.9. in the English manual of 2015-10-03)."
+ :group 'org-export-koma-letter
+ :type 'string)
+
(defcustom org-koma-letter-opening ""
"Letter's opening, as a string.
This option can also be set with the OPENING keyword. Moreover,
when:
- (1) this value is the empty string;
- (2) there's no OPENING keyword or it is empty;
- (3) `org-koma-letter-headline-is-opening-maybe' is non-nil;
- (4) the letter contains a headline without a special
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or the CLOSING keyword is empty
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline without a special
tag (e.g. \"to\" or \"ps\");
-then the opening will be implicitly set as the headline title."
+then the opening will be implicitly set as the untagged headline title."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-closing ""
"Letter's closing, as a string.
-This option can also be set with the CLOSING keyword."
+This option can also be set with the CLOSING keyword. Moreover,
+when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or the CLOSING keyword is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag \"closing\";
+then the opening will be set as the title of the closing special
+heading title."
:group 'org-export-koma-letter
:type 'string)
(defcustom org-koma-letter-signature ""
"Signature, as a string.
-This option can also be set with the SIGNATURE keyword."
+This option can also be set with the SIGNATURE keyword.
+Moreover, when:
+ (1) Either `org-koma-letter-prefer-special-headings' is non-nil
+ or there is no CLOSING keyword or the CLOSING keyword is empty;
+ (2) `org-koma-letter-headline-is-opening-maybe' is non-nil;
+ (3) the letter contains a headline with the special
+ tag \"closing\";
+then the signature will be set as the content of the
+closing special heading.
+
+Note if the content is empty the signature will not be set."
:group 'org-export-koma-letter
:type 'string)
@@ -222,7 +260,9 @@ This option can also be set with the OPTIONS keyword, e.g.:
:type 'boolean)
(defcustom org-koma-letter-subject-format t
- "Use the title as the subject of the letter.
+ "Non-nil means include the subject.
+
+Support formatting options.
When t, insert a subject using default options. When nil, do not
insert a subject at all. It can also be a list of symbols among
@@ -336,16 +376,6 @@ This option can also be set with the OPTIONS keyword, e.g.:
:group 'org-export-koma-letter
:type 'boolean)
-(defcustom org-koma-letter-use-title t
- "Non-nil means use a title in the letter if present.
-This option can also be set with the OPTIONS keyword,
-e.g. \"title:nil\".
-
-See also `org-koma-letter-prefer-subject' for the handling of
-title versus subject."
- :group 'org-export-koma-letter
- :type 'boolean)
-
(defcustom org-koma-letter-default-class "default-koma-letter"
"Default class for `org-koma-letter'.
The value must be a member of `org-latex-classes'."
@@ -353,34 +383,37 @@ The value must be a member of `org-latex-classes'."
:type 'string)
(defcustom org-koma-letter-headline-is-opening-maybe t
- "Non-nil means a headline may be used as an opening.
-A headline is only used if #+OPENING is not set. See also
-`org-koma-letter-opening'."
+ "Non-nil means a headline may be used as an opening and closing.
+See also `org-koma-letter-opening' and
+`org-koma-letter-closing'."
:group 'org-export-koma-letter
:type 'boolean)
(defcustom org-koma-letter-prefer-subject nil
- "Non-nil means title should be interpret as subject if subject is missing.
+ "Non-nil means title should be interpreted as subject if subject is missing.
This option can also be set with the OPTIONS keyword,
-e.g. \"title-subject:t\".
-
-This may be useful for older documents where the SUBJECT keyword
-was not present."
+e.g. \"title-subject:t\"."
:group 'org-export-koma-letter
:type 'boolean)
-(defconst org-koma-letter-special-tags-in-letter '(to from)
+(defconst org-koma-letter-special-tags-in-letter '(to from closing location)
"Header tags related to the letter itself.")
-(defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
- "Header tags to be inserted after closing.")
+(defconst org-koma-letter-special-tags-after-closing '(after_closing ps encl cc)
+ "Header tags to be inserted in the letter after closing.")
+
+(defconst org-koma-letter-special-tags-as-macro '(ps encl cc)
+ "Header tags to be inserted as macros")
(defconst org-koma-letter-special-tags-after-letter '(after_letter)
- "Header tags to be inserted after closing.")
+ "Header tags to be inserted after the letter.")
(defvar org-koma-letter-special-contents nil
"Holds special content temporarily.")
+(make-obsolete-variable 'org-koma-letter-use-title
+ 'org-export-with-title
+ "25.1" 'set)
;;; Define Back-End
@@ -389,51 +422,53 @@ was not present."
:options-alist
'((:latex-class "LATEX_CLASS" nil org-koma-letter-default-class t)
(:lco "LCO" nil org-koma-letter-class-option-file)
- (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) t)
- (:from-address "FROM_ADDRESS" nil nil newline)
+ (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) parse)
+ (:author-changed-in-buffer-p "AUTHOR" nil nil t)
+ (:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
(:to-address "TO_ADDRESS" nil nil newline)
(:place "PLACE" nil org-koma-letter-place)
- (:subject "SUBJECT" nil nil space)
- (:opening "OPENING" nil org-koma-letter-opening)
- (:closing "CLOSING" nil org-koma-letter-closing)
+ (:location "LOCATION" nil org-koma-letter-location)
+ (:subject "SUBJECT" nil nil parse)
+ (:opening "OPENING" nil org-koma-letter-opening parse)
+ (:closing "CLOSING" nil org-koma-letter-closing parse)
(:signature "SIGNATURE" nil org-koma-letter-signature newline)
- (:special-headings nil "special-headings"
- org-koma-letter-prefer-special-headings)
- (:special-tags nil nil (append
- org-koma-letter-special-tags-in-letter
- org-koma-letter-special-tags-after-closing
- org-koma-letter-special-tags-after-letter))
- (:with-after-closing nil "after-closing-order"
- org-koma-letter-special-tags-after-closing)
- (:with-after-letter nil "after-letter-order"
- org-koma-letter-special-tags-after-letter)
+ (:special-headings nil "special-headings" org-koma-letter-prefer-special-headings)
+ (:special-tags-as-macro nil nil org-koma-letter-special-tags-as-macro)
+ (:special-tags-in-letter nil nil org-koma-letter-special-tags-in-letter)
+ (:special-tags-after-closing nil "after-closing-order"
+ org-koma-letter-special-tags-after-closing)
+ (:special-tags-after-letter nil "after-letter-order"
+ org-koma-letter-special-tags-after-letter)
(:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
(:with-email nil "email" org-koma-letter-use-email)
(:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
(:with-phone nil "phone" org-koma-letter-use-phone)
(:with-place nil "place" org-koma-letter-use-place)
(:with-subject nil "subject" org-koma-letter-subject-format)
- (:with-title nil "title" org-koma-letter-use-title)
(:with-title-as-subject nil "title-subject" org-koma-letter-prefer-subject)
+ (:with-headline-opening nil nil org-koma-letter-headline-is-opening-maybe)
;; Special properties non-nil when a setting happened in buffer.
;; They are used to prioritize in-buffer settings over "lco"
;; files. See `org-koma-letter-template'.
(:inbuffer-author "AUTHOR" nil 'koma-letter:empty)
+ (:inbuffer-from "FROM" nil 'koma-letter:empty)
(:inbuffer-email "EMAIL" nil 'koma-letter:empty)
(:inbuffer-phone-number "PHONE_NUMBER" nil 'koma-letter:empty)
(:inbuffer-place "PLACE" nil 'koma-letter:empty)
+ (:inbuffer-location "LOCATION" nil 'koma-letter:empty)
(:inbuffer-signature "SIGNATURE" nil 'koma-letter:empty)
(:inbuffer-with-backaddress nil "backaddress" 'koma-letter:empty)
(:inbuffer-with-email nil "email" 'koma-letter:empty)
(:inbuffer-with-foldmarks nil "foldmarks" 'koma-letter:empty)
- (:inbuffer-with-phone nil "phone" 'koma-letter:empty))
+ (:inbuffer-with-phone nil "phone" 'koma-letter:empty)
+ (:inbuffer-with-place nil "place" 'koma-letter:empty))
:translate-alist '((export-block . org-koma-letter-export-block)
- (export-snippet . org-koma-letter-export-snippet)
- (headline . org-koma-letter-headline)
- (keyword . org-koma-letter-keyword)
- (template . org-koma-letter-template))
+ (export-snippet . org-koma-letter-export-snippet)
+ (headline . org-koma-letter-headline)
+ (keyword . org-koma-letter-keyword)
+ (template . org-koma-letter-template))
:menu-entry
'(?k "Export with KOMA Scrlttr2"
((?L "As LaTeX buffer" org-koma-letter-export-as-latex)
@@ -458,8 +493,9 @@ was not present."
(defun org-koma-letter--get-tagged-contents (key)
"Get contents from a headline tagged with KEY.
The contents is stored in `org-koma-letter-special-contents'."
- (cdr (assoc (org-koma-letter--get-value key)
- org-koma-letter-special-contents)))
+ (let ((value (cdr (assoc-string (org-koma-letter--get-value key)
+ org-koma-letter-special-contents))))
+ (when value (org-string-nw-p (org-trim value)))))
(defun org-koma-letter--get-value (value)
"Turn value into a string whenever possible.
@@ -471,47 +507,31 @@ return a string or nil."
((symbolp value) (symbol-name value))
(t value))))
-(defun org-koma-letter--special-contents-as-macro
- (keywords &optional keep-newlines no-tag)
- "Process KEYWORDS members of `org-koma-letter-special-contents'.
+(defun org-koma-letter--special-contents-inline (keywords info)
+ "Process KEYWORDS members of `org-koma-letter-special-contents'.
KEYWORDS is a list of symbols. Return them as a string to be
formatted.
The function is used for inserting content of special headings
-such as PS.
-
-If KEEP-NEWLINES is t newlines will not be removed. If NO-TAG is
-t the content in `org-koma-letter-special-contents' will not be
-wrapped in a macro named whatever the members of KEYWORDS are
-called."
+such as the one tagged with PS.
+"
(mapconcat
- #'(lambda (keyword)
- (let* ((name (org-koma-letter--get-value keyword))
- (value (org-koma-letter--get-tagged-contents name)))
- (when value
- (if no-tag (if keep-newlines value (org-trim value))
- (format "\\%s{%s}\n"
- name
- (if keep-newlines value (org-trim value)))))))
+ (lambda (keyword)
+ (let* ((name (org-koma-letter--get-value keyword))
+ (value (org-koma-letter--get-tagged-contents name))
+ (macrop (memq keyword (plist-get info :special-tags-as-macro))))
+ (cond ((not value) nil)
+ (macrop (format "\\%s{%s}\n" name value))
+ (t value))))
keywords
- ""))
-
-(defun org-koma-letter--determine-to-and-from (info key)
- "Given INFO determine KEY for the letter.
-KEY should be `to' or `from'.
-
-`ox-koma-letter' allows two ways to specify TO and FROM. If both
-are present return the preferred one as determined by
-`org-koma-letter-prefer-special-headings'."
- (let ((option (plist-get info (if (eq key 'to) :to-address :from-address)))
- (headline (org-koma-letter--get-tagged-contents key)))
- (replace-regexp-in-string
- "\n" "\\\\\\\\\n"
- (org-trim
- (or (if (plist-get info :special-headings) (or headline option)
- (or option headline))
- ;; Fallback values.
- (if (eq key 'to) "\\mbox{}" org-koma-letter-from-address))))))
+ "\n"))
+
+
+(defun org-koma-letter--add-latex-newlines (string)
+ "Replace regular newlines with LaTeX newlines (i.e. `\\\\')"
+ (let ((str (org-trim string)))
+ (when (org-string-nw-p str)
+ (replace-regexp-in-string "\n" "\\\\\\\\\n" str))))
@@ -559,19 +579,44 @@ Note that if a headline is tagged with a tag from
`org-koma-letter-special-tags' it will not be exported, but
stored in `org-koma-letter-special-contents' and included at the
appropriate place."
- (unless (let ((tag (car (org-export-get-tags headline info))))
- (and tag
- (member-ignore-case
- tag (mapcar #'symbol-name (plist-get info :special-tags)))
- ;; Store association for later use and bail out.
- (push (cons tag contents) org-koma-letter-special-contents)))
- ;; Opening is not defined yet: use headline's title.
- (when (and org-koma-letter-headline-is-opening-maybe
- (not (org-string-nw-p (plist-get info :opening))))
- (plist-put info :opening
- (org-export-data (org-element-property :title headline) info)))
- ;; In any case, insert contents in letter's body.
- contents))
+ (let ((special-tag (org-koma-letter--special-tag headline info)))
+ (if (not special-tag)
+ contents
+ (push (cons special-tag contents) org-koma-letter-special-contents)
+ "")))
+
+(defun org-koma-letter--special-tag (headline info)
+ "Non-nil if HEADLINE is a special headline.
+INFO is a plist holding contextual information. Return first
+special tag headline."
+ (let ((special-tags (append
+ (plist-get info :special-tags-in-letter)
+ (plist-get info :special-tags-after-closing)
+ (plist-get info :special-tags-after-letter))))
+ (catch 'exit
+ (dolist (tag (org-export-get-tags headline info))
+ (let ((tag (assoc-string tag special-tags)))
+ (when tag (throw 'exit tag)))))))
+
+(defun org-koma-letter--keyword-or-headline (plist-key pred info)
+ "Return the correct version of opening or closing.
+PLIST-KEY should be a key in info, typically :opening
+or :closing. PRED is a predicate run on headline to determine
+which title to use which takes two arguments, a headline element
+and an info plist. INFO is a plist holding contextual
+information. Return the preferred candidate for the exported of
+PLIST-KEY."
+ (let* ((keyword-candidate (plist-get info plist-key))
+ (headline-candidate (when (and (plist-get info :with-headline-opening)
+ (or (plist-get info :special-headings)
+ (not keyword-candidate)))
+ (org-element-map (plist-get info :parse-tree)
+ 'headline
+ (lambda (head)
+ (when (funcall pred head info)
+ (org-element-property :title head)))
+ info t))))
+ (org-export-data (or headline-candidate keyword-candidate "") info)))
;;;; Template
@@ -583,28 +628,10 @@ holding export options."
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; LaTeX compiler
+ (org-latex--insert-compiler info)
;; Document class and packages.
- (let* ((class (plist-get info :latex-class))
- (class-options (plist-get info :latex-class-options))
- (header (nth 1 (assoc class org-latex-classes)))
- (document-class-string
- (and (stringp header)
- (if (not class-options) header
- (replace-regexp-in-string
- "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
- class-options header t nil 1)))))
- (if (not document-class-string)
- (user-error "Unknown LaTeX class `%s'" class)
- (org-latex-guess-babel-language
- (org-latex-guess-inputenc
- (org-element-normalize-string
- (org-splice-latex-header
- document-class-string
- org-latex-default-packages-alist ; Defined in org.el.
- org-latex-packages-alist nil ; Defined in org.el.
- (concat (org-element-normalize-string (plist-get info :latex-header))
- (plist-get info :latex-header-extra)))))
- info)))
+ (org-latex--make-preamble info)
;; Settings. They can come from three locations, in increasing
;; order of precedence: global variables, LCO files and in-buffer
;; settings. Thus, we first insert settings coming from global
@@ -615,49 +642,68 @@ holding export options."
(org-split-string (or (plist-get info :lco) "") " ")
"")
(org-koma-letter--build-settings 'buffer info)
- ;; From address.
- (let ((from-address (org-koma-letter--determine-to-and-from info 'from)))
- (when (org-string-nw-p from-address)
- (format "\\setkomavar{fromaddress}{%s}\n" from-address)))
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
- ;; Document start
- "\\begin{document}\n\n"
- ;; Subject and title
- (let ((with-subject (plist-get info :with-subject)))
- (when with-subject
- (concat
- (unless (eq with-subject t)
- (format "\\KOMAoption{subject}{%s}\n"
- (if (symbolp with-subject) with-subject
- (mapconcat #'symbol-name with-subject ","))))
- (let* ((title-as-subject (plist-get info :with-title-as-subject))
- (subject* (org-string-nw-p
- (org-export-data (plist-get info :subject) info)))
- (title* (and (plist-get info :with-title)
- (org-string-nw-p
- (org-export-data (plist-get info :title) info))))
- (subject (if title-as-subject (or subject* title*) subject*))
- (title (if title-as-subject (and subject* title*) title*)))
- (concat
- (and subject (format "\\setkomavar{subject}{%s}\n" subject))
- (and title (format "\\setkomavar{title}{%s}\n" title))
- (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n"))))))
+ ;; Hyperref, document start, and subject and title.
+ (let* ((with-subject (plist-get info :with-subject))
+ (with-title (plist-get info :with-title))
+ (title-as-subject (and with-subject
+ (plist-get info :with-title-as-subject)))
+ (subject* (org-string-nw-p
+ (org-export-data (plist-get info :subject) info)))
+ (title* (and with-title
+ (org-string-nw-p
+ (org-export-data (plist-get info :title) info))))
+ (subject (cond ((not with-subject) nil)
+ (title-as-subject (or subject* title*))
+ (t subject*)))
+ (title (cond ((not with-title) nil)
+ (title-as-subject (and subject* title*))
+ (t title*)))
+ (hyperref-template (plist-get info :latex-hyperref-template))
+ (spec (append (list (cons ?t (or title subject "")))
+ (org-latex--format-spec info))))
+ (concat
+ (when (and with-subject (not (eq with-subject t)))
+ (format "\\KOMAoption{subject}{%s}\n"
+ (if (symbolp with-subject) with-subject
+ (mapconcat #'symbol-name with-subject ","))))
+ ;; Hyperref.
+ (format-spec hyperref-template spec)
+ ;; Document start.
+ "\\begin{document}\n\n"
+ ;; Subject and title.
+ (when subject (format "\\setkomavar{subject}{%s}\n" subject))
+ (when title (format "\\setkomavar{title}{%s}\n" title))
+ (when (or (org-string-nw-p title) (org-string-nw-p subject)) "\n")))
;; Letter start.
- (format "\\begin{letter}{%%\n%s}\n\n"
- (org-koma-letter--determine-to-and-from info 'to))
+ (let ((keyword-val (plist-get info :to-address))
+ (heading-val (org-koma-letter--get-tagged-contents 'to)))
+ (format "\\begin{letter}{%%\n%s}\n\n"
+ (org-koma-letter--add-latex-newlines
+ (or (if (plist-get info :special-headings)
+ (or heading-val keyword-val)
+ (or keyword-val heading-val))
+ "\\\\mbox{}"))))
;; Opening.
- (format "\\opening{%s}\n\n" (plist-get info :opening))
+ (format "\\opening{%s}\n\n"
+ (org-koma-letter--keyword-or-headline
+ :opening (lambda (h i) (not (org-koma-letter--special-tag h i)))
+ info))
;; Letter body.
contents
;; Closing.
- (format "\n\\closing{%s}\n" (plist-get info :closing))
- (org-koma-letter--special-contents-as-macro
- (plist-get info :with-after-closing))
+ (format "\\closing{%s}\n"
+ (org-koma-letter--keyword-or-headline
+ :closing (lambda (h i) (eq (org-koma-letter--special-tag h i)
+ 'closing))
+ info))
+ (org-koma-letter--special-contents-inline
+ (plist-get info :special-tags-after-closing) info)
;; Letter end.
"\n\\end{letter}\n"
- (org-koma-letter--special-contents-as-macro
- (plist-get info :with-after-letter) t t)
+ (org-koma-letter--special-contents-inline
+ (plist-get info :special-tags-after-letter) info)
;; Document end.
"\n\\end{document}"))
@@ -665,14 +711,24 @@ holding export options."
"Build settings string according to type.
SCOPE is either `global' or `buffer'. INFO is a plist used as
a communication channel."
- (let ((check-scope
- (function
- ;; Non-nil value when SETTING was defined in SCOPE.
- (lambda (setting)
- (let ((property (intern (format ":inbuffer-%s" setting))))
- (if (eq scope 'global)
- (eq (plist-get info property) 'koma-letter:empty)
- (not (eq (plist-get info property) 'koma-letter:empty))))))))
+ (let* ((check-scope
+ (function
+ ;; Non-nil value when SETTING was defined in SCOPE.
+ (lambda (setting)
+ (let ((property (intern (format ":inbuffer-%s" setting))))
+ (if (eq scope 'global)
+ (eq (plist-get info property) 'koma-letter:empty)
+ (not (eq (plist-get info property) 'koma-letter:empty)))))))
+ (heading-or-key-value
+ (function
+ (lambda (heading key &optional scoped)
+ (let* ((heading-val
+ (org-koma-letter--get-tagged-contents heading))
+ (key-val (org-string-nw-p (plist-get info key)))
+ (scopedp (funcall check-scope (or scoped heading))))
+ (and (or (and key-val scopedp) heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (if scopedp key-val heading-val)))))))
(concat
;; Name.
(let ((author (plist-get info :author)))
@@ -680,6 +736,11 @@ a communication channel."
(funcall check-scope 'author)
(format "\\setkomavar{fromname}{%s}\n"
(org-export-data author info))))
+ ;; From.
+ (let ((from (funcall heading-or-key-value 'from :from-address)))
+ (and from
+ (format "\\setkomavar{fromaddress}{%s}\n"
+ (org-koma-letter--add-latex-newlines from))))
;; Email.
(let ((email (plist-get info :email)))
(and email
@@ -697,18 +758,36 @@ a communication channel."
(format "\\KOMAoption{fromphone}{%s}\n"
(if (plist-get info :with-phone) "true" "false")))
;; Signature.
- (let ((signature (plist-get info :signature)))
- (and (org-string-nw-p signature)
- (funcall check-scope 'signature)
- (format "\\setkomavar{signature}{%s}\n" signature)))
+ (let* ((heading-val
+ (and (plist-get info :with-headline-opening)
+ (org-string-nw-p
+ (org-trim
+ (org-export-data
+ (org-koma-letter--get-tagged-contents 'closing)
+ info)))))
+ (signature (org-string-nw-p (plist-get info :signature)))
+ (signature-scope (funcall check-scope 'signature)))
+ (and (or (and signature signature-scope)
+ heading-val)
+ (not (and (eq scope 'global) heading-val))
+ (format "\\setkomavar{signature}{%s}\n"
+ (if signature-scope signature heading-val))))
;; Back address.
(and (funcall check-scope 'with-backaddress)
(format "\\KOMAoption{backaddress}{%s}\n"
(if (plist-get info :with-backaddress) "true" "false")))
;; Place.
- (and (funcall check-scope 'place)
- (format "\\setkomavar{place}{%s}\n"
- (if (plist-get info :with-place) (plist-get info :place) "")))
+ (let ((with-place-set (funcall check-scope 'with-place))
+ (place-set (funcall check-scope 'place)))
+ (and (or (and with-place-set place-set)
+ (and (eq scope 'buffer) (or with-place-set place-set)))
+ (format "\\setkomavar{place}{%s}\n"
+ (if (plist-get info :with-place) (plist-get info :place)
+ ""))))
+ ;; Location.
+ (let ((location (funcall heading-or-key-value 'location :location)))
+ (and location
+ (format "\\setkomavar{location}{%s}\n" location)))
;; Folding marks.
(and (funcall check-scope 'with-foldmarks)
(let ((foldmarks (plist-get info :with-foldmarks)))
diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el
index c69a37b..39fce30 100644
--- a/contrib/lisp/ox-rss.el
+++ b/contrib/lisp/ox-rss.el
@@ -1,6 +1,6 @@
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
-;; Copyright (C) 2013, 2014 Bastien Guerry
+;; Copyright (C) 2013-2015 Bastien Guerry
;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: org, wp, blog, feed, rss
@@ -31,10 +31,11 @@
;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss'
;; (as a ".xml" file).
;;
-;; This backend understands two new option keywords:
+;; This backend understands three new option keywords:
;;
;; #+RSS_EXTENSION: xml
;; #+RSS_IMAGE_URL: http://myblog.org/mypicture.jpg
+;; #+RSS_FEED_URL: http://myblog.org/feeds/blog.xml
;;
;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
;;
@@ -42,6 +43,9 @@
;; PUBDATE property. If `org-rss-use-entry-url-as-guid', it will also add
;; an ID property, later used as the guid for the feed's item.
;;
+;; The top-level headline is used as the title of each RSS item unless
+;; an RSS_TITLE property is set on the headline.
+;;
;; You typically want to use it within a publishing project like this:
;;
;; (add-to-list
@@ -119,9 +123,12 @@ When nil, Org will create ids using `org-icalendar-create-uid'."
(if a (org-rss-export-to-rss t s v)
(org-open-file (org-rss-export-to-rss nil s v)))))))
:options-alist
- '((:with-toc nil nil nil) ;; Never include HTML's toc
+ '((:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:with-toc nil nil nil) ;; Never include HTML's toc
(:rss-extension "RSS_EXTENSION" nil org-rss-extension)
(:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url)
+ (:rss-feed-url "RSS_FEED_URL" nil nil t)
(:rss-categories nil nil org-rss-categories))
:filters-alist '((:filter-final-output . org-rss-final-function))
:translate-alist '((headline . org-rss-headline)
@@ -204,11 +211,10 @@ publishing directory.
Return output file name."
(let ((bf (get-file-buffer filename)))
(if bf
- (progn
- (org-icalendar-create-uid filename 'warn-user)
(with-current-buffer bf
+ (org-icalendar-create-uid filename 'warn-user)
(org-rss-add-pubdate-property)
- (write-file filename)))
+ (write-file filename))
(find-file filename)
(org-icalendar-create-uid filename 'warn-user)
(org-rss-add-pubdate-property)
@@ -233,24 +239,21 @@ communication channel."
(hl-home (file-name-as-directory (plist-get info :html-link-home)))
(hl-pdir (plist-get info :publishing-directory))
(hl-perm (org-element-property :RSS_PERMALINK headline))
- (anchor
- (org-export-solidify-link-text
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" (mapconcat 'number-to-string hl-number "-")))))
+ (anchor (org-export-get-reference headline info))
(category (org-rss-plain-text
(or (org-element-property :CATEGORY headline) "") info))
- (pubdate
- (let ((system-time-locale "C"))
- (format-time-string
- "%a, %d %b %Y %H:%M:%S %z"
- (org-time-string-to-time
- (or (org-element-property :PUBDATE headline)
- (error "Missing PUBDATE property"))))))
- (title (replace-regexp-in-string
- org-bracket-link-regexp
- (lambda (m) (or (match-string 3 m)
- (match-string 1 m)))
- (org-element-property :raw-value headline)))
+ (pubdate0 (org-element-property :PUBDATE headline))
+ (pubdate (let ((system-time-locale "C"))
+ (if pubdate0
+ (format-time-string
+ "%a, %d %b %Y %H:%M:%S %z"
+ (org-time-string-to-time pubdate0)))))
+ (title (or (org-element-property :RSS_TITLE headline)
+ (replace-regexp-in-string
+ org-bracket-link-regexp
+ (lambda (m) (or (match-string 3 m)
+ (match-string 1 m)))
+ (org-element-property :raw-value headline))))
(publink
(or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
(concat
@@ -265,18 +268,19 @@ communication channel."
(org-element-property :CUSTOM_ID headline)
publink)
info))))
- (format
- (concat
- "<item>\n"
- "<title>%s</title>\n"
- "<link>%s</link>\n"
- "<author>%s</author>\n"
- "<guid isPermaLink=\"false\">%s</guid>\n"
- "<pubDate>%s</pubDate>\n"
- (org-rss-build-categories headline info) "\n"
- "<description><![CDATA[%s]]></description>\n"
- "</item>\n")
- title publink author guid pubdate contents))))
+ (if (not pubdate0) "" ;; Skip entries with no PUBDATE prop
+ (format
+ (concat
+ "<item>\n"
+ "<title>%s</title>\n"
+ "<link>%s</link>\n"
+ "<author>%s</author>\n"
+ "<guid isPermaLink=\"false\">%s</guid>\n"
+ "<pubDate>%s</pubDate>\n"
+ (org-rss-build-categories headline info) "\n"
+ "<description><![CDATA[%s]]></description>\n"
+ "</item>\n")
+ title publink author guid pubdate contents)))))
(defun org-rss-build-categories (headline info)
"Build categories for the RSS item."
@@ -329,10 +333,11 @@ as a communication channel."
(image (url-encode-url (plist-get info :rss-image-url)))
(ifile (plist-get info :input-file))
(publink
- (concat (file-name-as-directory blogurl)
- (file-name-nondirectory
- (file-name-sans-extension ifile))
- "." rssext)))
+ (or (plist-get info :rss-feed-url)
+ (concat (file-name-as-directory blogurl)
+ (file-name-nondirectory
+ (file-name-sans-extension ifile))
+ "." rssext))))
(format
"\n<title>%s</title>
<atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" />
diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el
index 26e83a3..503bfd0 100644
--- a/contrib/lisp/ox-s5.el
+++ b/contrib/lisp/ox-s5.el
@@ -48,7 +48,14 @@
;; in an Org mode buffer. See ox.el and ox-html.el for more details
;; on how this exporter works.
+;; TODOs
+;; ------
+;; The title page is formatted using format-spec. This is error prone
+;; when details are missing and may insert empty tags, like <h2></h2>,
+;; for missing values.
+
(require 'ox-html)
+(eval-when-compile (require 'cl))
(org-export-define-derived-backend 's5 'html
:menu-entry
@@ -173,6 +180,7 @@ or an empty string."
(defcustom org-s5-title-slide-template
"<h1>%t</h1>
+<h2>%s</h2>
<h2>%a</h2>
<h3>%e</h3>
<h4>%d</h4>"
@@ -201,7 +209,7 @@ INFO is a plist used as a communication channel."
(concat section-number
(org-export-data
(org-export-get-alt-title headline info) info)
- (and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags))))
+ (and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags info))))
(defun org-s5-toc (depth info)
(let* ((headlines (org-export-collect-headlines info depth))
diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el
index 761e180..664a0ea 100644
--- a/contrib/lisp/ox-taskjuggler.el
+++ b/contrib/lisp/ox-taskjuggler.el
@@ -1,6 +1,6 @@
;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine
;;
-;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2016 Free Software Foundation, Inc.
;;
;; Emacs Lisp Archive Entry
;; Filename: ox-taskjuggler.el
@@ -64,7 +64,7 @@
;; should end up with something similar to the example by Peter Jones
;; in:
;;
-;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
+;; http://www.devalot.com/assets/articles/2008/07/project-planning/project-planning.org.
;;
;; Now mark the top node of your tasks with a tag named
;; "taskjuggler_project" (or whatever you customized
@@ -307,7 +307,23 @@ but before any resource and task declarations."
startbuffer startcredit statusnote chargeset charge)
"Valid attributes for Taskjuggler tasks.
If one of these appears as a property for a headline, it will be
-exported with the corresponding task."
+exported with the corresponding task.
+
+Note that multiline properties are not supported, so attributes
+like note or journalentry have to be on a single line."
+ :group 'org-export-taskjuggler)
+
+(defcustom org-taskjuggler-valid-project-attributes
+ '(timingresolution timezone alertlevels currency currencyformat
+ dailyworkinghours extend includejournalentry now numberformat
+ outputdir scenario shorttimeformat timeformat trackingscenario
+ weekstartsmonday weekstartssunday workinghours
+ yearlyworkingdays)
+ "Valid attributes for Taskjuggler project.
+If one of these appears as a property for a headline that is a
+project definition, it will be exported with the corresponding
+task. Attribute 'timingresolution' should be the first in the
+list."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-valid-resource-attributes
@@ -483,9 +499,9 @@ Return new string. If S is the empty string, return it."
(if (equal "" s) s (replace-regexp-in-string "^ *\\S-" " \\&" s)))
(defun org-taskjuggler--build-attributes (item attributes)
- "Return attributes string for task, resource or report ITEM.
-ITEM is a headline. ATTRIBUTES is a list of symbols
-representing valid attributes for ITEM."
+ "Return attributes string for ITEM.
+ITEM is a project, task, resource or report headline. ATTRIBUTES
+is a list of symbols representing valid attributes for ITEM."
(mapconcat
(lambda (attribute)
(let ((value (org-element-property
@@ -587,7 +603,7 @@ doesn't include leading \"depends\"."
(let ((id (org-element-property :TASK_ID dep)))
(and id
(string-match (concat id " +\\({.*?}\\)") dep-str)
- (org-match-string-no-properties 1))))
+ (org-match-string-no-properties 1 dep-str))))
path)
;; Compute number of exclamation marks by looking for the
;; common ancestor between TASK and DEP.
@@ -715,18 +731,27 @@ PROJECT is a headline. INFO is a plist used as a communication
channel. If no start date is specified, start today. If no end
date is specified, end `org-taskjuggler-default-project-duration'
days from now."
- (format "project %s \"%s\" \"%s\" %s %s {\n}\n"
- (org-taskjuggler-get-id project info)
- (org-taskjuggler-get-name project)
- ;; Version is obtained through :TASKJUGGLER_VERSION:
- ;; property or `org-taskjuggler-default-project-version'.
- (or (org-element-property :VERSION project)
- org-taskjuggler-default-project-version)
- (or (org-taskjuggler-get-start project)
- (format-time-string "%Y-%m-%d"))
- (let ((end (org-taskjuggler-get-end project)))
- (or (and end (format "- %s" end))
- (format "+%sd" org-taskjuggler-default-project-duration)))))
+ (concat
+ ;; Opening project.
+ (format "project %s \"%s\" \"%s\" %s %s {\n"
+ (org-taskjuggler-get-id project info)
+ (org-taskjuggler-get-name project)
+ ;; Version is obtained through :TASKJUGGLER_VERSION:
+ ;; property or `org-taskjuggler-default-project-version'.
+ (or (org-element-property :VERSION project)
+ org-taskjuggler-default-project-version)
+ (or (org-taskjuggler-get-start project)
+ (format-time-string "%Y-%m-%d"))
+ (let ((end (org-taskjuggler-get-end project)))
+ (or (and end (format "- %s" end))
+ (format "+%sd"
+ org-taskjuggler-default-project-duration))))
+ ;; Add attributes.
+ (org-taskjuggler--indent-string
+ (org-taskjuggler--build-attributes
+ project org-taskjuggler-valid-project-attributes))
+ ;; Closing project.
+ "}\n"))
(defun org-taskjuggler--build-resource (resource info)
"Return a resource declaration.
diff --git a/contrib/scripts/org-docco.org b/contrib/scripts/org-docco.org
index d846aa3..cb75359 100644
--- a/contrib/scripts/org-docco.org
+++ b/contrib/scripts/org-docco.org
@@ -5,7 +5,7 @@
The =docco= tool (see http://jashkenas.github.com/docco/) generates
HTML from JavaScript source code providing an attractive side-by-side
-display of source code and comments. This file (see [[http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=contrib/scripts/org-docco.org;hb=HEAD][org-docco.org]])
+display of source code and comments. This file (see [[http://orgmode.org/cgit.cgi/org-mode.git/plain/contrib/scripts/org-docco.org][org-docco.org]])
generates the same type of output from Org-mode documents with code
embedded in code blocks.
diff --git a/doc/docstyle.texi b/doc/docstyle.texi
new file mode 100644
index 0000000..dfd1430
--- a/dev/null
+++ b/doc/docstyle.texi
@@ -0,0 +1,10 @@
+@c Emacs documentation style settings
+@documentencoding UTF-8
+@c These two require Texinfo 5.0 or later, so we use the older
+@c equivalent @set variables supported in 4.11 and hence
+@ignore
+@codequotebacktick on
+@codequoteundirected on
+@end ignore
+@set txicodequoteundirected
+@set txicodequotebacktick
diff --git a/doc/htmlxref.cnf b/doc/htmlxref.cnf
new file mode 100644
index 0000000..13aa8ce
--- a/dev/null
+++ b/doc/htmlxref.cnf
@@ -0,0 +1,2 @@
+calc mono http://www.gnu.org/software/emacs/manual/html_mono/calc.html
+calc node http://www.gnu.org/software/emacs/manual/html_node/calc/
diff --git a/doc/org.texi b/doc/org.texi
index 9205abb..17b01c2 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -1,7 +1,8 @@
-\input texinfo
+\input texinfo @c -*- coding: utf-8 -*-
@c %**start of header
-@setfilename ../../info/org
+@setfilename ../../info/org.info
@settitle The Org Manual
+@include docstyle.texi
@include org-version.inc
@@ -11,7 +12,6 @@
@set MAINTAINER Carsten Dominik
@set MAINTAINEREMAIL @email{carsten at orgmode dot org}
@set MAINTAINERCONTACT @uref{mailto:carsten at orgmode dot org,contact the maintainer}
-@documentencoding UTF-8
@c %**end of header
@finalout
@@ -259,13 +259,13 @@
@copying
This manual is for Org version @value{VERSION}.
-Copyright @copyright{} 2004--2014 Free Software Foundation, Inc.
+Copyright @copyright{} 2004--2016 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU Manual,''
+Invariant Sections, with the Front-Cover Texts being ``A GNU Manual,''
and with the Back-Cover Texts as in (a) below. A copy of the license
is included in the section entitled ``GNU Free Documentation License.''
@@ -432,7 +432,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
Properties and columns
@@ -462,8 +462,7 @@ Dates and times
* Deadlines and scheduling:: Planning your work
* Clocking work time:: Tracking how long you spend on a task
* Effort estimates:: Planning work effort in advance
-* Relative timer:: Notes with a running timer
-* Countdown timer:: Starting a countdown timer for a task
+* Timers:: Notes with a running timer
Creating timestamps
@@ -581,10 +580,11 @@ Exporting
* HTML export:: Exporting to HTML
* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
* Markdown export:: Exporting to Markdown
-* OpenDocument text export:: Exporting to OpenDocument Text
+* OpenDocument Text export:: Exporting to OpenDocument Text
* Org export:: Exporting to Org
+* Texinfo export:: Exporting to Texinfo
* iCalendar export:: Exporting to iCalendar
-* Other built-in back-ends:: Exporting to @code{Texinfo} or a man page
+* Other built-in back-ends:: Exporting to a man page
* Export in foreign buffers:: Author tables and lists in Org syntax
* Advanced configuration:: Fine-tuning the export output
@@ -636,6 +636,16 @@ Advanced topics in ODT export
* Customizing tables in ODT export:: How to define and use Table templates
* Validating OpenDocument XML:: How to debug corrupt OpenDocument files
+Texinfo export
+
+* Texinfo export commands:: How to invoke Texinfo export
+* Document preamble:: File header, title and copyright page
+* Headings and sectioning structure:: Building document structure
+* Indices:: Creating indices
+* Quoting Texinfo code:: Incorporating literal Texinfo code
+* Texinfo specific attributes:: Controlling Texinfo output
+* An example::
+
Publishing
* Configuration:: Defining projects
@@ -691,7 +701,7 @@ Using header arguments
Specific header arguments
* var:: Pass arguments to code blocks
-* Results:: Specify the type of results and how they will
+* results:: Specify the type of results and how they will
be collected and handled
* file:: Specify a path for file output
* file-desc:: Specify a description for file results
@@ -821,7 +831,7 @@ reproducible research compendium.
Org keeps simple things simple. When first fired up, it should feel like a
straightforward, easy to use outliner. Complexity is not imposed, but a
large amount of functionality is available when needed. Org is a toolbox.
-Many users usilize only a (very personal) fraction of Org's capabilities, and
+Many users actually run only a (very personal) fraction of Org's capabilities, and
know that there is more whenever they need it.
All of this is achieved with strictly plain text files, the most portable and
@@ -863,7 +873,11 @@ We @b{strongly recommend} to stick to a single installation method.
Recent Emacs distributions include a packaging system which lets you install
Elisp libraries. You can install Org with @kbd{M-x package-install RET org}.
-You need to do this in a session where no @code{.org} file has been visited.
+
+@noindent @b{Important}: you need to do this in a session where no @code{.org} file has
+been visited, i.e., where no Org built-in function have been loaded.
+Otherwise autoload Org functions will mess up the installation.
+
Then, to make sure your Org configuration is taken into account, initialize
the package system with @code{(package-initialize)} in your @file{.emacs}
before setting any Org option. If you want to use Org's package repository,
@@ -987,6 +1001,8 @@ active region by using the mouse to select a region, or pressing
If you find problems with Org, or if you have questions, remarks, or ideas
about it, please mail to the Org mailing list @email{emacs-orgmode@@gnu.org}.
+You can subscribe to the list
+@uref{https://lists.gnu.org/mailman/listinfo/emacs-orgmode, on this web page}.
If you are not a member of the mailing list, your mail will be passed to the
list after a moderator has approved it@footnote{Please consider subscribing
to the mailing list, in order to minimize the work the mailing list
@@ -1022,7 +1038,7 @@ is not necessary. In that case it is sufficient to start Emacs as
shown below.
@lisp
-;;; Minimal setup to load latest `org-mode'
+;;; Minimal setup to load latest 'org-mode'
;; activate debugging
(setq debug-on-error t
@@ -1101,21 +1117,21 @@ special meaning are written with all capitals.
@end table
Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title)
-and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML}
-environment). They are written in uppercase in the manual to enhance its
-readability, but you can use lowercase in your Org files@footnote{Easy
-templates insert lowercase keywords and Babel dynamically inserts
-@code{#+results}.}.
+and @i{environment keywords} (like @code{#+BEGIN_EXPORT html} to start
+a @code{HTML} environment). They are written in uppercase in the manual to
+enhance its readability, but you can use lowercase in your Org
+files@footnote{Easy templates insert lowercase keywords and Babel dynamically
+inserts @code{#+results}.}.
-@subsubheading Keybindings and commands
+@subsubheading Key bindings and commands
@kindex C-c a
@findex org-agenda
@kindex C-c c
@findex org-capture
-The manual suggests a few global keybindings, in particular @kbd{C-c a} for
+The manual suggests a few global key bindings, in particular @kbd{C-c a} for
@code{org-agenda} and @kbd{C-c c} for @code{org-capture}. These are only
-suggestions, but the rest of the manual assumes that these keybindings are in
+suggestions, but the rest of the manual assumes that these key bindings are in
place in order to list commands by key access.
Also, the manual lists both the keys and the corresponding commands for
@@ -1179,7 +1195,7 @@ start with one or more stars, on the left margin@footnote{See the variables
@code{org-special-ctrl-a/e}, @code{org-special-ctrl-k}, and
@code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a},
@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with
-headings indented less then 30 stars.}. For example:
+headings indented less than 30 stars.}. For example:
@example
* Top level headline
@@ -1192,7 +1208,12 @@ headings indented less then 30 stars.}. For example:
* Another top level headline
@end example
-@noindent Some people find the many stars too noisy and would prefer an
+@vindex org-footnote-section
+@noindent Note that a headline named after @code{org-footnote-section},
+which defaults to @samp{Footnotes}, is considered as special. A subtree with
+this headline will be silently ignored by exporting functions.
+
+Some people find the many stars too noisy and would prefer an
outline that has whitespace followed by a single star as headline
starters. @ref{Clean view}, describes a setup to realize this.
@@ -1287,20 +1308,13 @@ Expose all the headings of the subtree, CONTENT view for just one subtree.
Expose all direct children of the subtree. With a numeric prefix argument N,
expose all children down to level N@.
@orgcmd{C-c C-x b,org-tree-to-indirect-buffer}
-Show the current subtree in an indirect buffer@footnote{The indirect
-buffer
-@ifinfo
-(@pxref{Indirect Buffers,,,emacs,GNU Emacs Manual})
-@end ifinfo
-@ifnotinfo
-(see the Emacs manual for more information about indirect buffers)
-@end ifnotinfo
-will contain the entire buffer, but will be narrowed to the current
-tree. Editing the indirect buffer will also change the original buffer,
-but without affecting visibility in that buffer.}. With a numeric
-prefix argument N, go up to level N and then take that tree. If N is
-negative then go up that many levels. With a @kbd{C-u} prefix, do not remove
-the previously used indirect buffer.
+Show the current subtree in an indirect buffer@footnote{The indirect buffer
+(@pxref{Indirect Buffers,,,emacs,GNU Emacs Manual}) will contain the entire
+buffer, but will be narrowed to the current tree. Editing the indirect
+buffer will also change the original buffer, but without affecting visibility
+in that buffer.}. With a numeric prefix argument N, go up to level N and
+then take that tree. If N is negative then go up that many levels. With a
+@kbd{C-u} prefix, do not remove the previously used indirect buffer.
@orgcmd{C-c C-x v,org-copy-visible}
Copy the @i{visible} text in the region into the kill ring.
@end table
@@ -1417,19 +1431,23 @@ See also the option @code{org-goto-interface}.
@orgcmd{M-@key{RET},org-insert-heading}
@vindex org-M-RET-may-split-line
Insert a new heading/item with the same level as the one at point.
-If the cursor is in a plain list item, a new item is created
-(@pxref{Plain lists}). To prevent this behavior in lists, call the
-command with a prefix argument. When this command is used in the
-middle of a line, the line is split and the rest of the line becomes
-the new item or headline@footnote{If you do not want the line to be
-split, customize the variable @code{org-M-RET-may-split-line}.}. If
-the command is used at the @emph{beginning} of a headline, the new
-headline is created before the current line. If the command is used
-at the @emph{end} of a folded subtree (i.e., behind the ellipses at
-the end of a headline), then a headline will be
-inserted after the end of the subtree. Calling this command with
-@kbd{C-u C-u} will unconditionally respect the headline's content and
-create a new item at the end of the parent subtree.
+
+If the cursor is in a plain list item, a new item is created (@pxref{Plain
+lists}). To prevent this behavior in lists, call the command with one prefix
+argument. When this command is used in the middle of a line, the line is
+split and the rest of the line becomes the new item or headline. If you do
+not want the line to be split, customize @code{org-M-RET-may-split-line}.
+
+If the command is used at the @emph{beginning} of a line, and if there is a
+heading or an item at point, the new heading/item is created @emph{before}
+the current line. If the command is used at the @emph{end} of a folded
+subtree (i.e., behind the ellipses at the end of a headline), then a headline
+will be inserted after the end of the subtree.
+
+Calling this command with @kbd{C-u C-u} will unconditionally respect the
+headline's content and create a new item at the end of the parent subtree.
+
+If point is at the beginning of a normal line, turn this line into a heading.
@orgcmd{C-@key{RET},org-insert-heading-respect-content}
Just like @kbd{M-@key{RET}}, except when adding a new heading below the
current heading, the new heading is placed after the body instead of before
@@ -1544,18 +1562,14 @@ functionality.
@cindex folding, sparse trees
@cindex occur, command
-@vindex org-show-hierarchy-above
-@vindex org-show-following-heading
-@vindex org-show-siblings
-@vindex org-show-entry-below
+@vindex org-show-context-detail
An important feature of Org mode is the ability to construct @emph{sparse
trees} for selected information in an outline tree, so that the entire
document is folded as much as possible, but the selected information is made
visible along with the headline structure above it@footnote{See also the
-variables @code{org-show-hierarchy-above}, @code{org-show-following-heading},
-@code{org-show-siblings}, and @code{org-show-entry-below} for detailed
-control on how much context is shown around each match.}. Just try it out
-and you will see immediately how it works.
+variable @code{org-show-context-detail} to decide how much context is shown
+around each match.}. Just try it out and you will see immediately how it
+works.
Org mode contains several commands for creating such trees, all these
commands can be accessed through a dispatcher:
@@ -1679,7 +1693,7 @@ In that case, all items are closed. Here is an example:
But in the end, no individual scenes matter but the film as a whole.
Important actors in this film are:
- @b{Elijah Wood} :: He plays Frodo
- - @b{Sean Austin} :: He plays Sam, Frodo's friend. I still remember
+ - @b{Sean Astin} :: He plays Sam, Frodo's friend. I still remember
him very well from his role as Mikey Walsh in @i{The Goonies}.
@end group
@end example
@@ -1892,14 +1906,13 @@ or on a per-file basis by using
@section Footnotes
@cindex footnotes
-Org mode supports the creation of footnotes. In contrast to the
-@file{footnote.el} package, Org mode's footnotes are designed for work on
-a larger document, not only for one-off documents like emails.
+Org mode supports the creation of footnotes.
A footnote is started by a footnote marker in square brackets in column 0, no
indentation allowed. It ends at the next footnote definition, headline, or
after two consecutive empty lines. The footnote reference is simply the
-marker in square brackets, inside text. For example:
+marker in square brackets, inside text. Markers always start with
+@code{fn:}. For example:
@example
The Org homepage[fn:1] now looks a lot better than it used to.
@@ -1908,23 +1921,16 @@ The Org homepage[fn:1] now looks a lot better than it used to.
@end example
Org mode extends the number-based syntax to @emph{named} footnotes and
-optional inline definition. Using plain numbers as markers (as
-@file{footnote.el} does) is supported for backward compatibility, but not
-encouraged because of possible conflicts with @LaTeX{} snippets (@pxref{Embedded
-@LaTeX{}}). Here are the valid references:
+optional inline definition. Here are the valid references:
@table @code
-@item [1]
-A plain numeric footnote marker. Compatible with @file{footnote.el}, but not
-recommended because something like @samp{[1]} could easily be part of a code
-snippet.
@item [fn:name]
A named footnote reference, where @code{name} is a unique label word, or, for
simplicity of automatic creation, a number.
-@item [fn:: This is the inline definition of this footnote]
+@item [fn::This is the inline definition of this footnote]
A @LaTeX{}-like anonymous footnote where the definition is given directly at the
reference point.
-@item [fn:name: a definition]
+@item [fn:name:a definition]
An inline definition of a footnote, which also specifies a name for the note.
Since Org allows multiple references to the same note, you can then use
@code{[fn:name]} to create additional references.
@@ -1971,9 +1977,7 @@ r @r{Renumber the simple @code{fn:N} footnotes. Automatic renumbering}
S @r{Short for first @code{r}, then @code{s} action.}
n @r{Normalize the footnotes by collecting all definitions (including}
@r{inline definitions) into a special section, and then numbering them}
- @r{in sequence. The references will then also be numbers. This is}
- @r{meant to be the final step before finishing a document (e.g., sending}
- @r{off an email).}
+ @r{in sequence. The references will then also be numbers.}
d @r{Delete the footnote at point, and all definitions of and references}
@r{to it.}
@end example
@@ -1993,6 +1997,14 @@ location with a prefix argument, offer the same menu as @kbd{C-c C-x f}.
@item C-c C-o @r{or} mouse-1/2
Footnote labels are also links to the corresponding definition/reference, and
you can use the usual commands to follow these links.
+
+@vindex org-edit-footnote-reference
+@kindex C-c '
+@item C-c '
+@item C-c '
+Edit the footnote definition corresponding to the reference at point in
+a seperate window. The window can be closed by pressing @kbd{C-c '}.
+
@end table
@node Orgstruct mode
@@ -2052,6 +2064,10 @@ abstract structure. The export engine relies on the information stored in
this list. Most interactive commands (e.g., for structure editing) also
rely on the syntactic meaning of the surrounding context.
+@cindex syntax checker
+@cindex linter
+You can check syntax in your documents using @code{org-lint} command.
+
@node Tables
@chapter Tables
@cindex tables
@@ -2136,6 +2152,9 @@ table. But it is easier just to start typing, like
@orgcmd{C-c C-c,org-table-align}
Re-align the table and don't move to another field.
@c
+@orgcmd{C-c SPC,org-table-blank-field}
+Blank the field at point.
+@c
@orgcmd{<TAB>,org-table-next-field}
Re-align the table, move to the next field. Creates a new row if
necessary.
@@ -2189,8 +2208,10 @@ point is before the first column, you will be prompted for the sorting
column. If there is an active region, the mark specifies the first line
and the sorting column, while point should be in the last line to be
included into the sorting. The command prompts for the sorting type
-(alphabetically, numerically, or by time). When called with a prefix
-argument, alphabetic sorting will be case-sensitive.
+(alphabetically, numerically, or by time). You can sort in normal or
+reverse order. You can also supply your own key extraction and comparison
+functions. When called with a prefix argument, alphabetic sorting will be
+case-sensitive.
@tsubheading{Regions}
@orgcmd{C-c C-x M-w,org-table-copy-region}
@@ -2321,7 +2342,7 @@ Fields that are wider become clipped and end in the string @samp{=>}.
Note that the full text is still in the buffer but is hidden.
To see the full text, hold the mouse over the field---a tool-tip window
will show the full content. To edit such a field, use the command
-@kbd{C-c `} (that is @kbd{C-c} followed by the backquote). This will
+@kbd{C-c `} (that is @kbd{C-c} followed by the grave accent). This will
open a new window with the full field. Edit it and finish with @kbd{C-c
C-c}.
@@ -2364,13 +2385,13 @@ a group of its own. Boundaries between column groups will upon export be
marked with vertical lines. Here is an example:
@example
-| N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) |
-|---+-----+-----+-----+---------+------------|
-| / | < | | > | < | > |
-| 1 | 1 | 1 | 1 | 1 | 1 |
-| 2 | 4 | 8 | 16 | 1.4142 | 1.1892 |
-| 3 | 9 | 27 | 81 | 1.7321 | 1.3161 |
-|---+-----+-----+-----+---------+------------|
+| N | N^2 | N^3 | N^4 | ~sqrt(n)~ | ~sqrt[4](N)~ |
+|---+-----+-----+-----+-----------+--------------|
+| / | < | | > | < | > |
+| 1 | 1 | 1 | 1 | 1 | 1 |
+| 2 | 4 | 8 | 16 | 1.4142 | 1.1892 |
+| 3 | 9 | 27 | 81 | 1.7321 | 1.3161 |
+|---+-----+-----+-----+-----------+--------------|
#+TBLFM: $2=$1^2::$3=$1^3::$4=$1^4::$5=sqrt($1)::$6=sqrt(sqrt(($1)))
@end example
@@ -2715,9 +2736,11 @@ Operations, , Logical Operations, calc, GNU Emacs Calc Manual}). For example
@item if($1 < 20, teen, string(""))
"teen" if age $1 is less than 20, else the Org table result field is set to
empty with the empty string.
-@item if("$1" == "nan" || "$2" == "nan", string(""), $1 + $2); E
+@item if("$1" == "nan" || "$2" == "nan", string(""), $1 + $2); E f-1
Sum of the first two columns. When at least one of the input fields is empty
-the Org table result field is set to empty.
+the Org table result field is set to empty. @samp{E} is required to not
+convert empty fields to 0. @samp{f-1} is an optional Calc format string
+similar to @samp{%.1f} but leaves empty results empty.
@item if(typeof(vmean($1..$7)) == 12, string(""), vmean($1..$7); E
Mean value of a range unless there is any empty field. Every field in the
range that is empty is replaced by @samp{nan} which lets @samp{vmean} result
@@ -2746,7 +2769,7 @@ It is also possible to write a formula in Emacs Lisp. This can be useful
for string manipulation and control structures, if Calc's functionality is
not enough.
-If a formula starts with a single-quote followed by an opening parenthesis,
+If a formula starts with an apostrophe followed by an opening parenthesis,
then it is evaluated as a Lisp form. The evaluation should return either a
string or a number. Just as with @file{calc} formulas, you can specify modes
and a printf format after a semicolon.
@@ -3242,11 +3265,17 @@ functions.
@cindex plot tables using Gnuplot
@cindex #+PLOT
-Org-Plot can produce 2D and 3D graphs of information stored in org tables
-using @file{Gnuplot} @uref{http://www.gnuplot.info/} and @file{gnuplot-mode}
+Org-Plot can produce graphs of information stored in org tables, either
+graphically or in ASCII-art.
+
+@subheading Graphical plots using @file{Gnuplot}
+
+Org-Plot produces 2D and 3D graphs using @file{Gnuplot}
+@uref{http://www.gnuplot.info/} and @file{gnuplot-mode}
@uref{http://xafs.org/BruceRavel/GnuplotMode}. To see this in action, ensure
that you have both Gnuplot and Gnuplot mode installed on your system, then
-call @code{org-plot/gnuplot} on the following table.
+call @kbd{C-c " g} or @kbd{M-x org-plot/gnuplot @key{RET}} on the following
+table.
@example
@group
@@ -3264,8 +3293,8 @@ call @code{org-plot/gnuplot} on the following table.
Notice that Org Plot is smart enough to apply the table's headers as labels.
Further control over the labels, type, content, and appearance of plots can
be exercised through the @code{#+PLOT:} lines preceding a table. See below
-for a complete list of Org-plot options. For more information and examples
-see the Org-plot tutorial at
+for a complete list of Org-plot options. The @code{#+PLOT:} lines are
+optional. For more information and examples see the Org-plot tutorial at
@uref{http://orgmode.org/worg/org-tutorials/org-plot.html}.
@subsubheading Plot Options
@@ -3321,6 +3350,47 @@ may still want to specify the plot type, as that can impact the content of
the data file.
@end table
+@subheading ASCII bar plots
+
+While the cursor is on a column, typing @kbd{C-c " a} or
+@kbd{M-x orgtbl-ascii-plot @key{RET}} create a new column containing an
+ASCII-art bars plot. The plot is implemented through a regular column
+formula. When the source column changes, the bar plot may be updated by
+refreshing the table, for example typing @kbd{C-u C-c *}.
+
+@example
+@group
+| Sede | Max cites | |
+|---------------+-----------+--------------|
+| Chile | 257.72 | WWWWWWWWWWWW |
+| Leeds | 165.77 | WWWWWWWh |
+| Sao Paolo | 71.00 | WWW; |
+| Stockholm | 134.19 | WWWWWW: |
+| Morelia | 257.56 | WWWWWWWWWWWH |
+| Rochefourchat | 0.00 | |
+#+TBLFM: $3='(orgtbl-ascii-draw $2 0.0 257.72 12)
+@end group
+@end example
+
+The formula is an elisp call:
+@lisp
+(orgtbl-ascii-draw COLUMN MIN MAX WIDTH)
+@end lisp
+
+@table @code
+@item COLUMN
+ is a reference to the source column.
+
+@item MIN MAX
+ are the minimal and maximal values displayed. Sources values
+ outside this range are displayed as @samp{too small}
+ or @samp{too large}.
+
+@item WIDTH
+ is the width in characters of the bar-plot. It defaults to @samp{12}.
+
+@end table
+
@node Hyperlinks
@chapter Hyperlinks
@cindex hyperlinks
@@ -3494,10 +3564,14 @@ file:projects.org::some words @r{text search in Org file}@footnote{
The actual behavior of the search will depend on the value of
the option @code{org-link-search-must-match-exact-headline}. If its value
is @code{nil}, then a fuzzy text search will be done. If it is t, then only the
-exact headline will be matched. If the value is @code{'query-to-create},
-then an exact headline will be searched; if it is not found, then the user
-will be queried to create it.}
-file:projects.org::*task title @r{heading search in Org file}
+exact headline will be matched, ignoring spaces and cookies. If the value is
+@code{query-to-create}, then an exact headline will be searched; if it is not
+found, then the user will be queried to create it.}
+file:projects.org::*task title @r{heading search in Org
+file}@footnote{ Headline searches always match the exact headline, ignoring
+spaces and cookies. If the headline is not found and the value of the option
+@code{org-link-search-must-match-exact-headline} is @code{query-to-create},
+then the user will be queried to create it.}
file+sys:/path/to/file @r{open via OS, like double-click}
file+emacs:/path/to/file @r{force opening by Emacs}
docview:papers/last.pdf::NNN @r{open in doc-view mode at page}
@@ -3512,7 +3586,7 @@ gnus:group @r{Gnus group link}
gnus:group#id @r{Gnus article link}
bbdb:R.*Stallman @r{BBDB link (with regexp)}
irc:/irc.com/#emacs/bob @r{IRC link}
-info:org#External links @r{Info node link}
+info:org#External links @r{Info node or index link}
shell:ls *.org @r{A shell command}
elisp:org-agenda @r{Interactive Elisp command}
elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate}
@@ -4181,11 +4255,10 @@ unique keys across both sets of keywords.}
@cindex #+SEQ_TODO
It can be very useful to use different aspects of the TODO mechanism in
-different files. For file-local settings, you need to add special lines
-to the file which set the keywords and interpretation for that file
-only. For example, to set one of the two examples discussed above, you
-need one of the following lines, starting in column zero anywhere in the
-file:
+different files. For file-local settings, you need to add special lines to
+the file which set the keywords and interpretation for that file only. For
+example, to set one of the two examples discussed above, you need one of the
+following lines anywhere in the file:
@example
#+TODO: TODO FEEDBACK VERIFY | DONE CANCELED
@@ -4251,6 +4324,7 @@ foreground or a background color.
@subsection TODO dependencies
@cindex TODO dependencies
@cindex dependencies, of TODO states
+@cindex TODO dependencies, NOBLOCKING
@vindex org-enforce-todo-dependencies
@cindex property, ORDERED
@@ -4279,6 +4353,16 @@ example:
** TODO c, needs to wait for (a) and (b)
@end example
+You can ensure an entry is never blocked by using the @code{NOBLOCKING}
+property:
+
+@example
+* This entry is never blocked
+ :PROPERTIES:
+ :NOBLOCKING: t
+ :END:
+@end example
+
@table @kbd
@orgcmd{C-c C-x o,org-toggle-ordered-property}
@vindex org-track-ordered-property-with-tag
@@ -4482,6 +4566,10 @@ actual habit with some history:
@example
** TODO Shave
SCHEDULED: <2009-10-17 Sat .+2d/4d>
+ :PROPERTIES:
+ :STYLE: habit
+ :LAST_REPEAT: [2009-10-19 Mon 00:36]
+ :END:
- State "DONE" from "TODO" [2009-10-15 Thu]
- State "DONE" from "TODO" [2009-10-12 Mon]
- State "DONE" from "TODO" [2009-10-10 Sat]
@@ -4492,10 +4580,6 @@ actual habit with some history:
- State "DONE" from "TODO" [2009-09-19 Sat]
- State "DONE" from "TODO" [2009-09-16 Wed]
- State "DONE" from "TODO" [2009-09-12 Sat]
- :PROPERTIES:
- :STYLE: habit
- :LAST_REPEAT: [2009-10-19 Mon 00:36]
- :END:
@end example
What this habit says is: I want to shave at most every 2 days (given by the
@@ -4795,7 +4879,7 @@ You may specify special faces for specific tags using the option
@menu
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
@end menu
@@ -5034,41 +5118,104 @@ instead of @kbd{C-c C-c}). If you set the variable to the value
@code{expert}, the special window is not even shown for single-key tag
selection, it comes up only when you press an extra @kbd{C-c}.
-@node Tag groups
-@section Tag groups
+@node Tag hierarchy
+@section Tag hierarchy
@cindex group tags
@cindex tags, groups
-In a set of mutually exclusive tags, the first tag can be defined as a
-@emph{group tag}. When you search for a group tag, it will return matches
-for all members in the group. In an agenda view, filtering by a group tag
-will display headlines tagged with at least one of the members of the
-group. This makes tag searches and filters even more flexible.
+@cindex tag hierarchy
+Tags can be defined in hierarchies. A tag can be defined as a @emph{group
+tag} for a set of other tags. The group tag can be seen as the ``broader
+term'' for its set of tags. Defining multiple @emph{group tags} and nesting
+them creates a tag hierarchy.
+
+One use-case is to create a taxonomy of terms (tags) that can be used to
+classify nodes in a document or set of documents.
-You can set group tags by inserting a colon between the group tag and other
-tags---beware that all whitespaces are mandatory so that Org can parse this
-line correctly:
+When you search for a group tag, it will return matches for all members in
+the group and its subgroup. In an agenda view, filtering by a group tag will
+display or hide headlines tagged with at least one of the members of the
+group or any of its subgroups. This makes tag searches and filters even more
+flexible.
+
+You can set group tags by using brackets and inserting a colon between the
+group tag and its related tags---beware that all whitespaces are mandatory so
+that Org can parse this line correctly:
@example
-#+TAGS: @{ @@read : @@read_book @@read_ebook @}
+#+TAGS: [ GTD : Control Persp ]
@end example
-In this example, @samp{@@read} is a @emph{group tag} for a set of three
-tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
+In this example, @samp{GTD} is the @emph{group tag} and it is related to two
+other tags: @samp{Control}, @samp{Persp}. Defining @samp{Control} and
+@samp{Persp} as group tags creates an hierarchy of tags:
-You can also use the @code{:grouptags} keyword directly when setting
-@code{org-tag-alist}:
+@example
+#+TAGS: [ Control : Context Task ]
+#+TAGS: [ Persp : Vision Goal AOF Project ]
+@end example
+
+That can conceptually be seen as a hierarchy of tags:
+
+@example
+- GTD
+ - Persp
+ - Vision
+ - Goal
+ - AOF
+ - Project
+ - Control
+ - Context
+ - Task
+@end example
+
+You can use the @code{:startgrouptag}, @code{:grouptags} and
+@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
+directly:
@lisp
-(setq org-tag-alist '((:startgroup . nil)
- ("@@read" . nil)
- (:grouptags . nil)
- ("@@read_book" . nil)
- ("@@read_ebook" . nil)
- (:endgroup . nil)))
+(setq org-tag-alist '((:startgrouptag)
+ ("GTD")
+ (:grouptags)
+ ("Control")
+ ("Persp")
+ (:endgrouptag)
+ (:startgrouptag)
+ ("Control")
+ (:grouptags)
+ ("Context")
+ ("Task")
+ (:endgrouptag)))
@end lisp
-You cannot nest group tags or use a group tag as a tag in another group.
+The tags in a group can be mutually exclusive if using the same group syntax
+as is used for grouping mutually exclusive tags together; using curly
+brackets.
+
+@example
+#+TAGS: @{ Context : @@Home @@Work @@Call @}
+@end example
+
+When setting @code{org-tag-alist} you can use @code{:startgroup} &
+@code{:endgroup} instead of @code{:startgrouptag} & @code{:endgrouptag} to
+make the tags mutually exclusive.
+
+Furthermore, the members of a @emph{group tag} can also be regular
+expressions, creating the possibility of a more dynamic and rule-based
+tag structure. The regular expressions in the group must be specified
+within @{ @}. Here is an expanded example:
+
+@example
+#+TAGS: [ Vision : @{V@@@.+@} ]
+#+TAGS: [ Goal : @{G@@@.+@} ]
+#+TAGS: [ AOF : @{AOF@@@.+@} ]
+#+TAGS: [ Project : @{P@@@.+@} ]
+@end example
+
+Searching for the tag @samp{Project} will now list all tags also including
+regular expression matches for @samp{P@@@.+}, and similarly for tag searches on
+@samp{Vision}, @samp{Goal} and @samp{AOF}. For example, this would work well
+for a project tagged with a common project-identifier, e.g. @samp{P@@2014_OrgTags}.
@kindex C-c C-x q
@vindex org-group-tags
@@ -5144,10 +5291,12 @@ Properties can be conveniently edited and viewed in column view
@cindex drawer, for properties
Properties are key-value pairs. When they are associated with a single entry
-or with a tree they need to be inserted into a special
-drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property
-is specified on a single line, with the key (surrounded by colons)
-first, and the value after it. Here is an example:
+or with a tree they need to be inserted into a special drawer
+(@pxref{Drawers}) with the name @code{PROPERTIES}, which has to be located
+right below a headline, and its planning line (@pxref{Deadlines and
+scheduling}) when applicable. Each property is specified on a single line,
+with the key (surrounded by colons) first, and the value after it. Keys are
+case-insensitives. Here is an example:
@example
* CD collection
@@ -5163,7 +5312,7 @@ first, and the value after it. Here is an example:
@end example
Depending on the value of @code{org-use-property-inheritance}, a property set
-this way will either be associated with a single entry, or the sub-tree
+this way will either be associated with a single entry, or the subtree
defined by the entry, see @ref{Property inheritance}.
You may define the allowed values for a particular property @samp{:Xyz:}
@@ -5266,49 +5415,43 @@ nearest column format definition.
Special properties provide an alternative access method to Org mode features,
like the TODO state or the priority of an entry, discussed in the previous
-chapters. This interface exists so that you can include these states in a
-column view (@pxref{Column view}), or to use them in queries. The following
-property names are special and (except for @code{:CATEGORY:}) should not be
-used as keys in the properties drawer:
+chapters. This interface exists so that you can include these states in
+a column view (@pxref{Column view}), or to use them in queries. The
+following property names are special and should not be used as keys in the
+properties drawer:
-@cindex property, special, ID
-@cindex property, special, TODO
-@cindex property, special, TAGS
@cindex property, special, ALLTAGS
-@cindex property, special, CATEGORY
-@cindex property, special, PRIORITY
+@cindex property, special, BLOCKED
+@cindex property, special, CLOCKSUM
+@cindex property, special, CLOCKSUM_T
+@cindex property, special, CLOSED
@cindex property, special, DEADLINE
+@cindex property, special, FILE
+@cindex property, special, ITEM
+@cindex property, special, PRIORITY
@cindex property, special, SCHEDULED
-@cindex property, special, CLOSED
+@cindex property, special, TAGS
@cindex property, special, TIMESTAMP
@cindex property, special, TIMESTAMP_IA
-@cindex property, special, CLOCKSUM
-@cindex property, special, CLOCKSUM_T
-@cindex property, special, BLOCKED
-@c guessing that ITEM is needed in this area; also, should this list be sorted?
-@cindex property, special, ITEM
-@cindex property, special, FILE
+@cindex property, special, TODO
@example
-ID @r{A globally unique ID used for synchronization during}
- @r{iCalendar or MobileOrg export.}
-TODO @r{The TODO keyword of the entry.}
-TAGS @r{The tags defined directly in the headline.}
ALLTAGS @r{All tags, including inherited ones.}
-CATEGORY @r{The category of an entry.}
-PRIORITY @r{The priority of the entry, a string with a single letter.}
-DEADLINE @r{The deadline time string, without the angular brackets.}
-SCHEDULED @r{The scheduling timestamp, without the angular brackets.}
-CLOSED @r{When was this entry closed?}
-TIMESTAMP @r{The first keyword-less timestamp in the entry.}
-TIMESTAMP_IA @r{The first inactive timestamp in the entry.}
+BLOCKED @r{"t" if task is currently blocked by children or siblings.}
CLOCKSUM @r{The sum of CLOCK intervals in the subtree. @code{org-clock-sum}}
@r{must be run first to compute the values in the current buffer.}
CLOCKSUM_T @r{The sum of CLOCK intervals in the subtree for today.}
@r{@code{org-clock-sum-today} must be run first to compute the}
@r{values in the current buffer.}
-BLOCKED @r{"t" if task is currently blocked by children or siblings}
-ITEM @r{The headline of the entry.}
+CLOSED @r{When was this entry closed?}
+DEADLINE @r{The deadline time string, without the angular brackets.}
FILE @r{The filename the entry is located in.}
+ITEM @r{The headline of the entry.}
+PRIORITY @r{The priority of the entry, a string with a single letter.}
+SCHEDULED @r{The scheduling timestamp, without the angular brackets.}
+TAGS @r{The tags defined directly in the headline.}
+TIMESTAMP @r{The first keyword-less timestamp in the entry.}
+TIMESTAMP_IA @r{The first inactive timestamp in the entry.}
+TODO @r{The TODO keyword of the entry.}
@end example
@node Property searches
@@ -5477,38 +5620,45 @@ optional. The individual parts have the following meaning:
@var{title} @r{The header text for the column. If omitted, the property}
@r{name is used.}
@{@var{summary-type}@} @r{The summary type. If specified, the column values for}
- @r{parent nodes are computed from the children.}
+ @r{parent nodes are computed from the children@footnote{If
+ more than one summary type apply to the property, the parent
+ values are computed according to the first of them.}.}
@r{Supported summary types are:}
@{+@} @r{Sum numbers in this column.}
@{+;%.1f@} @r{Like @samp{+}, but format result with @samp{%.1f}.}
@{$@} @r{Currency, short for @samp{+;%.2f}.}
- @{:@} @r{Sum times, HH:MM, plain numbers are hours.}
- @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.}
- @{X/@} @r{Checkbox status, @samp{[n/m]}.}
- @{X%@} @r{Checkbox status, @samp{[n%]}.}
@{min@} @r{Smallest number in column.}
@{max@} @r{Largest number.}
@{mean@} @r{Arithmetic mean of numbers.}
+ @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.}
+ @{X/@} @r{Checkbox status, @samp{[n/m]}.}
+ @{X%@} @r{Checkbox status, @samp{[n%]}.}
+ @{:@} @r{Sum times, HH:MM, plain numbers are
+ hours@footnote{A time can also be a duration, using effort
+ modifiers defined in @code{org-effort-durations}, e.g.,
+ @samp{3d 1h}. If any value in the column is as such, the
+ summary will also be an effort duration.}.}
@{:min@} @r{Smallest time value in column.}
@{:max@} @r{Largest time value.}
@{:mean@} @r{Arithmetic mean of time values.}
- @{@@min@} @r{Minimum age (in days/hours/mins/seconds).}
+ @{@@min@} @r{Minimum age@footnote{An age is defined as
+ a duration since a given time-stamp (@pxref{Timestamps}). It
+ can also be expressed as days, hours, minutes and seconds,
+ identified by @samp{d}, @samp{h}, @samp{m} and @samp{s}
+ suffixes, all mandatory, e.g., @samp{0d 13h 0m 10s}.} (in
+ days/hours/mins/seconds).}
@{@@max@} @r{Maximum age (in days/hours/mins/seconds).}
@{@@mean@} @r{Arithmetic mean of ages (in days/hours/mins/seconds).}
- @{est+@} @r{Add low-high estimates.}
+ @{est+@} @r{Add @samp{low-high} estimates.}
@end example
-@noindent
-Be aware that you can only have one summary type for any property you
-include. Subsequent columns referencing the same property will all display the
-same summary information.
-
The @code{est+} summary type requires further explanation. It is used for
-combining estimates, expressed as low-high ranges. For example, instead
-of estimating a particular task will take 5 days, you might estimate it as
-5--6 days if you're fairly confident you know how much work is required, or
-1--10 days if you don't really know what needs to be done. Both ranges
-average at 5.5 days, but the first represents a more predictable delivery.
+combining estimates, expressed as @samp{low-high} ranges or plain numbers.
+For example, instead of estimating a particular task will take 5 days, you
+might estimate it as 5--6 days if you're fairly confident you know how much
+work is required, or 1--10 days if you don't really know what needs to be
+done. Both ranges average at 5.5 days, but the first represents a more
+predictable delivery.
When combining a set of such estimates, simply adding the lows and highs
produces an unrealistically wide result. Instead, @code{est+} adds the
@@ -5522,6 +5672,10 @@ full job more realistically, at 10--15 days.
Numbers are right-aligned when a format specifier with an explicit width like
@code{%5d} or @code{%5.1f} is used.
+@vindex org-columns-summary-types
+You can also define custom summary types by setting
+@code{org-columns-summary-types}, which see.
+
Here is an example for a complete columns definition, along with allowed
values.
@@ -5558,14 +5712,15 @@ today.
@orgcmd{C-c C-x C-c,org-columns}
@vindex org-columns-default-format
Turn on column view. If the cursor is before the first headline in the file,
-column view is turned on for the entire file, using the @code{#+COLUMNS}
-definition. If the cursor is somewhere inside the outline, this command
-searches the hierarchy, up from point, for a @code{:COLUMNS:} property that
-defines a format. When one is found, the column view table is established
-for the tree starting at the entry that contains the @code{:COLUMNS:}
-property. If no such property is found, the format is taken from the
-@code{#+COLUMNS} line or from the variable @code{org-columns-default-format},
-and column view is established for the current entry and its subtree.
+or the function called with the universal prefix argument, column view is
+turned on for the entire file, using the @code{#+COLUMNS} definition. If the
+cursor is somewhere inside the outline, this command searches the hierarchy,
+up from point, for a @code{:COLUMNS:} property that defines a format. When
+one is found, the column view table is established for the tree starting at
+the entry that contains the @code{:COLUMNS:} property. If no such property
+is found, the format is taken from the @code{#+COLUMNS} line or from the
+variable @code{org-columns-default-format}, and column view is established
+for the current entry and its subtree.
@orgcmd{r,org-columns-redo}
Recreate the column view, to include recent changes made in the buffer.
@orgcmd{g,org-columns-redo}
@@ -5653,6 +5808,8 @@ When set to a number, don't capture entries below this level.
@item :skip-empty-rows
When set to @code{t}, skip rows where the only non-empty specifier of the
column view is @code{ITEM}.
+@item :indent
+When non-@code{nil}, indent each @code{ITEM} field according to its level.
@end table
@@ -5715,8 +5872,7 @@ is used in a much wider sense.
* Deadlines and scheduling:: Planning your work
* Clocking work time:: Tracking how long you spend on a task
* Effort estimates:: Planning work effort in advance
-* Relative timer:: Notes with a running timer
-* Countdown timer:: Starting a countdown timer for a task
+* Timers:: Notes with a running timer
@end menu
@@ -5774,7 +5930,7 @@ package@footnote{When working with the standard diary sexp functions, you
need to be very careful with the order of the arguments. That order depends
evilly on the variable @code{calendar-date-style} (or, for older Emacs
versions, @code{european-calendar-style}). For example, to specify a date
-December 12, 2005, the call might look like @code{(diary-date 12 1 2005)} or
+December 1, 2005, the call might look like @code{(diary-date 12 1 2005)} or
@code{(diary-date 1 12 2005)} or @code{(diary-date 2005 12 1)}, depending on
the settings. This has been the source of much confusion. Org mode users