[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/org 0555665 2/6: Remove the contrib/ directory
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/org 0555665 2/6: Remove the contrib/ directory |
|
Date: |
Mon, 3 May 2021 07:57:11 -0400 (EDT) |
branch: externals/org
commit 0555665bb935833da02556d7bb88b2183bdf6ec8
Author: Bastien <bzg@gnu.org>
Commit: Bastien <bzg@gnu.org>
Remove the contrib/ directory
The files have been moved to a new repository:
https://git.sr.ht/~bzg/org-contrib
---
contrib/README | 100 -
contrib/lisp/ob-arduino.el | 105 --
contrib/lisp/ob-clojure-literate.el | 294 ---
contrib/lisp/ob-csharp.el | 83 -
contrib/lisp/ob-eukleides.el | 98 -
contrib/lisp/ob-fomus.el | 92 -
contrib/lisp/ob-julia.el | 302 ---
contrib/lisp/ob-mathematica.el | 81 -
contrib/lisp/ob-mathomatic.el | 145 --
contrib/lisp/ob-oz.el | 294 ---
contrib/lisp/ob-php.el | 57 -
contrib/lisp/ob-redis.el | 44 -
contrib/lisp/ob-sclang.el | 92 -
contrib/lisp/ob-smiles.el | 57 -
contrib/lisp/ob-spice.el | 182 --
contrib/lisp/ob-stata.el | 312 ----
contrib/lisp/ob-tcl.el | 128 --
contrib/lisp/ob-vbnet.el | 84 -
contrib/lisp/ol-bookmark.el | 90 -
contrib/lisp/ol-elisp-symbol.el | 157 --
contrib/lisp/ol-git-link.el | 231 ---
contrib/lisp/ol-man.el | 85 -
contrib/lisp/ol-mew.el | 355 ----
contrib/lisp/ol-notmuch.el | 154 --
contrib/lisp/ol-vm.el | 167 --
contrib/lisp/ol-wl.el | 304 ---
contrib/lisp/org-annotate-file.el | 157 --
contrib/lisp/org-attach-embedded-images.el | 131 --
contrib/lisp/org-bibtex-extras.el | 137 --
contrib/lisp/org-checklist.el | 141 --
contrib/lisp/org-choose.el | 496 -----
contrib/lisp/org-collector.el | 232 ---
contrib/lisp/org-contacts.el | 1243 -------------
contrib/lisp/org-contribdir.el | 38 -
contrib/lisp/org-depend.el | 431 -----
contrib/lisp/org-effectiveness.el | 369 ----
contrib/lisp/org-eldoc.el | 203 --
contrib/lisp/org-eval-light.el | 199 --
contrib/lisp/org-eval.el | 216 ---
contrib/lisp/org-expiry.el | 361 ----
contrib/lisp/org-interactive-query.el | 311 ----
contrib/lisp/org-invoice.el | 403 ----
contrib/lisp/org-learn.el | 177 --
contrib/lisp/org-license.el | 540 ------
contrib/lisp/org-link-edit.el | 392 ----
contrib/lisp/org-mac-iCal.el | 250 ---
contrib/lisp/org-mac-link.el | 1020 ----------
contrib/lisp/org-mairix.el | 333 ----
contrib/lisp/org-notify.el | 406 ----
contrib/lisp/org-panel.el | 638 -------
contrib/lisp/org-passwords.el | 384 ----
contrib/lisp/org-registry.el | 272 ---
contrib/lisp/org-screen.el | 106 --
contrib/lisp/org-screenshot.el | 529 ------
contrib/lisp/org-secretary.el | 230 ---
contrib/lisp/org-static-mathjax.el | 187 --
contrib/lisp/org-sudoku.el | 288 ---
contrib/lisp/org-toc.el | 508 -----
contrib/lisp/org-track.el | 211 ---
contrib/lisp/org-velocity.el | 819 --------
contrib/lisp/org-wikinodes.el | 327 ----
contrib/lisp/orgtbl-sqlinsert.el | 118 --
contrib/lisp/ox-bibtex.el | 430 -----
contrib/lisp/ox-confluence.el | 258 ---
contrib/lisp/ox-deck.el | 585 ------
contrib/lisp/ox-extra.el | 211 ---
contrib/lisp/ox-freemind.el | 527 ------
contrib/lisp/ox-groff.el | 1960 --------------------
contrib/lisp/ox-koma-letter.el | 1010 ----------
contrib/lisp/ox-rss.el | 419 -----
contrib/lisp/ox-s5.el | 433 -----
contrib/lisp/ox-taskjuggler.el | 1033 -----------
contrib/scripts/.gitignore | 1 -
contrib/scripts/StartOzServer.oz | 231 ---
contrib/scripts/dir2org.zsh | 56 -
contrib/scripts/ditaa.jar | Bin 186095 -> 0 bytes
contrib/scripts/docco.css | 185 --
contrib/scripts/org-docco.org | 206 --
contrib/scripts/org2hpda | 106 --
contrib/scripts/staticmathjax/.gitignore | 1 -
contrib/scripts/staticmathjax/README.org | 79 -
contrib/scripts/staticmathjax/application.ini | 11 -
.../scripts/staticmathjax/chrome/chrome.manifest | 1 -
.../scripts/staticmathjax/chrome/content/main.js | 198 --
.../scripts/staticmathjax/chrome/content/main.xul | 11 -
.../staticmathjax/defaults/preferences/prefs.js | 1 -
contrib/scripts/x11idle.c | 33 -
87 files changed, 24882 deletions(-)
diff --git a/contrib/README b/contrib/README
deleted file mode 100644
index 73b4552..0000000
--- a/contrib/README
+++ /dev/null
@@ -1,100 +0,0 @@
-This directory contains add-ons to Org-mode.
-
-These contributions are not part of GNU Emacs or of the official
-Org-mode package. But the git repository for Org-mode is glad to
-provide useful way to distribute and develop them as long as they
-are distributed under a free software license.
-
-Please put your contribution in one of these directories:
-
-LISP (Emacs Lisp)
-=================
-
-Org utils
-~~~~~~~~~
-org-annotate-file.el --- Annotate a file with org syntax
-org-bibtex-extras.el --- Extras for working with org-bibtex entries
-org-bookmark.el --- Links to bookmarks
-org-checklist.el --- org functions for checklist handling
-org-choose.el --- Use TODO keywords to mark decision states
-org-collector.el --- Collect properties into tables
-org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
-org-contacts.el --- Contacts management
-org-contribdir.el --- Dummy file to mark the org contrib Lisp directory
-org-depend.el --- TODO dependencies for Org-mode
-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-expiry.el --- Expiry mechanism for Org entries
-org-export-generic.el --- Export framework for configurable backends
-org-git-link.el --- Provide org links to specific file version
-org-interactive-query.el --- Interactive modification of tags query
-org-invoice.el --- Help manage client invoices in OrgMode
-org-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
-org-man.el --- Support for links to manpages in Org-mode
-org-mew.el --- Support for links to Mew messages
-org-mime.el --- org html export for text/html MIME emails
-org-mtags.el --- Support for some Muse-like tags in Org-mode
-org-notify.el --- Notifications for Org-mode
-org-notmuch.el --- Support for links to notmuch messages
-org-panel.el --- Simple routines for us with bad memory
-org-registry.el --- A registry for Org links
-org-screen.el --- Visit screen sessions through Org-mode links
-org-screenshot.el --- Take and manage screenshots in Org-mode files
-org-secretary.el --- Team management with org-mode
-org-static-mathjax.el --- Muse-like tags in Org-mode
-org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables
-org-toc.el --- Table of contents for Org-mode buffer
-org-track.el --- Keep up with Org development
-org-velocity.el --- something like Notational Velocity for Org
-org-vm.el --- Support for links to VM messages
-org-w3m.el --- Support link/copy/paste from w3m to Org-mode
-org-wikinodes.el --- CamelCase wiki-like links for Org
-org-wl.el --- Support for links to Wanderlust messages
-orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions
-
-Org exporters
-~~~~~~~~~~~~~
-ox-confluence.el --- Confluence Wiki exporter
-ox-deck.el --- deck.js presentations exporter
-ox-groff.el --- Groff exporter
-ox-koma-letter.el --- KOMA Scrlttr2 exporter
-ox-rss.el --- RSS 2.0 exporter
-ox-s5.el --- S5 presentations exporter
-ox-taskjuggler.el --- TaskJuggler exporter
-
-Org Babel languages
-~~~~~~~~~~~~~~~~~~~
-ob-eukleides.el --- Org-babel functions for eukleides evaluation
-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
-~~~~~~~~~~~~~~~~~~
-htmlize.el --- Convert buffer text and decorations to HTML
-
-
-SCRIPTS (shell, bash, etc.)
-===========================
-StartOzServer.oz --- implements the Oz-side of the Org-babel Oz
interface
-dir2org.zsh --- Org compatible fs structure output
-ditaa.jar --- ASCII to PNG converter by Stathis Sideris, GPL
-org-docco.org --- docco side-by-side annotated code export to HTML
-org2hpda --- Generate hipster pda style printouts from Org-mode
-staticmathjax --- XULRunner application to process MathJax statically
-x11idle.c --- get the idle time of your X session
-
-This directory also contains supporting files for the following
-packages: ob-oz.el, org-docco.org, and org-static-mathjax.el.
diff --git a/contrib/lisp/ob-arduino.el b/contrib/lisp/ob-arduino.el
deleted file mode 100644
index ff19644..0000000
--- a/contrib/lisp/ob-arduino.el
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; ob-arduino.el --- Org-mode Babel support for Arduino.
-;;
-;; Authors: stardiviner <numbchild@gmail.com>
-;; Package-Requires: ((emacs "24.4") (org "24.1"))
-;; Package-Version: 1.0
-;; Keywords: arduino org babel
-;; homepage: https://github.com/stardiviner/arduino-mode
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; Like the following src block, press =[C-c C-c]= to upload to Arduino board.
-;;
-;; #+begin_src arduino
-;; // the setup function runs once when you press reset or power the board
-;; void setup() {
-;; // initialize digital pin LED_BUILTIN as an output.
-;; pinMode(LED_BUILTIN, OUTPUT);
-;; }
-;;
-;; // the loop function runs over and over again forever
-;; void loop() {
-;; digitalWrite(LED_BUILTIN, HIGH); // turn the LED on (HIGH is the
voltage level)
-;; delay(100); // wait for 0.1 second
-;; digitalWrite(LED_BUILTIN, LOW); // turn the LED off by making the
voltage LOW
-;; delay(100); // wait for 0.1 second
-;; }
-;; #+end_src
-;;
-;;; Code:
-
-(require 'org)
-(require 'ob)
-(require 'arduino-mode nil t)
-
-(defgroup ob-arduino nil
- "org-mode blocks for Arduino."
- :group 'org)
-
-(defcustom ob-arduino:program "arduino"
- "Default Arduino program name."
- :group 'ob-arduino
- :type 'string)
-
-(defcustom ob-arduino:port "/dev/ttyACM0"
- "Default Arduino port."
- :group 'ob-arduino
- :type 'string)
-
-(defcustom ob-arduino:board "arduino:avr:uno"
- "Default Arduino board."
- :group 'ob-arduino
- :type 'string)
-
-
-(defvar org-babel-default-header-args:sclang nil)
-
-;;;###autoload
-(defun org-babel-execute:arduino (body params)
- "org-babel arduino hook."
- (let* ((port (cdr (assoc :port params)))
- (board (cdr (assoc :board params)))
- (cmd (mapconcat 'identity (list
- ob-arduino:program "--upload"
- (if port (concat "--port " port))
- (if board (concat "--board " board))
- ) " "))
- (code (org-babel-expand-body:generic body params))
- (src-file (org-babel-temp-file "ob-arduino-" ".ino")))
- ;; delete all `ob-arduino' temp files, otherwise arduino will compile all
- ;; ob-arduino temp files, and report error.
- (mapc
- (lambda (f)
- (unless (file-directory-p f)
- (delete-file (expand-file-name f org-babel-temporary-directory))))
- (directory-files
- (file-name-directory (org-babel-temp-file "ob-arduino-" ".ino"))
- nil ".ino"))
- ;; specify file for arduino command.
- (with-temp-file src-file
- (insert code))
- (org-babel-eval
- (concat ob-arduino:program
- " " "--upload"
- " " (if port (concat "--port " port))
- " " (if board (concat "--board " board))
- " " src-file)
- "" ; pass empty string "" as `BODY' to
`org-babel--shell-command-on-region'
- ;; to fix command `arduino' don't accept string issue.
- )
- ))
-
-
-;;;###autoload
-(eval-after-load 'org
- '(add-to-list 'org-src-lang-modes '("arduino" . arduino)))
-
-
-
-
-(provide 'ob-arduino)
-
-;;; ob-arduino.el ends here
diff --git a/contrib/lisp/ob-clojure-literate.el
b/contrib/lisp/ob-clojure-literate.el
deleted file mode 100644
index 172f7c0..0000000
--- a/contrib/lisp/ob-clojure-literate.el
+++ /dev/null
@@ -1,294 +0,0 @@
-;;; ob-clojure-literate.el --- Clojure's Org-mode Literate Programming.
-
-;; Authors: stardiviner <numbchild@gmail.com>
-;; Package-Requires: ((emacs "24.4") (org "9") (cider "0.16.0") (dash
"2.12.0"))
-;; Package-Version: 1.1
-;; Keywords: tools
-;; homepage: https://github.com/stardiviner/ob-clojure-literate
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Auto setup ob-clojure-literate scaffold and jack-in Clojure project.
-;;
-;; Usage:
-;;
-;; [M-x ob-clojure-literate-mode] to toggle this minor mode.
-
-;;; Code:
-
-(require 'ob-clojure)
-(require 'cider nil t)
-
-(defgroup ob-clojure-literate nil
- "Clojure's Org-mode Literate Programming."
- :prefix "ob-clojure-literate-"
- :group 'ob-babel)
-
-;;;###autoload
-(defcustom ob-clojure-literate-auto-jackin-p nil
- "Auto jack in ob-clojure project.
-Don't auto jack in by default for not rude."
- :type 'boolean
- :group 'ob-clojure-literate)
-
-(defcustom ob-clojure-literate-project-location nil
- "The location for `ob-clojure-literate' scaffold project.
-If it is nil, then `cider-jack-in' will jack-in outside of Clojure project.
-If it is a directory, `ob-clojure-literate' will try to create Clojure project
automatically."
- :type 'string
- :group 'ob-clojure-literate)
-
-(defvar ob-clojure-literate-session nil)
-(defvar ob-clojure-literate-original-ns nil)
-(defvar ob-clojure-literate-session-ns nil)
-(defvar ob-clojure-literate-cider-connections nil)
-
-(defcustom ob-clojure-literate-default-session "*cider-repl localhost*"
- "The default session name for `ob-clojure-literate'."
- :type 'string
- :group 'ob-clojure-literate)
-
-(defun ob-clojure-literate-any-connection-p ()
- "Return t if have any CIDER connection."
- (and
- ;; handle the case `cider-jack-in' is not finished creating connection, but
`ob-clojure-literate-mode' is enabled.
- (not (null (cider-connections)))
- (not (null ob-clojure-literate-session)) ; before mode enabled, it is nil.
- (not (string-empty-p ob-clojure-literate-session)) ; after disable, it is
"".
- ))
-
-(defun ob-clojure-literate-get-session-list ()
- "Return a list of available started CIDER REPL sessions list."
- (mapcar #'buffer-name
- ;; for multiple connections case.
- ;; get global value instead of buffer local.
- (default-value 'cider-connections)))
-
-;;; Do not allow "ob-clojure" project session name.
-(defun ob-clojure-literate-set-session ()
- "Set session name for buffer local."
- ;; if default session is the only one in connections list.
- (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
- (member ob-clojure-literate-default-session
(ob-clojure-literate-get-session-list)))
- (setq-local ob-clojure-literate-session
ob-clojure-literate-default-session)
- ;; if have any connections, choose one from them.
- (if (ob-clojure-literate-any-connection-p)
- (setq-local ob-clojure-literate-session
- (completing-read "Choose ob-clojure-literate :session : "
- (ob-clojure-literate-get-session-list)))
- ;; if none, set to default session name to fix `ob-clojure-literate-mode'
- ;; is enabled before `cider-jack-in' generated connections.
- (setq-local ob-clojure-literate-session
- ob-clojure-literate-default-session))))
-
-;;;###autoload
-(defun ob-clojure-literate-specify-session ()
- "Specify ob-clojure header argument :session with value selected from a list
of available sessions."
- (interactive)
- (let ((lang (nth 0 (org-babel-get-src-block-info))))
- (if (and (string= lang "clojure") ; only in clojure src block.
- (car (seq-filter ; only when :session is not specified yet.
- (lambda (header-argument)
- (if (eq (car header-argument) :session)
- (not (null (cdr header-argument)))))
- (nth 2 (org-babel-get-src-block-info)))))
- (org-babel-insert-header-arg
- "session"
- (format "\"%s\""
- (completing-read
- "Choose :session for ob-clojure-literate: "
- (ob-clojure-literate-get-session-list))))
- (message "This function only used in `clojure' src block.")))
- )
-
-;;; Auto start CIDER REPL session in a complete Leiningen project environment
for Org-mode Babel to jack-in.
-;;;###autoload
-(defun ob-clojure-literate-auto-jackin ()
- "Auto setup ob-clojure-literate scaffold and jack-in Clojure project."
- (interactive)
- (cond
- ;; jack-in outside of Clojure project.
- ((null ob-clojure-literate-project-location)
- (if (member (get-buffer "*cider-repl localhost*") cider-connections)
- (message "CIDER default session already launched.")
- (cider-jack-in nil)))
- ((not (null ob-clojure-literate-project-location))
- (unless (file-directory-p (expand-file-name
ob-clojure-literate-project-location))
- (make-directory ob-clojure-literate-project-location t)
- (let ((default-directory ob-clojure-literate-project-location))
- (shell-command "lein new ob-clojure")))
- (unless (or
- (and (cider-connected-p)
- (if (not (null ob-clojure-literate-session))
- (seq-contains cider-connections (get-buffer
ob-clojure-literate-session))))
- cider-connections
- (ob-clojure-literate-any-connection-p))
- ;; return back to original file.
- (if (not (and (= (length (ob-clojure-literate-get-session-list)) 1)
- (member ob-clojure-literate-default-session
(ob-clojure-literate-get-session-list))))
- (save-window-excursion
- (find-file (expand-file-name (concat
ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj")))
- (with-current-buffer "core.clj"
- (cider-jack-in))))))))
-
-(defun ob-clojure-literate-set-local-cider-connections (toggle?)
- "Set buffer local `cider-connections' for `ob-clojure-literate-mode'
`TOGGLE?'."
- (if toggle?
- (progn
- (setq ob-clojure-literate-cider-connections cider-connections)
- (unless (local-variable-if-set-p 'cider-connections)
- (make-local-variable 'cider-connections))
- (setq-local cider-connections ob-clojure-literate-cider-connections))
- ;; store/restore emptied CIDER connections by `ob-clojure-literate-enable'.
- (kill-local-variable 'cider-connections) ; kill local variable so that I
can get the original global variable value.
- ;; Empty all CIDER connections to avoid `cider-current-connection' return
any connection.
- ;; FIXME: when try to enable, `cider-connections' is local and nil.
- ;; (if (and (= (length (ob-clojure-literate-get-session-list)) 1)
- ;; (member ob-clojure-literate-default-session
(ob-clojure-literate-get-session-list))))
- ;; (unless (local-variable-if-set-p 'cider-connections)
- ;; (make-local-variable 'cider-connections))
- ;; (setq-local cider-connections '())
- ))
-
-(defun ob-clojure-literate-set-ns (body params)
- "Fix the issue that `cider-current-ns' try to invoke `clojure-find-ns' to
extract ns from buffer."
- ;; TODO: Is it possible to find ns in `body'?
- (when (ob-clojure-literate-any-connection-p)
- (setq ob-clojure-literate-original-ns (cider-current-ns))
- (with-current-buffer ob-clojure-literate-session
- (setq ob-clojure-literate-session-ns cider-buffer-ns))
- (setq-local cider-buffer-ns (or (cdr (assq :ns params))
- ob-clojure-literate-session-ns)))
- (message (format "ob-clojure-literate: current CIDER ns is [%s]."
cider-buffer-ns)))
-
-(defun ob-clojure-literate-set-local-session (toggle?)
- "Set buffer local `org-babel-default-header-args:clojure' for
`ob-clojure-literate-mode' `TOGGLE?'."
- (if toggle?
- (progn
- ;; set local default session for ob-clojure.
- (setq ob-clojure-literate-session (ob-clojure-literate-set-session))
- (unless (local-variable-if-set-p
'org-babel-default-header-args:clojure)
- (make-local-variable 'org-babel-default-header-args:clojure))
- (add-to-list 'org-babel-default-header-args:clojure
- `(:session . ,ob-clojure-literate-session))
- )
- ;; remove :session from buffer local default header arguments list.
- (unless (local-variable-if-set-p 'org-babel-default-header-args:clojure)
- (make-local-variable 'org-babel-default-header-args:clojure))
- (setq org-babel-default-header-args:clojure
- (delq t
- (mapcar
- (lambda (cons) (if (eq (car cons) :session) t cons))
- org-babel-default-header-args:clojure)))))
-
-
-;;; Support header arguments :results graphics :file "image.png" by inject
Clojure code.
-(defun ob-clojure-literate-inject-code (args)
- "Inject Clojure code into `BODY' in `ARGS'.
-It is used to change Clojure currently working directory in a FAKE way.
-And generate inline graphics image file link result.
-Use header argument like this:
-
-:results graphics :file \"incanter-plot.png\"
-
-Then you need to assign image variable to this :file value like:
-(def incanter-plot (histogram (sample-normal 1000)))
-
-*NOTE*: Currently only support Incanter's `save' function.
-"
- (let* ((body (nth 0 args))
- (params (nth 1 args))
- (dir (cdr (assq :dir params)))
- (default-directory (and (buffer-file-name) (file-name-directory
(buffer-file-name))))
- (directory (and dir (file-name-as-directory (expand-file-name dir))))
- (result-type (cdr (assq :results params)))
- (file (cdr (assq :file params)))
- (file-name (and file (file-name-base file)))
- ;; TODO: future support `:graphics-file' to avoid collision.
- (graphics-result (member "graphics" (cdr (assq :result-params
params))))
- ;; (graphics-file (cdr (assq :graphics-file params)))
- ;; (graphics-name (file-name-base graphics-file))
- (prepend-to-body (lambda (code)
- (setq body (concat code "\n" body))))
- (append-to-body (lambda (code)
- (setq body (concat body "\n" code "\n"))))
- )
- (when directory
- (unless (file-directory-p (expand-file-name directory))
- (warn (format "Target directory %s does not exist, please create it."
dir))))
- (when file
- (funcall append-to-body
- (format "(save %s \"%s\")" file-name (concat directory file)))
- )
- (list body params) ; return modified argument list
- ))
-
-;;; support :results graphics :dir "data/image" :file "incanter-plot.png"
-(defun ob-clojure-literate-support-graphics-result (result)
- "Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\"
-reset `RESULT' to `nil'."
- (let* ((params (nth 2 info))
- (graphics-result (member "graphics" (cdr (assq :result-params
params)))))
- (if graphics-result
- (setq result nil))
- result))
-
-
-(defvar ob-clojure-literate-mode-map
- (let ((map (make-sparse-keymap)))
- map)
- "Keymap for `ob-clojure-literate-mode'.")
-
-(define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session)
-(define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin)
-;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp)
-;; (define-key org-babel-map (kbd "M-d") 'cider-doc)
-
-;;;###autoload
-(defun ob-clojure-literate-enable ()
- "Enable Org-mode buffer locally for `ob-clojure-literate'."
- (when (and (not (null cider-connections)) ; only enable
`ob-clojure-literate-mode' when has CIDER connections.
- (equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only
works in `org-mode'.
- (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
- (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
- (advice-add 'org-babel-execute:clojure :before
#'ob-clojure-literate-set-ns)
- (advice-add 'org-babel-expand-body:clojure :filter-args
#'ob-clojure-literate-inject-code)
- (advice-add 'org-babel-execute:clojure :filter-return
#'ob-clojure-literate-support-graphics-result)
- (message "ob-clojure-literate minor mode enabled.")))
-
-;;;###autoload
-(defun ob-clojure-literate-disable ()
- "Disable Org-mode buffer locally for `ob-clojure-literate'."
- (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-set-ns)
- (advice-remove 'org-babel-expand-body:clojure
#'ob-clojure-literate-inject-code)
- (advice-remove 'org-babel-execute:clojure
#'ob-clojure-literate-support-graphics-result)
- (setq-local cider-buffer-ns ob-clojure-literate-original-ns)
- (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode)
- (ob-clojure-literate-set-local-session ob-clojure-literate-mode)
- (message "ob-clojure-literate minor mode disabled."))
-
-;;;###autoload
-(if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin))
-
-;;;###autoload
-(define-minor-mode ob-clojure-literate-mode
- "A minor mode to toggle `ob-clojure-literate'."
- :require 'ob-clojure-literate
- :init-value nil
- :lighter " clj-lp"
- :group 'ob-clojure-literate
- :keymap ob-clojure-literate-mode-map
- :global nil
- (if ob-clojure-literate-mode
- (ob-clojure-literate-enable)
- (ob-clojure-literate-disable))
- )
-
-
-
-(provide 'ob-clojure-literate)
-
-;;; ob-clojure-literate.el ends here
diff --git a/contrib/lisp/ob-csharp.el b/contrib/lisp/ob-csharp.el
deleted file mode 100644
index 1a0be15..0000000
--- a/contrib/lisp/ob-csharp.el
+++ /dev/null
@@ -1,83 +0,0 @@
-;;; ob-csharp.el --- org-babel functions for csharp evaluation
-
-;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
-
-;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric
Schulte
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Currently this only supports the external compilation and execution
-;; of csharp code blocks (i.e., no session support).
-
-;;; Code:
-(require 'ob)
-
-(defvar org-babel-tangle-lang-exts)
-(add-to-list 'org-babel-tangle-lang-exts '("csharp" . "cs"))
-
-(defcustom org-babel-csharp-command "mono"
- "Name of the csharp command.
-May be either a command in the path, like mono
-or an absolute path name, like /usr/local/bin/mono
-parameters may be used, like mono -verbose"
- :group 'org-babel
- :version "24.3"
- :type 'string)
-
-(defcustom org-babel-csharp-compiler "mcs"
- "Name of the csharp compiler.
-May be either a command in the path, like mcs
-or an absolute path name, like /usr/local/bin/mcs
-parameters may be used, like mcs -warnaserror+"
- :group 'org-babel
- :version "24.3"
- :type 'string)
-
-(defun org-babel-execute:csharp (body params)
- (let* ((full-body (org-babel-expand-body:generic body params))
- (cmpflag (or (cdr (assq :cmpflag params)) ""))
- (cmdline (or (cdr (assq :cmdline params)) ""))
- (src-file (org-babel-temp-file "csharp-src-" ".cs"))
- (exe-file (concat (file-name-sans-extension src-file) ".exe"))
- (compile
- (progn (with-temp-file src-file (insert full-body))
- (org-babel-eval
- (concat org-babel-csharp-compiler " " cmpflag " " src-file)
""))))
- (let ((results (org-babel-eval (concat org-babel-csharp-command " "
cmdline " " exe-file) "")))
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assq :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
- (org-babel-pick-name
- (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
-
-(defun org-babel-prep-session:csharp (session params)
- "Return an error because csharp does not support sessions."
- (error "Sessions are not supported for CSharp"))
-
-(provide 'ob-csharp)
-
-
-
-;;; ob-csharp.el ends here
diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el
deleted file mode 100644
index be3f1fd..0000000
--- a/contrib/lisp/ob-eukleides.el
+++ /dev/null
@@ -1,98 +0,0 @@
-;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
-
-;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
-
-;; Author: Luis Anaya
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating eukleides script.
-;;
-;; Inspired by Ian Yang's org-export-blocks-format-eukleides
-;; https://www.emacswiki.org/emacs/org-export-blocks-format-eukleides.el
-
-;;; Requirements:
-
-;; eukleides | http://eukleides.org
-;; eukleides | `org-eukleides-path' should point to the eukleides
executablexs
-
-;;; Code:
-(require 'ob)
-(require 'ob-eval)
-
-(defvar org-babel-default-header-args:eukleides
- '((:results . "file") (:exports . "results"))
- "Default arguments for evaluating a eukleides source block.")
-
-(defcustom org-eukleides-path nil
- "Path to the eukleides executable file."
- :group 'org-babel
- :type 'string)
-
-(defcustom org-eukleides-eps-to-raster nil
- "Command used to convert EPS to raster. Nil for no conversion."
- :group 'org-babel
- :type '(choice
- (repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
- (const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b}" )
- (const :tag "NetPNM" "a=%s;b=%s;pstopnm -stdout ${a} | pnmtopng >
${b}" )
- (const :tag "None" nil)))
-
-(defun org-babel-execute:eukleides (body params)
- "Execute a block of eukleides code with org-babel.
-This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assq :results params)) "")))
- (out-file (or (cdr (assq :file params))
- (error "Eukleides requires a \":file\" header
argument")))
- (cmdline (cdr (assq :cmdline params)))
- (in-file (org-babel-temp-file "eukleides-"))
- (java (or (cdr (assq :java params)) ""))
- (cmd (if (not org-eukleides-path)
- (error "`org-eukleides-path' is not set")
- (concat (expand-file-name org-eukleides-path)
- " -b --output="
- (org-babel-process-file-name
- (concat
- (file-name-sans-extension out-file) ".eps"))
- " "
- (org-babel-process-file-name in-file)))))
- (unless (file-exists-p org-eukleides-path)
- (error "Could not find eukleides at %s" org-eukleides-path))
-
- (if (string= (file-name-extension out-file) "png")
- (if org-eukleides-eps-to-raster
- (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")))
-
- (with-temp-file in-file (insert body))
- (message "%s" cmd) (org-babel-eval cmd "")
- nil)) ;; signal that output has already been written to file
-
-(defun org-babel-prep-session:eukleides (session params)
- "Return an error because eukleides does not support sessions."
- (error "Eukleides does not support sessions"))
-
-(provide 'ob-eukleides)
-
-
-
-;;; ob-eukleides.el ends here
diff --git a/contrib/lisp/ob-fomus.el b/contrib/lisp/ob-fomus.el
deleted file mode 100644
index 6ff27b6..0000000
--- a/contrib/lisp/ob-fomus.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; ob-fomus.el --- Org-babel functions for fomus evaluation
-
-;; Copyright (C) 2011-2014 Torsten Anders
-
-;; Author: Torsten Anders
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://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, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating Fomus source code.
-;; For information on Fomus see http://fomus.sourceforge.net/
-;;
-;; This differs from most standard languages in that
-;;
-;; 1) there is no such thing as a "session" in fomus
-;;
-;; 2) we are generally only going to return results of type "file"
-;;
-;; 3) we are adding the "file" and "cmdline" header arguments
-;;
-;; 4) there are no variables (at least for now)
-
-;;; Code:
-(require 'ob)
-(require 'ob-eval)
-
-(defvar org-babel-default-header-args:fomus
- '((:results . "file") (:exports . "results"))
- "Default arguments to use when evaluating a fomus source block.")
-
-(defun org-babel-expand-body:fomus (body params)
- "Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (org-babel--get-vars params)))
- (mapc
- (lambda (pair)
- (let ((name (symbol-name (car pair)))
- (value (cdr pair)))
- (setq body
- (replace-regexp-in-string
- (concat "\$" (regexp-quote name))
- (if (stringp value) value (format "%S" value))
- body))))
- vars)
- body))
-
-(defun org-babel-execute:fomus (body params)
- "Execute a block of Fomus code with org-babel.
-This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (cdr (assq :result-params params)))
- (out-file (cdr (assq :file params)))
- (cmdline (cdr (assq :cmdline params)))
- (cmd (or (cdr (assq :cmd params)) "fomus"))
- (in-file (org-babel-temp-file "fomus-" ".fms")))
- (with-temp-file in-file
- (insert (org-babel-expand-body:fomus body params)))
- ;; TMP: testing
- ;; (message (concat cmd
- ;; " " (org-babel-process-file-name in-file)
- ;; " " cmdline
- ;; " -o " (org-babel-process-file-name out-file)))
- (org-babel-eval
- (concat cmd
- " " (org-babel-process-file-name in-file)
- " " cmdline
- " -o " (org-babel-process-file-name out-file)) "")
- nil)) ;; signal that output has already been written to file
-
-(defun org-babel-prep-session:fomus (session params)
- "Return an error because Fomus does not support sessions."
- (error "Fomus does not support sessions"))
-
-(provide 'ob-fomus)
-
-;;; ob-fomus.el ends here
diff --git a/contrib/lisp/ob-julia.el b/contrib/lisp/ob-julia.el
deleted file mode 100644
index 536d9ad..0000000
--- a/contrib/lisp/ob-julia.el
+++ /dev/null
@@ -1,302 +0,0 @@
-;;; ob-julia.el --- org-babel functions for julia code evaluation
-
-;; Copyright (C) 2013, 2014 G. Jay Kerns
-;; Author: G. Jay Kerns, based on ob-R.el by Eric Schulte and Dan Davison
-;; Maintainer: Alberto Ramos
-
-;; 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 julia code.
-;;
-;; See https://github.com/gjkerns/ob-julia/blob/master/ob-julia-doc.org
-;; for detailed instructions on how to get started. The git repository
-;; contains more documentation: git://github.com/gjkerns/ob-julia.git
-
-;;; Code:
-(require 'ob)
-(require 'cl-lib)
-
-(declare-function orgtbl-to-csv "org-table" (table params))
-(declare-function julia "ext:ess-julia" (&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:julia
- '((width . :any)
- (horizontal . :any)
- (results . ((file list vector table scalar verbatim)
- (raw org html latex code pp wrap)
- (replace silent append prepend)
- (output value graphics))))
- "julia-specific header arguments.")
-
-(add-to-list 'org-babel-tangle-lang-exts '("julia" . "jl"))
-
-(defvar org-babel-default-header-args:julia '())
-
-(defcustom org-babel-julia-command inferior-julia-program-name
- "Name of command to use for executing julia code."
- :group 'org-babel
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'string)
-
-(defvar ess-local-process-name) ; dynamically scoped
-(defun org-babel-edit-prep:julia (info)
- (let ((session (cdr (assq :session (nth 2 info)))))
- (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
- (save-match-data (org-babel-julia-initiate-session session nil)))))
-
-(defun org-babel-expand-body:julia (body params &optional graphics-file)
- "Expand BODY according to PARAMS, return the expanded body."
- (let ((graphics-file
- (or graphics-file (org-babel-julia-graphical-output-file params))))
- (mapconcat
- #'identity
- ((lambda (inside)
- (if graphics-file
- inside
- inside))
- (append (org-babel-variable-assignments:julia params)
- (list body))) "\n")))
-
-(defun org-babel-execute:julia (body params)
- "Execute a block of julia code.
-This function is called by `org-babel-execute-src-block'."
- (save-excursion
- (let* ((result-params (cdr (assq :result-params params)))
- (result-type (cdr (assq :result-type params)))
- (session (org-babel-julia-initiate-session
- (cdr (assq :session params)) params))
- (colnames-p (cdr (assq :colnames params)))
- (rownames-p (cdr (assq :rownames params)))
- (graphics-file (org-babel-julia-graphical-output-file params))
- (full-body (org-babel-expand-body:julia body params graphics-file))
- (result
- (org-babel-julia-evaluate
- session full-body result-type result-params
- (or (equal "yes" colnames-p)
- (org-babel-pick-name
- (cdr (assq :colname-names params)) colnames-p))
- (or (equal "yes" rownames-p)
- (org-babel-pick-name
- (cdr (assq :rowname-names params)) rownames-p)))))
- (if graphics-file nil result))))
-
-(defun org-babel-prep-session:julia (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (org-babel-julia-initiate-session session params))
- (var-lines (org-babel-variable-assignments:julia 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:julia (session body params)
- "Load BODY into SESSION."
- (save-window-excursion
- (let ((buffer (org-babel-prep-session:julia 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:julia (params)
- "Return list of julia statements assigning the block's variables."
- (let ((vars (org-babel--get-vars params)))
- (mapcar
- (lambda (pair)
- (org-babel-julia-assign-elisp
- (car pair) (cdr pair)
- (equal "yes" (cdr (assq :colnames params)))
- (equal "yes" (cdr (assq :rownames params)))))
- (mapcar
- (lambda (i)
- (cons (car (nth i vars))
- (org-babel-reassemble-table
- (cdr (nth i vars))
- (cdr (nth i (cdr (assq :colname-names params))))
- (cdr (nth i (cdr (assq :rowname-names params)))))))
- (org-number-sequence 0 (1- (length vars)))))))
-
-(defun org-babel-julia-quote-csv-field (s)
- "Quote field S for export to julia."
- (if (stringp s)
- (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
- (format "%S" s)))
-
-(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 (cl-remove-if-not
- #'sequencep value))))
- (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)
- (unless (listp (car value)) (setq value (list value)))
- (with-temp-file transition-file
- (insert
- (orgtbl-to-csv value '(:fmt org-babel-julia-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 = readcsv(\"%s\")" name file)
- (format "%s = readcsv(\"%s\")"
- name file))))
- (format "%s = %s" name (org-babel-julia-quote-csv-field value))))
-
-(defvar ess-ask-for-ess-directory) ; dynamically scoped
-
-(defun org-babel-julia-initiate-session (session params)
- "If there is not a current julia process then create one."
- (unless (string= session "none")
- (let ((session (or session "*julia*"))
- (ess-ask-for-ess-directory
- (and (and (boundp 'ess-ask-for-ess-directory)
ess-ask-for-ess-directory)
- (not (cdr (assq :dir params))))))
- (if (org-babel-comint-buffer-livep session)
- session
- (save-window-excursion
- (require 'ess) (julia)
- (rename-buffer
- (if (bufferp session)
- (buffer-name session)
- (if (stringp session)
- session
- (buffer-name))))
- (current-buffer))))))
-
-(defun org-babel-julia-associate-session (session)
- "Associate julia code buffer with a julia 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-julia-graphical-output-file (params)
- "Name of file to which julia should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
-(defvar org-babel-julia-eoe-indicator "print(\"org_babel_julia_eoe\")")
-(defvar org-babel-julia-eoe-output "org_babel_julia_eoe")
-
-(defvar org-babel-julia-write-object-command "writecsv(\"%s\",%s)")
-
-;; The following was a very complicated write object command
-;; The replacement needs to add error catching
-;(defvar org-babel-julia-write-object-command
"{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
-
-(defun org-babel-julia-evaluate
- (session body result-type result-params column-names-p row-names-p)
- "Evaluate julia code in BODY."
- (if session
- (org-babel-julia-evaluate-session
- session body result-type result-params column-names-p row-names-p)
- (org-babel-julia-evaluate-external-process
- body result-type result-params column-names-p row-names-p)))
-
-(defun org-babel-julia-evaluate-external-process
- (body result-type result-params column-names-p row-names-p)
- "Evaluate BODY in external julia 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 "julia-")))
- (org-babel-eval org-babel-julia-command
- (format org-babel-julia-write-object-command
- (org-babel-process-file-name tmp-file 'noquote)
- (format "begin\n%s\nend" body)))
- (org-babel-julia-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-julia-command body))))
-
-(defun org-babel-julia-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 "julia-")))
- (org-babel-comint-eval-invisibly-and-wait-for-file
- session tmp-file
- (format org-babel-julia-write-object-command
- (org-babel-process-file-name tmp-file 'noquote) "ans"))
- (org-babel-julia-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-julia-eoe-output)
- (insert (mapconcat #'org-babel-chomp
- (list body org-babel-julia-eoe-indicator)
- "\n"))
- (inferior-ess-send-input)))))) "\n"))))
-
-(defun org-babel-julia-process-value-result (result column-names-p)
- "julia-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-julia)
-
-;;; ob-julia.el ends here
diff --git a/contrib/lisp/ob-mathematica.el b/contrib/lisp/ob-mathematica.el
deleted file mode 100644
index cb35dec..0000000
--- a/contrib/lisp/ob-mathematica.el
+++ /dev/null
@@ -1,81 +0,0 @@
-;;; 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)
-
-(declare-function org-trim "org" (s &optional keep-lead))
-
-;; 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 (assq :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-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
deleted file mode 100644
index adc7c37..0000000
--- a/contrib/lisp/ob-mathomatic.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
-
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-
-;; Author: Eric S Fraga
-;; Eric Schulte
-;; Luis Anaya (Mathomatic)
-
-;; Keywords: literate programming, reproducible research, mathomatic
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating mathomatic entries.
-;;
-;; This differs from most standard languages in that
-;;
-;; 1) there is no such thing as a "session" in mathomatic
-;;
-;; 2) we are adding the "cmdline" header argument
-
-;;; Code:
-(require 'ob)
-
-(defvar org-babel-tangle-lang-exts)
-(add-to-list 'org-babel-tangle-lang-exts '("mathomatic" . "math"))
-
-(defvar org-babel-default-header-args:mathomatic '())
-
-(defcustom org-babel-mathomatic-command
- (if (boundp 'mathomatic-command) mathomatic-command "mathomatic")
- "Command used to call mathomatic on the shell."
- :group 'org-babel)
-
-(defun org-babel-mathomatic-expand (body params)
- "Expand a block of Mathomatic code according to its header arguments."
- (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
-called by `org-babel-execute-src-block'."
- (message "executing Mathomatic source code block")
- (let ((result-params (split-string (or (cdr (assq :results params)) "")))
- (result
- (let* ((cmdline (or (cdr (assq :cmdline params)) ""))
- (in-file (org-babel-temp-file "mathomatic-" ".math"))
- (cmd (format "%s -t -c -q %s %s"
- org-babel-mathomatic-command in-file cmdline)))
- (with-temp-file in-file (insert (org-babel-mathomatic-expand body
params)))
- (message cmd)
- ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed
'/^$/d' "
- (mapconcat
- #'identity
- (delq nil
- (mapcar (lambda (line)
- (unless (or (string-match "batch" line)
- (string-match "^rat: replaced .*$"
line)
- (= 0 (length line)))
- line))
- (split-string raw "[\r\n]"))) "\n"))
- (org-babel-eval cmd "")))))
- (if (org-babel-mathomatic-graphical-output-file params)
- nil
- (if (or (member "scalar" result-params)
- (member "verbatim" result-params)
- (member "output" result-params))
- result
- (let ((tmp-file (org-babel-temp-file "mathomatic-res-")))
- (with-temp-file tmp-file (insert result))
- (org-babel-import-elisp-from-file tmp-file))))))
-
-(defun org-babel-prep-session:mathomatic (session params)
- (error "Mathomatic does not support sessions"))
-
-(defun org-babel-mathomatic-var-to-mathomatic (pair)
- "Convert an elisp val into a string of mathomatic code specifying a var
-of the same value."
- (let ((var (car pair))
- (val (cdr pair)))
- (when (symbolp val)
- (setq val (symbol-name val))
- (when (= (length val) 1)
- (setq val (string-to-char val))))
- (format "%s=%s" var
- (org-babel-mathomatic-elisp-to-mathomatic val))))
-
-(defun org-babel-mathomatic-graphical-output-file (params)
- "Name of file to which mathomatic should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
-(defun org-babel-mathomatic-elisp-to-mathomatic (val)
- "Return a string of mathomatic code which evaluates to VAL."
- (if (listp val)
- (mapconcat #'org-babel-mathomatic-elisp-to-mathomatic val " ")
- (format "%s" val)))
-
-(provide 'ob-mathomatic)
-
-;;; ob-mathomatic.el ends here
diff --git a/contrib/lisp/ob-oz.el b/contrib/lisp/ob-oz.el
deleted file mode 100644
index 46bf536..0000000
--- a/contrib/lisp/ob-oz.el
+++ /dev/null
@@ -1,294 +0,0 @@
-;;; ob-oz.el --- Org-babel functions for Oz evaluation
-
-;; Copyright (C) 2009-2014 Torsten Anders and Eric Schulte
-
-;; Author: Torsten Anders and Eric Schulte
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
-;; Version: 0.02
-
-;; 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:
-
-;; Org-Babel support for evaluating Oz source code.
-;;
-;; Oz code is always send to the Oz Programming Environment (OPI), the
-;; Emacs mode and compiler interface for Oz programs. Therefore, only
-;; session mode is supported. In practice, non-session code blocks are
-;; handled equally well by the session mode. However, only a single
-;; session is supported. Consequently, the :session header argument is
-;; ignored.
-;;
-;; The Org-babel header argument :results is interpreted as
-;; follows. :results output requires the respective code block to be
-;; an Oz statement and :results value requires an Oz
-;; expression. Currently, results are only supported for expressions
-;; (i.e. the result of :results output is always nil).
-;;
-;; Expression evaluation happens synchronously. Therefore there is an
-;; additional header argument :wait-time <number>, which specifies the
-;; maximum time to wait for the result of a given expression. nil
-;; means to wait as long as it takes to get a result (potentially wait
-;; forever).
-;;
-;; NOTE: Currently the copyright of this file may not be in a state to
-;; permit inclusion as core software into Emacs or Org-mode.
-
-;;; Requirements:
-
-;; - Mozart Programming System, the implementation of the Oz
-;; programming language (http://www.mozart-oz.org/), which includes
-;; the major mode mozart for editing Oz programs.
-;;
-;; - StartOzServer.oz which is located in the contrib/scripts
-;; directory of the Org-mode repository
-
-;;; TODO:
-
-;; - Decide: set communication to \\switch -threadedqueries?
-;;
-;; - Only start Oz compiler when required, e.g., load Org-babel only when
needed?
-;;
-;; - Avoid synchronous evaluation to avoid blocking Emacs (complex
-;; Strasheela programs can take long to find a result..). In order
-;; to cleanly map code blocks to their associated results (which can
-;; arrive then in any order) I could use IDs
-;; (e.g. integers). However, how do I do concurrency in Emacs Lisp,
-;; and how can I define org-babel-execute:oz concurrently.
-;;
-;; - Expressions are rarely used in Oz at the top-level, and using
-;; them in documentation and Literate Programs will cause
-;; confusion. Idea: hide expression from reader and instead show
-;; them statement (e.g., MIDI output statement) and then include
-;; result in Org file. Implementation: for expressions (:results
-;; value) support an additional header argument that takes arbitrary
-;; Oz code. This code is not seen by the reader, but will be used
-;; for the actual expression at the end. Alternative: feed all
-;; relevant code as statement (:results output), then add expression
-;; as extra code block which outputs, e.g., file name (so the file
-;; name must be accessible by global var), but the code of this
-;; extra codeblock is not seen. Hm, in that case it might be even
-;; more easy to manually add this link to the Org file.
-;;
-
-
-(require 'ob)
-;;; major mode for editing Oz programs
-(require 'mozart nil t)
-
-;;
-;; Interface to communicate with Oz.
-;; (1) For statements without any results: oz-send-string
-;; (2) For expressions with a single result: oz-send-string-expression
-;; (defined in org-babel-oz-ResultsValue.el)
-;;
-
-;; oz-send-string-expression implements an additional very direct
-;; communication between Org-babel and the Oz compiler. Communication
-;; with the Oz server works already without this code via the function
-;; oz-send-string from mozart.el.in, but this function does not get
-;; back any results from Oz to Emacs. The following code creates a
-;; socket for sending code to the OPI compiler and results are
-;; returned by the same socket. On the Oz side, a socket is opened and
-;; connected to the compiler of the OPI (via oz-send-string). On the
-;; Emacs side, a connection to this socket is created for feeding code
-;; and receiving results. This additional communication channel to the
-;; OPI compiler ensures that results are returned cleanly (e.g., only
-;; the result of the sent code is returned, no parsing or any
-;; processing of *Oz Emulator* is required).
-;;
-;; There is no buffer, nor sentinel involved. Oz code is send
-;; directly, and results from Oz are send back, but Emacs Lisp
-;; requires a filter function for processing results.
-
-(defvar org-babel-oz-server-dir
- (file-name-as-directory
- (expand-file-name
- "contrib/scripts"
- (file-name-as-directory
- (expand-file-name
- "../../.."
- (file-name-directory (or load-file-name buffer-file-name))))))
- "Path to the contrib/scripts directory in which
-StartOzServer.oz is located.")
-
-(defvar org-babel-oz-port 6001
- "Port for communicating with Oz compiler.")
-(defvar org-babel-oz-OPI-socket nil
- "Socket for communicating with OPI.")
-
-(defvar org-babel-oz-collected-result nil
- "Aux var to hand result from org-babel-oz-filter to
oz-send-string-expression.")
-(defun org-babel-oz-filter (proc string)
- "Processes output from socket org-babel-oz-OPI-socket."
-;; (setq org-babel-oz-collected-results (cons string
org-babel-oz-collected-results))
- (setq org-babel-oz-collected-result string)
- )
-
-
-(defun org-babel-oz-create-socket ()
- (message "Create OPI socket for evaluating expressions")
- ;; Start Oz directly
- (run-oz)
- ;; Create socket on Oz side (after Oz was started).
- (oz-send-string (concat "\\insert '" org-babel-oz-server-dir
"StartOzServer.oz'"))
- ;; Wait until socket is created before connecting to it.
- ;; Quick hack: wait 3 sec
- ;;
- ;; extending time to 30 secs does not help when starting Emacs for
- ;; the first time (and computer does nothing else)
- (sit-for 3)
- ;; connect to OPI socket
- (setq org-babel-oz-OPI-socket
- ;; Creates a socket. I/O interface of Emacs sockets as for processes.
- (open-network-stream "*Org-babel-OPI-socket*" nil "localhost"
org-babel-oz-port))
- ;; install filter
- (set-process-filter org-babel-oz-OPI-socket #'org-babel-oz-filter)
-)
-
-;; communication with org-babel-oz-OPI-socket is asynchronous, but
-;; oz-send-string-expression turns is into synchronous...
-(defun oz-send-string-expression (string &optional wait-time)
- "Similar to oz-send-string, oz-send-string-expression sends a string to the
OPI compiler. However, string must be expression and this function returns the
result of the expression (as string). oz-send-string-expression is synchronous,
wait-time allows to specify a maximum wait time. After wait-time is over with
no result, the function returns nil."
- (if (not org-babel-oz-OPI-socket)
- (org-babel-oz-create-socket))
- (let ((polling-delay 0.1)
- result)
- (process-send-string org-babel-oz-OPI-socket string)
- ;; wait for result
- (if wait-time
- (let ((waited 0))
- (unwind-protect
- (progn
- (while
- ;; stop loop if org-babel-oz-collected-result \= nil or
waiting time is over
- (not (or (not (equal org-babel-oz-collected-result nil))
- (> waited wait-time)))
- (progn
- (sit-for polling-delay)
-;; (message "org-babel-oz: next polling iteration")
- (setq waited (+ waited polling-delay))))
-;; (message "org-babel-oz: waiting over, got result or waiting
timed out")
-;; (message (format "wait-time: %s, waited: %s" wait-time waited))
- (setq result org-babel-oz-collected-result)
- (setq org-babel-oz-collected-result nil))))
- (unwind-protect
- (progn
- (while (equal org-babel-oz-collected-result nil)
- (sit-for polling-delay))
- (setq result org-babel-oz-collected-result)
- (setq org-babel-oz-collected-result nil))))
- result))
-
-(defun org-babel-expand-body:oz (body params)
- (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)
- (format "%s=%s"
- (car pair)
- (org-babel-oz-var-to-oz (cdr
pair))))
- vars)))
- ;; only add var declarations if any variables are there
- (mapconcat #'identity
- (append (list "local") var-string (list "in" body "end"))
- "\n"))
- body)))
-
-(defun org-babel-execute:oz (body params)
- "Execute a block of Oz code with org-babel. This function is
-called by `org-babel-execute-src-block' via multiple-value-bind."
- (let* ((result-params (cdr (assq :result-params params)))
- (full-body (org-babel-expand-body:oz body params))
- (wait-time (plist-get params :wait-time)))
- ;; actually execute the source-code block
- (org-babel-reassemble-table
- (cond
- ((member "output" result-params)
- (message "Org-babel: executing Oz statement")
- (oz-send-string full-body))
- ((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")))
- (org-babel-pick-name (cdr (assq :colname-names params))
- (cdr (assq :colnames params)))
- (org-babel-pick-name (cdr (assq :roname-names params))
- (cdr (assq :rownames params))))))
-
-;; This function should be used to assign any variables in params in
-;; the context of the session environment.
-(defun org-babel-prep-session:oz (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (error "org-babel-prep-session:oz unimplemented"))
-;; TODO: testing... (copied from org-babel-haskell.el)
-;; (defun org-babel-prep-session:oz (session params)
-;; "Prepare SESSION according to the header arguments specified in PARAMS."
-;; (save-window-excursion
-;; (org-babel-oz-initiate-session session)
-;; (let* ((vars (org-babel-ref-variables params))
-;; (var-lines (mapconcat ;; define any variables
-;; (lambda (pair)
-;; (format "%s=%s"
-;; (car pair)
-;; (org-babel-ruby-var-to-ruby (cdr pair))))
-;; vars "\n"))
-;; (vars-file (concat (make-temp-file "org-babel-oz-vars") ".oz")))
-;; (when vars
-;; (with-temp-buffer
-;; (insert var-lines) (write-file vars-file)
-;; (oz-mode)
-;; ;; (inferior-oz-load-file) ; ??
-;; ))
-;; (current-buffer))))
-;;
-
-
-;; TODO: testing... (simplified version of def in org-babel-prep-session:ocaml)
-;;
-;; BUG: does not work yet. Error: ad-Orig-error: buffer none doesn't exist or
has no process
-;; UNUSED DEF
-(defun org-babel-oz-initiate-session (&optional session params)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session."
- (unless (string= session "none")
- ;; TODO: make it possible to have multiple sessions
- (save-window-excursion
- ;; (run-oz)
- (get-buffer oz-compiler-buffer))))
-
-(defun org-babel-oz-var-to-oz (var)
- "Convert an elisp var into a string of Oz source code
-specifying a var of the same value."
- (if (listp var)
-;; (concat "[" (mapconcat #'org-babel-oz-var-to-oz var ", ") "]")
- (eval var)
- (format "%s" var) ; don't preserve string quotes.
-;; (format "%s" var)
- ))
-
-;; TODO:
-(defun org-babel-oz-table-or-string (results)
- "If the results look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (error "org-babel-oz-table-or-string unimplemented"))
-
-
-(provide 'ob-oz)
-;;; org-babel-oz.el ends here
diff --git a/contrib/lisp/ob-php.el b/contrib/lisp/ob-php.el
deleted file mode 100644
index 99b084c..0000000
--- a/contrib/lisp/ob-php.el
+++ /dev/null
@@ -1,57 +0,0 @@
-;;; ob-php.el --- Execute PHP within org-mode blocks.
-;; Copyright 2016 stardiviner
-
-;; Author: stardiviner <numbchild@gmail.com>
-;; Maintainer: stardiviner <numbchild@gmail.com>
-;; Keywords: org babel php
-;; URL: https://github.com/stardiviner/ob-php
-;; Created: 04th May 2016
-;; Version: 0.0.1
-;; Package-Requires: ((org "8"))
-
-;;; Commentary:
-;;
-;; Execute PHP within org-mode blocks.
-
-;;; Code:
-(require 'org)
-(require 'ob)
-
-(defgroup ob-php nil
- "org-mode blocks for PHP."
- :group 'org)
-
-(defcustom org-babel-php-command "php"
- "The command to execute babel body code."
- :group 'ob-php
- :type 'string)
-
-(defcustom org-babel-php-command-options nil
- "The php command options to use when execute code."
- :group 'ob-php
- :type 'string)
-
-(defcustom ob-php:inf-php-buffer "*php*"
- "Default PHP inferior buffer."
- :group 'ob-php
- :type 'string)
-
-;;;###autoload
-(defun org-babel-execute:php (body params)
- "Orgmode Babel PHP evaluate function for `BODY' with `PARAMS'."
- (let* ((cmd (concat org-babel-php-command " " org-babel-php-command-options))
- (body (concat "<?php\n" body "\n?>")))
- (org-babel-eval cmd body)))
-
-;;;###autoload
-(eval-after-load 'org
- '(add-to-list 'org-src-lang-modes '("php" . php)))
-
-(defvar org-babel-default-header-args:php '())
-
-(add-to-list 'org-babel-default-header-args:php
- '(:results . "output"))
-
-(provide 'ob-php)
-
-;;; ob-php.el ends here
diff --git a/contrib/lisp/ob-redis.el b/contrib/lisp/ob-redis.el
deleted file mode 100644
index 086b4cd..0000000
--- a/contrib/lisp/ob-redis.el
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; ob-redis.el --- Execute Redis queries within org-mode blocks.
-;; Copyright 2016 stardiviner
-
-;; Author: stardiviner <numbchild@gmail.com>
-;; Maintainer: stardiviner <numbchild@gmail.com>
-;; Keywords: org babel redis
-;; URL: https://github.com/stardiviner/ob-redis
-;; Created: 28th Feb 2016
-;; Version: 0.0.1
-;; Package-Requires: ((org "8"))
-
-;;; Commentary:
-;;
-;; Execute Redis queries within org-mode blocks.
-
-;;; Code:
-(require 'org)
-(require 'ob)
-
-(defgroup ob-redis nil
- "org-mode blocks for Redis."
- :group 'org)
-
-(defcustom ob-redis:default-db "127.0.0.1:6379"
- "Default Redis database."
- :group 'ob-redis
- :type 'string)
-
-;;;###autoload
-(defun org-babel-execute:redis (body params)
- "org-babel redis hook."
- (let* ((db (or (cdr (assoc :db params))
- ob-redis:default-db))
- (cmd (mapconcat 'identity (list "redis-cli") " ")))
- (org-babel-eval cmd body)
- ))
-
-;;;###autoload
-(eval-after-load 'org
- '(add-to-list 'org-src-lang-modes '("redis" . redis)))
-
-(provide 'ob-redis)
-
-;;; ob-redis.el ends here
diff --git a/contrib/lisp/ob-sclang.el b/contrib/lisp/ob-sclang.el
deleted file mode 100644
index a72b7c4..0000000
--- a/contrib/lisp/ob-sclang.el
+++ /dev/null
@@ -1,92 +0,0 @@
-;;; ob-sclang.el --- SCLang support for Org-mode Babel
-;;; -*- coding: utf-8 -*-
-
-;; Copyright (C) 2017-2021 Free Software Foundation, Inc.
-
-;; Authors: stardiviner <numbchild@gmail.com>
-;; Package-Version: 0.1
-;; Keywords: babel sclang
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `ob-sclang' requires `sclang' from SuperCollider.
-;; Usually SuperCollider dependencies for Emacs are at
/usr/share/emacs/site-lisp/SuperCollider/
-;; You can install SuperCollider following this article:
-;; https://github.com/supercollider/supercollider#building-the-source-code
-
-;; Usage:
-
-;; Support to evaluate sclang Org-mode src block with function
`sclang-eval-string'.
-
-;; For example:
-
-;; #+BEGIN_SRC sclang :results none
-;; "Hello World".postln;
-;; #+END_SRC
-;;
-;; *NOTE* Temporary output to org-babel result output is not supported.
-;; Because `sclang-eval-string' will send output to Sclang Post Buffer.
-;; And command line `sclang' execute will not automatically stop after
finished execution.
-;;
-;; #+BEGIN_SRC sclang :results none
-;; // modulate a sine frequency and a noise amplitude with another sine
-;; // whose frequency depends on the horizontal mouse pointer position
-;; {
-;; var x = SinOsc.ar(MouseX.kr(1, 100));
-;; SinOsc.ar(300 * x + 800, 0, 0.1)
-;; +
-;; PinkNoise.ar(0.1 * x + 0.1)
-;; }.play;
-;; #+END_SRC
-
-
-;;; Code:
-;;;
----------------------------------------------------------------------------
-(require 'org)
-(require 'ob)
-
-(require 'sclang nil t)
-
-(defgroup ob-sclang nil
- "org-mode blocks for SuperCollider SCLang."
- :group 'org)
-
-;;;###autoload
-(defun org-babel-execute:sclang (body params)
- "Org-mode Babel sclang hook for evaluate `BODY' with `PARAMS'."
- (unless (or (equal (buffer-name) sclang-post-buffer)
- (sclang-get-process))
- (sclang-start))
- (sclang-eval-string body t))
-
-(defvar org-babel-default-header-args:sclang nil)
-
-(setq org-babel-default-header-args:sclang
- '((:session . "*SCLang:Workspace*")
- ;; TODO: temporary can't find way to let sclang output to stdout for
org-babel.
- (:output . "none")))
-
-(eval-after-load 'org
- '(progn
- (add-to-list 'org-src-lang-modes '("sclang" . sclang))))
-
-;;;
----------------------------------------------------------------------------
-
-(provide 'ob-sclang)
-
-;;; ob-sclang.el ends here
diff --git a/contrib/lisp/ob-smiles.el b/contrib/lisp/ob-smiles.el
deleted file mode 100644
index 9b1ac68..0000000
--- a/contrib/lisp/ob-smiles.el
+++ /dev/null
@@ -1,57 +0,0 @@
-;;; ob-smiles.el --- Org-mode Babel support for SMILES.
-;;; -*- coding: utf-8 -*-
-
-;; Keywords: org babel SMILES
-;; Version: 0.0.1
-;; Package-Requires: ((smiles-mode "0.0.1") (org "8"))
-
-;;; Commentary:
-
-;;; I copy code from:
-;;;
https://kitchingroup.cheme.cmu.edu/blog/2016/03/26/A-molecule-link-for-org-mode
-
-;; Author: John Kitchin [jkitchin@andrew.cmu.edu]
-;; Maintainer: stardiviner [numbchild@gmail.com]
-
-;;; Code:
-
-(require 'ob)
-(require 'org-element)
-
-;; Org-mode Babel
-(defun org-babel-execute:smiles (body params)
- "Execute SMILES babel `BODY' with `PARAMS'."
- (shell-command-to-string
- (format "obabel -:\"%s\" -osvg 2> /dev/null" body)))
-
-;; Org-mode link
-(defun molecule-jump (name)
- "Jump to molecule `NAME' definition."
- (org-mark-ring-push)
- (org-link-open-from-string (format "[[%s]]" name)))
-
-(defun molecule-export (path desc backend)
- "Export molecule to HTML format on `PATH' with `DESC' and `BACKEND'."
- (let ((name (save-window-excursion
- (molecule-jump path)
- (org-element-property :name (org-element-context)))))
- (cond
- ((eq 'html backend)
- (format "<a href=\"#%s\">%s</a>" name name)))))
-
-(org-link-set-parameters
- "molecule"
- :follow 'molecule-jump
- :export 'molecule-export)
-
-;; org-mode element
-(org-element-map (org-element-parse-buffer)
- 'src-block
- (lambda (src)
- (when (string= "smiles" (org-element-property :language src))
- (org-element-property :name src))))
-
-
-(provide 'ob-smiles)
-
-;;; ob-smiles.el ends here
diff --git a/contrib/lisp/ob-spice.el b/contrib/lisp/ob-spice.el
deleted file mode 100644
index e8ea87a..0000000
--- a/contrib/lisp/ob-spice.el
+++ /dev/null
@@ -1,182 +0,0 @@
-;;; ob-spice.el --- org-babel functions for spice evaluation
-;;; -*- coding: utf-8 -*-
-
-;; Author: Tiago Oliveira Weber
-;; Maintainer: stardiviner (numbchild@gmail.com)
-;; Version: 0.4
-;; Package-Requires: ((spice-mode "0.0.1") (org "8"))
-;; Homepage: https://tiagoweber.github.io
-
-;; License: GPL v3, or any later version
-;;
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-;;
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating spice script.
-;; Inspired by Ian Yang's org-export-blocks-format-plantuml
(https://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el)
-
-;;; Requirements:
-;;
-;; - ngspice
-
-;;; Code:
-(require 'ob)
-
-(add-to-list 'org-babel-tangle-lang-exts '("spice" . "cir"))
-
-(defun ob-spice-concat (wordlist)
- "Concatenate elements of a `WORDLIST' into a string separated by spaces."
- ;; example of usage
- ;; (ob-spice-concat '("This" "is" "a" "long" "journey"))
- (setq newtext (car wordlist)) ; first word is without space before
- (setq wordlist (rest wordlist)) ; exclude the first word from the list
- (dolist (word wordlist newtext) ; loop through the list and concatenate the
values
- (setq newtext (concat newtext " " word))))
-
-(defun org-babel-expand-body:spice (body params)
- "Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (setq newbody "");
- (setq bodylinelist (split-string body "\n"))
- (dolist (line bodylinelist newbody)
- (progn ;loop through list of lines
- (setq wordlist (split-string line " "))
- (setq firstword 1)
- (dolist (word wordlist)
- (progn ;loop through the words
- (if (string-match "\\$\\(.*\\)\\[\\(.*\\)\\]" word)
- (progn
- ;; if matches a vector variable format
- (setq varname (match-string 1 word))
- (setq varindex (match-string 2 word))
- ;; search varname in vars and use the value of varindex to
word
- (setq newword
- (nth (string-to-number varindex)
- (car (assoc-default varname vars
- (lambda (key candidate)
- (string= key candidate))))))
- (if (not (eq newword nil))
- (if (not (stringp newword))
- (setq word (number-to-string newword))
- (setq word newword)))
- )
- ) ; end of (if (string-match "\\$\\(.*\\)\\[\\(.*\\)\\]" word))
- (if (string-match "\\$\\(.*\\)\\." word) ; if variable has a dot
in the end
- (progn
- ;; if matches a non-vector variable format
- (setq varname (match-string 1 word))
- (setq newword
- (assoc-default varname vars
- (lambda (key candidate)
- (string= key candidate))))
- (if (not (eq newword nil))
- (progn
- (if (not (stringp newword))
- (setq newword (number-to-string newword)))
- (setq word (replace-match (concat newword ".") nil
nil word))
- ;(setq word word)
- )
- ))
- );; end of (if (string-match "\\$\\(.*\\)\\." word)
- (if (string-match "\\$\\(.*\\)" word)
- (progn
- ;; if matches a non-vector variable format
- (setq varname (match-string 1 word))
- (setq newword
- (assoc-default varname vars
- (lambda (key candidate)
- (string= key candidate))))
- (if (not (eq newword nil))
- (if (not (stringp newword))
- (setq word (number-to-string newword))
- (setq word newword)
- ))
- )
- ) ; end of (if (string-match "\\$\\(.*\\)" word)
-
-
- (setq newbody (concat newbody
- (if (not (eq firstword 1)) " ")
- word))
- (setq firstword 0)
- ) ; end of (progn
- ) ; end of (dolist (word wordlist))
-
- (setq newbody (concat newbody "\n"))
- ) ; end of (progn ;; loop through list of lines ... )
- ) ; end of (dolist (line bodylinelist) ...function ...)
- ))
-
-;;;###autoload
-(defun org-babel-execute:spice (body params)
- "Execute a block of Spice code `BODY' with org-babel and `PARAMS'."
- (let ((body (org-babel-expand-body:spice body params))
- (vars (mapcar #'cdr (org-babel-get-header params :var))))
-
- ;;******************************
- ;; clean temporary files
- (mapc (lambda (pair)
- (when (string= (car pair) "file")
- (setq textfile (concat (cdr pair) ".txt"))
- (setq imagefile (concat (cdr pair) ".png"))
- )
- )
- vars)
- ;; (if (file-readable-p textfile) (delete-file textfile))
- ;; (if (file-readable-p imagefile) (delete-file imagefile))
- ;;*******************************
-
- (org-babel-eval "ngspice -b " body)
-
- ;; loop through all pairs (elements) of the list vars and set text and
image file if finds "file" var
- (mapc (lambda (pair)
- (when (string= (car pair) "file")
- (setq textfile (concat (cdr pair) ".txt"))
- (setq imagefile (concat (cdr pair) ".png"))))
- vars)
- ;; produce results
- ;; THE FOLLOWING WAS COMMENTED TEMPORARILY
- ;; (concat
- ;; (if (file-readable-p textfile)
- ;; (get-string-from-file textfile))
- ;; (if (file-readable-p imagefile)
- ;; (concat '"#+ATTR_HTML: :width 600px \n [[file:./" imagefile
"]]")
- ;; )
- ;; )
-
- ;; ;; Get measurement values from text-file by splitting comma separated
values
- (if (file-readable-p textfile)
- (progn
- (setq rawtext (get-string-from-file textfile))
- ;;(setq rawtext (replace-regexp-in-string "\n" "" rawtext))
- (setq rawtext (replace-regexp-in-string "\n" "" rawtext))
- (setq result (split-string rawtext ","))))
- (if (file-readable-p imagefile)
- (progn
- ;; test if result exist already
- ;;(if (boundp 'result)
- (add-to-list 'result (concat '"[[file:./" imagefile "]]") t) ;;
add imagefile to last entry
- ;;(concat '"[[file:./" imagefile "]]")
- ;;)
- ))
- result
- ;; Produce output like '(test test2)
- ;;'(test test2)
-
- )
- )
-
-(provide 'ob-spice)
-;;; ob-spice.el ends here
diff --git a/contrib/lisp/ob-stata.el b/contrib/lisp/ob-stata.el
deleted file mode 100644
index f783464..0000000
--- a/contrib/lisp/ob-stata.el
+++ /dev/null
@@ -1,312 +0,0 @@
-;;; 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: https://stata.com
-;; ESS: https://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 (assq :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 (assq :result-params params)))
- (result-type (cdr (assq :result-type params)))
- (session (org-babel-stata-initiate-session
- (cdr (assq :session params)) params))
- (colnames-p (cdr (assq :colnames params)))
- (rownames-p (cdr (assq :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 (assq :colname-names params)) colnames-p))
- (or (equal "yes" rownames-p)
- (org-babel-pick-name
- (cdr (assq :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 (assq :colnames params)))
- (equal "yes" (cdr (assq :rownames params)))))
- (mapcar
- (lambda (i)
- (cons (car (nth i vars))
- (org-babel-reassemble-table
- (cdr (nth i vars))
- (cdr (nth i (cdr (assq :colname-names params))))
- (cdr (nth i (cdr (assq :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 (assq :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
deleted file mode 100644
index 6270047..0000000
--- a/contrib/lisp/ob-tcl.el
+++ /dev/null
@@ -1,128 +0,0 @@
-;;; ob-tcl.el --- Org-babel functions for tcl evaluation
-
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-
-;; Authors: Dan Davison
-;; Eric Schulte
-;; Luis Anaya (tcl)
-;;
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating tcl source code.
-
-;;; Code:
-(require 'ob)
-(require 'ob-eval)
-(eval-when-compile (require 'cl))
-
-(defvar org-babel-tangle-lang-exts)
-(add-to-list 'org-babel-tangle-lang-exts '("tcl" . "tcl"))
-
-(defvar org-babel-default-header-args:tcl nil)
-
-(defcustom org-babel-tcl-command "tclsh"
-"Name of command to use for executing Tcl code."
- :group 'org-babel
- :type 'string)
-
-
-(defun org-babel-execute:tcl (body params)
- "Execute a block of Tcl code with Babel.
-This function is called by `org-babel-execute-src-block'."
- (let* ((session (cdr (assq :session params)))
- (result-params (cdr (assq :result-params params)))
- (result-type (cdr (assq :result-type params)))
- (full-body (org-babel-expand-body:generic
- body params (org-babel-variable-assignments:tcl params)))
- (session (org-babel-tcl-initiate-session session)))
- (org-babel-reassemble-table
- (org-babel-tcl-evaluate session full-body result-type)
- (org-babel-pick-name
- (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
- (org-babel-pick-name
- (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
-
-(defun org-babel-prep-session:tcl (session params)
- "Prepare SESSION according to the header arguments in PARAMS."
- (error "Sessions are not supported for Tcl"))
-
-(defun org-babel-variable-assignments:tcl (params)
- "Return list of tcl statements assigning the block's variables."
- (mapcar
- (lambda (pair)
- (format "set %s %s"
- (car pair)
- (org-babel-tcl-var-to-tcl (cdr pair))))
- (org-babel--get-vars params)))
-
-;; helper functions
-
-(defun org-babel-tcl-var-to-tcl (var)
- "Convert an elisp value to a tcl variable.
-The elisp value, VAR, is converted to a string of tcl source code
-specifying a var of the same value."
- (if (listp var)
- (concat "{" (mapconcat #'org-babel-tcl-var-to-tcl var " ") "}")
- (format "%s" var)))
-
-(defvar org-babel-tcl-buffers '(:default . nil))
-
-(defun org-babel-tcl-initiate-session (&optional session params)
- "Return nil because sessions are not supported by tcl."
-nil)
-
-(defvar org-babel-tcl-wrapper-method
- "
-proc main {} {
- %s
-}
-
-set r [eval main]
-set o [open \"%s\" \"w\"];
-puts $o $r
-flush $o
-close $o
-
-")
-
-(defvar org-babel-tcl-pp-wrapper-method
- nil)
-
-(defun org-babel-tcl-evaluate (session body &optional result-type)
- "Pass BODY to the Tcl process in SESSION.
-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"))
- (case result-type
- (output (org-babel-eval org-babel-tcl-command body))
- (value (let ((tmp-file (org-babel-temp-file "tcl-")))
- (org-babel-eval
- org-babel-tcl-command
- (format org-babel-tcl-wrapper-method body
- (org-babel-process-file-name tmp-file 'noquote)))
- (org-babel-eval-read-file tmp-file)))))
-
-(provide 'ob-tcl)
-
-
-
-;;; ob-tcl.el ends here
diff --git a/contrib/lisp/ob-vbnet.el b/contrib/lisp/ob-vbnet.el
deleted file mode 100644
index 1ea572d..0000000
--- a/contrib/lisp/ob-vbnet.el
+++ /dev/null
@@ -1,84 +0,0 @@
-;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation
-
-;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
-
-;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric
Schulte
-;; Keywords: literate programming, reproducible research
-;; Homepage: https://orgmode.org
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Currently this only supports the external compilation and execution
-;; of VB.Net code blocks (i.e., no session support).
-
-;;; Code:
-(require 'ob)
-
-(defvar org-babel-tangle-lang-exts)
-(add-to-list 'org-babel-tangle-lang-exts '("vbnet" . "vb"))
-
-(defcustom org-babel-vbnet-command "mono"
- "Name of the mono command.
-May be either a command in the path, like mono
-or an absolute path name, like /usr/local/bin/mono
-parameters may be used, like mono -verbose"
- :group 'org-babel
- :version "24.3"
- :type 'string)
-
-(defcustom org-babel-vbnet-compiler "vbnc"
- "Name of the VB.Net compiler.
-May be either a command in the path, like vbnc
-or an absolute path name, like /usr/local/bin/vbnc
-parameters may be used, like vbnc /warnaserror+"
- :group 'org-babel
- :version "24.3"
- :type 'string)
-
-(defun org-babel-execute:vbnet (body params)
- (let* ((full-body (org-babel-expand-body:generic body params))
- (cmpflag (or (cdr (assq :cmpflag params)) ""))
- (cmdline (or (cdr (assq :cmdline params)) ""))
- (src-file (org-babel-temp-file "vbnet-src-" ".vb"))
- (exe-file (concat (file-name-sans-extension src-file) ".exe"))
- (compile
- (progn (with-temp-file src-file (insert full-body))
- (org-babel-eval
- (concat org-babel-vbnet-compiler " " cmpflag " " src-file)
- ""))))
- (let ((results (org-babel-eval (concat org-babel-vbnet-command " " cmdline
" " exe-file) "")))
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assq :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
- (org-babel-pick-name
- (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
-
-(defun org-babel-prep-session:vbnet (session params)
- "Return an error because vbnet does not support sessions."
- (error "Sessions are not supported for VB.Net"))
-
-(provide 'ob-vbnet)
-
-
-
-;;; ob-vbnet.el ends here
diff --git a/contrib/lisp/ol-bookmark.el b/contrib/lisp/ol-bookmark.el
deleted file mode 100644
index 08932e9..0000000
--- a/contrib/lisp/ol-bookmark.el
+++ /dev/null
@@ -1,90 +0,0 @@
-;;; ol-bookmark.el - Links to bookmarks
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-;;
-;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
-;; Version: 1.0
-;; Keywords: outlines, hypermedia, calendar, wp
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; 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.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-(require 'bookmark)
-(require 'ol)
-
-(defgroup org-bookmark nil
- "Options concerning the bookmark link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-bookmark-in-dired nil
- "Use org-bookmark in dired."
- :group 'org-bookmark
- :type 'boolean)
-
-(defcustom org-bookmark-when-visiting-a-file nil
- "Use org-bookmark in any buffer visiting a file."
- :group 'org-bookmark
- :type 'boolean)
-
-(defcustom org-bookmark-use-first-bookmark nil
- "If several bookmarks links to the buffer, take the first one.
-Otherwise prompt the user for the right bookmark to use."
- :group 'org-bookmark
- :type 'boolean)
-
-(org-link-set-parameters "bookmark"
- :follow #'org-bookmark-open
- :store #'org-bookmark-store-link)
-
-(defun org-bookmark-open (bookmark _)
- "Visit the bookmark BOOKMARK."
- (bookmark-jump bookmark))
-
-(defun org-bookmark-store-link ()
- "Store a link to the current line's bookmark in bookmark list."
- (let (file bookmark bmks)
- (cond ((and org-bookmark-in-dired
- (eq major-mode 'dired-mode))
- (setq file (abbreviate-file-name (dired-get-filename))))
- ((and org-bookmark-when-visiting-a-file
- (buffer-file-name (buffer-base-buffer)))
- (setq file (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))
- (if (not file)
- (when (eq major-mode 'bookmark-bmenu-mode)
- (setq bookmark (bookmark-bmenu-bookmark)))
- (when (and (setq bmks
- (mapcar (lambda (name)
- (if (equal file
- (abbreviate-file-name
- (bookmark-location name)))
- name))
- (bookmark-all-names)))
- (setq bmks (delete nil bmks)))
- (setq bookmark
- (if (or (eq 1 (length bmks)) org-bookmark-use-first-bookmark)
- (car bmks)
- (completing-read "Bookmark: " bmks nil t nil nil (car bmks))))))
- (if bookmark
- (org-store-link-props :link (concat "bookmark:" bookmark)
- :description bookmark))))
-
-(provide 'ol-bookmark)
-
-;;; ol-bookmark.el ends here
diff --git a/contrib/lisp/ol-elisp-symbol.el b/contrib/lisp/ol-elisp-symbol.el
deleted file mode 100644
index 6215b0f..0000000
--- a/contrib/lisp/ol-elisp-symbol.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; ol-elisp-symbol.el --- Links to Emacs-lisp symbols
-;;
-;; Copyright 2007-2021 Free Software Foundation, Inc.
-;;
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Version: 0.2
-;; Keywords: org, remember, lisp
-;; URL: http://www.cognition.ens.fr/~guerry/u/org-elisp-symbol.el
-;;
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; Org-mode already lets you store/insert links to emacs-lisp files,
-;; just like any other file. This package lets you precisely link to
-;; any emacs-lisp symbol and access useful information about the symbol.
-;;
-;; Here is the list of available properties when linking from a elisp-symbol:
-;;
-;; :name The symbol's name.
-;; :stype The symbol's type (commandp, function, etc.)
-;; :def The function used to set the symbol's value (defun, etc.)
-;; :keys The keys associated with the command.
-;; :args The arguments of the function.
-;; :docstring The docstring of the symbol.
-;; :doc The first line of the dostring.
-;; :comment A comment line just above the sexp, if any.
-;; :fixme A FIXME comment line just above the sexp, if any.
-;;
-;; Let's say we have a defun like this one:
-;;
-;; ;; FIXME update docstring
-;; (defun org-export-latex-lists ()
-;; "Convert lists to LaTeX."
-;; (goto-char (point-min))
-;; (while (re-search-forward org-export-latex-list-beginning-re nil t)
-;; (beginning-of-line)
-;; (insert (org-list-to-latex (org-list-parse-list t)) "\n")))
-;;
-;; And a remember template like:
-;;
-;; (setq org-remember-templates
-;; '((?s "* DEBUG `%:name' (%:args)\n\n%?\n\nFixme: %:fixme\n \
-;; Doc: \"%:doc\"\n\n%a")))
-;;
-;; Then M-x `org-remember' on this sexp will produce this buffer:
-;;
-;; =====================================================================
-;; * DEBUG `org-export-latex-lists' ()
-;;
-;; <== point
-;;
-;; Fixme: update the docstring
-;; Doc: "Convert lists to LaTeX."
-;;
-;; [[file:~/path/file.el::defun%20my-func][Function: my-func]]
-;; =====================================================================
-;;
-;; Put this file into your load-path and the following into your ~/.emacs:
-;; (require 'org-elisp-symbol)
-
-;;; Code:
-
-(provide 'ol-elisp-symbol)
-(require 'ol)
-(require 'org)
-
-(org-link-set-parameters "elisp-symbol"
- :follow #'org-elisp-symbol-open
- :store #'org-elisp-symbol-store-link)
-
-(defun org-elisp-symbol-open (symbol arg)
- (org-link-open-as-file symbol arg))
-
-(defun org-elisp-symbol-store-link ()
- "Store a link to an emacs-lisp elisp-symbol."
- (when (eq major-mode 'emacs-lisp-mode)
- (save-excursion
- (or (looking-at "^(") (beginning-of-defun))
- (looking-at "^(\\([a-z]+\\) \\([^)\n ]+\\) ?\n?[
\t]*\\(?:(\\(.*\\))\\)?")
- (let* ((end (save-excursion
- (save-match-data
- (end-of-defun) (point))))
- (def (match-string 1))
- (name (match-string 2))
- (sym-name (intern-soft name))
- (stype (cond ((commandp sym-name) "Command")
- ((functionp sym-name) "Function")
- ((user-variable-p sym-name) "User variable")
- ((string= def "defvar") "Variable")
- ((string= def "defmacro") "Macro")
- ((string= def "defun") "Function or command")
- (t "Symbol")))
- (args (if (match-string 3)
- (mapconcat (lambda (a) (unless (string-match "^&" a) a))
- (split-string (match-string 3)) " ")
- "no arg"))
- (docstring (cond ((functionp sym-name)
- (or (documentation sym-name)
- "[no documentation]"))
- ((string-match "[Vv]ariable" stype)
- (documentation-property sym-name
- 'variable-documentation))
- (t "no documentation")))
- (doc (and (string-match "^\\([^\n]+\\)$" docstring)
- (match-string 1 docstring)))
- (fixme (save-excursion
- (beginning-of-defun) (end-of-defun)
- (if (re-search-forward "^;+ ?FIXME[ :]*\\(.*\\)$" end t)
- (match-string 1) "nothing to fix")))
- (comment (save-excursion
- (beginning-of-defun) (end-of-defun)
- (if (re-search-forward "^;;+ ?\\(.*\\)$" end t)
- (match-string 1) "no comment")))
- keys keys-desc link description)
- (if (equal stype "Command")
- (setq keys (where-is-internal sym-name)
- keys-desc
- (if keys (mapconcat 'key-description keys " ") "none")))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" def " " name))
- (setq description (concat stype ": " name))
- (org-store-link-props
- :type "elisp-symbol"
- :link link
- :description description
- :def def
- :name name
- :stype stype
- :args args
- :keys keys-desc
- :docstring docstring
- :doc doc
- :fixme fixme
- :comment comment)))))
-
-(provide 'org-elisp-symbol)
-
-
-;;;;##########################################################################
-;;;; User Options, Variables
-;;;;##########################################################################
-
-;;; ol-elisp-symbol.el ends here
diff --git a/contrib/lisp/ol-git-link.el b/contrib/lisp/ol-git-link.el
deleted file mode 100644
index 9d236cf..0000000
--- a/contrib/lisp/ol-git-link.el
+++ /dev/null
@@ -1,231 +0,0 @@
-;;; ol-git-link.el --- Links to specific file version
-
-;; Copyright (C) 2009-2014 Reimar Finken
-
-;; Author: Reimar Finken <reimar.finken@gmx.de>
-;; Keywords: files, calendar, hypermedia
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `org-git-link.el' defines two new link types. The `git' link
-;; type is meant to be used in the typical scenario and mimics the
-;; `file' link syntax as closely as possible. The `gitbare' link
-;; type exists mostly for debugging reasons, but also allows e.g.
-;; linking to files in a bare git repository for the experts.
-
-;; * User friendy form
-;; [[git:/path/to/file::searchstring]]
-
-;; This form is the familiar from normal org file links
-;; including search options. However, its use is
-;; restricted to files in a working directory and does not
-;; handle bare repositories on purpose (see the bare form for
-;; that).
-
-;; The search string references a commit (a tree-ish in Git
-;; terminology). The two most useful types of search strings are
-
-;; - A symbolic ref name, usually a branch or tag name (e.g.
-;; master or nobelprize).
-;; - A ref followed by the suffix @ with a date specification
-;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2
-;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00})
-;; to specify the value of the ref at a prior point in time
-;;
-;; * Bare git form
-;; [[gitbare:$GIT_DIR::$OBJECT]]
-;;
-;; This is the more bare metal version, which gives the user most
-;; control. It directly translates to the git command
-;; git --no-pager --git-dir=$GIT_DIR show $OBJECT
-;; Using this version one can also view files from a bare git
-;; repository. For detailed information on how to specify an
-;; object, see the man page of `git-rev-parse' (section
-;; SPECIFYING REVISIONS). A specific blob (file) can be
-;; specified by a suffix clolon (:) followed by a path.
-
-;;; Code:
-
-(require 'org)
-(require 'ol)
-
-(defcustom org-git-program "git"
- "Name of the git executable used to follow git links."
- :type '(string)
- :group 'org)
-
-;; org link functions
-;; bare git link
-(org-link-set-parameters "gitbare" :follow #'org-gitbare-open)
-
-(defun org-gitbare-open (str _)
- (let* ((strlist (org-git-split-string str))
- (gitdir (nth 0 strlist))
- (object (nth 1 strlist)))
- (org-git-open-file-internal gitdir object)))
-
-
-(defun org-git-open-file-internal (gitdir object)
- (let* ((sha (org-git-blob-sha gitdir object))
- (tmpdir (concat temporary-file-directory "org-git-" sha))
- (filename (org-git-link-filename object))
- (tmpfile (expand-file-name filename tmpdir)))
- (unless (file-readable-p tmpfile)
- (make-directory tmpdir)
- (with-temp-file tmpfile
- (org-git-show gitdir object (current-buffer))))
- (org-open-file tmpfile)
- (set-buffer (get-file-buffer tmpfile))
- (setq buffer-read-only t)))
-
-;; user friendly link
-(org-link-set-parameters "git" :follow #'org-git-open :store
#'org-git-store-link)
-
-(defun org-git-open (str _)
- (let* ((strlist (org-git-split-string str))
- (filepath (nth 0 strlist))
- (commit (nth 1 strlist))
- (line (nth 2 strlist))
- (dirlist (org-git-find-gitdir (file-truename filepath)))
- (gitdir (nth 0 dirlist))
- (relpath (nth 1 dirlist)))
- (org-git-open-file-internal gitdir (concat commit ":" relpath))
- (when line
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (1- (string-to-number line)))))))
-
-
-;; Utility functions (file names etc)
-
-(defun org-git-split-dirpath (dirpath)
- "Given a directory name, return '(dirname basname)"
- (let ((dirname (file-name-directory (directory-file-name dirpath)))
- (basename (file-name-nondirectory (directory-file-name dirpath))))
- (list dirname basename)))
-
-;; finding the git directory
-(defun org-git-find-gitdir (path)
- "Given a file (not necessarily existing) file path, return the
- a pair (gitdir relpath), where gitdir is the path to the first
- .git subdirectory found updstream and relpath is the rest of
- the path. Example: (org-git-find-gitdir
- \"~/gitrepos/foo/bar.txt\") returns
- '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git
repository, return nil."
- (let ((dir (expand-file-name (file-name-directory path)))
- (relpath (file-name-nondirectory path)))
- (catch 'toplevel
- (while (not (file-exists-p (expand-file-name ".git" dir)))
- (let ((dirlist (org-git-split-dirpath dir)))
- (when (string= (nth 1 dirlist) "") ; at top level
- (throw 'toplevel nil))
- (setq dir (nth 0 dirlist)
- relpath (concat (file-name-as-directory (nth 1 dirlist))
relpath))))
- (list (expand-file-name ".git" dir) relpath))))
-
-
-(eval-and-compile
- (defalias 'org-git-gitrepos-p 'org-git-find-gitdir
- "Return non-nil if path is in git repository"))
-
-;; splitting the link string
-
-;; Both link open functions are called with a string of
-;; consisting of three parts separated by a double colon (::).
-(defun org-git-split-string (str)
- "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) "" ""))
- ((= 2 (length strlist))
- (append strlist (list "")))
- ((= 3 (length strlist))
- strlist)
- (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)
- "Given an object description (see the man page of
- git-rev-parse), return the nondirectory part of the referenced
- filename, if it can be extracted. Otherwise, return a valid
- filename."
- (let* ((match (and (string-match "[^:]+$" str)
- (match-string 0 str)))
- (filename (and match (file-name-nondirectory match)))) ;extract the
final part without slash
- filename))
-
-;; creating a link
-(defun org-git-create-searchstring (branch timestring)
- (concat branch "@{" timestring "}"))
-
-
-(defun org-git-create-git-link (file &optional line)
- "Create git link part to file at specific time"
- (interactive "FFile: ")
- (let* ((gitdir (nth 0 (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)
- (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)))
- (line (line-number-at-pos)))
- (when (org-git-gitrepos-p file)
- (org-store-link-props
- :type "git"
- :link (org-git-create-git-link file line))))))
-
-(defun org-git-insert-link-interactively (file searchstring &optional
description)
- (interactive "FFile: \nsSearch string: \nsDescription: ")
- (insert (org-make-link-string (concat "git:" file "::" searchstring)
description)))
-
-;; Calling git
-(defun org-git-show (gitdir object buffer)
- "Show the output of git --git-dir=gitdir show object in buffer."
- (unless
- (zerop (call-process org-git-program nil buffer nil
- "--no-pager" (concat "--git-dir=" gitdir) "show"
object))
- (error "git error: %s " (with-current-buffer buffer (buffer-string)))))
-
-(defun org-git-blob-sha (gitdir object)
- "Return sha of the referenced object"
- (with-temp-buffer
- (if (zerop (call-process org-git-program nil t nil
- "--no-pager" (concat "--git-dir=" gitdir)
"rev-parse" object))
- (buffer-substring (point-min) (1- (point-max))) ; to strip off final
newline
- (error "git error: %s " (buffer-string)))))
-
-(defun org-git-get-current-branch (gitdir)
- "Return the name of the current branch."
- (with-temp-buffer
- (if (not (zerop (call-process org-git-program nil t nil
- "--no-pager" (concat "--git-dir=" gitdir)
"symbolic-ref" "-q" "HEAD")))
- (error "git error: %s " (buffer-string))
- (goto-char (point-min))
- (if (looking-at "^refs/heads/") ; 11 characters
- (buffer-substring 12 (1- (point-max))))))) ; to strip off final
newline
-
-(provide 'ol-git-link)
-
-;;; ol-git-link.el ends here
diff --git a/contrib/lisp/ol-man.el b/contrib/lisp/ol-man.el
deleted file mode 100644
index f676579..0000000
--- a/contrib/lisp/ol-man.el
+++ /dev/null
@@ -1,85 +0,0 @@
-;;; ol-man.el - Links to man pages
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 1.0
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-(require 'ol)
-
-(org-link-set-parameters "man"
- :follow #'org-man-open
- :export #'org-man-export
- :store #'org-man-store-link)
-
-(defcustom org-man-command 'man
- "The Emacs command to be used to display a man page."
- :group 'org-link
- :type '(choice (const man) (const woman)))
-
-(defun org-man-open (path _)
- "Visit the manpage on PATH.
-PATH should be a topic that can be thrown at the man command.
-If PATH contains extra ::STRING which will use `occur' to search
-matched strings in man buffer."
- (string-match "\\(.*?\\)\\(?:::\\(.*\\)\\)?$" path)
- (let* ((command (match-string 1 path))
- (search (match-string 2 path)))
- (funcall org-man-command command)
- (when search
- (with-current-buffer (concat "*Man " command "*")
- (goto-char (point-min))
- (search-forward search)))))
-
-(defun org-man-store-link ()
- "Store a link to a README file."
- (when (memq major-mode '(Man-mode woman-mode))
- ;; This is a man page, we do make this link
- (let* ((page (org-man-get-page-name))
- (link (concat "man:" page))
- (description (format "Manpage for %s" page)))
- (org-link-store-props
- :type "man"
- :link link
- :description description))))
-
-(defun org-man-get-page-name ()
- "Extract the page name from the buffer name."
- ;; This works for both `Man-mode' and `woman-mode'.
- (if (string-match " \\(\\S-+\\)\\*" (buffer-name))
- (match-string 1 (buffer-name))
- (error "Cannot create link to this man page")))
-
-(defun org-man-export (link description format)
- "Export a man page link from Org files."
- (let ((path (format "http://man.he.net/?topic=%s§ion=all"; link))
- (desc (or description link)))
- (cond
- ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path
desc))
- ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
- ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
- ((eq format 'ascii) (format "%s (%s)" desc path))
- ((eq format 'md) (format "[%s](%s)" desc path))
- (t path))))
-
-(provide 'ol-man)
-
-;;; ol-man.el ends here
diff --git a/contrib/lisp/ol-mew.el b/contrib/lisp/ol-mew.el
deleted file mode 100644
index a8aa5d0..0000000
--- a/contrib/lisp/ol-mew.el
+++ /dev/null
@@ -1,355 +0,0 @@
-;;; ol-mew.el --- Links to Mew messages
-
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-
-;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements links to Mew messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-;;
-;; Here is an example of workflow:
-
-;; In your ~/.mew.el configuration file:
-;;
-;; (define-key mew-summary-mode-map "'" 'org-mew-search)
-;; (eval-after-load "mew-summary"
-;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture))
-
-;; 1. In the Mew's inbox folder, take a glance at new messages to find
-;; a message that requires any action.
-
-;; 2. If the message is a reply from somebody and associated with the
-;; existing orgmode entry, type M-x `org-mew-search' RET (or press
-;; the ' key simply) to find the entry. If you can find the entry
-;; successfully and think you should start the task right now,
-;; start the task by M-x `org-agenda-clock-in' RET.
-
-;; 3. If the message is a new message, type M-x `org-mew-capture' RET,
-;; enter the refile folder, and the buffer to capture the message
-;; is shown up (without selecting the template by hand). Then you
-;; can fill the template and type C-c C-c to complete the capture.
-;; Note that you can configure `org-capture-templates' so that the
-;; captured entry has a link to the message.
-
-;;; Code:
-
-(require 'org)
-(require 'ol)
-
-(defgroup org-mew nil
- "Options concerning the Mew link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-mew-link-to-refile-destination t
- "Create a link to the refile destination if the message is marked as refile."
- :group 'org-mew
- :type 'boolean)
-
-(defcustom org-mew-inbox-folder nil
- "The folder where new messages are incorporated.
-If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message
-in this inbox folder as well as the folder specified by the link."
- :group 'org-mew
- :type 'string)
-
-(defcustom org-mew-use-id-db t
- "Use ID database to locate the message if id.db is created."
- :group 'org-mew
- :type 'boolean)
-
-(defcustom org-mew-subject-alist
- (list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*"
- "\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *"
- "\\(?:\\(?:re\\|fwd?\\): *\\)*"
- "\\(.*\\)[ \t]*")
- 1))
- "Alist of subject regular expression and matched group number for search."
- :group 'org-mew
- :type '(repeat (cons (regexp) (integer))))
-
-(defcustom org-mew-capture-inbox-folders nil
- "List of inbox folders whose messages need refile marked before capture.
-`org-mew-capture' will ask you to put the refile mark on the
-message if the message's folder is any of these folders and the
-message is not marked. Nil means `org-mew-capture' never ask you
-destination folders before capture."
- :group 'org-mew
- :type '(repeat string))
-
-(defcustom org-mew-capture-guess-alist nil
- "Alist of the regular expression of the folder name and the capture
-template selection keys.
-
-For example,
- '((\"^%emacs-orgmode$\" . \"o\")
- (\"\" . \"t\"))
-the messages in \"%emacs-orgmode\" folder will be captured with
-the capture template associated with \"o\" key, and any other
-messages will be captured with the capture template associated
-with \"t\" key."
- :group 'org-mew
- :type '(repeat (cons regexp string)))
-
-;; Declare external functions and variables
-(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
-(declare-function mew-case-folder "ext:mew-func" (case folder))
-(declare-function mew-folder-path-to-folder
- "ext:mew-func" (path &optional has-proto))
-(declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev))
-(declare-function mew-folder-remotep "ext:mew-func" (folder))
-(declare-function mew-folder-virtualp "ext:mew-func" (folder))
-(declare-function mew-header-get-value "ext:mew-header"
- (field &optional as-list))
-(declare-function mew-init "ext:mew" ())
-(declare-function mew-refile-get "ext:mew-refile" (msg))
-(declare-function mew-sinfo-get-case "ext:mew-summary" ())
-(declare-function mew-summary-diag-global "ext:mew-thread" (id opt who))
-(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
-(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
-(declare-function mew-summary-get-mark "ext:mew-mark" ())
-(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
-(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
- (pattern folder src-msgs))
-(declare-function mew-summary-refile "ext:mew-refile" (&optional report))
-(declare-function mew-summary-search-msg "ext:mew-const" (msg))
-(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
-(declare-function mew-summary-visit-folder "ext:mew-summary4"
- (folder &optional goend no-ls))
-(declare-function mew-window-push "ext:mew" ())
-(declare-function mew-expand-folder "ext:mew-func" (folder))
-(declare-function mew-case:folder-folder "ext:mew-func" (case:folder))
-(declare-function mew "ext:mew" (&optional arg))
-(declare-function mew-message-goto-summary "ext:mew-message" ())
-(declare-function mew-summary-mode "ext:mew-summary" ())
-
-(defvar mew-init-p)
-(defvar mew-mark-afterstep-spec)
-(defvar mew-summary-goto-line-then-display)
-
-;; Install the link type
-(org-link-set-parameters "mew" :follow #'org-mew-open :store
#'org-mew-store-link)
-
-;; Implementation
-(defun org-mew-store-link ()
- "Store a link to a Mew folder or message."
- (save-window-excursion
- (if (eq major-mode 'mew-message-mode)
- (mew-message-goto-summary))
- (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
- (let ((msgnum (mew-summary-message-number2))
- (folder-name (org-mew-folder-name)))
- (if (fboundp 'mew-summary-set-message-buffer)
- (mew-summary-set-message-buffer folder-name msgnum)
- (set-buffer (mew-cache-hit folder-name msgnum t)))
- (let* ((message-id (mew-header-get-value "Message-Id:"))
- (from (mew-header-get-value "From:"))
- (to (mew-header-get-value "To:"))
- (date (mew-header-get-value "Date:"))
- (subject (mew-header-get-value "Subject:"))
- desc link)
- (org-store-link-props :type "mew" :from from :to to :date date
- :subject subject :message-id message-id)
- (setq message-id (org-unbracket-string "<" ">" message-id))
- (setq desc (org-email-link-description))
- (setq link (concat "mew:" folder-name "#" message-id))
- (org-add-link-props :link link :description desc)
- link)))))
-
-(defun org-mew-folder-name ()
- "Return the folder name of the current message."
- (save-window-excursion
- (if (eq major-mode 'mew-message-mode)
- (mew-message-goto-summary))
- (let* ((msgnum (mew-summary-message-number2))
- (mark-info (mew-summary-get-mark)))
- (if (and org-mew-link-to-refile-destination
- (eq mark-info ?o)) ; marked as refile
- (mew-case-folder (mew-sinfo-get-case)
- (nth 1 (mew-refile-get msgnum)))
- (let ((folder-or-path (mew-summary-folder-name)))
- (mew-folder-path-to-folder folder-or-path t))))))
-
-(defun org-mew-open (path _)
- "Follow the Mew message link specified by PATH."
- (let (folder message-id)
- (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for
Bastien's
- (setq folder (match-string 1 path))
- (setq message-id (match-string 2 path)))
- ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
- (setq folder (match-string 1 path))
- (setq message-id (match-string 4 path)))
- ((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path))
- (setq folder nil)
- (setq message-id (match-string 1 path)))
- (t (error "Error in Mew link")))
- (require 'mew)
- (mew-window-push)
- (unless mew-init-p (mew-init))
- (if (null folder)
- (progn
- (mew t)
- (org-mew-open-by-message-id message-id))
- (or (org-mew-follow-link folder message-id)
- (and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder))
- (org-mew-follow-link org-mew-inbox-folder message-id))
- (and org-mew-use-id-db
- (org-mew-open-by-message-id message-id))
- (error "Message not found")))))
-
-(defun org-mew-follow-link (folder message-id)
- (unless (org-mew-folder-exists-p folder)
- (error "No such folder or wrong folder %s" folder))
- (mew-summary-visit-folder folder)
- (when message-id
- (let ((msgnum (org-mew-get-msgnum folder message-id)))
- (when (mew-summary-search-msg msgnum)
- (if mew-summary-goto-line-then-display
- (mew-summary-display))
- t))))
-
-(defun org-mew-folder-exists-p (folder)
- (let ((dir (mew-expand-folder folder)))
- (cond
- ((mew-folder-virtualp folder) (get-buffer folder))
- ((null dir) nil)
- ((mew-folder-remotep (mew-case:folder-folder folder)) t)
- (t (file-directory-p dir)))))
-
-(defun org-mew-get-msgnum (folder message-id)
- (if (string-match "\\`[0-9]+\\'" message-id)
- message-id
- (let* ((pattern (concat "message-id=" message-id))
- (msgs (mew-summary-pick-with-mewl pattern folder nil)))
- (car msgs))))
-
-(defun org-mew-open-by-message-id (message-id)
- "Open message using ID database."
- (let ((result (mew-summary-diag-global (format "<%s>" message-id)
- "-p" "Message")))
- (unless (eq result t)
- (error "Message not found"))))
-
-;; In ~/.mew.el, add the following line:
-;; (define-key mew-summary-mode-map "'" 'org-mew-search)
-(defun org-mew-search (&optional arg)
- "Show all entries related to the message using `org-search-view'.
-
-It shows entries which contains the message ID, the reference
-IDs, or the subject of the message.
-
-With C-u prefix, search for the entries that contains the message
-ID or any of the reference IDs. With C-u C-u prefix, search for
-the message ID or the last reference ID.
-
-The search phase for the subject is extracted with
-`org-mew-subject-alist', which defines the regular expression of
-the subject and the group number to extract. You can get rid of
-\"Re:\" and some other prefix from the subject text."
- (interactive "P")
- (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
- (let ((last-reference-only (equal arg '(16)))
- (by-subject (null arg))
- (msgnum (mew-summary-message-number2))
- (folder-name (mew-summary-folder-name))
- subject message-id references id-list)
- (save-window-excursion
- (if (fboundp 'mew-summary-set-message-buffer)
- (mew-summary-set-message-buffer folder-name msgnum)
- (set-buffer (mew-cache-hit folder-name msgnum t)))
- (setq subject (mew-header-get-value "Subject:"))
- (setq message-id (mew-header-get-value "Message-Id:"))
- (setq references (mew-header-get-value "References:")))
- (setq id-list (mapcar (lambda (id) (org-unbracket-string "<" ">" id))
- (mew-idstr-to-id-list references)))
- (if last-reference-only
- (setq id-list (last id-list))
- (if message-id
- (setq id-list (cons (org-unbracket-string "<" ">" message-id)
- id-list))))
- (when (and by-subject (stringp subject))
- (catch 'matched
- (mapc (lambda (elem)
- (let ((regexp (car elem))
- (num (cdr elem)))
- (when (string-match regexp subject)
- (setq subject (match-string num subject))
- (throw 'matched t))))
- org-mew-subject-alist))
- (setq id-list (cons subject id-list)))
- (cond ((null id-list)
- (error "No message ID to search"))
- ((equal (length id-list) 1)
- (org-search-view nil (car id-list)))
- (t
- (org-search-view nil (format "{\\(%s\\)}"
- (mapconcat 'regexp-quote
- id-list "\\|"))))))
- (delete-other-windows)))
-
-(defun org-mew-capture (arg)
- "Guess the capture template from the folder name and invoke `org-capture'.
-
-This selects a capture template in `org-capture-templates' by
-searching for capture template selection keys defined in
-`org-mew-capture-guess-alist' which are associated with the
-regular expression that matches the message's folder name, and
-then invokes `org-capture'.
-
-If the message's folder is a inbox folder, you are prompted to
-put the refile mark on the message and the capture template is
-guessed from the refile destination folder. You can customize
-the inbox folders by `org-mew-capture-inbox-folders'.
-
-If ARG is non-nil, this does not guess the capture template but
-asks you to select the capture template."
- (interactive "P")
- (or (not (member (org-mew-folder-name)
- org-mew-capture-inbox-folders))
- (eq (mew-summary-get-mark) ?o)
- (save-window-excursion
- (if (eq major-mode 'mew-message-mode)
- (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"))
- (let* ((org-mew-link-to-refile-destination t)
- (folder-name (org-mew-folder-name))
- (keys (if arg
- nil
- (org-mew-capture-guess-selection-keys folder-name))))
- (org-capture nil keys)))
-
-(defun org-mew-capture-guess-selection-keys (folder-name)
- (catch 'found
- (let ((alist org-mew-capture-guess-alist))
- (while alist
- (let ((elem (car alist)))
- (if (string-match (car elem) folder-name)
- (throw 'found (cdr elem))))
- (setq alist (cdr alist))))))
-
-(provide 'ol-mew)
-
-;;; ol-mew.el ends here
diff --git a/contrib/lisp/ol-notmuch.el b/contrib/lisp/ol-notmuch.el
deleted file mode 100644
index 47882e2..0000000
--- a/contrib/lisp/ol-notmuch.el
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; ol-notmuch.el --- Links to notmuch messages
-
-;; Copyright (C) 2010-2014 Matthieu Lemerre
-
-;; Author: Matthieu Lemerre <racin@free.fr>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-
-;; This file is not part of GNU Emacs.
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file implements links to notmuch messages and "searches". A
-;; search is a query to be performed by notmuch; it is the equivalent
-;; to folders in other mail clients. Similarly, mails are referred to
-;; by a query, so both a link can refer to several mails.
-
-;; Links have one the following form
-;; notmuch:<search terms>
-;; notmuch-search:<search terms>.
-
-;; The first form open the queries in notmuch-show mode, whereas the
-;; second link open it in notmuch-search mode. Note that queries are
-;; performed at the time the link is opened, and the result may be
-;; different from when the link was stored.
-
-;;; Code:
-
-(require 'ol)
-
-;; 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)
-
-(make-obsolete-variable 'org-notmuch-search-open-function nil "9.3")
-
-
-
-;; Install the link type
-(org-link-set-parameters "notmuch"
- :follow #'org-notmuch-open
- :store #'org-notmuch-store-link)
-
-(defun org-notmuch-store-link ()
- "Store a link to a notmuch search or message."
- (when (memq major-mode '(notmuch-show-mode notmuch-tree-mode))
- (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-link-store-props :type "notmuch" :from from :to to :date date
- :subject subject :message-id message-id)
- (setq desc (org-link-email-description))
- (setq link (concat "notmuch:id:" message-id))
- (org-link-add-props :link link :description desc)
- link)))
-
-(defun org-notmuch-open (path _)
- "Follow a notmuch message link specified by PATH."
- (funcall org-notmuch-open-function path))
-
-(defun org-notmuch-follow-link (search)
- "Follow a notmuch link to SEARCH.
-
-Can link to more than one message, if so all matching messages are shown."
- (require 'notmuch)
- (notmuch-show search))
-
-
-
-(org-link-set-parameters "notmuch-search"
- :follow #'org-notmuch-search-open
- :store #'org-notmuch-search-store-link)
-
-(defun org-notmuch-search-store-link ()
- "Store a link to a notmuch search or message."
- (when (eq major-mode 'notmuch-search-mode)
- (let ((link (concat "notmuch-search:" notmuch-search-query-string))
- (desc (concat "Notmuch search: " notmuch-search-query-string)))
- (org-link-store-props :type "notmuch-search"
- :link link
- :description desc)
- link)))
-
-(defun org-notmuch-search-open (path _)
- "Follow a notmuch message link specified by PATH."
- (message "%s" path)
- (org-notmuch-search-follow-link path))
-
-(defun org-notmuch-search-follow-link (search)
- "Follow a notmuch link by displaying SEARCH in notmuch-search mode."
- (require 'notmuch)
- (notmuch-search search))
-
-
-
-(org-link-set-parameters "notmuch-tree"
- :follow #'org-notmuch-tree-open
- :store #'org-notmuch-tree-store-link)
-
-(defun org-notmuch-tree-store-link ()
- "Store a link to a notmuch search or message."
- (when (eq major-mode 'notmuch-tree-mode)
- (let ((link (concat "notmuch-tree:" (notmuch-tree-get-query)))
- (desc (concat "Notmuch tree: " (notmuch-tree-get-query))))
- (org-link-store-props :type "notmuch-tree"
- :link link
- :description desc)
- link)))
-
-(defun org-notmuch-tree-open (path _)
- "Follow a notmuch message link specified by PATH."
- (message "%s" path)
- (org-notmuch-tree-follow-link path))
-
-(defun org-notmuch-tree-follow-link (search)
- "Follow a notmuch link by displaying SEARCH in notmuch-tree mode."
- (require 'notmuch)
- (notmuch-tree search))
-
-(provide 'ol-notmuch)
-
-;;; ol-notmuch.el ends here
diff --git a/contrib/lisp/ol-vm.el b/contrib/lisp/ol-vm.el
deleted file mode 100644
index a07342b..0000000
--- a/contrib/lisp/ol-vm.el
+++ /dev/null
@@ -1,167 +0,0 @@
-;;; ol-vm.el --- Links to VM messages
-
-;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;;
-;; Support for IMAP folders added
-;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net>
-;; Requires VM 8.2.0a or later.
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;; This file implements links to VM messages and folders from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'ol)
-(require 'org)
-
-;; Declare external functions and variables
-(declare-function vm-preview-current-message "ext:vm-page" ())
-(declare-function vm-follow-summary-cursor "ext:vm-motion" ())
-(declare-function vm-get-header-contents "ext:vm-summary"
- (message header-name-regexp &optional clump-sep))
-(declare-function vm-isearch-narrow "ext:vm-search" ())
-(declare-function vm-isearch-update "ext:vm-search" ())
-(declare-function vm-select-folder-buffer "ext:vm-macro" ())
-(declare-function vm-su-message-id "ext:vm-summary" (m))
-(declare-function vm-su-subject "ext:vm-summary" (m))
-(declare-function vm-summarize "ext:vm-summary" (&optional display raise))
-(declare-function vm-imap-folder-p "ext:vm-save" ())
-(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer))
-(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec))
-(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec))
-(declare-function vm-imap-spec-for-account "ext:vm-imap" (account))
-(defvar vm-message-pointer)
-(defvar vm-folder-directory)
-
-;; Install the link type
-(org-link-set-parameters "vm" :follow #'org-vm-open :store #'org-vm-store-link)
-(org-link-set-parameters "vm-imap" :follow #'org-vm-imap-open)
-
-;; Implementation
-(defun org-vm-store-link ()
- "Store a link to a VM folder or message."
- (when (and (or (eq major-mode 'vm-summary-mode)
- (eq major-mode 'vm-presentation-mode))
- (save-window-excursion
- (vm-select-folder-buffer) buffer-file-name))
- (and (eq major-mode 'vm-presentation-mode) (vm-summarize))
- (vm-follow-summary-cursor)
- (save-excursion
- (vm-select-folder-buffer)
- (let* ((message (car vm-message-pointer))
- (subject (vm-su-subject message))
- (to (vm-get-header-contents message "To"))
- (from (vm-get-header-contents message "From"))
- (message-id (vm-su-message-id message))
- (link-type (if (vm-imap-folder-p) "vm-imap" "vm"))
- (date (vm-get-header-contents message "Date"))
- folder desc link)
- (if (vm-imap-folder-p)
- (let ((spec (vm-imap-find-spec-for-buffer (current-buffer))))
- (setq folder (vm-imap-folder-for-spec spec)))
- (progn
- (setq folder (abbreviate-file-name buffer-file-name))
- (if (and vm-folder-directory
- (string-match (concat "^" (regexp-quote
vm-folder-directory))
- folder))
- (setq folder (replace-match "" t t folder)))))
- (setq message-id (org-unbracket-string "<" ">" message-id))
- (org-store-link-props :type link-type :from from :to to :subject subject
- :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)
- link))))
-
-(defun org-vm-open (path _)
- "Follow a VM message link specified by PATH."
- (let (folder article)
- (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
- (error "Error in VM link"))
- (setq folder (match-string 1 path)
- article (match-string 3 path))
- ;; The prefix argument will be interpreted as read-only
- (org-vm-follow-link folder article current-prefix-arg)))
-
-(defun org-vm-follow-link (&optional folder article readonly)
- "Follow a VM link to FOLDER and ARTICLE."
- (require 'vm)
- (setq article (org-link-add-angle-brackets article))
- (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder)
- ;; ange-ftp or efs or tramp access
- (let ((user (or (match-string 1 folder) (user-login-name)))
- (host (match-string 2 folder))
- (file (match-string 3 folder)))
- (cond
- ((featurep 'tramp)
- ;; use tramp to access the file
- (setq folder (format "/%s@%s:%s" user host file)))
- (t
- ;; use ange-ftp or efs
- (require 'ange-ftp)
- (setq folder (format "/%s@%s:%s" user host file))))))
- (when folder
- (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly)
- (when article
- (org-vm-select-message (org-link-add-angle-brackets article)))))
-
-(defun org-vm-imap-open (path _)
- "Follow a VM link to an IMAP folder."
- (require 'vm-imap)
- (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path)
- (let* ((account-name (match-string 1 path))
- (mailbox-name (match-string 2 path))
- (message-id (match-string 3 path))
- (account-spec (vm-imap-parse-spec-to-list
- (vm-imap-spec-for-account account-name)))
- (mailbox-spec (mapconcat 'identity
- (append (butlast account-spec 4)
- (cons mailbox-name
- (last account-spec 3)))
- ":")))
- (funcall (cdr (assq 'vm-imap org-link-frame-setup))
- mailbox-spec)
- (when message-id
- (org-vm-select-message (org-link-add-angle-brackets message-id))))))
-
-(defun org-vm-select-message (message-id)
- "Go to the message with message-id in the current folder."
- (require 'vm-search)
- (sit-for 0.1)
- (vm-select-folder-buffer)
- (widen)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (if (not (re-search-forward
- (concat "^" "message-id: *" (regexp-quote message-id))))
- (error "Could not find the specified message in this folder"))
- (vm-isearch-update)
- (vm-isearch-narrow)
- (vm-preview-current-message)
- (vm-summarize)))
-
-(provide 'ol-vm)
-
-;;; ol-vm.el ends here
diff --git a/contrib/lisp/ol-wl.el b/contrib/lisp/ol-wl.el
deleted file mode 100644
index cc122c5..0000000
--- a/contrib/lisp/ol-wl.el
+++ /dev/null
@@ -1,304 +0,0 @@
-;;; ol-wl.el --- Links to Wanderlust messages
-
-;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
-
-;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
-;; David Maus <dmaus at ictsoc dot de>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements links to Wanderlust messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
-
-;;; Code:
-
-(require 'ol)
-(require 'org)
-
-(defgroup org-wl nil
- "Options concerning the Wanderlust link."
- :tag "Org Startup"
- :group 'org-link)
-
-(defcustom org-wl-link-to-refile-destination t
- "Create a link to the refile destination if the message is marked as refile."
- :group 'org-wl
- :type 'boolean)
-
-(defcustom org-wl-link-remove-filter nil
- "Remove filter condition if message is filter folder."
- :group 'org-wl
- :type 'boolean)
-
-(defcustom org-wl-shimbun-prefer-web-links nil
- "If non-nil create web links for shimbun messages."
- :group 'org-wl
- :type 'boolean)
-
-(defcustom org-wl-nntp-prefer-web-links nil
- "If non-nil create web links for nntp messages.
-When folder name contains string \"gmane\" link to gmane,
-googlegroups otherwise."
- :type 'boolean
- :group 'org-wl)
-
-(defcustom org-wl-disable-folder-check t
- "Disable check for new messages when open a link."
- :type 'boolean
- :group 'org-wl)
-
-(defcustom org-wl-namazu-default-index nil
- "Default namazu search index."
- :type '(choice (const nil) (directory))
- :group 'org-wl)
-
-;; Declare external functions and variables
-(declare-function elmo-folder-exists-p "ext:elmo" (folder) t)
-(declare-function elmo-message-entity-field "ext:elmo-msgdb"
- (entity field &optional type))
-(declare-function elmo-message-field "ext:elmo"
- (folder number field &optional type) t)
-(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t)
-;; Backward compatibility to old version of wl
-(declare-function wl "ext:wl" () t)
-(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t)
-(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary"
- (&optional id))
-(declare-function wl-summary-jump-to-msg "ext:wl-summary"
- (&optional number beg end))
-(declare-function wl-summary-line-from "ext:wl-summary" ())
-(declare-function wl-summary-line-subject "ext:wl-summary" ())
-(declare-function wl-summary-message-number "ext:wl-summary" ())
-(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg))
-(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number))
-(declare-function wl-folder-goto-folder-subr "ext:wl-folder"
- (&optional folder sticky))
-(declare-function wl-folder-get-petname "ext:wl-folder" (name))
-(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder"
- (&optional getid))
-(declare-function wl-folder-buffer-group-p "ext:wl-folder")
-(defvar wl-init)
-(defvar wl-summary-buffer-elmo-folder)
-(defvar wl-summary-buffer-folder-name)
-(defvar wl-folder-group-regexp)
-(defvar wl-auto-check-folder-name)
-(defvar elmo-nntp-default-server)
-
-(defconst org-wl-folder-types
- '(("%" . imap) ("-" . nntp) ("+" . mh) ("." . maildir)
- ("=" . spool) ("$" . archive) ("&" . pop) ("@" . shimbun)
- ("rss" . rss) ("[" . search) ("*" . multi) ("/" . filter)
- ("|" . pipe) ("'" . internal) )
- "List of folder indicators. See Wanderlust manual, section 3.")
-
-;; Install the link type
-(org-link-set-parameters "wl" :follow #'org-wl-open :store #'org-wl-store-link)
-
-;; Implementation
-
-(defun org-wl-folder-type (folder)
- "Return symbol that indicates the type of FOLDER.
-FOLDER is the wanderlust folder name. The first character of the
-folder name determines the folder type."
- (let* ((indicator (substring folder 0 1))
- (type (cdr (assoc indicator org-wl-folder-types))))
- ;; maybe access or file folder
- (when (not type)
- (setq type
- (cond
- ((and (>= (length folder) 5)
- (string= (substring folder 0 5) "file:"))
- 'file)
- ((and (>= (length folder) 7)
- (string= (substring folder 0 7) "access:"))
- 'access)
- (t
- nil))))
- type))
-
-(defun org-wl-message-field (field entity)
- "Return content of FIELD in ENTITY.
-FIELD is a symbol of a rfc822 message header field.
-ENTITY is a message entity."
- (let ((content (elmo-message-entity-field entity field 'string)))
- (if (listp content) (car content) content)))
-
-(defun org-wl-store-link ()
- "Store a link to a WL message or folder."
- (unless (eobp)
- (cond
- ((memq major-mode '(wl-summary-mode mime-view-mode))
- (org-wl-store-link-message))
- ((eq major-mode 'wl-folder-mode)
- (org-wl-store-link-folder))
- (t
- nil))))
-
-(defun org-wl-store-link-folder ()
- "Store a link to a WL folder."
- (let* ((folder (wl-folder-get-entity-from-buffer))
- (petname (wl-folder-get-petname folder))
- (link (concat "wl:" folder)))
- (save-excursion
- (beginning-of-line)
- (unless (and (wl-folder-buffer-group-p)
- (looking-at wl-folder-group-regexp))
- (org-store-link-props :type "wl" :description petname
- :link link)
- link))))
-
-(defun org-wl-store-link-message ()
- "Store a link to a WL message."
- (save-excursion
- (let ((buf (if (eq major-mode 'wl-summary-mode)
- (current-buffer)
- (and (boundp 'wl-message-buffer-cur-summary-buffer)
- wl-message-buffer-cur-summary-buffer))))
- (when buf
- (with-current-buffer buf
- (let* ((msgnum (wl-summary-message-number))
- (mark-info (wl-summary-registered-temp-mark msgnum))
- (folder-name
- (if (and org-wl-link-to-refile-destination
- mark-info
- (equal (nth 1 mark-info) "o")) ; marked as refile
- (nth 2 mark-info)
- wl-summary-buffer-folder-name))
- (folder-type (org-wl-folder-type folder-name))
- (wl-message-entity
- (if (fboundp 'elmo-message-entity)
- (elmo-message-entity
- wl-summary-buffer-elmo-folder msgnum)
- (elmo-msgdb-overview-get-entity
- msgnum (wl-summary-buffer-msgdb))))
- (message-id
- (org-wl-message-field 'message-id wl-message-entity))
- (message-id-no-brackets
- (org-unbracket-string "<" ">" message-id))
- (from (org-wl-message-field 'from wl-message-entity))
- (to (org-wl-message-field 'to wl-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))
- desc link)
-
- ;; remove text properties of subject string to avoid possible bug
- ;; when formatting the subject
- ;; (Emacs bug #5306, fixed)
- (set-text-properties 0 (length subject) nil subject)
-
- ;; maybe remove filter condition
- (when (and (eq folder-type 'filter) org-wl-link-remove-filter)
- (while (eq (org-wl-folder-type folder-name) 'filter)
- (setq folder-name
- (replace-regexp-in-string "^/[^/]+/" "" folder-name))))
-
- ;; maybe create http link
- (cond
- ((and (eq folder-type 'shimbun)
- org-wl-shimbun-prefer-web-links xref)
- (org-store-link-props :type "http" :link xref :description subject
- :from from :to to :message-id message-id
- :message-id-no-brackets
message-id-no-brackets
- :subject subject))
- ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links)
- (setq link
- (format
- (if (string-match-p "gmane\\." folder-name)
- "http://mid.gmane.org/%s";
- "https://groups.google.com/groups/search?as_umsgid=%s";)
- (url-encode-url message-id)))
- (org-store-link-props :type "http" :link link :description subject
- :from from :to to :message-id message-id
- :message-id-no-brackets
message-id-no-brackets
- :subject subject))
- (t
- (org-store-link-props :type "wl" :from from :to to
- :subject subject :message-id message-id
- :message-id-no-brackets
message-id-no-brackets)
- (setq desc (org-email-link-description))
- (setq link (concat "wl:" folder-name "#" message-id-no-brackets))
- (org-add-link-props :link link :description desc)))
- (org-add-link-props :date date)
- (or link xref)))))))
-
-(defun org-wl-open-nntp (path)
- "Follow the nntp: link specified by PATH."
- (let* ((spec (split-string path "/"))
- (server (split-string (nth 2 spec) "@"))
- (group (nth 3 spec))
- (article (nth 4 spec)))
- (org-wl-open
- (concat "-" group ":" (if (cdr server)
- (car (split-string (car server) ":"))
- "")
- (if (string= elmo-nntp-default-server (nth 2 spec))
- ""
- (concat "@" (or (cdr server) (car server))))
- (if article (concat "#" article) "")))))
-
-(defun org-wl-open (path &rest _)
- "Follow the WL message link specified by PATH.
-When called with one prefix, open message in namazu search folder
-with `org-wl-namazu-default-index' as search index. When called
-with two prefixes or `org-wl-namazu-default-index' is nil, ask
-for namazu index."
- (require 'wl)
- (let ((wl-auto-check-folder-name
- (if org-wl-disable-folder-check
- 'none
- wl-auto-check-folder-name)))
- (unless wl-init (wl))
- ;; XXX: The imap-uw's MH folder names start with "%#".
- (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path))
- (error "Error in Wanderlust link"))
- (let ((folder (match-string 1 path))
- (article (match-string 3 path)))
- ;; maybe open message in namazu search folder
- (when current-prefix-arg
- (setq folder (concat "[" article "]"
- (if (and (equal current-prefix-arg '(4))
- org-wl-namazu-default-index)
- org-wl-namazu-default-index
- (read-directory-name "Namazu index: ")))))
- (if (not (elmo-folder-exists-p (with-no-warnings
- (wl-folder-get-elmo-folder folder))))
- (error "No such folder: %s" folder))
- (let ((old-buf (current-buffer))
- (old-point (point-marker)))
- (wl-folder-goto-folder-subr folder)
- (with-current-buffer old-buf
- ;; XXX: `wl-folder-goto-folder-subr' moves point to the
- ;; beginning of the current line. So, restore the point
- ;; in the old buffer.
- (goto-char old-point))
- (when article
- (if (string-match-p "@" article)
- (wl-summary-jump-to-msg-by-message-id (org-link-add-angle-brackets
- article))
- (or (wl-summary-jump-to-msg (string-to-number article))
- (error "No such message: %s" article)))
- (wl-summary-redisplay))))))
-
-(provide 'ol-wl)
-
-;;; ol-wl.el ends here
diff --git a/contrib/lisp/org-annotate-file.el
b/contrib/lisp/org-annotate-file.el
deleted file mode 100644
index e1f1f13..0000000
--- a/contrib/lisp/org-annotate-file.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; org-annotate-file.el --- Annotate a file with org syntax
-
-;; Copyright (C) 2008-2014 Philip Jackson
-
-;; Author: Philip Jackson <phil@shellarchive.co.uk>
-;; Version: 0.2
-
-;; This file is not currently part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is yet another implementation to allow the annotation of a
-;; file without modification of the file itself. The annotation is in
-;; org syntax so you can use all of the org features you are used to.
-
-;; To use you might put the following in your .emacs:
-;;
-;; (require 'org-annotate-file)
-;; (global-set-key (kbd "C-c C-l") 'org-annotate-file) ; for example
-;;
-;; To change the location of the annotation file:
-;;
-;; (setq org-annotate-file-storage-file "~/annotated.org")
-;;
-;; Then when you visit any file and hit C-c C-l you will find yourself
-;; in an org buffer on a headline which links to the file you were
-;; visiting, e.g:
-
-;; * ~/org-annotate-file.el
-
-;; Under here you can put anything you like, save the file
-;; and next time you hit C-c C-l you will hit those notes again.
-;;
-;; To put a subheading with a text search for the current line set
-;; `org-annotate-file-add-search` to non-nil value. Then when you hit
-;; C-c C-l (on the above line for example) you will get:
-
-;; * ~/org-annotate-file.el
-;; ** `org-annotate-file-add-search` to non-nil value. Then when...
-
-;; Note that both of the above will be links.
-
-;;; Code:
-
-(require 'org)
-
-(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.
-Trim whitespace at beginning and end of STRING and replace any
- characters that appear after the occurrence of AFTER with '...'"
- (let* ((after (number-to-string (or after 30)))
- (replace-map (list (cons "^[ \t]*" "")
- (cons "[ \t]*$" "")
- (cons (concat "^\\(.\\{" after
- "\\}\\).*") "\\1..."))))
- (mapc (lambda (x)
- (when (string-match (car x) string)
- (setq string (replace-match (cdr x) nil nil string))))
- replace-map)
- string))
-
-;;;###autoload
-(defun org-annotate-file ()
- "Visit `org-annotate-file-storage-file` and add a new annotation section.
-The annotation is opened at the new section which will be referencing
-the point in the current file."
- (interactive)
- (unless (buffer-file-name)
- (error "This buffer has no associated file!"))
- (switch-to-buffer
- (org-annotate-file-show-section org-annotate-file-storage-file)))
-
-;;;###autoload
-(defun org-annotate-file-show-section (storage-file &optional annotated-buffer)
- "Add or show annotation entry in STORAGE-FILE and return the buffer.
-The annotation will link to ANNOTATED-BUFFER if specified,
- otherwise the current buffer is used."
- (let ((filename (abbreviate-file-name (or annotated-buffer
- (buffer-file-name))))
- (line (buffer-substring-no-properties (point-at-bol) (point-at-eol)))
- (annotation-buffer (find-file-noselect storage-file)))
- (with-current-buffer annotation-buffer
- (org-annotate-file-annotate filename line))
- annotation-buffer))
-
-(defun org-annotate-file-annotate (filename line)
- "Add annotation for FILENAME at LINE using current buffer."
- (let* ((link (org-make-link-string (concat "file:" filename) filename))
- (search-link (org-make-link-string
- (concat "file:" filename "::" line)
- (org-annotate-file-ellipsify-desc line))))
- (unless (eq major-mode 'org-mode)
- (org-mode))
- (goto-char (point-min))
- (widen)
- (when org-annotate-file-always-open
- (show-all))
- (unless (search-forward-regexp
- (concat "^* " (regexp-quote link)) nil t)
- (org-annotate-file-add-upper-level link))
- (beginning-of-line)
- (org-narrow-to-subtree)
- ;; deal with a '::' search if need be
- (when org-annotate-file-add-search
- (unless (search-forward-regexp
- (concat "^** " (regexp-quote search-link)) nil t)
- (org-annotate-file-add-second-level search-link)))))
-
-(defun org-annotate-file-add-upper-level (link)
- "Add and link heading to LINK."
- (goto-char (point-min))
- (call-interactively 'org-insert-heading)
- (insert link))
-
-(defun org-annotate-file-add-second-level (link)
- "Add and link subheading to LINK."
- (goto-char (point-at-eol))
- (call-interactively 'org-insert-subheading)
- (insert link))
-
-(provide 'org-annotate-file)
-
-;;; org-annotate-file.el ends here
diff --git a/contrib/lisp/org-attach-embedded-images.el
b/contrib/lisp/org-attach-embedded-images.el
deleted file mode 100644
index 45fd004..0000000
--- a/contrib/lisp/org-attach-embedded-images.el
+++ /dev/null
@@ -1,131 +0,0 @@
-;;; org-attach-embedded-images.el --- Transmute images to attachments
-;;
-;; Copyright 2018-2021 Free Software Foundation, Inc.
-;;
-;; Author: Marco Wahl
-;; Version: 0.1
-;; Keywords: org, media
-;;
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; There are occasions when images are displayed in a subtree which
-;; are not org attachments. For example if you copy and paste a part
-;; of a web page (containing images) from eww to an org subtree.
-
-;; This module provides command `org-attach-embedded-images-in-subtree'
-;; to save such images as attachments and insert org links to them.
-
-;; Install:
-
-;; To use this module insert it to `org-modules'. The insert can be
-;; performed via {M-x customize-variable RET org-modules RET} followed
-;; by insertion of `org-attach-embedded-images' to the external
-;; modules section.
-
-;; Alternatively you can add the line
-
-;; (require 'org-attach-embedded-images)
-
-;; to your emacs configuration.
-
-;; Use
-
-;; M-x org-attach-embedded-images-in-subtree
-
-;; in a subtree with embedded images. The images get attached and can
-;; later be reviewed.
-
-;; Note: Possibly
-
-;; M-x org-toggle-inline-images
-
-;; is needed to see the images in the Org mode window.
-
-
-;; Code:
-
-(require 'org)
-(require 'org-attach)
-
-
-;; Auxiliary functions
-
-(defun org-attach-embedded-images--next-property-display-data (position limit)
- "Return position of the next property-display location with image data.
-Return nil if there is no next display property.
-POSITION and LIMIT as in `next-single-property-change'."
- (let ((pos (next-single-property-change position 'display nil limit)))
- (while (and (< pos limit)
- (let ((display-prop
- (plist-get (text-properties-at pos) 'display)))
- (or (not display-prop)
- (not (plist-get (cdr display-prop) :data)))))
- (setq pos (next-single-property-change pos 'display nil limit)))
- pos))
-
-(defun org-attach-embedded-images--attach-with-sha1-name (data)
- "Save the image given as DATA as org attachment with its sha1 as name.
-Return the filename."
- (let* ((extension (symbol-name (image-type-from-data data)))
- (basename (concat (sha1 data) "." extension))
- (dir (org-attach-dir t))
- (filename (concat dir "/" basename)))
- (unless (file-exists-p filename)
- (with-temp-file filename
- (setq buffer-file-coding-system 'binary)
- (set-buffer-multibyte nil)
- (insert data)))
- (org-attach-sync)
- basename))
-
-
-;; Command
-
-;;;###autoload
-(defun org-attach-embedded-images-in-subtree ()
- "Save the displayed images as attachments and insert links to them."
- (interactive)
- (when (org-before-first-heading-p)
- (user-error "Before first heading. Nothing has been attached."))
- (save-excursion
- (org-attach-dir t)
- (let ((beg (progn (org-back-to-heading) (point)))
- (end (progn (org-end-of-subtree) (point)))
- names)
- ;; pass 1
- (goto-char beg)
- (while (< (goto-char
(org-attach-embedded-images--next-property-display-data (point) end)) end)
- (let ((data (plist-get (cdr (plist-get (text-properties-at (point))
'display)) :data)))
- (assert data)
- (push (org-attach-embedded-images--attach-with-sha1-name data)
- names)))
- ;; pass 2
- (setq names (nreverse names))
- (goto-char beg)
- (while names
- (goto-char (org-attach-embedded-images--next-property-display-data
(point) end))
- (while (get-text-property (point) 'display)
- (goto-char (next-property-change (point) nil end)))
- (skip-chars-forward "]")
- (insert (concat "\n[[attachment:" (pop names) "]]"))))))
-
-
-(provide 'org-attach-embedded-images)
-
-
-;;; org-attach-embedded-images.el ends here
diff --git a/contrib/lisp/org-bibtex-extras.el
b/contrib/lisp/org-bibtex-extras.el
deleted file mode 100644
index d7e9e46..0000000
--- a/contrib/lisp/org-bibtex-extras.el
+++ /dev/null
@@ -1,137 +0,0 @@
-;;; org-bibtex-extras --- extras for working with org-bibtex entries
-
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-
-;; Author: Eric Schulte <eric dot schulte at gmx dot com>
-;; Keywords: outlines, hypermedia, bibtex, d3
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Warning: This should certainly be considered EXPERIMENTAL and still
-;; in development, feedback is welcome, but don't expect it
-;; to work.
-
-;; This file add some extra functionality to your bibtex entries which
-;; are stored as Org-mode headlines using org-bibtex.el. Most
-;; features expect that you keep all of your reading notes in a single
-;; file, set the `obe-bibtex-file' variable to the path to this file.
-;;
-;; - d3 view :: d3 is a Javascript library which supports interactive
-;; display of graphs. To view your citations as a d3
-;; graph, execute the following which will create a .json
-;; export of your references file, then grab a copy of
-;; d3, edit examples/force/force.js to replace
-;;
-;; var source`"miserables.json";
-;;
-;; with
-;;
-;; var source`"your-references.json";
-;;
-;; then view examples/force/force.html in your browser.
-;;
-;; - HTML export :: Customize the `obe-html-link-base' variable so
-;; that it points to an html export of your
-;; references, then add the following to your html
-;; export hook, and citations will be resolved during
-;; html export.
-;;
-;; (add-hook 'org-export-first-hook
-;; (lambda ()
-;; (when (equal org-export-current-backend 'html)
-;; (obe-html-export-citations))))
-
-;;; Code:
-(require 'ol-bibtex)
-
-(declare-function org-trim "org" (s &optional keep-lead))
-
-(defcustom obe-bibtex-file nil "File holding bibtex entries.")
-
-(defcustom obe-html-link-base nil
- "Base of citation links.
-For example, to point to your `obe-bibtex-file' use the following.
-
- (setq obe-html-link-base (format \"file:%s\" obe-bibtex-file))
-")
-
-(defvar obe-citations nil)
-(defun obe-citations ()
- "Return all citations from `obe-bibtex-file'."
- (or obe-citations
- (save-window-excursion
- (find-file (or obe-bibtex-file
- (error "`obe-bibtex-file' has not been configured")))
- (goto-char (point-min))
- (while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t)
- (push (org-no-properties (match-string 1))
- obe-citations))
- obe-citations)))
-
-(defun obe-html-export-citations ()
- "Convert all \\cite{...} citations in the current file into HTML links."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\\\\cite{\\([^\000}]+\\)}" nil t)
- (replace-match
- (save-match-data
- (mapconcat (lambda (c) (format "[[%s#%s][%s]]" obe-html-link-base c c))
- (mapcar #'org-trim
- (split-string (match-string 1) ",")) ", "))))))
-
-(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)
- (flet ((id (it) (position it nodes :test #'string= :key #'car))
- (col (k) (mapcar (lambda (r) (cdr (assoc k r))) meta))
- (add (lst)
- (dolist (el lst) (push (cons el counter) nodes))
- (incf counter)))
- ;; build the nodes of the graph
- (add (col :title))
- (add (remove-if (lambda (author) (string-match "others" author))
- (remove-duplicates (apply #'append (col :authors))
- :test #'string=)))
- (dolist (field fields)
- (add (remove-duplicates (col field) :test #'string=)))
- ;; build the links in the graph
- (dolist (citation meta)
- (let ((dest (id (cdr (assq :title citation)))))
- (dolist (author (mapcar #'id (cdr (assq :authors citation))))
- (when author (push (cons author dest) links)))
- (let ((jid (id (cdr (assq :journal citation)))))
- (when jid (push (cons jid dest) links)))
- (let ((cid (id (cdr (assq :category citation)))))
- (when cid (push (cons cid dest) links)))))
- ;; build the json string
- (format "{\"nodes\":[%s],\"links\":[%s]}"
- (mapconcat
- (lambda (pair)
- (format "{\"name\":%S,\"group\":%d}"
- (car pair) (cdr pair)))
- nodes ",")
- (mapconcat
- (lambda (link)
- (format "{\"source\":%d,\"target\":%d,\"value\":1}"
- (car link) (cdr link)))
- (meta-to-links meta nodes) ",")))))
-
-(provide 'org-bibtex-extras)
-;;; org-bibtex-extras ends here
diff --git a/contrib/lisp/org-checklist.el b/contrib/lisp/org-checklist.el
deleted file mode 100644
index 2b05017..0000000
--- a/contrib/lisp/org-checklist.el
+++ /dev/null
@@ -1,141 +0,0 @@
-;;; org-checklist.el --- org functions for checklist handling
-
-;; Copyright (C) 2008-2014 James TD Smith
-
-;; Author: James TD Smith (@ ahktenzero (. mohorovi cc))
-;; Version: 1.0
-;; Keywords: org, checklists
-;;
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file provides some functions for handing repeated tasks which involve
-;; checking off a list of items. By setting the RESET_CHECK_BOXES property in
an
-;; item, when the TODO state is set to done all checkboxes under that item are
-;; cleared. If the LIST_EXPORT_BASENAME property is set, a file will be created
-;; using the value of that property plus a timestamp, containing all the items
-;; in the list which are not checked. Additionally the user will be prompted to
-;; print the list.
-;;
-;; I use this for to keep track of stores of various things (food stores,
-;; components etc) which I check periodically and use the exported list of
items
-;; which are not present as a shopping list.
-;;
-;;; Usage:
-;; (require 'org-checklist)
-;;
-;; Set the RESET_CHECK_BOXES and LIST_EXPORT_BASENAME properties in items as
-;; needed.
-;;
-;;; Code:
-(require 'org)
-(load "a2ps-print" 'no-error)
-
-(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons
"LIST_EXPORT_BASENAME" org-default-properties)))
-
-(defgroup org-checklist nil
- "Extended checklist handling for org"
- :tag "Org-checklist"
- :group 'org)
-
-(defcustom org-checklist-export-time-format "%Y%m%d%H%M"
- "The format of timestamp appended to LIST_EXPORT_BASENAME to
- make the name of the export file."
- :link '(function-link format-time-string)
- :group 'org-checklist
- :type 'string)
-
-(defcustom org-checklist-export-function 'org-export-as-ascii
- "function used to prepare the export file for printing"
- :group 'org-checklist
- :type '(radio (function-item :tag "ascii text" org-export-as-ascii)
- (function-item :tag "HTML" org-export-as-html)
- (function-item :tag "LaTeX" :value org-export-as-latex)
- (function-item :tag "XOXO" :value org-export-as-xoxo)))
-
-(defcustom org-checklist-export-params nil
- "options for the export function file for printing"
- :group 'org-checklist
- :type '(repeat string))
-
-(defcustom org-checklist-a2ps-params nil
- "options for a2ps for printing"
- :group 'org-checklist
- :type '(repeat string))
-
-(defun org-reset-checkbox-state-maybe ()
- "Reset all checkboxes in an entry if the `RESET_CHECK_BOXES' property is set"
- (interactive "*")
- (if (org-entry-get (point) "RESET_CHECK_BOXES")
- (org-reset-checkbox-state-subtree)))
-
-
-(defun org-make-checklist-export ()
- "Produce a checklist containing all unchecked items from a list
-of checkbox items"
- (interactive "*")
- (if (org-entry-get (point) "LIST_EXPORT_BASENAME")
- (let* ((export-file (concat (org-entry-get (point)
"LIST_EXPORT_BASENAME" nil)
- "-" (format-time-string
- org-checklist-export-time-format)
- ".org"))
- (print (case (org-entry-get (point) "PRINT_EXPORT" nil)
- (("" "nil" nil) nil)
- (t t)
- (nil (y-or-n-p "Print list? "))))
- exported-lines
- (title "Checklist export"))
- (save-restriction
- (save-excursion
- (org-narrow-to-subtree)
- (org-update-checkbox-count-maybe)
- (org-show-subtree)
- (goto-char (point-min))
- (when (looking-at org-complex-heading-regexp)
- (setq title (match-string 4)))
- (goto-char (point-min))
- (let ((end (point-max)))
- (while (< (point) end)
- (when (and (org-at-item-checkbox-p)
- (or (string= (match-string 0) "[ ]")
- (string= (match-string 0) "[-]")))
- (add-to-list 'exported-lines (thing-at-point 'line) t))
- (beginning-of-line 2)))
- (set-buffer (get-buffer-create export-file))
- (org-insert-heading)
- (insert (or title export-file) "\n")
- (dolist (entry exported-lines) (insert entry))
- (org-update-checkbox-count-maybe)
- (write-file export-file)
- (if (print)
- (progn (funcall org-checklist-export-function
- org-checklist-export-params)
- (let* ((current-a2ps-switches a2ps-switches)
- (a2ps-switches (append current-a2ps-switches
-
org-checklist-a2ps-params)))
- (a2ps-buffer)))))))))
-
-(defun org-checklist ()
- (when (member org-state org-done-keywords) ;; org-state dynamically bound in
org.el/org-todo
- (org-make-checklist-export)
- (org-reset-checkbox-state-maybe)))
-
-(add-hook 'org-after-todo-state-change-hook 'org-checklist)
-
-(provide 'org-checklist)
-
-;;; org-checklist.el ends here
diff --git a/contrib/lisp/org-choose.el b/contrib/lisp/org-choose.el
deleted file mode 100644
index 839a38b..0000000
--- a/contrib/lisp/org-choose.el
+++ /dev/null
@@ -1,496 +0,0 @@
-;;; org-choose.el --- decision management for org-mode
-
-;; Copyright (C) 2009-2014 Tom Breton (Tehom)
-
-;; This file is not part of GNU Emacs.
-
-;; Author: Tom Breton (Tehom)
-;; Keywords: outlines, convenience
-
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is code to support decision management. It lets you treat a
-;; group of sibling items in org-mode as alternatives in a decision.
-
-;; There are no user commands in this file. You use it by:
-;; * Loading it (manually or by M-x customize-apropos org-modules)
-
-;; * Setting up at least one set of TODO keywords with the
-;; interpretation "choose" by either:
-
-;; * Using the file directive #+CHOOSE_TODO:
-
-;; * For instance, "#+CHOOSE_TODO: NO(,-) MAYBE(,0) YES"
-
-;; * Or by M-x customize-apropos org-todo-keywords
-
-;; * Operating on single items with the TODO commands.
-
-;; * Use C-S-right to change the keyword set. Use this to change to
-;; the "choose" keyword set that you just defined.
-
-;; * Use S-right to advance the TODO mark to the next setting.
-
-;; For "choose", that means you like this alternative more than
-;; before. Other alternatives will be automatically demoted to
-;; keep your settings consistent.
-
-;; * Use S-left to demote TODO to the previous setting.
-
-;; For "choose", that means you don't like this alternative as much
-;; as before. Other alternatives will be automatically promoted,
-;; if this item was all that was keeping them down.
-
-;; * All the other TODO commands are available and behave essentially
-;; the normal way.
-
-;;; Requires
-
-(require 'org)
- ;(eval-when-compile
- ; (require 'cl))
-(require 'cl)
-
-;;; Body
-;;; The variables
-
-(defstruct (org-choose-mark-data. (:type list))
- "The format of an entry in org-choose-mark-data.
-Indexes are 0-based or `nil'.
-"
- keyword
- bot-lower-range
- top-upper-range
- range-length
- static-default
- all-keywords)
-
-(defvar org-choose-mark-data
- ()
- "Alist of information for choose marks.
-
-Each entry is an `org-choose-mark-data.'" )
-(make-variable-buffer-local 'org-choose-mark-data)
-;;;_ , For setup
-;;;_ . org-choose-filter-one
-
-(defun org-choose-filter-one (i)
- "Return a list of
- * a canonized version of the string
- * optionally one symbol"
-
- (if
- (not
- (string-match "(.*)" i))
- (list i i)
- (let*
- (
- (end-text (match-beginning 0))
- (vanilla-text (substring i 0 end-text))
- ;;Get the parenthesized part.
- (match (match-string 0 i))
- ;;Remove the parentheses.
- (args (substring match 1 -1))
- ;;Split it
- (arglist
- (let
- ((arglist-x (org-split-string args ",")))
- ;;When string starts with "," `split-string' doesn't
- ;;make a first arg, so in that case make one
- ;;manually.
- (if
- (string-match "^," args)
- (cons nil arglist-x)
- arglist-x)))
- (decision-arg (second arglist))
- (type
- (cond
- ((string= decision-arg "0")
- 'default-mark)
- ((string= decision-arg "+")
- 'top-upper-range)
- ((string= decision-arg "-")
- 'bot-lower-range)
- (t nil)))
- (vanilla-arg (first arglist))
- (vanilla-mark
- (if vanilla-arg
- (concat vanilla-text "("vanilla-arg")")
- vanilla-text)))
- (if type
- (list vanilla-text vanilla-mark type)
- (list vanilla-text vanilla-mark)))))
-
-;;;_ . org-choose-setup-vars
-(defun org-choose-setup-vars (bot-lower-range top-upper-range
- static-default num-items
all-mark-texts)
- "Add to org-choose-mark-data according to arguments"
- (let*
- ((tail
- ;;If there's no bot-lower-range or no default, we don't
- ;;have ranges.
- (cdr
- (if (and static-default bot-lower-range)
- (let*
- ;;If there's no top-upper-range, use the last
- ;;item.
- ((top-upper-range
- (or top-upper-range (1- num-items)))
- (lower-range-length
- (1+ (- static-default bot-lower-range)))
- (upper-range-length
- (- top-upper-range static-default))
- (range-length
- (min upper-range-length lower-range-length)))
- (make-org-choose-mark-data.
- :keyword nil
- :bot-lower-range bot-lower-range
- :top-upper-range top-upper-range
- :range-length range-length
- :static-default static-default
- :all-keywords all-mark-texts))
- (make-org-choose-mark-data.
- :keyword nil
- :bot-lower-range nil
- :top-upper-range nil
- :range-length nil
- :static-default (or static-default 0)
- :all-keywords all-mark-texts)))))
- (dolist (text all-mark-texts)
- (pushnew (cons text tail)
- org-choose-mark-data
- :test
- (lambda (a b)
- (equal (car a) (car b)))))))
-
-;;; org-choose-filter-tail
-(defun org-choose-filter-tail (raw)
- "Return a translation of RAW to vanilla and set appropriate
-buffer-local variables.
-
-RAW is a list of strings representing the input text of a choose
-interpretation."
- (let
- ((vanilla-list nil)
- (all-mark-texts nil)
- (index 0)
- bot-lower-range top-upper-range range-length static-default)
- (dolist (i raw)
- (destructuring-bind
- (vanilla-text vanilla-mark &optional type)
- (org-choose-filter-one i)
- (cond
- ((eq type 'bot-lower-range)
- (setq bot-lower-range index))
- ((eq type 'top-upper-range)
- (setq top-upper-range index))
- ((eq type 'default-mark)
- (setq static-default index)))
- (incf index)
- (push vanilla-text all-mark-texts)
- (push vanilla-mark vanilla-list)))
-
- (org-choose-setup-vars bot-lower-range top-upper-range
- static-default index (reverse all-mark-texts))
- (nreverse vanilla-list)))
-
-;;; org-choose-setup-filter
-
-(defun org-choose-setup-filter (raw)
- "A setup filter for choose interpretations."
- (when (eq (car raw) 'choose)
- (cons
- 'choose
- (org-choose-filter-tail (cdr raw)))))
-
-;;; org-choose-conform-after-promotion
-(defun org-choose-conform-after-promotion (entry-pos keywords highest-ok-ix)
- "Conform the current item after another item was promoted"
- (unless
- ;;Skip the entry that triggered this by skipping any entry with
- ;;the same starting position. plist uses the start of the
- ;;header line as the position, but map no longer does, so we
- ;;have to go back to the heading.
- (=
- (save-excursion
- (org-back-to-heading)
- (point))
- entry-pos)
- (let
- ((ix
- (org-choose-get-entry-index keywords)))
- ;;If the index of the entry exceeds the highest allowable
- ;;index, change it to that.
- (when (and ix
- (> ix highest-ok-ix))
- (org-todo
- (nth highest-ok-ix keywords))))))
-;;;_ . org-choose-conform-after-demotion
-(defun org-choose-conform-after-demotion (entry-pos keywords
- raise-to-ix
- old-highest-ok-ix)
- "Conform the current item after another item was demoted."
- (unless
- ;;Skip the entry that triggered this.
- (=
- (save-excursion
- (org-back-to-heading)
- (point))
- entry-pos)
- (let
- ((ix
- (org-choose-get-entry-index keywords)))
- ;;If the index of the entry was at or above the old allowable
- ;;position, change it to the new mirror position if there is
- ;;one.
- (when (and
- ix
- raise-to-ix
- (>= ix old-highest-ok-ix))
- (org-todo
- (nth raise-to-ix keywords))))))
-
-;;; org-choose-keep-sensible (the org-trigger-hook function)
-(defun org-choose-keep-sensible (change-plist)
- "Bring the other items back into a sensible state after an item's
-setting was changed."
- (let*
- ( (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (entry-pos
- (set-marker
- (make-marker)
- (plist-get change-plist :position)))
- (kwd-data
- (assoc to org-todo-kwd-alist)))
- (when
- (eq (nth 1 kwd-data) 'choose)
- (let*
- (
- (data
- (assoc to org-choose-mark-data))
- (keywords
- (org-choose-mark-data.-all-keywords data))
- (old-index
- (org-choose-get-index-in-keywords
- from
- keywords))
- (new-index
- (org-choose-get-index-in-keywords
- to
- keywords))
- (highest-ok-ix
- (org-choose-highest-other-ok
- new-index
- data))
- (funcdata
- (cond
- ;;The entry doesn't participate in conformance,
- ;;so give `nil' which does nothing.
- ((not highest-ok-ix) nil)
- ;;The entry was created or promoted
- ((or
- (not old-index)
- (> new-index old-index))
- (list
- #'org-choose-conform-after-promotion
- entry-pos keywords
- highest-ok-ix))
- (t ;;Otherwise the entry was demoted.
- (let
- (
- (raise-to-ix
- (min
- highest-ok-ix
- (org-choose-mark-data.-static-default
- data)))
- (old-highest-ok-ix
- (org-choose-highest-other-ok
- old-index
- data)))
- (list
- #'org-choose-conform-after-demotion
- entry-pos
- keywords
- raise-to-ix
- old-highest-ok-ix))))))
- (if funcdata
- ;;The funny-looking names are to make variable capture
- ;;unlikely. (Poor-man's lexical bindings).
- (destructuring-bind (func-d473 . args-46k) funcdata
- (let
- ((map-over-entries
- (org-choose-get-fn-map-group))
- ;;We may call `org-todo', so let various hooks
- ;;`nil' so we don't cause loops.
- org-after-todo-state-change-hook
- org-trigger-hook
- org-blocker-hook
- org-todo-get-default-hook
- ;;Also let this alist `nil' so we don't log
- ;;secondary transitions.
- org-todo-log-states)
- ;;Map over group
- (funcall map-over-entries
- (lambda ()
- (apply func-d473 args-46k))))))))
- ;;Remove the marker
- (set-marker entry-pos nil)))
-
-;;; Getting the default mark
-;;; org-choose-get-index-in-keywords
-(defun org-choose-get-index-in-keywords (ix all-keywords)
- "Return the index of the current entry."
- (if ix
- (position ix all-keywords
- :test #'equal)))
-
-;;; org-choose-get-entry-index
-(defun org-choose-get-entry-index (all-keywords)
- "Return index of current entry."
- (let*
- ((state (org-entry-get (point) "TODO")))
- (org-choose-get-index-in-keywords state all-keywords)))
-
-;;; org-choose-get-fn-map-group
-
-(defun org-choose-get-fn-map-group ()
- "Return a function to map over the group"
- (lambda (fn)
- (require 'org-agenda) ;; `org-map-entries' seems to need it.
- (save-excursion
- (unless (org-up-heading-safe)
- (error "Choosing is only supported between siblings in a tree, not on
top level"))
- (let
- ((level (org-reduced-level (org-outline-level))))
- (save-restriction
- (org-map-entries
- fn
- (format "LEVEL=%d" level)
- 'tree))))))
-
-;;; org-choose-get-highest-mark-index
-
-(defun org-choose-get-highest-mark-index (keywords)
- "Get the index of the highest current mark in the group.
-If there is none, return 0"
- (let*
- ;;Func maps over applicable entries.
- ((map-over-entries
- (org-choose-get-fn-map-group))
- (indexes-list
- (remove nil
- (funcall map-over-entries
- (lambda ()
- (org-choose-get-entry-index keywords))))))
- (if
- indexes-list
- (apply #'max indexes-list)
- 0)))
-
-;;; org-choose-highest-ok
-
-(defun org-choose-highest-other-ok (ix data)
- "Return the highest index that any choose mark can sensibly have,
-given that another mark has index IX.
-DATA must be a `org-choose-mark-data.'."
- (let
- ((bot-lower-range
- (org-choose-mark-data.-bot-lower-range data))
- (top-upper-range
- (org-choose-mark-data.-top-upper-range data))
- (range-length
- (org-choose-mark-data.-range-length data)))
- (when (and ix bot-lower-range)
- (let*
- ((delta
- (- top-upper-range ix)))
- (unless
- (< range-length delta)
- (+ bot-lower-range delta))))))
-
-;;; org-choose-get-default-mark-index
-
-(defun org-choose-get-default-mark-index (data)
- "Return the index of the default mark in a choose interpretation.
-
-DATA must be a `org-choose-mark-data.'."
- (or
- (let
- ((highest-mark-index
- (org-choose-get-highest-mark-index
- (org-choose-mark-data.-all-keywords data))))
- (org-choose-highest-other-ok
- highest-mark-index data))
- (org-choose-mark-data.-static-default data)))
-
-;;; org-choose-get-mark-N
-(defun org-choose-get-mark-N (n data)
- "Get the text of the nth mark in a choose interpretation."
-
- (let*
- ((l (org-choose-mark-data.-all-keywords data)))
- (nth n l)))
-
-;;; org-choose-get-default-mark
-
-(defun org-choose-get-default-mark (new-mark old-mark)
- "Get the default mark IFF in a choose interpretation.
-NEW-MARK and OLD-MARK are the text of the new and old marks."
- (let*
- ((old-kwd-data
- (assoc old-mark org-todo-kwd-alist))
- (new-kwd-data
- (assoc new-mark org-todo-kwd-alist))
- (becomes-choose
- (and
- (or
- (not old-kwd-data)
- (not
- (eq (nth 1 old-kwd-data) 'choose)))
- (eq (nth 1 new-kwd-data) 'choose))))
- (when
- becomes-choose
- (let
- ((new-mark-data
- (assoc new-mark org-choose-mark-data)))
- (if
- new-mark
- (org-choose-get-mark-N
- (org-choose-get-default-mark-index
- new-mark-data)
- new-mark-data)
- (error "Somehow got an unrecognizable mark"))))))
-
-;;; Setting it all up
-
-(eval-after-load 'org
- '(progn
- (add-to-list 'org-todo-setup-filter-hook
- #'org-choose-setup-filter)
- (add-to-list 'org-todo-get-default-hook
- #'org-choose-get-default-mark)
- (add-to-list 'org-trigger-hook
- #'org-choose-keep-sensible)
- (add-to-list 'org-todo-interpretation-widgets
- '(:tag "Choose (to record decisions)" choose)
- 'append)))
-
-(provide 'org-choose)
-
-;;; org-choose.el ends here
diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el
deleted file mode 100644
index c6d2204..0000000
--- a/contrib/lisp/org-collector.el
+++ /dev/null
@@ -1,232 +0,0 @@
-;;; org-collector --- collect properties into tables
-
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-
-;; Author: Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
-;; organization, properties
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Pass in an alist of columns, each column can be either a single
-;; property or a function which takes column names as arguments.
-;;
-;; For example the following propview block would collect the value of
-;; the 'amount' property from each header in the current buffer
-;;
-;; #+BEGIN: propview :cols (ITEM amount)
-;; | "ITEM" | "amount" |
-;; |---------------------+----------|
-;; | "December Spending" | 0 |
-;; | "Grocery Store" | 56.77 |
-;; | "Athletic club" | 75.0 |
-;; | "Restaurant" | 30.67 |
-;; | "January Spending" | 0 |
-;; | "Athletic club" | 75.0 |
-;; | "Restaurant" | 50.00 |
-;; |---------------------+----------|
-;; | | |
-;; #+END:
-;;
-;; This slightly more selective propview block will limit those
-;; headers included to those in the subtree with the id 'december'
-;; in which the spendtype property is equal to "food"
-;;
-;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols
(ITEM amount)
-;; | "ITEM" | "amount" |
-;; |-----------------+----------|
-;; | "Grocery Store" | 56.77 |
-;; | "Restaurant" | 30.67 |
-;; |-----------------+----------|
-;; | | |
-;; #+END:
-;;
-;; Org Collector allows arbitrary processing of the property values
-;; through elisp in the cols: property. This allows for both simple
-;; computations as in the following example
-;;
-;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f
d))
-;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" |
"(+ f d)" |
-;;
|--------+-----+-----+-------------------------+--------------------------+-----------|
-;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 |
35 |
-;; | "run2" | 2 | 34 | :na | :na |
36 |
-;; | "run3" | 2 | 35 | :na | :na |
37 |
-;; | "run4" | 2 | 36 | :na | :na |
38 |
-;; | | | | | |
|
-;; #+END:
-;;
-;; or more complex computations as in the following example taken from
-;; an org file where each header in "results" subtree contained a
-;; property "sorted_hits" which was passed through the
-;; "average-precision" elisp function
-;;
-;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
-;; | "ITEM" | "(average-precision sorted_hits)" |
-;; |-----------+-----------------------------------|
-;; | run (80) | 0.105092 |
-;; | run (70) | 0.108142 |
-;; | run (10) | 0.111348 |
-;; | run (60) | 0.113593 |
-;; | run (50) | 0.116446 |
-;; | run (100) | 0.118863 |
-;; #+END:
-;;
-
-;;; Code:
-(require 'org)
-(require 'org-table)
-
-(defvar org-propview-default-value 0
- "Default value to insert into the propview table when the no
-value is calculated either through lack of required variables for
-a column, or through the generation of an error.")
-
-(defun and-rest (list)
- (if (listp list)
- (if (> (length list) 1)
- (and (car list) (and-rest (cdr list)))
- (car list))
- list))
-
-(put 'org-collector-error
- 'error-conditions
- '(error column-prop-error org-collector-error))
-
-(defun org-dblock-write:propview (params)
- "collect the column specification from the #+cols line
-preceding the dblock, then update the contents of the dblock."
- (interactive)
- (condition-case er
- (let ((cols (plist-get params :cols))
- (inherit (plist-get params :inherit))
- (conds (plist-get params :conds))
- (match (plist-get params :match))
- (scope (plist-get params :scope))
- (noquote (plist-get params :noquote))
- (colnames (plist-get params :colnames))
- (defaultval (plist-get params :defaultval))
- (content-lines (org-split-string (plist-get params :content) "\n"))
- id table line pos)
- (save-excursion
- (when (setq id (plist-get params :id))
- (cond ((not id) nil)
- ((eq id 'global) (goto-char (point-min)))
- ((eq id 'local) nil)
- ((setq idpos (org-find-entry-with-id id))
- (goto-char idpos))
- (t (error "Cannot find entry with :ID: %s" id))))
- (unless (eq id 'global) (org-narrow-to-subtree))
- (setq stringformat (if noquote "%s" "%S"))
- (let ((org-propview-default-value (if defaultval defaultval
org-propview-default-value)))
- (setq table (org-propview-to-table
- (org-propview-collect cols stringformat conds match
scope inherit
- (if colnames colnames cols))
stringformat)))
- (widen))
- (setq pos (point))
- (when content-lines
- (while (string-match "^#" (car content-lines))
- (insert (pop content-lines) "\n")))
- (insert table) (insert "\n|--") (org-cycle) (move-end-of-line 1)
- (message (format "point-%d" pos))
- (while (setq line (pop content-lines))
- (when (string-match "^#" line)
- (insert "\n" line)))
- (goto-char pos)
- (org-table-recalculate 'all))
- (org-collector-error (widen) (error "%s" er))
- (error (widen) (error "%s" er))))
-
-(defun org-propview-eval-w-props (props body)
- "evaluate the BODY-FORMS binding the variables using the
-variables and values specified in props"
- (condition-case nil ;; catch any errors
- (eval `(let ,(mapcar
- (lambda (pair) (list (intern (car pair)) (cdr pair)))
- props)
- ,body))
- (error nil)))
-
-(defun org-propview-get-with-inherited (&optional inherit)
- (append
- (org-entry-properties)
- (delq nil
- (mapcar (lambda (i)
- (let* ((n (symbol-name i))
- (p (org-entry-get (point) n 'do-inherit)))
- (when p (cons n p))))
- inherit))))
-
-(defun org-propview-collect (cols stringformat &optional conds match scope
inherit colnames)
- (interactive)
- ;; collect the properties from every header
- (let* ((header-props
- (let ((org-trust-scanner-tags t) alst)
- (org-map-entries
- (quote (cons (cons "ITEM" (org-get-heading t))
- (org-propview-get-with-inherited inherit)))
- match scope)))
- ;; read property values
- (header-props
- (mapcar (lambda (props)
- (mapcar (lambda (pair)
- (let ((inhibit-lisp-eval (string= (car pair)
"ITEM")))
- (cons (car pair) (org-babel-read (cdr pair)
inhibit-lisp-eval))))
- props))
- header-props))
- ;; collect all property names
- (prop-names
- (mapcar 'intern (delete-dups
- (apply 'append (mapcar (lambda (header)
- (mapcar 'car header))
- header-props))))))
- (append
- (list
- (if colnames colnames (mapcar (lambda (el) (format stringformat el))
cols))
- 'hline) ;; ------------------------------------------------
- (mapcar ;; calculate the value of the column for each header
- (lambda (props) (mapcar (lambda (col)
- (let ((result (org-propview-eval-w-props props col)))
- (if result result org-propview-default-value)))
- cols))
- (if conds
- ;; eliminate the headers which don't satisfy the property
- (delq nil
- (mapcar
- (lambda (props)
- (if (and-rest (mapcar
- (lambda (col)
- (org-propview-eval-w-props props col))
- conds))
- props))
- header-props))
- header-props)))))
-
-(defun org-propview-to-table (results stringformat)
- ;; (message (format "cols:%S" cols))
- (orgtbl-to-orgtbl
- (mapcar
- (lambda (row)
- (if (equal row 'hline)
- 'hline
- (mapcar (lambda (el) (format stringformat el)) row)))
- (delq nil results)) '()))
-
-(provide 'org-collector)
-;;; org-collector ends here
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
deleted file mode 100644
index 57368e9..0000000
--- a/contrib/lisp/org-contacts.el
+++ /dev/null
@@ -1,1243 +0,0 @@
-;;; org-contacts.el --- Contacts management
-
-;; Copyright (C) 2010-2014 Julien Danjou <julien@danjou.info>
-
-;; Author: Julien Danjou <julien@danjou.info>
-;; Maintainer: stardiviner <numbchild@gmail.com>
-;; Keywords: outlines, hypermedia, calendar
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file contains the code for managing your contacts into Org-mode.
-
-;; To enter new contacts, you can use `org-capture' and a minimal template
just like
-;; this:
-
-;; ("c" "Contacts" entry (file "~/Org/contacts.org")
-;; "* %(org-contacts-template-name)
-;; :PROPERTIES:
-;; :EMAIL: %(org-contacts-template-email)
-;; :END:")))
-;;
-;; You can also use a complex template, for example:
-;;
-;; ("c" "Contacts" entry (file "~/Org/contacts.org")
-;; "* %(org-contacts-template-name)
-;; :PROPERTIES:
-;; :EMAIL: %(org-contacts-template-email)
-;; :PHONE:
-;; :ALIAS:
-;; :NICKNAME:
-;; :IGNORE:
-;; :ICON:
-;; :NOTE:
-;; :ADDRESS:
-;; :BIRTHDAY:
-;; :END:")))
-
-;;;; Usage:
-
-;;; How to search?
-;;;
-;;; You can use `org-sparse-tree' [C-c / p] to filter based on a
-;;; specific property. Or other matcher on `org-sparse-tree'.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'org)
-(require 'gnus-util)
-(require 'gnus-art)
-(require 'mail-utils)
-(require 'org-agenda)
-(require 'org-capture)
-(require 'ol)
-
-(defgroup org-contacts nil
- "Options about contacts management."
- :group 'org)
-
-(defcustom org-contacts-files nil
- "List of Org files to use as contacts source.
-When set to nil, all your Org files will be used."
- :type '(repeat file)
- :group 'org-contacts)
-
-(defcustom org-contacts-email-property "EMAIL"
- "Name of the property for contact email address."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-tel-property "PHONE"
- "Name of the property for contact phone number."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-address-property "ADDRESS"
- "Name of the property for contact address."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-birthday-property "BIRTHDAY"
- "Name of the property for contact birthday date."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-note-property "NOTE"
- "Name of the property for contact note."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-alias-property "ALIAS"
- "Name of the property for contact name alias."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-ignore-property "IGNORE"
- "Name of the property, which values will be ignored when
-completing or exporting to vcard."
- :type 'string
- :group 'org-contacts)
-
-
-(defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
- "Format of the anniversary agenda entry.
-The following replacements are available:
-
- %h - Heading name
- %l - Link to the heading
- %y - Number of year
- %Y - Number of year (ordinal)"
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL"
- "Name of the property for contact last read email link storage."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-icon-property "ICON"
- "Name of the property for contact icon."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-nickname-property "NICKNAME"
- "Name of the property for IRC nickname match."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-icon-size 32
- "Size of the contacts icons."
- :type 'string
- :group 'org-contacts)
-
-(defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve)
- "Whether use Gravatar to fetch contact icons."
- :type 'boolean
- :group 'org-contacts)
-
-(defcustom org-contacts-completion-ignore-case t
- "Ignore case when completing contacts."
- :type 'boolean
- :group 'org-contacts)
-
-(defcustom org-contacts-group-prefix "+"
- "Group prefix."
- :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
- (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
- :group 'org-contacts)
-
-(defcustom org-contacts-email-link-description-format "%s (%d)"
- "Format used to store links to email.
-This overrides `org-email-link-description-format' if set."
- :group 'org-contacts
- :type 'string)
-
-(defcustom org-contacts-vcard-file "contacts.vcf"
- "Default file for vcard export."
- :group 'org-contacts
- :type 'file)
-
-(defcustom org-contacts-enable-completion t
- "Enable or not the completion in `message-mode' with `org-contacts'."
- :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")
-(declare-function wl-summary-message-number "ext:wl-summary")
-(declare-function wl-address-header-extract-address "ext:wl-address")
-(declare-function wl-address-header-extract-realname "ext:wl-address")
-(declare-function erc-buffer-list "ext:erc")
-(declare-function erc-get-channel-user-list "ext:erc")
-(declare-function google-maps-static-show "ext:google-maps-static")
-(declare-function elmo-message-field "ext:elmo-pipe")
-(declare-function std11-narrow-to-header "ext:std11")
-(declare-function std11-fetch-field "ext:std11")
-
-(defconst org-contacts-property-values-separators "[,; \f\t\n\r\v]+"
- "The default value of separators for `org-contacts-split-property'.
-
-A regexp matching strings of whitespace, `,' and `;'.")
-
-(defvar org-contacts-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "M" 'org-contacts-view-send-email)
- (define-key map "i" 'org-contacts-view-switch-to-irc-buffer)
- map)
- "The keymap used in `org-contacts' result list.")
-
-(defvar org-contacts-db nil
- "Org Contacts database.")
-
-(defvar org-contacts-last-update nil
- "Last time the Org Contacts database has been updated.")
-
-(defun org-contacts-files ()
- "Return list of Org files to use for contact management."
- (or org-contacts-files (org-agenda-files t 'ifmode)))
-
-(defun org-contacts-db-need-update-p ()
- "Determine whether `org-contacts-db' needs to be refreshed."
- (or (null org-contacts-last-update)
- (cl-find-if (lambda (file)
- (or (time-less-p org-contacts-last-update
- (elt (file-attributes file) 5))))
- (org-contacts-files))
- (org-contacts-db-has-dead-markers-p org-contacts-db)))
-
-(defun org-contacts-db-has-dead-markers-p (org-contacts-db)
- "Returns t if at least one dead marker is found in
-ORG-CONTACTS-DB. A dead marker in this case is a marker pointing
-to dead or no buffer."
- ;; Scan contacts list looking for dead markers, and return t at first
found.
- (catch 'dead-marker-found
- (while org-contacts-db
- (unless (marker-buffer (nth 1 (car org-contacts-db)))
- (throw 'dead-marker-found t))
- (setq org-contacts-db (cdr org-contacts-db)))
- nil))
-
-(defun org-contacts-db ()
- "Return the latest Org Contacts Database."
- (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))
- (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))))
- (setf org-contacts-db result
- org-contacts-last-update (current-time))
- (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.
-
-The optional PROP-MATCH argument is a single (PROP . VALUE) cons
-cell corresponding to the contact properties.
-"
- (if (and (null name-match)
- (null prop-match)
- (null tags-match))
- (org-contacts-db)
- (cl-loop for contact in (org-contacts-db)
- if (or
- (and name-match
- (string-match-p name-match
- (first contact)))
- (and prop-match
- (cl-find-if (lambda (prop)
- (and (string= (car prop-match) (car prop))
- (string-match-p (cdr prop-match) (cdr
prop))))
- (caddr contact)))
- (and tags-match
- (cl-find-if (lambda (tag)
- (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...
- (defun completion-table-case-fold (table &optional dont-fold)
- (lambda (string pred action)
- (let ((completion-ignore-case (not dont-fold)))
- (complete-with-action action table string pred)))))
-
-(defun org-contacts-try-completion-prefix (to-match collection &optional
predicate)
- "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."
- (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'.
-
-This function works like `compare-strings' excepted that it
-returns a cons.
-- The CAR is the number of characters that match at the beginning.
-- The CDR is T is the two strings are the same and NIL otherwise."
- (let ((ret (compare-strings s1 start1 end1 s2 start2 end2 ignore-case)))
- (if (eq ret t)
- (cons (or end1 (length s1)) t)
- (cons (1- (abs ret)) nil))))
-
-(defun org-contacts-common-substring (s1 start1 end1 s2 start2 end2)
- "Extract the common substring between S1 and S2.
-
-This function extracts the common substring between S1 and S2 and
-adjust the part that remains common.
-
-START1 and END1 delimit the part in S1 that we know is common
-between the two strings. This applies to START2 and END2 for S2.
-
-This function returns a list whose contains:
-- The common substring found.
-- The new value of the start of the known inner substring.
-- The new value of the end of the known inner substring."
- ;; Given two strings:
- ;; s1: "foo bar baz"
- ;; s2: "fooo bar baz"
- ;; and the inner substring is "bar"
- ;; then: start1 = 4, end1 = 6, start2 = 5, end2 = 7
- ;;
- ;; To find the common substring we will compare two substrings:
- ;; " oof" and " ooof" to find the beginning of the common substring.
- ;; " baz" and " baz" to find the end of the common substring.
- (let* ((len1 (length s1))
- (start1 (or start1 0))
- (end1 (or end1 len1))
-
- (len2 (length s2))
- (start2 (or start2 0))
- (end2 (or end2 len2))
-
- (new-start (car (org-contacts-compare-strings
- (substring (org-reverse-string s1) (- len1 start1))
nil nil
- (substring (org-reverse-string s2) (- len2 start2))
nil nil)))
-
- (new-end (+ end1 (car (org-contacts-compare-strings
- (substring s1 end1) nil nil
- (substring s2 end2) nil nil)))))
- (list (substring s1 (- start1 new-start) new-end)
- new-start
- (+ new-start (- end1 start1)))))
-
-(defun org-contacts-all-completions-prefix (to-match collection &optional
predicate)
- "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."
- (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."
- (lexical-let ((collection collection))
- (lambda (string predicate flag)
- (cond ((eq flag nil)
- (org-contacts-try-completion-prefix string collection predicate))
- ((eq flag t)
- ;; `org-contacts-all-completions-prefix' has already been
- ;; used to compute `all-completions'.
- collection)
- ((eq flag 'lambda)
- (org-contacts-test-completion-prefix string collection predicate))
- ((and (listp flag) (eq (car flag) 'boundaries))
- (cl-destructuring-bind (to-ignore &rest suffix)
- flag
- (org-contacts-boundaries-prefix string collection predicate
suffix)))
- ((eq flag 'metadata)
- (org-contacts-metadata-prefix string collection predicate))
- (t nil ; operation unsupported
- )))))
-
-(defun org-contacts-display-sort-function (completions)
- "Sort function for contacts display."
- (mapcar (lambda (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)
- (cl-find-if (lambda (el)
- (and (or (null predicate) (funcall predicate el))
- (string= string el)))
- collection))
-
-(defun org-contacts-boundaries-prefix (string collection predicate suffix)
- (list* 'boundaries (completion-boundaries string collection predicate
suffix)))
-
-(defun org-contacts-metadata-prefix (string collection predicate)
- '(metadata .
- ((cycle-sort-function . org-contacts-display-sort-function)
- (display-sort-function . org-contacts-display-sort-function))))
-
-(defun org-contacts-complete-group (start end string)
- "Complete text at START from a group.
-
-A group FOO is composed of contacts with the tag FOO."
- (let* ((completion-ignore-case org-contacts-completion-ignore-case)
- (group-completion-p (string-match-p
- (concat "^" org-contacts-group-prefix) string)))
- (when group-completion-p
- (let ((completion-list
- (all-completions
- string
- (mapcar (lambda (group)
- (propertize (concat org-contacts-group-prefix group)
- 'org-contacts-group group))
- (org-uniquify
- (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
- (lexical-let ((tag (get-text-property 0 'org-contacts-group
- (car completion-list))))
- (lambda (string pred &optional to-ignore)
- (mapconcat 'identity
- (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 (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."
- (cl-remove-if (lambda (el)
- (cl-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
- (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))))
- (when completion-list
- (list start end
- (org-contacts-make-collection-prefix completion-list)))))
-
-(defun org-contacts-message-complete-function (&optional start)
- "Function used in `completion-at-point-functions' in `message-mode'."
- ;; Avoid to complete in `post-command-hook'.
- (when completion-in-region-mode
- (remove-hook 'post-command-hook #'completion-in-region--postch))
- (let ((mail-abbrev-mode-regexp
-
"^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):"))
- (when (mail-abbrev-in-expansion-header-p)
- (lexical-let*
- ((end (point))
- (start (or start
- (save-excursion
- (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
- (goto-char (match-end 0))
- (point))))
- (string (buffer-substring start end)))
- (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."
- (if (gnus-alive-p)
- (gnus-with-article-headers
- (mail-extract-address-components
- (or (mail-fetch-field "From") "")))))
-
-(defun org-contacts-gnus-article-from-get-marker ()
- "Return a marker for a contact based on From."
- (let* ((address (org-contacts-gnus-get-name-email))
- (name (car address))
- (email (cadr address)))
- (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."
- (interactive)
- (let ((marker (org-contacts-gnus-article-from-get-marker)))
- (when marker
- (switch-to-buffer-other-window (marker-buffer marker))
- (goto-char marker)
- (when (eq major-mode 'org-mode) (org-show-context 'agenda)))))
-
-(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
-(defun org-contacts-anniversaries (&optional field format)
- "Compute FIELD anniversary for each contact, returning FORMAT.
-Default FIELD value is \"BIRTHDAY\".
-
-Format is a string matching the following format specification:
-
- %h - Heading name
- %l - Link to the heading
- %y - Number of year
- %Y - Number of year (ordinal)"
- (let ((calendar-date-style 'american)
- (entry ""))
- (unless format (setq format org-contacts-birthday-format))
- (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
- hist def inherit-input-method)
- "Like `completing-read' but reads a date.
-Only PROMPT and DEF are really used."
- (org-read-date nil nil nil prompt nil def))
-
-(add-to-list 'org-property-set-functions-alist
- `(,org-contacts-birthday-property . org-completing-read-date))
-
-(defun org-contacts-template-name (&optional return-value)
- "Try to return the contact name for a template.
-If not found return RETURN-VALUE or something that would ask the user."
- (or (car (org-contacts-gnus-get-name-email))
- return-value
- "%^{Name}"))
-
-(defun org-contacts-template-email (&optional return-value)
- "Try to return the contact email for a template.
-If not found return RETURN-VALUE or something that would ask the user."
- (or (cadr (org-contacts-gnus-get-name-email))
- return-value
- (concat "%^{" org-contacts-email-property "}p")))
-
-(defun org-contacts-gnus-store-last-mail ()
- "Store a link between mails and contacts.
-
-This function should be called from `gnus-article-prepare-hook'."
- (let ((marker (org-contacts-gnus-article-from-get-marker)))
- (when marker
- (with-current-buffer (marker-buffer marker)
- (save-excursion
- (goto-char marker)
- (let* ((org-email-link-description-format (or
org-contacts-email-link-description-format
-
org-email-link-description-format))
- (link (gnus-with-article-buffer (org-store-link nil))))
- (org-set-property org-contacts-last-read-mail-property link)))))))
-
-(defun org-contacts-icon-as-string ()
- "Return the contact icon as a string."
- (let ((image (org-contacts-get-icon)))
- (concat
- (propertize "-" 'display
- (append
- (if image
- image
- `'(space :width (,org-contacts-icon-size)))
- '(:ascent center)))
- " ")))
-
-;;;###autoload
-(defun org-contacts (name)
- "Create agenda view for contacts matching NAME."
- (interactive (list (read-string "Name: ")))
- (let ((org-agenda-files (org-contacts-files))
- (org-agenda-skip-function
- (lambda () (org-agenda-skip-if nil `(notregexp ,name))))
- (org-agenda-prefix-format (propertize
- "%(org-contacts-icon-as-string)%
s%(org-contacts-irc-number-of-unread-messages) "
- 'keymap org-contacts-keymap))
- (org-agenda-overriding-header
- (or org-agenda-overriding-header
- (concat "List of contacts matching `" name "':"))))
- (setq org-agenda-skip-regexp name)
- (org-tags-view nil org-contacts-matcher)
- (with-current-buffer org-agenda-buffer-name
- (setq org-agenda-redo-command
- (list 'org-contacts name)))))
-
-(defun org-contacts-completing-read (prompt
- &optional predicate
- initial-input hist def
inherit-input-method)
- "Call `completing-read' with contacts name as collection."
- (org-completing-read
- prompt (org-contacts-filter) predicate t initial-input hist def
inherit-input-method))
-
-(defun org-contacts-format-name (name)
- "Trim any local formatting to get a bare NAME."
- ;; Remove radio targets characters
- (replace-regexp-in-string org-radio-target-regexp "\\1" name))
-
-(defun org-contacts-format-email (name email)
- "Format an EMAIL address corresponding to NAME."
- (unless email
- (error "`email' cannot be nul"))
- (if name
- (concat (org-contacts-format-name name) " <" email ">")
- email))
-
-(defun org-contacts-check-mail-address (mail)
- "Add MAIL address to contact at point if it does not have it."
- (let ((mails (org-entry-get (point) org-contacts-email-property)))
- (unless (member mail (split-string mails))
- (when (yes-or-no-p
- (format "Do you want to add this address to %s?" (org-get-heading
t)))
- (org-set-property org-contacts-email-property (concat mails " "
mail))))))
-
-(defun org-contacts-gnus-check-mail-address ()
- "Check that contact has the current address recorded.
-This function should be called from `gnus-article-prepare-hook'."
- (let ((marker (org-contacts-gnus-article-from-get-marker)))
- (when marker
- (org-with-point-at marker
- (org-contacts-check-mail-address (cadr
(org-contacts-gnus-get-name-email)))))))
-
-(defun org-contacts-gnus-insinuate ()
- "Add some hooks for Gnus user.
-This adds `org-contacts-gnus-check-mail-address' and
-`org-contacts-gnus-store-last-mail' to
-`gnus-article-prepare-hook'. It also adds a binding on `;' in
-`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'"
- (require 'gnus)
- (require 'gnus-art)
- (define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto)
- (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
- (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail))
-
-(defun org-contacts-setup-completion-at-point ()
- "Add `org-contacts-message-complete-function' as a new function
-to complete the thing at point."
- (add-to-list 'completion-at-point-functions
- 'org-contacts-message-complete-function))
-
-(defun org-contacts-unload-hook ()
- (remove-hook 'message-mode-hook 'org-contacts-setup-completion-at-point))
-
-(when (and org-contacts-enable-completion
- (boundp 'completion-at-point-functions))
- (add-hook 'message-mode-hook 'org-contacts-setup-completion-at-point))
-
-(defun org-contacts-wl-get-from-header-content ()
- "Retrieve the content of the `From' header of an email.
-Works from wl-summary-mode and mime-view-mode - that is while viewing email.
-Depends on Wanderlust been loaded."
- (with-current-buffer (org-capture-get :original-buffer)
- (cond
- ((eq major-mode 'wl-summary-mode) (when (and (boundp
'wl-summary-buffer-elmo-folder)
- wl-summary-buffer-elmo-folder)
- (elmo-message-field
- wl-summary-buffer-elmo-folder
- (wl-summary-message-number)
- 'from)))
- ((eq major-mode 'mime-view-mode) (std11-narrow-to-header)
- (prog1
- (std11-fetch-field "From")
- (widen))))))
-
-(defun org-contacts-wl-get-name-email ()
- "Get name and email address from Wanderlust email.
-See `org-contacts-wl-get-from-header-content' for limitations."
- (let ((from (org-contacts-wl-get-from-header-content)))
- (when from
- (list (wl-address-header-extract-realname from)
- (wl-address-header-extract-address from)))))
-
-(defun org-contacts-template-wl-name (&optional return-value)
- "Try to return the contact name for a template from wl.
-If not found, return RETURN-VALUE or something that would ask the
-user."
- (or (car (org-contacts-wl-get-name-email))
- return-value
- "%^{Name}"))
-
-(defun org-contacts-template-wl-email (&optional return-value)
- "Try to return the contact email for a template from Wanderlust.
-If not found return RETURN-VALUE or something that would ask the user."
- (or (cadr (org-contacts-wl-get-name-email))
- return-value
- (concat "%^{" org-contacts-email-property "}p")))
-
-(defun org-contacts-view-send-email (&optional ask)
- "Send email to the contact at point.
-If ASK is set, ask for the email address even if there's only one
-address."
- (interactive "P")
- (let ((marker (org-get-at-bol 'org-hd-marker)))
- (org-with-point-at marker
- (let ((emails (org-entry-get (point) org-contacts-email-property)))
- (if emails
- (let ((email-list (org-contacts-split-property emails)))
- (if (and (= (length email-list) 1) (not ask))
- (compose-mail (org-contacts-format-email
- (org-get-heading t) emails))
- (let ((email (completing-read "Send mail to which address: "
email-list)))
- (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)"
- org-contacts-email-property)))))))
-
-(defun org-contacts-get-icon (&optional pom)
- "Get icon for contact at POM."
- (setq pom (or pom (point)))
- (catch 'icon
- ;; Use `org-contacts-icon-property'
- (let ((image-data (org-entry-get pom org-contacts-icon-property)))
- (when image-data
- (throw 'icon
- (if (fboundp 'gnus-rescale-image)
- (gnus-rescale-image (create-image image-data)
- (cons org-contacts-icon-size
org-contacts-icon-size))
- (create-image image-data)))))
- ;; Next, try Gravatar
- (when org-contacts-icon-use-gravatar
- (let* ((gravatar-size org-contacts-icon-size)
- (email-list (org-entry-get pom org-contacts-email-property))
- (gravatar
- (when email-list
- (cl-loop for email in (org-contacts-split-property email-list)
- for gravatar = (gravatar-retrieve-synchronously
(org-contacts-strip-link email))
- if (and gravatar
- (not (eq gravatar 'error)))
- return gravatar))))
- (when gravatar (throw 'icon gravatar))))))
-
-(defun org-contacts-irc-buffer (&optional pom)
- "Get the IRC buffer associated with the entry at POM."
- (setq pom (or pom (point)))
- (let ((nick (org-entry-get pom org-contacts-nickname-property)))
- (when nick
- (let ((buffer (get-buffer nick)))
- (when buffer
- (with-current-buffer buffer
- (when (eq major-mode 'erc-mode)
- buffer)))))))
-
-(defun org-contacts-irc-number-of-unread-messages (&optional pom)
- "Return the number of unread messages for contact at POM."
- (when (boundp 'erc-modified-channels-alist)
- (let ((number (cadr (assoc (org-contacts-irc-buffer pom)
erc-modified-channels-alist))))
- (if number
- (format (concat "%3d unread message" (if (> number 1) "s" " ") " ")
number)
- (make-string 21 ? )))))
-
-(defun org-contacts-view-switch-to-irc-buffer ()
- "Switch to the IRC buffer of the current contact if it has one."
- (interactive)
- (let ((marker (org-get-at-bol 'org-hd-marker)))
- (org-with-point-at marker
- (switch-to-buffer-other-window (org-contacts-irc-buffer)))))
-
-(defun org-contacts-completing-read-nickname (prompt collection
- &optional predicate
require-match initial-input
- hist def
inherit-input-method)
- "Like `completing-read' but reads a nickname."
- (org-completing-read prompt (append collection (erc-nicknames-list))
predicate require-match
- initial-input hist def inherit-input-method))
-
-(defun erc-nicknames-list ()
- "Return all nicknames of all ERC buffers."
- (cl-loop for buffer in (erc-buffer-list)
- nconc (with-current-buffer buffer
- (cl-loop for user-entry in (mapcar 'car
(erc-get-channel-user-list))
- collect (elt user-entry 1)))))
-
-(add-to-list 'org-property-set-functions-alist
- `(,org-contacts-nickname-property .
org-contacts-completing-read-nickname))
-
-(defun org-contacts-vcard-escape (str)
- "Escape ; , and \n in STR for the VCard format."
- ;; Thanks to this library for the regexp:
- ;; https://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el
- (when str
- (replace-regexp-in-string
- "\n" "\\\\n"
- (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str))))
-
-(defun org-contacts-vcard-encode-name (name)
- "Try to encode NAME as VCard's N property.
-The N property expects
-
- FamilyName;GivenName;AdditionalNames;Prefix;Postfix.
-
-Org-contacts does not specify how to encode the name. So we try
-to do our best."
- (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name)
";;;"))
-
-(defun org-contacts-vcard-format (contact)
- "Formats CONTACT in VCard 3.0 format."
- (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)))
- (tel (cdr (assoc-string org-contacts-tel-property properties)))
- (ignore-list (cdr (assoc-string org-contacts-ignore-property
properties)))
- (ignore-list (when ignore-list
- (org-contacts-split-property ignore-list)))
- (note (cdr (assoc-string org-contacts-note-property properties)))
- (bday (org-contacts-vcard-escape (cdr (assoc-string
org-contacts-birthday-property properties))))
- (addr (cdr (assoc-string org-contacts-address-property properties)))
- (nick (org-contacts-vcard-escape (cdr (assoc-string
org-contacts-nickname-property properties))))
- (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))
- emails-list result phones-list)
- (concat head
- (when email (progn
- (setq emails-list
(org-contacts-remove-ignored-property-values ignore-list
(org-contacts-split-property email)))
- (setq result "")
- (while emails-list
- (setq result (concat result "EMAIL:"
(org-contacts-strip-link (car emails-list)) "\n"))
- (setq emails-list (cdr emails-list)))
- result))
- (when addr
- (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
- (when tel (progn
- (setq phones-list
(org-contacts-remove-ignored-property-values ignore-list
(org-contacts-split-property tel)))
- (setq result "")
- (while phones-list
- (setq result (concat result "TEL:"
(org-contacts-strip-link (org-link-unescape (car phones-list))) "\n"))
- (setq phones-list (cdr phones-list)))
- result))
- (when bday
- (let ((cal-bday (calendar-gregorian-from-absolute
(org-time-string-to-absolute bday))))
- (format "BDAY:%04d-%02d-%02d\n"
- (calendar-extract-year cal-bday)
- (calendar-extract-month cal-bday)
- (calendar-extract-day cal-bday))))
- (when nick (format "NICKNAME:%s\n" nick))
- (when note (format "NOTE:%s\n" note))
- "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."
- (let* ((filename (or file org-contacts-vcard-file))
- (buffer (if to-buffer
- (get-buffer-create to-buffer)
- (find-file-noselect filename))))
- (message "Exporting...")
- (set-buffer buffer)
- (let ((inhibit-read-only t)) (erase-buffer))
- (fundamental-mode)
- (when (fboundp 'set-buffer-file-coding-system)
- (set-buffer-file-coding-system coding-system-for-write))
- (cl-loop for contact in (org-contacts-filter name)
- do (insert (org-contacts-vcard-format contact)))
- (if to-buffer
- (current-buffer)
- (progn (save-buffer) (kill-buffer)))))
-
-(defun org-contacts-show-map (&optional name)
- "Show contacts on a map.
-Requires google-maps-el."
- (interactive)
- (unless (fboundp 'google-maps-static-show)
- (error "`org-contacts-show-map' requires `google-maps-el'"))
- (google-maps-static-show
- :markers
- (cl-loop
- for contact in (org-contacts-filter name)
- 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)))))))
-
-(defun org-contacts-strip-link (link)
- "Remove brackets, description, link type and colon from an org
-link string and return the pure link target."
- (let (startpos colonpos endpos)
- (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:";)) link))
- (if startpos
- (progn
- (setq colonpos (string-match ":" link))
- (setq endpos (string-match "\\]" link))
- (if endpos (substring link (1+ colonpos) endpos) link))
- (progn
- (setq startpos (string-match "mailto:"; link))
- (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-link-set-parameters "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
-for SEPARATORS but keep Org links intact.
-
-The beginning and end of STRING, and each match for SEPARATORS, are
-splitting points. The substrings matching SEPARATORS are removed, and
-the substrings between the splitting points are collected as a list,
-which is returned.
-
-If SEPARATORS is non-nil, it should be a regular expression
-matching text which separates, but is not part of, the
-substrings. If nil it defaults to `org-contacts-property-values-separators',
-normally \"[,; \f\t\n\r\v]+\", and OMIT-NULLS is forced to t.
-
-If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
-that for the default value of SEPARATORS leading and trailing whitespace
-are effectively trimmed). If nil, all zero-length substrings are retained."
- (let* ((omit-nulls (if separators omit-nulls t))
- (rexp (or separators org-contacts-property-values-separators))
- (inputlist (split-string string rexp omit-nulls))
- (linkstring "")
- (bufferstring "")
- (proplist (list "")))
- (while inputlist
- (setq bufferstring (pop inputlist))
- (if (string-match "\\[\\[" bufferstring)
- (progn
- (setq linkstring (concat bufferstring " "))
- (while (not (string-match "\\]\\]" bufferstring))
- (setq bufferstring (pop inputlist))
- (setq linkstring (concat linkstring bufferstring " ")))
- (setq proplist (cons (org-trim linkstring) proplist)))
- (setq proplist (cons bufferstring proplist))))
- (cdr (reverse proplist))))
-
-;;; Add an Org link type `org-contact:' for easy jump to or searching
org-contacts headline.
-;;; link spec: [[org-contact:query][desc]]
-(org-link-set-parameters "org-contact"
- :follow 'org-contacts-link-open
- :complete 'org-contacts-link-complete
- :store 'org-contacts-link-store
- :face 'org-contacts-link-face)
-
-(defun org-contacts-link-store ()
- "Store the contact in `org-contacts-files' with a link."
- (when (and (eq major-mode 'org-mode)
- (member (buffer-file-name) (mapcar 'expand-file-name
org-contacts-files)))
- (if (bound-and-true-p org-id-link-to-org-use-id)
- (org-id-store-link)
- (let ((headline-str (substring-no-properties (org-get-heading t t t t))))
- (org-store-link-props
- :type "org-contact"
- :link headline-str
- :description headline-str)
- (setq desc headline-str)
- (setq link (concat "org-contact:" headline-str))
- (org-add-link-props :link link :description desc)
- link))))
-
-(defun org-contacts--all-contacts ()
- "Return an alist (name . (file . position)) of all contacts in
`org-contacts-files'."
- (car (mapcar
- (lambda (file)
- (unless (buffer-live-p (get-buffer (file-name-nondirectory file)))
- (find-file file))
- (with-current-buffer (get-buffer (file-name-nondirectory file))
- (org-map-entries
- (lambda ()
- (let ((name (substring-no-properties (org-get-heading t t t t)))
- (file (buffer-file-name))
- (position (point)))
- `(:name ,name :file ,file :position ,position))))))
- org-contacts-files)))
-
-(defun org-contacts-link-open (path)
- "Open contacts: link type with jumping or searching."
- (let ((query path))
- (cond
- ;; /query/ format searching
- ((string-match "/.*/" query)
- (let* ((f (car org-contacts-files))
- (buf (get-buffer (file-name-nondirectory f))))
- (unless (buffer-live-p buf) (find-file f))
- (with-current-buffer buf
- (string-match "/\\(.*\\)/" query)
- (occur (match-string 1 query)))))
- ;; jump to contact headline directly
- (t
- (let* ((f (car org-contacts-files))
- (buf (get-buffer (file-name-nondirectory f))))
- (unless (buffer-live-p buf) (find-file f))
- (with-current-buffer buf
- (goto-char (marker-position (org-find-exact-headline-in-buffer
query))))
- (display-buffer buf '(display-buffer-below-selected)))
- ;; FIXME
- ;; (let* ((contact-entry (plist-get (org-contacts--all-contacts) query))
- ;; (contact-name (plist-get contact-entry :name))
- ;; (file (plist-get contact-entry :file))
- ;; (position (plist-get contact-entry :position))
- ;; (buf (get-buffer (file-name-nondirectory file))))
- ;; (unless (buffer-live-p buf) (find-file file))
- ;; (with-current-buffer buf (goto-char position)))
- ))))
-
-(defun org-contacts-link-complete (&optional arg)
- "Create a org-contacts link using completion."
- (let ((name (completing-read "org-contact Name: "
- (mapcar
- (lambda (plist) (plist-get plist :name))
- (org-contacts--all-contacts)))))
- (concat "org-contact:" name)))
-
-(defun org-contacts-link-face (path)
- "Different face color for different org-contacts link query."
- (cond
- ((string-match "/.*/" path)
- '(:background "sky blue" :overline t :slant 'italic))
- (t '(:inherit 'org-link))))
-
-(provide 'org-contacts)
-
-;;; org-contacts.el ends here
diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el
deleted file mode 100644
index 0a26513..0000000
--- a/contrib/lisp/org-contribdir.el
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; org-contribdir.el --- Mark the location of the contrib directory
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-
-;; The sole purpose of this file is to be located in the same place
-;; as where the contributed Org files are located, typically in the
-;; contrib/lisp directory of the Org-mode distribution. This is to
-;; make sure that the command `org-reload' can reliably locate
-;; contributed org files.
-
-(provide 'org-contribdir)
-
-;;; org-contribdir.el ends here
diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
deleted file mode 100644
index 5d0df03..0000000
--- a/contrib/lisp/org-depend.el
+++ /dev/null
@@ -1,431 +0,0 @@
-;;; org-depend.el --- TODO dependencies for Org-mode
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 0.08
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; WARNING: This file is just a PROOF OF CONCEPT, not a supported part
-;; of Org-mode.
-;;
-;; This is an example implementation of TODO dependencies in Org-mode.
-;; It uses the new hooks in version 5.13 of Org-mode,
-;; `org-trigger-hook' and `org-blocker-hook'.
-;;
-;; It implements the following:
-;;
-;; Triggering
-;; ----------
-;;
-;; 1) If an entry contains a TRIGGER property that contains the string
-;; "chain-siblings(KEYWORD)", then switching that entry to DONE does
-;; do the following:
-;; - The sibling following this entry switched to todo-state KEYWORD.
-;; - The sibling also gets a TRIGGER property "chain-sibling(KEYWORD)",
-;; property, to make sure that, when *it* is DONE, the chain will
-;; continue.
-;;
-;; 2) If an entry contains a TRIGGER property that contains the string
-;; "chain-siblings-scheduled", then switching that entry to DONE does
-;; the following actions, similarly to "chain-siblings(KEYWORD)":
-;; - The sibling receives the same scheduled time as the entry
-;; marked as DONE (or, in the case, in which there is no scheduled
-;; time, the sibling does not get any either).
-;; - The sibling also gets the same TRIGGER property
-;; "chain-siblings-scheduled", so the chain can continue.
-;;
-;; 3) If the TRIGGER property contains the string
-;; "chain-find-next(KEYWORD[,OPTIONS])", then switching that entry
-;; to DONE do the following:
-;; - All siblings are of the entry are collected into a temporary
-;; list and then filtered and sorted according to OPTIONS
-;; - The first sibling on the list is changed into KEYWORD state
-;; - The sibling also gets the same TRIGGER property
-;; "chain-find-next", so the chain can continue.
-;;
-;; OPTIONS should be a comma separated string without spaces, and
-;; can contain following options:
-;;
-;; - from-top the candidate list is all of the siblings in
-;; the current subtree
-;;
-;; - from-bottom candidate list are all siblings from bottom up
-;;
-;; - from-current candidate list are all siblings from current item
-;; until end of subtree, then wrapped around from
-;; first sibling
-;;
-;; - no-wrap candidate list are siblings from current one down
-;;
-;; - todo-only Only consider siblings that have a todo keyword
-;; -
-;; - todo-and-done-only
-;; Same as above but also include done items.
-;;
-;; - priority-up sort by highest priority
-;; - priority-down sort by lowest priority
-;; - effort-up sort by highest effort
-;; - effort-down sort by lowest effort
-;;
-;; Default OPTIONS are from-top
-;;
-;;
-;; 4) If the TRIGGER property contains any other words like
-;; XYZ(KEYWORD), these are treated as entry id's with keywords. That
-;; means Org-mode will search for an entry with the ID property XYZ
-;; and switch that entry to KEYWORD as well.
-;;
-;; Blocking
-;; --------
-;;
-;; 1) If an entry contains a BLOCKER property that contains the word
-;; "previous-sibling", the sibling above the current entry is
-;; checked when you try to mark it DONE. If it is still in a TODO
-;; state, the current state change is blocked.
-;;
-;; 2) If the BLOCKER property contains any other words, these are
-;; treated as entry id's. That means Org-mode will search for an
-;; entry with the ID property exactly equal to this word. If any
-;; of these entries is not yet marked DONE, the current state change
-;; will be blocked.
-;;
-;; 3) Whenever a state change is blocked, an org-mark is pushed, so that
-;; you can find the offending entry with `C-c &'.
-;;
-;;; Example:
-;;
-;; When trying this example, make sure that the settings for TODO keywords
-;; have been activated, i.e. include the following line and press C-c C-c
-;; on the line before working with the example:
-;;
-;; #+TYP_TODO: TODO NEXT | DONE
-;;
-;; * TODO Win a million in Las Vegas
-;; The "third" TODO (see above) cannot become a TODO without this money.
-;;
-;; :PROPERTIES:
-;; :ID: I-cannot-do-it-without-money
-;; :END:
-;;
-;; * Do this by doing a chain of TODO's
-;; ** NEXT This is the first in this chain
-;; :PROPERTIES:
-;; :TRIGGER: chain-siblings(NEXT)
-;; :END:
-;;
-;; ** This is the second in this chain
-;;
-;; ** This is the third in this chain
-;; :PROPERTIES:
-;; :BLOCKER: I-cannot-do-it-without-money
-;; :END:
-;;
-;; ** This is the forth in this chain
-;; When this is DONE, we will also trigger entry XYZ-is-my-id
-;; :PROPERTIES:
-;; :TRIGGER: XYZ-is-my-id(TODO)
-;; :END:
-;;
-;; ** This is the fifth in this chain
-;;
-;; * Start writing report
-;; :PROPERTIES:
-;; :ID: XYZ-is-my-id
-;; :END:
-;;
-;;
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defcustom org-depend-tag-blocked t
- "Whether to indicate blocked TODO items by a special tag."
- :group 'org
- :type 'boolean)
-
-(defcustom org-depend-find-next-options
- "from-current,todo-only,priority-up"
- "Default options for chain-find-next trigger"
- :group 'org
- :type 'string)
-
-(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
- "Perform a set of actions on the next sibling, if it exists,
-copying the sibling spec TRIGGER-VAL to the next sibling."
- `(catch 'exit
- (save-excursion
- (goto-char pos)
- ;; find the sibling, exit if no more siblings
- (condition-case nil
- (outline-forward-same-level 1)
- (error (throw 'exit t)))
- ;; mark the sibling TODO
- ,@rest
- ;; make sure the sibling will continue the chain
- (org-entry-add-to-multivalued-property
- nil "TRIGGER" ,trigger-val))))
-
-(defvar org-depend-doing-chain-find-next nil)
-
-(defun org-depend-trigger-todo (change-plist)
- "Trigger new TODO entries after the current is switched to DONE.
-This does two different kinds of triggers:
-
-- If the current entry contains a TRIGGER property that contains
- \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it
- KEYWORD and also installs the \"chain-sibling\" trigger to continue
- the chain.
-- If the current entry contains a TRIGGER property that contains
- \"chain-siblings-scheduled\", we go to the next sibling and copy
- the scheduled time from the current task, also installing the property
- in the sibling.
-- Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER
- property is seen as an entry id. Org-mode finds the entry with the
- corresponding ID property and switches it to the state TODO as well."
-
- ;; Refresh the effort text properties
- (org-refresh-properties org-effort-property 'org-effort)
- ;; Get information from the plist
- (let* ((type (plist-get change-plist :type))
- (pos (plist-get change-plist :position))
- (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (org-log-done nil) ; IMPORTANT!: no logging during automatic trigger!
- trigger triggers tr p1 p2 kwd id)
- (catch 'return
- (unless (eq type 'todo-state-change)
- ;; We are only handling todo-state-change....
- (throw 'return t))
- (unless (and (member from org-not-done-keywords)
- (member to org-done-keywords))
- ;; This is not a change from TODO to DONE, ignore it
- (throw 'return t))
-
- ;; OK, we just switched from a TODO state to a DONE state
- ;; Lets see if this entry has a TRIGGER property.
- ;; If yes, split it up on whitespace.
- (setq trigger (org-entry-get pos "TRIGGER")
- triggers (and trigger (split-string trigger)))
-
- ;; Go through all the triggers
- (while (setq tr (pop triggers))
- (cond
- ((and (not org-depend-doing-chain-find-next)
- (string-match "\\`chain-find-next(\\b\\(.+?\\)\\b\\(.*\\))\\'"
tr))
- ;; smarter sibling selection
- (let* ((org-depend-doing-chain-find-next t)
- (kwd (match-string 1 tr))
- (options (match-string 2 tr))
- (options (if (or (null options)
- (equal options ""))
- org-depend-find-next-options
- options))
- (todo-only (string-match "todo-only" options))
- (todo-and-done-only (string-match "todo-and-done-only"
- options))
- (from-top (string-match "from-top" options))
- (from-bottom (string-match "from-bottom" options))
- (from-current (string-match "from-current" options))
- (no-wrap (string-match "no-wrap" options))
- (priority-up (string-match "priority-up" options))
- (priority-down (string-match "priority-down" options))
- (effort-up (string-match "effort-up" options))
- (effort-down (string-match "effort-down" options)))
- (save-excursion
- (org-back-to-heading t)
- (let ((this-item (point)))
- ;; go up to the parent headline, then advance to next child
- (org-up-heading-safe)
- (let ((end (save-excursion (org-end-of-subtree t)
- (point)))
- (done nil)
- (items '()))
- (outline-next-heading)
- (while (not done)
- (if (not (looking-at org-complex-heading-regexp))
- (setq done t)
- (let ((todo-kwd (match-string 2))
- (tags (match-string 5))
- (priority (org-get-priority (or (match-string 3)
"")))
- (effort (when (or effort-up effort-down)
- (let ((effort (get-text-property (point)
'org-effort)))
- (when effort
- (org-duration-to-minutes effort))))))
- (push (list (point) todo-kwd priority tags effort)
- items))
- (unless (org-goto-sibling)
- (setq done t))))
- ;; massage the list according to options
- (setq items
- (cond (from-top (nreverse items))
- (from-bottom items)
- ((or from-current no-wrap)
- (let* ((items (nreverse items))
- (pos (position this-item items :key
#'first))
- (items-before (subseq items 0 pos))
- (items-after (subseq items pos)))
- (if no-wrap items-after
- (append items-after items-before))))
- (t (nreverse items))))
- (setq items (remove-if
- (lambda (item)
- (or (equal (first item) this-item)
- (and (not todo-and-done-only)
- (member (second item)
org-done-keywords))
- (and (or todo-only
- todo-and-done-only)
- (null (second item)))))
- items))
- (setq items
- (sort
- items
- (lambda (item1 item2)
- (let* ((p1 (third item1))
- (p2 (third item2))
- (e1 (fifth item1))
- (e2 (fifth item2))
- (p1-lt (< p1 p2))
- (p1-gt (> p1 p2))
- (e1-lt (and e1 (or (not e2) (< e1 e2))))
- (e2-gt (and e2 (or (not e1) (> e1 e2)))))
- (cond (priority-up
- (or p1-gt
- (and (equal p1 p2)
- (or (and effort-up e1-lt)
- (and effort-down e2-gt)))))
- (priority-down
- (or p1-lt
- (and (equal p1 p2)
- (or (and effort-up e1-lt)
- (and effort-down e2-gt)))))
- (effort-up
- (or e2-gt (and (equal e1 e2) p1-gt)))
- (effort-down
- (or e1-lt (and (equal e1 e2) p1-gt))))))))
- (when items
- (goto-char (first (first items)))
- (org-entry-add-to-multivalued-property nil "TRIGGER" tr)
- (org-todo kwd)))))))
- ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
- ;; This is a TODO chain of siblings
- (setq kwd (match-string 1 tr))
- (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
- (org-todo kwd)))
- ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
- ;; This seems to be ENTRY_ID(KEYWORD)
- (setq id (match-string 1 tr)
- kwd (match-string 2 tr)
- p1 (org-find-entry-with-id id))
- ;; First check current buffer, then all files.
- (if p1
- ;; There is an entry with this ID, mark it TODO.
- (save-excursion
- (goto-char p1)
- (org-todo kwd))
- (when (setq p2 (org-id-find id))
- (save-excursion
- (with-current-buffer (find-file-noselect (car p2))
- (goto-char (cdr p2))
- (org-todo kwd))))))
- ((string-match "\\`chain-siblings-scheduled\\'" tr)
- (let ((time (org-get-scheduled-time pos)))
- (when time
- (org-depend-act-on-sibling
- "chain-siblings-scheduled"
- (org-schedule nil time))))))))))
-
-(defun org-depend-block-todo (change-plist)
- "Block turning an entry into a TODO.
-This checks for a BLOCKER property in an entry and checks
-all the entries listed there. If any of them is not done,
-block changing the current entry into a TODO entry. If the property contains
-the word \"previous-sibling\", the sibling above the current entry is checked.
-Any other words are treated as entry id's. If an entry exists with the
-this ID property, that entry is also checked."
- ;; Get information from the plist
- (let* ((type (plist-get change-plist :type))
- (pos (plist-get change-plist :position))
- (from (plist-get change-plist :from))
- (to (plist-get change-plist :to))
- (org-log-done nil) ; IMPORTANT!: no logging during automatic trigger
- blocker blockers bl p1 p2
- (proceed-p
- (catch 'return
- ;; If this is not a todo state change, or if this entry is
- ;; DONE, do not block
- (when (or (not (eq type 'todo-state-change))
- (member from (cons 'done org-done-keywords))
- (member to (cons 'todo org-not-done-keywords))
- (not to))
- (throw 'return t))
-
- ;; OK, the plan is to switch from nothing to TODO
- ;; Lets see if we will allow it. Find the BLOCKER property
- ;; and split it on whitespace.
- (setq blocker (org-entry-get pos "BLOCKER")
- blockers (and blocker (split-string blocker)))
-
- ;; go through all the blockers
- (while (setq bl (pop blockers))
- (cond
- ((equal bl "previous-sibling")
- ;; the sibling is required to be DONE.
- (catch 'ignore
- (save-excursion
- (goto-char pos)
- ;; find the older sibling, exit if no more siblings
- (unless (org-get-last-sibling)
- (throw 'ignore t))
- ;; Check if this entry is not yet done and block
- (unless (org-entry-is-done-p)
- ;; return nil, to indicate that we block the change!
- (org-mark-ring-push)
- (throw 'return nil)))))
- ((setq p1 (org-find-entry-with-id bl))
- ;; there is an entry with this ID, check it out
- (save-excursion
- (goto-char p1)
- (unless (org-entry-is-done-p)
- ;; return nil, to indicate that we block the change!
- (org-mark-ring-push)
- (throw 'return nil))))
- ((setq p2 (org-id-find bl))
- (save-excursion
- (with-current-buffer (find-file-noselect (car p2))
- (goto-char (cdr p2))
- (unless (org-entry-is-done-p)
- (org-mark-ring-push)
- (throw 'return nil)))))))
- ;; Return t to indicate that we are not blocking.
- t)))
- (when org-depend-tag-blocked
- (org-toggle-tag "blocked" (if proceed-p 'off 'on)))
-
- proceed-p))
-
-(add-hook 'org-trigger-hook 'org-depend-trigger-todo)
-(add-hook 'org-blocker-hook 'org-depend-block-todo)
-
-(provide 'org-depend)
-
-;;; org-depend.el ends here
diff --git a/contrib/lisp/org-effectiveness.el
b/contrib/lisp/org-effectiveness.el
deleted file mode 100644
index e6673a6..0000000
--- a/contrib/lisp/org-effectiveness.el
+++ /dev/null
@@ -1,369 +0,0 @@
-;;; org-effectiveness.el --- Measuring the personal effectiveness
-
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
-
-;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
-;; Keywords: effectiveness, plot
-;; Homepage: https://orgmode.org
-;;
-;; This file is not part of GNU Emacs, yet.
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements functions to measure the effectiveness in org.
-;; Org-mode doesn't load this module by default - if this is not what
-;; you want, configure the variable `org-modules'. Thanks to #emacs-es
-;; irc channel for your support.
-
-;;; Code:
-
-(require 'org)
-
-(defcustom org-effectiveness-max-todo 50
- "This variable is useful to advice to the user about
-many TODO pending"
- :type 'integer
- :group 'org-effectiveness)
-
-(defun org-effectiveness-advice()
- "Advicing about a possible excess of TODOS"
- (interactive)
- (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)
-
-(defun org-effectiveness-count-keyword(keyword)
- "Print a message with the number of keyword outline in the current buffer"
- (interactive "sKeyword: ")
- (save-excursion
- (goto-char (point-min))
- (message "Number of %s: %d" keyword (count-matches (concat "* "
keyword)))))
-
-(defun org-effectiveness-count-todo()
- "Print a message with the number of todo tasks in the current buffer"
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (message "Number of TODO: %d" (count-matches "* TODO"))))
-
-(defun org-effectiveness-count-done()
- "Print a message with the number of done tasks in the current buffer"
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (message "Number of DONE: %d" (count-matches "* DONE"))))
-
-(defun org-effectiveness-count-canceled()
- "Print a message with the number of canceled tasks in the current buffer"
- (interactive)
- (save-excursion
- (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)
- (save-excursion
- (goto-char (point-min))
- (let ((done (float (count-matches "* DONE.*\n.*")))
- (canc (float (count-matches "* CANCEL+ED.*\n.*"))))
- (if (and (= done canc) (zerop done))
- (setq effectiveness 0)
- (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 &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-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)
- (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)
- (save-excursion
- (goto-char (point-min))
- (let ((done (float (count-matches (concat "* DONE.*\n.*" date))))
- (canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date)))))
- (if (and (= done canc) (zerop done))
- (setq effectiveness 0)
- (setq effectiveness (* 100 (/ done (+ done canc)))))
- (if (eq notmessage 1)
- (message "%d" effectiveness)
- (message "Effectiveness: %d " effectiveness)))))
-
-(defun org-effectiveness-month-to-string (m)
- (if (< m 10)
- (concat "0" (number-to-string m))
- (number-to-string m)))
-
-(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 (assq 'startyear dates)))
- (setq smonth (cadr (assq 'startmonth dates)))
- (setq eyear (cadr (assq 'endyear dates)))
- (setq emonth (assq 'endmonth dates))
-;; Checking the format of the dates
- (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
- (message "The start date must have the next format YYYY-MM"))
- (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
- (message "The end date must have the next format YYYY-MM"))
-;; Checking if startdate < enddate
- (if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
- (setq startyear (string-to-number (match-string 0 startdate))))
- (if (string-match "[0-9][0-9]$" startdate)
- (setq startmonth (string-to-number (match-string 0 startdate))))
- (if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
- (setq endyear (string-to-number (match-string 0 enddate))))
- (if (string-match "[0-9][0-9]$" enddate)
- (setq endmonth (string-to-number (match-string 0 enddate))))
- (if (> startyear endyear)
- (message "The start date must be before that end date"))
- (if (and (= startyear endyear) (> startmonth endmonth))
- (message "The start date must be before that end date"))
-;; Create a file
- (let ((month startmonth)
- (year startyear)
- (str ""))
- (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
- (setq year (+ 1 year))
- (setq month 1))
- (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" 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: ")
- (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### %s ###" label))
- (insert "\n-")
- (while (< x n)
- (insert "-")
- (setq x (+ x 1)))
- (insert "+\n")
- (insert (format "%d" n))
- (if (> n 10)
- (setq y (+ y 1)))
- (while (< y n)
- (insert " ")
- (setq y (+ y 1)))
- (insert "|\n")
- (insert "-")
- (while (< z n)
- (insert "-")
- (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)
- (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate))
- (setq str "The start date must have the next format YYYY-MM"))
- (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate))
- (setq str "The end date must have the next format YYYY-MM"))
-;; Checking if startdate < enddate
- (if (string-match "^[0-9][0-9][0-9][0-9]" startdate)
- (setq startyear (string-to-number (match-string 0 startdate))))
- (if (string-match "[0-9][0-9]$" startdate)
- (setq startmonth (string-to-number (match-string 0 startdate))))
- (if (string-match "^[0-9][0-9][0-9][0-9]" enddate)
- (setq endyear (string-to-number (match-string 0 enddate))))
- (if (string-match "[0-9][0-9]$" enddate)
- (setq endmonth (string-to-number (match-string 0 enddate))))
- (if (> startyear endyear)
- (setq str "The start date must be before that end date"))
- (if (and (= startyear endyear) (> startmonth endmonth))
- (setq str "The start date must be before that end date"))
- (if str
- (message str)
-;; (list (list startyear startmonth) (list endyear endmonth))))
- (list (list 'startyear startyear) (list 'startmonth startmonth) (list
'endyear endyear) (list 'endmonth endmonth))))
-
-(defun org-effectiveness-plot-ascii (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 (assq 'startyear dates)))
- (smonth (cadr (assq 'startmonth dates)))
- (year (cadr (assq 'startyear dates)))
- (month (cadr (assq 'startmonth dates)))
- (emonth (cadr (assq 'endmonth dates)))
- (eyear (cadr (assq 'endyear dates)))
- (buffer (current-buffer))
- (str ""))
- (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*")
- (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-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 (assq 'startyear dates)))
- (smonth (cadr (assq 'startmonth dates)))
- (year (cadr (assq 'startyear dates)))
- (month (cadr (assq 'startmonth dates)))
- (emonth (cadr (assq 'endmonth dates)))
- (eyear (cadr (assq '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 (assq 'startyear dates)))
- (smonth (cadr (assq 'startmonth dates)))
- (year (cadr (assq 'startyear dates)))
- (month (cadr (assq 'startmonth dates)))
- (emonth (cadr (assq 'endmonth dates)))
- (eyear (cadr (assq '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 (assq 'startyear dates)))
- (smonth (cadr (assq 'startmonth dates)))
- (year (cadr (assq 'startyear dates)))
- (month (cadr (assq 'startmonth dates)))
- (emonth (cadr (assq 'endmonth dates)))
- (eyear (cadr (assq '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
deleted file mode 100644
index 550f857..0000000
--- a/contrib/lisp/org-eldoc.el
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; org-eldoc.el --- display org header and src block info using eldoc -*-
lexical-binding: t; -*-
-
-;; Copyright (c) 2014-2021 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 <https://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 (or (nth 0 info) "no lang") '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 (org-src-get-lang-mode lang))
- doc-func)
- (if (eq 'empty cached-func)
- (when (fboundp mode-func)
- (with-temp-buffer
- (funcall mode-func)
- (setq doc-func (if (boundp 'eldoc-documentation-functions)
- (let ((doc-funs eldoc-documentation-functions))
- (lambda (callback)
- (let ((eldoc-documentation-functions
doc-funs))
- (run-hook-with-args-until-success
- 'eldoc-documentation-functions
- callback))))
- (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 (&rest args)
- "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"))
- (cond ((and (boundp 'eldoc-documentation-functions) ; Emacs>=28
- (fboundp 'elisp-eldoc-var-docstring)
- (fboundp 'elisp-eldoc-funcall))
- (let ((eldoc-documentation-functions
- '(elisp-eldoc-var-docstring elisp-eldoc-funcall)))
- (eldoc-print-current-symbol-info)))
- ((fboundp 'elisp-eldoc-documentation-function)
- (elisp-eldoc-documentation-function))
- (t ; Emacs<25
- (let (eldoc-documentation-function)
- (eldoc-print-current-symbol-info)))))
- ((or
- (string= lang "c") ;; https://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))
- (callback (car args)))
- (when (functionp doc-fun)
- (if (functionp callback)
- (funcall doc-fun callback)
- (funcall doc-fun)))))))))
-
-;;;###autoload
-(defun org-eldoc-load ()
- "Set up org-eldoc documentation function."
- (interactive)
- ;; This approach is taken from python.el.
- (with-no-warnings
- (cond
- ((null eldoc-documentation-function) ; Emacs<25
- (setq-local eldoc-documentation-function
- #'org-eldoc-documentation-function))
- ((boundp 'eldoc-documentation-functions) ; Emacs>=28
- (add-hook 'eldoc-documentation-functions
- #'org-eldoc-documentation-function nil t))
- (t
- (add-function :before-until (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-eval-light.el b/contrib/lisp/org-eval-light.el
deleted file mode 100644
index 5c8404f..0000000
--- a/contrib/lisp/org-eval-light.el
+++ /dev/null
@@ -1,199 +0,0 @@
-;;; org-eval-light.el --- Display result of evaluating code in various
languages (light)
-
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>,
-;; Eric Schulte <schulte dot eric at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp, literate programming,
-;; reproducible research
-;; Homepage: https://orgmode.org
-;; Version: 0.04
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file is based off of org-eval, with the following changes.
-;;
-;; 1) forms are only executed manually, (allowing for the execution of
-;; an entire subtree of forms)
-;; 2) use the org-mode style src blocks, rather than the muse style
-;; <code></code> blocks
-;; 3) forms are not replaced by their outputs, but rather the output
-;; is placed in the buffer immediately following the src block
-;; commented by `org-eval-light-make-region-example' (when
-;; evaluated with a prefix argument no output is placed in the
-;; buffer)
-;; 4) add defadvice to org-ctrl-c-ctrl-c so that when called inside of
-;; a source block it will call `org-eval-light-current-snippet'
-
-;;; Code:
-(require 'org)
-
-(defgroup org-eval-light nil
- "Options concerning including output from commands into the Org-mode buffer."
- :tag "Org Eval"
- :group 'org)
-
-(defvar org-eval-light-example-size-cutoff 10
- "The number of lines under which an example is considered
-'small', and is exported with the '^:' syntax instead of in a
-large example block")
-
-(defvar org-eval-light-regexp nil)
-
-(defun org-eval-light-set-interpreters (var value)
- (set-default var value)
- (setq org-eval-light-regexp
- (concat "#\\+begin_src \\("
- (mapconcat 'regexp-quote value "\\|")
- "\\)\\([^\000]+?\\)#\\+end_src")))
-
-(defcustom org-eval-light-interpreters '("lisp" "emacs-lisp" "ruby" "shell")
- "Interpreters allows for evaluation tags.
-This is a list of program names (as strings) that can evaluate code and
-insert the output into an Org-mode buffer. Valid choices are
-
-lisp Interpret Emacs Lisp code and display the result
-shell Pass command to the shell and display the result
-perl The perl interpreter
-python Thy python interpreter
-ruby The ruby interpreter"
- :group 'org-eval-light
- :set 'org-eval-light-set-interpreters
- :type '(set :greedy t
- (const "lisp")
- (const "emacs-lisp")
- (const "perl")
- (const "python")
- (const "ruby")
- (const "shell")))
-
-;;; functions
-(defun org-eval-light-inside-snippet ()
- (interactive)
- (save-excursion
- (let ((case-fold-search t)
- (start-re "^#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n")
- (end-re "\n#\\+end_src")
- (pos (point))
- beg end)
- (if (and (setq beg (re-search-backward start-re nil t))
- (setq end (re-search-forward end-re nil t))
- (<= beg pos) (>= end pos))
- t))))
-
-(defun org-eval-light-make-region-example (beg end)
- "Comment out region using either the '^:' or the BEGIN_EXAMPLE
-syntax based on the size of the region as compared to
-`org-eval-light-example-size-cutoff'."
- (interactive "*r")
- (let ((size (abs (- (line-number-at-pos end)
- (line-number-at-pos beg)))))
- (if (= size 0)
- (let ((result (buffer-substring beg end)))
- (delete-region beg end)
- (insert (concat ": " result)))
- (if (<= size org-eval-light-example-size-cutoff)
- (save-excursion
- (goto-char beg)
- (dotimes (n size)
- (move-beginning-of-line 1) (insert ": ") (forward-line 1)))
- (let ((result (buffer-substring beg end)))
- (delete-region beg end)
- (insert (concat "#+BEGIN_EXAMPLE\n" result "#+END_EXAMPLE\n")))))))
-
-(defun org-eval-light-current-snippet (&optional arg)
- "Execute the current #+begin_src #+end_src block, and dump the
-results into the buffer immediately following the src block,
-commented by `org-eval-light-make-region-example'."
- (interactive "P")
- (let ((line (org-current-line))
- (case-fold-search t)
- (info (org-edit-src-find-region-and-lang))
- beg end lang result)
- (setq beg (nth 0 info)
- end (nth 1 info)
- lang (nth 2 info))
- (unless (member lang org-eval-light-interpreters)
- (error "Language is not in `org-eval-light-interpreters': %s" lang))
- (goto-line line)
- (setq result (org-eval-light-code lang (buffer-substring beg end)))
- (unless arg
- (save-excursion
- (re-search-forward "^#\\+end_src" nil t) (open-line 1) (forward-char 2)
- (let ((beg (point))
- (end (progn (insert result)
- (point))))
- (message (format "from %S %S" beg end))
- (org-eval-light-make-region-example beg end))))))
-
-(defun org-eval-light-eval-subtree (&optional arg)
- "Replace EVAL snippets in the entire subtree."
- (interactive "P")
- (save-excursion
- (org-narrow-to-subtree)
- (goto-char (point-min))
- (while (re-search-forward org-eval-light-regexp nil t)
- (org-eval-light-current-snippet arg))
- (widen)))
-
-(defun org-eval-light-code (interpreter code)
- (cond
- ((member interpreter '("lisp" "emacs-lisp"))
- (org-eval-light-lisp (concat "(progn\n" code "\n)")))
- ((equal interpreter "shell")
- (shell-command-to-string code))
- ((member interpreter '("perl" "python" "ruby"))
- (org-eval-light-run (executable-find interpreter) code))
- (t (error "Cannot evaluate code type %s" interpreter))))
-
-(defun org-eval-light-lisp (form)
- "Evaluate the given form and return the result as a string."
- (require 'pp)
- (save-match-data
- (condition-case err
- (let ((object (eval (read form))))
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- ((eq object nil) "")
- (t
- (pp-to-string object))))
- (error
- (org-display-warning (format "%s: Error evaluating %s: %s"
- "???" form err))
- "; INVALID LISP CODE"))))
-
-(defun org-eval-light-run (cmd code)
- (with-temp-buffer
- (insert code)
- (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
- (buffer-string)))
-
-(defadvice org-ctrl-c-ctrl-c (around org-cc-eval-source activate)
- (if (org-eval-light-inside-snippet)
- (call-interactively 'org-eval-light-current-snippet)
- ad-do-it))
-
-(provide 'org-eval-light)
-
-;;; org-eval-light.el ends here
diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el
deleted file mode 100644
index 1deccca..0000000
--- a/contrib/lisp/org-eval.el
+++ /dev/null
@@ -1,216 +0,0 @@
-;;; org-eval.el --- Display result of evaluating code in various languages
-;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 0.04
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This modules allows to include output from various commands into an
-;; Org-mode buffer, both for live display, and for export.
-;; This technique has been copied from emacs-wiki and Emacs Muse, and
-;; we try to make it work here in a way as similar as possible to
-;; Muse, so that people who move between both worlds don't need to learn
-;; new syntax.
-;;
-;; Basically it works like this:
-;;
-;; <lisp>(concat "aaa" "bbb")</lisp>
-;;
-;; will display "aaabbb" in the buffer and export like that as well.
-;; The leading lisp tag will also accept the attributes "markup" and
-;; "lang", to specify how the text should be formatted during export.
-;; For example,
-;;
-;; <lisp markup="src" lang="emacs-lisp"> .... </lisp>
-;;
-;; will format the result of the lisp form as if it was lisp source
-;; code. Internally, it will wrap the text into a
-;;
-;; #+begin_src emacs-lisp
-;; #+end_src
-;;
-;; structure so that the right things happen when the exporter is running.
-;;
-;; By default, only the <lisp> tag is turned on, but you can configure
-;; the variable `org-eval-interpreters' to add more interpreters like
-;; `perl', `python', or the `shell'.
-;;
-;; You can edit the code snippets with "C-c '" (org-edit-src-code).
-;;
-;; Please note that this mechanism is potentially dangerous, because it
-;; executes code that you don't even see. This gives you great power,
-;; but also enough rope to hang yourself. And, it gives your friends
-;; who send you Org files plenty of opportunity for good and bad jokes.
-;; This is also why this module is not turned on by default, but only
-;; available as a contributed package.
-;;
-;;
-;;
-(require 'org)
-
-;;; Customization
-
-(defgroup org-eval nil
- "Options concerning including output from commands into the Org-mode buffer."
- :tag "Org Eval"
- :group 'org)
-
-(defface org-eval
- (org-compatible-face nil
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey40"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey60"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
- "Face for command output that is included into an Org-mode buffer."
- :group 'org-eval
- :group 'org-faces)
-
-(defvar org-eval-regexp nil)
-
-(defun org-eval-set-interpreters (var value)
- (set-default var value)
- (setq org-eval-regexp
- (concat "<\\("
- (mapconcat 'regexp-quote value "\\|")
- "\\)"
- "\\([^>]\\{0,50\\}?\\)>"
- "\\([^\000]+?\\)</\\1>")))
-
-(defcustom org-eval-interpreters '("lisp")
- "Interpreters allows for evaluation tags.
-This is a list of program names (as strings) that can evaluate code and
-insert the output into an Org-mode buffer. Valid choices are
-
-lisp Interpret Emacs Lisp code and display the result
-shell Pass command to the shell and display the result
-perl The perl interpreter
-python Thy python interpreter
-ruby The ruby interpreter"
- :group 'org-eval
- :set 'org-eval-set-interpreters
- :type '(set :greedy t
- (const "lisp")
- (const "perl")
- (const "python")
- (const "ruby")
- (const "shell")))
-
-(defun org-eval-handle-snippets (limit &optional replace)
- "Evaluate code snippets and display the results as display property.
-When REPLACE is non-nil, replace the code region with the result (used
-for export)."
- (let (a)
- (while (setq a (text-property-any (point) (or limit (point-max))
- 'org-eval t))
- (remove-text-properties
- a (next-single-property-change a 'org-eval nil limit)
- '(display t intangible t org-eval t))))
- (while (re-search-forward org-eval-regexp limit t)
- (let* ((beg (match-beginning 0))
- (end (match-end 0))
- (kind (match-string 1))
- (attr (match-string 2))
- (code (match-string 3))
- (value (org-eval-code kind code))
- markup lang)
- (if replace
- (progn
- (setq attr (save-match-data (org-eval-get-attributes attr))
- markup (cdr (assoc "markup" attr))
- lang (cdr (assoc "lang" attr)))
- (replace-match
- (concat (if markup (format "#+BEGIN_%s" (upcase markup)))
- (if (and markup (equal (downcase markup) "src"))
- (concat " " (or lang "fundamental")))
- "\n"
- value
- (if markup (format "\n#+END_%s\n" (upcase markup))))
- t t))
- (add-text-properties
- beg end
- (list 'display value 'intangible t 'font-lock-multiline t
- 'face 'org-eval
- 'org-eval t))))))
-
-(defun org-eval-replace-snippts ()
- "Replace EVAL snippets in the entire buffer.
-This should go into the `org-export-preprocess-hook'."
- (goto-char (point-min))
- (org-eval-handle-snippets nil 'replace))
-
-(add-hook 'org-export-preprocess-hook 'org-eval-replace-snippts)
-(add-hook 'org-font-lock-hook 'org-eval-handle-snippets)
-
-(defun org-eval-get-attributes (str)
- (let ((start 0) key value rtn)
- (while (string-match "\\<\\([a-zA-Z]+\\)\\>=\"\\([^\"]+\\)\"" str start)
- (setq key (match-string 1 str)
- value (match-string 2 str)
- start (match-end 0))
- (push (cons key value) rtn))
- rtn))
-
-(defun org-eval-code (interpreter code)
- (cond
- ((equal interpreter "lisp")
- (org-eval-lisp (concat "(progn\n" code "\n)")))
- ((equal interpreter "shell")
- (shell-command-to-string code))
- ((member interpreter '("perl" "python" "ruby"))
- (org-eval-run (executable-find interpreter) code))
- (t (error "Cannot evaluate code type %s" interpreter))))
-
-(defun org-eval-lisp (form)
- "Evaluate the given form and return the result as a string."
- (require 'pp)
- (save-match-data
- (condition-case err
- (let ((object (eval (read form))))
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- ((eq object nil) "")
- (t
- (pp-to-string object))))
- (error
- (org-display-warning (format "%s: Error evaluating %s: %s"
- "???" form err))
- "; INVALID LISP CODE"))))
-
-(defun org-eval-run (cmd code)
- (with-temp-buffer
- (insert code)
- (shell-command-on-region (point-min) (point-max) cmd nil 'replace)
- (buffer-string)))
-
-(provide 'org-eval)
-
-;;; org-eval.el ends here
diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el
deleted file mode 100644
index 9c2bdae..0000000
--- a/contrib/lisp/org-expiry.el
+++ /dev/null
@@ -1,361 +0,0 @@
-;;; org-expiry.el --- expiry mechanism for Org entries
-;;
-;; Copyright 2007-2021 Free Software Foundation, Inc.
-;;
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Version: 0.2
-;; Keywords: org expiry
-
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; This gives you a chance to get rid of old entries in your Org files
-;; by expiring them.
-;;
-;; By default, entries that have no EXPIRY property are considered to be
-;; new (i.e. 0 day old) and only entries older than one year go to the
-;; expiry process, which consist in adding the ARCHIVE tag. None of
-;; your tasks will be deleted with the default settings.
-;;
-;; When does an entry expires?
-;;
-;; Consider this entry:
-;;
-;; * Stop watching TV
-;; :PROPERTIES:
-;; :CREATED: <2008-01-07 lun 08:01>
-;; :EXPIRY: <2008-01-09 08:01>
-;; :END:
-;;
-;; This entry will expire on the 9th, january 2008.
-
-;; * Stop watching TV
-;; :PROPERTIES:
-;; :CREATED: <2008-01-07 lun 08:01>
-;; :EXPIRY: +1w
-;; :END:
-;;
-;; This entry will expire on the 14th, january 2008, one week after its
-;; creation date.
-;;
-;; What happen when an entry is expired? Nothing until you explicitly
-;; M-x org-expiry-process-entries When doing this, org-expiry will check
-;; for expired entries and request permission to process them.
-;;
-;; Processing an expired entries means calling the function associated
-;; with `org-expiry-handler-function'; the default is to add the tag
-;; :ARCHIVE:, but you can also add a EXPIRED keyword or even archive
-;; the subtree.
-;;
-;; Is this useful? Well, when you're in a brainstorming session, it
-;; might be useful to know about the creation date of an entry, and be
-;; able to archive those entries that are more than xxx days/weeks old.
-;;
-;; When you're in such a session, you can insinuate org-expiry like
-;; this: M-x org-expiry-insinuate
-;;
-;; Then, each time you're pressing M-RET to insert an item, the CREATION
-;; property will be automatically added. Same when you're scheduling or
-;; deadlining items. You can deinsinuate: M-x org-expiry-deinsinuate
-
-;;; Code:
-
-;;; User variables:
-
-(defgroup org-expiry nil
- "Org expiry process."
- :tag "Org Expiry"
- :group 'org)
-
-(defcustom org-expiry-inactive-timestamps nil
- "Insert inactive timestamps for created/expired properties."
- :type 'boolean
- :group 'org-expiry)
-
-(defcustom org-expiry-created-property-name "CREATED"
- "The name of the property for setting the creation date."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-expiry-property-name "EXPIRY"
- "The name of the property for setting the expiry date/delay."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-keyword "EXPIRED"
- "The default keyword for `org-expiry-add-keyword'."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-wait "+1y"
- "Time span between the creation date and the expiry.
-The default value for this variable (\"+1y\") means that entries
-will expire if there are at least one year old.
-
-If the expiry delay cannot be retrieved from the entry or the
-subtree above, the expiry process compares the expiry delay with
-`org-expiry-wait'. This can be either an ISO date or a relative
-time specification. See `org-read-date' for details."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-created-date "+0d"
- "The default creation date.
-The default value of this variable (\"+0d\") means that entries
-without a creation date will be handled as if they were created
-today.
-
-If the creation date cannot be retrieved from the entry or the
-subtree above, the expiry process will compare the expiry delay
-with this date. This can be either an ISO date or a relative
-time specification. See `org-read-date' for details on relative
-time specifications."
- :type 'string
- :group 'org-expiry)
-
-(defcustom org-expiry-handler-function 'org-toggle-archive-tag
- "Function to process expired entries.
-Possible candidates for this function are:
-
-`org-toggle-archive-tag'
-`org-expiry-add-keyword'
-`org-expiry-archive-subtree'"
- :type 'function
- :group 'org-expiry)
-
-(defcustom org-expiry-confirm-flag t
- "Non-nil means confirm expiration process."
- :type '(choice
- (const :tag "Always require confirmation" t)
- (const :tag "Do not require confirmation" nil)
- (const :tag "Require confirmation in interactive expiry process"
- interactive))
- :group 'org-expiry)
-
-(defcustom org-expiry-advised-functions
- '(org-scheduled org-deadline org-time-stamp)
- "A list of advised functions.
-`org-expiry-insinuate' will activate the expiry advice for these
-functions. `org-expiry-deinsinuate' will deactivate them."
- :type 'boolean
- :group 'list)
-
-;;; Advices and insinuation:
-
-(defadvice org-schedule (after org-schedule-update-created)
- "Update the creation-date property when calling `org-schedule'."
- (org-expiry-insert-created))
-
-(defadvice org-deadline (after org-deadline-update-created)
- "Update the creation-date property when calling `org-deadline'."
- (org-expiry-insert-created))
-
-(defadvice org-time-stamp (after org-time-stamp-update-created)
- "Update the creation-date property when calling `org-time-stamp'."
- (org-expiry-insert-created))
-
-(defun org-expiry-insinuate (&optional arg)
- "Add hooks and activate advices for org-expiry.
-If ARG, also add a hook to `before-save-hook' in `org-mode' and
-restart `org-mode' if necessary."
- (interactive "P")
- (ad-activate 'org-schedule)
- (ad-activate 'org-time-stamp)
- (ad-activate 'org-deadline)
- (add-hook 'org-insert-heading-hook 'org-expiry-insert-created)
- (add-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
- (add-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
- (when arg
- (add-hook 'org-mode-hook
- (lambda() (add-hook 'before-save-hook
- 'org-expiry-process-entries t t)))
- ;; need this to refresh org-mode hooks
- (when (eq major-mode 'org-mode)
- (org-mode)
- (if (called-interactively-p 'any)
- (message "Org-expiry insinuated, `org-mode' restarted.")))))
-
-(defun org-expiry-deinsinuate (&optional arg)
- "Remove hooks and deactivate advices for org-expiry.
-If ARG, also remove org-expiry hook in Org's `before-save-hook'
-and restart `org-mode' if necessary."
- (interactive "P")
- (ad-deactivate 'org-schedule)
- (ad-deactivate 'org-time-stamp)
- (ad-deactivate 'org-deadline)
- (remove-hook 'org-insert-heading-hook 'org-expiry-insert-created)
- (remove-hook 'org-after-todo-state-change-hook 'org-expiry-insert-created)
- (remove-hook 'org-after-tags-change-hook 'org-expiry-insert-created)
- (remove-hook 'org-mode-hook
- (lambda() (add-hook 'before-save-hook
- 'org-expiry-process-entries t t)))
- (when arg
- ;; need this to refresh org-mode hooks
- (when (eq major-mode 'org-mode)
- (org-mode)
- (if (called-interactively-p 'any)
- (message "Org-expiry de-insinuated, `org-mode' restarted.")))))
-
-;;; org-expiry-expired-p:
-
-(defun org-expiry-expired-p ()
- "Check if the entry at point is expired.
-Return nil if the entry is not expired. Otherwise return the
-amount of time between today and the expiry date.
-
-If there is no creation date, use `org-expiry-created-date'.
-If there is no expiry date, use `org-expiry-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)
- 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))
- (org-read-date nil t ex-field))))
- (if (time-less-p ex ct)
- (time-subtract ct ex))))
-
-;;; Expire an entry or a region/buffer:
-
-(defun org-expiry-process-entry (&optional force)
- "Call `org-expiry-handler-function' on entry.
-If FORCE is non-nil, don't require confirmation from the user.
-Otherwise rely on `org-expiry-confirm-flag' to decide."
- (interactive "P")
- (save-excursion
- (when (called-interactively-p) (org-reveal))
- (when (org-expiry-expired-p)
- (org-back-to-heading)
- (looking-at org-complex-heading-regexp)
- (let* ((ov (make-overlay (point) (match-end 0)))
- (e (org-expiry-expired-p))
- (d (time-to-number-of-days e)))
- (overlay-put ov 'face 'secondary-selection)
- (if (or force
- (null org-expiry-confirm-flag)
- (and (eq org-expiry-confirm-flag 'interactive)
- (not (interactive)))
- (and org-expiry-confirm-flag
- (y-or-n-p (format "Entry expired by %d days. Process? "
d))))
- (funcall org-expiry-handler-function))
- (delete-overlay ov)))))
-
-(defun org-expiry-process-entries (beg end)
- "Process all expired entries between BEG and END.
-The expiry process will run the function defined by
-`org-expiry-handler-functions'."
- (interactive "r")
- (save-excursion
- (let ((beg (if (org-region-active-p)
- (region-beginning) (point-min)))
- (end (if (org-region-active-p)
- (region-end) (point-max))))
- (goto-char beg)
- (let ((expired 0) (processed 0))
- (while (and (outline-next-heading) (< (point) end))
- (when (org-expiry-expired-p)
- (setq expired (1+ expired))
- (if (if (called-interactively-p 'any)
- (call-interactively 'org-expiry-process-entry)
- (org-expiry-process-entry))
- (setq processed (1+ processed)))))
- (if (equal expired 0)
- (message "No expired entry")
- (message "Processed %d on %d expired entries"
- processed expired))))))
-
-;;; Insert created/expiry property:
-
-(defun org-expiry-insert-created (&optional arg)
- "Insert or update a property with the creation date.
-If ARG, always update it. With one `C-u' prefix, silently update
-to today's date. With two `C-u' prefixes, prompt the user for to
-update the date."
- (interactive "P")
- (let* ((d (org-entry-get (point) org-expiry-created-property-name))
- d-time d-hour timestr)
- (when (or (null d) arg)
- ;; update if no date or non-nil prefix argument
- ;; FIXME Use `org-time-string-to-time'
- (setq d-time (if d (org-time-string-to-time d)
- (current-time)))
- (setq d-hour (format-time-string "%H:%M" d-time))
- (setq timestr
- ;; two C-u prefixes will call org-read-date
- (if (equal arg '(16))
- (concat "<" (org-read-date
- nil nil nil nil d-time d-hour) ">")
- (format-time-string (cdr org-time-stamp-formats))))
- ;; maybe transform to inactive timestamp
- (if org-expiry-inactive-timestamps
- (setq timestr (concat "[" (substring timestr 1 -1) "]")))
- (save-excursion
- (org-entry-put
- (point) org-expiry-created-property-name timestr)))))
-
-(defun org-expiry-insert-expiry (&optional today)
- "Insert a property with the expiry date.
-With one `C-u' prefix, don't prompt interactively for the date
-and insert today's date."
- (interactive "P")
- (let* ((d (org-entry-get (point) org-expiry-expiry-property-name))
- d-time d-hour)
- (setq d-time (if d (org-time-string-to-time d)
- (current-time)))
- (setq d-hour (format-time-string "%H:%M" d-time))
- (setq timestr (if today
- (format-time-string (cdr org-time-stamp-formats))
- (concat "<" (org-read-date
- nil nil nil nil d-time d-hour) ">")))
- ;; maybe transform to inactive timestamp
- (if org-expiry-inactive-timestamps
- (setq timestr (concat "[" (substring timestr 1 -1) "]")))
-
- (save-excursion
- (org-entry-put
- (point) org-expiry-expiry-property-name timestr))))
-
-;;; Functions to process expired entries:
-
-(defun org-expiry-archive-subtree ()
- "Archive the entry at point if it is expired."
- (interactive)
- (save-excursion
- (if (org-expiry-expired-p)
- (org-archive-subtree)
- (if (called-interactively-p 'any)
- (message "Entry at point is not expired.")))))
-
-(defun org-expiry-add-keyword (&optional keyword)
- "Add KEYWORD to the entry at point if it is expired."
- (interactive "sKeyword: ")
- (if (or (member keyword org-todo-keywords-1)
- (setq keyword org-expiry-keyword))
- (save-excursion
- (if (org-expiry-expired-p)
- (org-todo keyword)
- (if (called-interactively-p 'any)
- (message "Entry at point is not expired."))))
- (error "\"%s\" is not a to-do keyword in this buffer" keyword)))
-
-;; FIXME what about using org-refile ?
-
-(provide 'org-expiry)
-
-;;; org-expiry.el ends here
diff --git a/contrib/lisp/org-interactive-query.el
b/contrib/lisp/org-interactive-query.el
deleted file mode 100644
index dba053f..0000000
--- a/contrib/lisp/org-interactive-query.el
+++ /dev/null
@@ -1,311 +0,0 @@
-;;; org-interactive-query.el --- Interactive modification of agenda query
-;;
-;; Copyright 2007-2021 Free Software Foundation, Inc.
-;;
-;; Author: Christopher League <league at contrapunctus dot net>
-;; Version: 1.0
-;; Keywords: org, wp
-;;
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-
-;; This library implements interactive modification of a tags/todo query
-;; in the org-agenda. It adds 4 keys to the agenda
-;;
-;; / add a keyword as a positive selection criterion
-;; \ add a keyword as a newgative selection criterion
-;; = clear a keyword from the selection string
-;; ;
-
-(require 'org)
-
-(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
-(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
-(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
-(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
-
-;;; Agenda interactive query manipulation
-
-(defcustom org-agenda-query-selection-single-key t
- "Non-nil means query manipulation exits after first change.
-When nil, you have to press RET to exit it.
-During query selection, you can toggle this flag with `C-c'.
-This variable can also have the value `expert'. In this case, the window
-displaying the tags menu is not even shown, until you press C-c again."
- :group 'org-agenda
- :type '(choice
- (const :tag "No" nil)
- (const :tag "Yes" t)
- (const :tag "Expert" expert)))
-
-(defun org-agenda-query-selection (current op table &optional todo-table)
- "Fast query manipulation with single keys.
-CURRENT is the current query string, OP is the initial
-operator (one of \"+|-=\"), TABLE is an alist of tags and
-corresponding keys, possibly with grouping information.
-TODO-TABLE is a similar table with TODO keywords, should these
-have keys assigned to them. If the keys are nil, a-z are
-automatically assigned. Returns the new query string, or nil to
-not change the current one."
- (let* ((fulltable (append table todo-table))
- (maxlen (apply 'max (mapcar
- (lambda (x)
- (if (stringp (car x)) (string-width (car x)) 0))
- fulltable)))
- (fwidth (+ maxlen 3 1 3))
- (ncol (/ (- (window-width) 4) fwidth))
- (expert (eq org-agenda-query-selection-single-key 'expert))
- (exit-after-next org-agenda-query-selection-single-key)
- (done-keywords org-done-keywords)
- tbl char cnt e groups ingroup
- tg c2 c c1 ntable rtn)
- (save-window-excursion
- (if expert
- (set-buffer (get-buffer-create " *Org tags*"))
- (delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
- (erase-buffer)
- (setq-local org-done-keywords done-keywords)
- (insert "Query: " current "\n")
- (org-agenda-query-op-line op)
- (insert "\n\n")
- (org-fast-tag-show-exit exit-after-next)
- (setq tbl fulltable char ?a cnt 0)
- (while (setq e (pop tbl))
- (cond
- ((equal e '(:startgroup))
- (push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
- (setq cnt 0)
- (insert "\n"))
- (insert "{ "))
- ((equal e '(:endgroup))
- (setq ingroup nil cnt 0)
- (insert "}\n"))
- (t
- (setq tg (car e) c2 nil)
- (if (cdr e)
- (setq c (cdr e))
- ;; automatically assign a character.
- (setq c1 (string-to-char
- (downcase (substring
- tg (if (= (string-to-char tg) ?@) 1 0)))))
- (if (or (rassoc c1 ntable) (rassoc c1 table))
- (while (or (rassoc char ntable) (rassoc char table))
- (setq char (1+ char)))
- (setq c2 c1))
- (setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
- (setq tg (org-add-props tg nil 'face
- (cond
- ((not (assoc tg table))
- (org-get-todo-face tg))
- (t nil))))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
- (insert "[" c "] " tg (make-string
- (- fwidth 4 (length tg)) ?\ ))
- (push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
- (insert "\n")
- (if ingroup (insert " "))
- (setq cnt 0)))))
- (setq ntable (nreverse ntable))
- (insert "\n")
- (goto-char (point-min))
- (if (and (not expert) (fboundp 'fit-window-to-buffer))
- (fit-window-to-buffer))
- (setq rtn
- (catch 'exit
- (while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept
[TAB]:free%s%s"
- (if groups " [!] no groups" " [!]groups")
- (if expert " [C-c]:window" (if exit-after-next "
[C-c]:single" " [C-c]:multi")))
- (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
- (cond
- ((= c ?\r) (throw 'exit t))
- ((= c ?!)
- (setq groups (not groups))
- (goto-char (point-min))
- (while (re-search-forward "[{}]" nil t) (replace-match " ")))
- ((= c ?\C-c)
- (if (not expert)
- (org-fast-tag-show-exit
- (setq exit-after-next (not exit-after-next)))
- (setq expert nil)
- (delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window " *Org tags*")
- (and (fboundp 'fit-window-to-buffer)
- (fit-window-to-buffer))))
- ((or (= c ?\C-g)
- (and (= c ?q) (not (rassoc c ntable))))
- (setq quit-flag t))
- ((= c ?\ )
- (setq current "")
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\[) ; clear left
- (org-agenda-query-decompose current)
- (setq current (concat "/" (match-string 2 current)))
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\]) ; clear right
- (org-agenda-query-decompose current)
- (setq current (match-string 1 current))
- (if exit-after-next (setq exit-after-next 'now)))
- ((= c ?\t)
- (condition-case nil
- (setq current (read-string "Query: " current))
- (quit))
- (if exit-after-next (setq exit-after-next 'now)))
- ;; operators
- ((or (= c ?/) (= c ?+)) (setq op "+"))
- ((or (= c ?\;) (= c ?|)) (setq op "|"))
- ((or (= c ?\\) (= c ?-)) (setq op "-"))
- ((= c ?=) (setq op "="))
- ;; todos
- ((setq e (rassoc c todo-table) tg (car e))
- (setq current (org-agenda-query-manip
- current op groups 'todo tg))
- (if exit-after-next (setq exit-after-next 'now)))
- ;; tags
- ((setq e (rassoc c ntable) tg (car e))
- (setq current (org-agenda-query-manip
- current op groups 'tag tg))
- (if exit-after-next (setq exit-after-next 'now))))
- (if (eq exit-after-next 'now) (throw 'exit t))
- (goto-char (point-min))
- (beginning-of-line 1)
- (delete-region (point) (point-at-eol))
- (insert "Query: " current)
- (beginning-of-line 2)
- (delete-region (point) (point-at-eol))
- (org-agenda-query-op-line op)
- (goto-char (point-min)))))
- (if rtn current nil))))
-
-(defun org-agenda-query-op-line (op)
- (insert "Operator: "
- (org-agenda-query-op-entry (equal op "+") "/+" "and")
- (org-agenda-query-op-entry (equal op "|") ";|" "or")
- (org-agenda-query-op-entry (equal op "-") "\\-" "not")
- (org-agenda-query-op-entry (equal op "=") "=" "clear")))
-
-(defun org-agenda-query-op-entry (matchp chars str)
- (if matchp
- (org-add-props (format "[%s %s] " chars (upcase str))
- nil 'face 'org-todo)
- (format "[%s]%s " chars str)))
-
-(defun org-agenda-query-decompose (current)
- (string-match "\\([^/]*\\)/?\\(.*\\)" current))
-
-(defun org-agenda-query-clear (current prefix tag)
- (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
- (replace-match "" t t current)
- current))
-
-(defun org-agenda-query-manip (current op groups kind tag)
- "Apply an operator to a query string and a tag.
-CURRENT is the current query string, OP is the operator, GROUPS is a
-list of lists of tags that are mutually exclusive. KIND is 'tag for a
-regular tag, or 'todo for a TODO keyword, and TAG is the tag or
-keyword string."
- ;; If this tag is already in query string, remove it.
- (setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
- (if (equal op "=") current
- ;; When using AND, also remove mutually exclusive tags.
- (if (equal op "+")
- (loop for g in groups do
- (if (member tag g)
- (mapc (lambda (x)
- (setq current
- (org-agenda-query-clear current "\\+" x)))
- g))))
- ;; Decompose current query into q1 (tags) and q2 (TODOs).
- (org-agenda-query-decompose current)
- (let* ((q1 (match-string 1 current))
- (q2 (match-string 2 current)))
- (cond
- ((eq kind 'tag)
- (concat q1 op tag "/" q2))
- ;; It's a TODO; when using AND, drop all other TODOs.
- ((equal op "+")
- (concat q1 "/+" tag))
- (t
- (concat q1 "/" q2 op tag))))))
-
-(defun org-agenda-query-global-todo-keys (&optional files)
- "Return alist of all TODO keywords and their fast keys, in all FILES."
- (let (alist)
- (unless (and files (car files))
- (setq files (org-agenda-files)))
- (save-excursion
- (loop for f in files do
- (set-buffer (find-file-noselect f))
- (loop for k in org-todo-key-alist do
- (setq alist (org-agenda-query-merge-todo-key
- alist k)))))
- alist))
-
-(defun org-agenda-query-merge-todo-key (alist entry)
- (let (e)
- (cond
- ;; if this is not a keyword (:startgroup, etc), ignore it
- ((not (stringp (car entry))))
- ;; if keyword already exists, replace char if it's null
- ((setq e (assoc (car entry) alist))
- (when (null (cdr e)) (setcdr e (cdr entry))))
- ;; if char already exists, prepend keyword but drop char
- ((rassoc (cdr entry) alist)
- (message "TRACE POSITION 2")
- (setq alist (cons (cons (car entry) nil) alist)))
- ;; else, prepend COPY of entry
- (t
- (setq alist (cons (cons (car entry) (cdr entry)) alist)))))
- alist)
-
-(defun org-agenda-query-generic-cmd (op)
- "Activate query manipulation with OP as initial operator."
- (let ((q (org-agenda-query-selection org-agenda-query-string op
- org-tag-alist
- (org-agenda-query-global-todo-keys))))
- (when q
- (setq org-agenda-query-string q)
- (org-agenda-redo))))
-
-(defun org-agenda-query-clear-cmd ()
- "Activate query manipulation, to clear a tag from the string."
- (interactive)
- (org-agenda-query-generic-cmd "="))
-
-(defun org-agenda-query-and-cmd ()
- "Activate query manipulation, initially using the AND (+) operator."
- (interactive)
- (org-agenda-query-generic-cmd "+"))
-
-(defun org-agenda-query-or-cmd ()
- "Activate query manipulation, initially using the OR (|) operator."
- (interactive)
- (org-agenda-query-generic-cmd "|"))
-
-(defun org-agenda-query-not-cmd ()
- "Activate query manipulation, initially using the NOT (-) operator."
- (interactive)
- (org-agenda-query-generic-cmd "-"))
-
-(provide 'org-interactive-query)
diff --git a/contrib/lisp/org-invoice.el b/contrib/lisp/org-invoice.el
deleted file mode 100644
index 6868894..0000000
--- a/contrib/lisp/org-invoice.el
+++ /dev/null
@@ -1,403 +0,0 @@
-;;; org-invoice.el --- Help manage client invoices in OrgMode
-;;
-;; Copyright (C) 2008-2014 pmade inc. (Peter Jones pjones@pmade.com)
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; Permission is hereby granted, free of charge, to any person obtaining
-;; a copy of this software and associated documentation files (the
-;; "Software"), to deal in the Software without restriction, including
-;; without limitation the rights to use, copy, modify, merge, publish,
-;; distribute, sublicense, and/or sell copies of the Software, and to
-;; permit persons to whom the Software is furnished to do so, subject to
-;; the following conditions:
-;;
-;; The above copyright notice and this permission notice shall be
-;; included in all copies or substantial portions of the Software.
-;;
-;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
-;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
-;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;;
-;;; Commentary:
-;;
-;; Building on top of the terrific OrgMode, org-invoice tries to
-;; provide functionality for managing invoices. Currently, it does
-;; this by implementing an OrgMode dynamic block where invoice
-;; information is aggregated so that it can be exported.
-;;
-;; It also provides a library of functions that can be used to collect
-;; this invoice information and use it in other ways, such as
-;; submitting it to on-line invoicing tools.
-;;
-;; I'm already working on an elisp package to submit this invoice data
-;; to the FreshBooks on-line accounting tool.
-;;
-;; Usage:
-;;
-;; In your ~/.emacs:
-;; (autoload 'org-invoice-report "org-invoice")
-;; (autoload 'org-dblock-write:invoice "org-invoice")
-;;
-;; See the documentation in the following functions:
-;;
-;; `org-invoice-report'
-;; `org-dblock-write:invoice'
-;;
-;; Latest version:
-;;
-;; git clone git://pmade.com/elisp
-(eval-when-compile
- (require 'cl)
- (require 'org))
-
-(declare-function org-duration-from-minutes "org-duration" (minutes &optional
fmt fractional))
-
-(defgroup org-invoice nil
- "OrgMode Invoice Helper"
- :tag "Org-Invoice" :group 'org)
-
-(defcustom org-invoice-long-date-format "%A, %B %d, %Y"
- "The format string for long dates."
- :type 'string :group 'org-invoice)
-
-(defcustom org-invoice-strip-ts t
- "Remove org timestamps that appear in headings."
- :type 'boolean :group 'org-invoice)
-
-(defcustom org-invoice-default-level 2
- "The heading level at which a new invoice starts. This value
-is used if you don't specify a scope option to the invoice block,
-and when other invoice helpers are trying to find the heading
-that starts an invoice.
-
-The default is 2, assuming that you structure your invoices so
-that they fall under a single heading like below:
-
-* Invoices
-** This is invoice number 1...
-** This is invoice number 2...
-
-If you don't structure your invoices using those conventions,
-change this setting to the number that corresponds to the heading
-at which an invoice begins."
- :type 'integer :group 'org-invoice)
-
-(defcustom org-invoice-start-hook nil
- "Hook called when org-invoice is about to collect data from an
-invoice heading. When this hook is called, point will be on the
-heading where the invoice begins.
-
-When called, `org-invoice-current-invoice' will be set to the
-alist that represents the info for this invoice."
- :type 'hook :group 'org-invoice)
-
- (defcustom org-invoice-heading-hook nil
- "Hook called when org-invoice is collecting data from a
-heading. You can use this hook to add additional information to
-the alist that represents the heading.
-
-When this hook is called, point will be on the current heading
-being processed, and `org-invoice-current-item' will contain the
-alist for the current heading.
-
-This hook is called repeatedly for each invoice item processed."
- :type 'hook :group 'org-invoice)
-
-(defvar org-invoice-current-invoice nil
- "Information about the current invoice.")
-
-(defvar org-invoice-current-item nil
- "Information about the current invoice item.")
-
-(defvar org-invoice-table-params nil
- "The table parameters currently being used.")
-
-(defvar org-invoice-total-time nil
- "The total invoice time for the summary line.")
-
-(defvar org-invoice-total-price nil
- "The total invoice price for the summary line.")
-
-(defconst org-invoice-version "1.0.0"
- "The org-invoice version number.")
-
-(defun org-invoice-goto-tree (&optional tree)
- "Move point to the heading that represents the head of the
-current invoice. The heading level will be taken from
-`org-invoice-default-level' unless tree is set to a string that
-looks like tree2, where the level is 2."
- (let ((level org-invoice-default-level))
- (save-match-data
- (when (and tree (string-match "^tree\\([0-9]+\\)$" tree))
- (setq level (string-to-number (match-string 1 tree)))))
- (org-back-to-heading)
- (while (and (> (org-reduced-level (org-outline-level)) level)
- (org-up-heading-safe)))))
-
-(defun org-invoice-heading-info ()
- "Return invoice information from the current heading."
- (let ((title (org-no-properties (org-get-heading t)))
- (date (org-entry-get nil "TIMESTAMP" 'selective))
- (work (org-entry-get nil "WORK" nil))
- (rate (or (org-entry-get nil "RATE" t) "0"))
- (level (org-outline-level))
- raw-date long-date)
- (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" 'selective)))
- (unless date (setq date (org-entry-get nil "TIMESTAMP" t)))
- (unless date (setq date (org-entry-get nil "TIMESTAMP_IA" t)))
- (unless work (setq work (org-entry-get nil "CLOCKSUM" nil)))
- (unless work (setq work "00:00"))
- (when date
- (setq raw-date (apply 'encode-time (org-parse-time-string date)))
- (setq long-date (format-time-string org-invoice-long-date-format
raw-date)))
- (when (and org-invoice-strip-ts (string-match org-ts-regexp-both title))
- (setq title (replace-match "" nil nil title)))
- (when (string-match "^[ \t]+" title)
- (setq title (replace-match "" nil nil title)))
- (when (string-match "[ \t]+$" title)
- (setq title (replace-match "" nil nil title)))
- (setq work (org-duration-to-minutes work))
- (setq rate (string-to-number rate))
- (setq org-invoice-current-item (list (cons 'title title)
- (cons 'date date)
- (cons 'raw-date raw-date)
- (cons 'long-date long-date)
- (cons 'work work)
- (cons 'rate rate)
- (cons 'level level)
- (cons 'price (* rate (/ work 60.0)))))
- (run-hook-with-args 'org-invoice-heading-hook)
- org-invoice-current-item))
-
-(defun org-invoice-level-min-max (ls)
- "Return a list where the car is the min level, and the cdr the max."
- (let ((max 0) min level)
- (dolist (info ls)
- (when (cdr (assq 'date info))
- (setq level (cdr (assq 'level info)))
- (when (or (not min) (< level min)) (setq min level))
- (when (> level max) (setq max level))))
- (cons (or min 0) max)))
-
-(defun org-invoice-collapse-list (ls)
- "Reorganize the given list by dates."
- (let ((min-max (org-invoice-level-min-max ls)) new)
- (dolist (info ls)
- (let* ((date (cdr (assq 'date info)))
- (work (cdr (assq 'work info)))
- (price (cdr (assq 'price info)))
- (long-date (cdr (assq 'long-date info)))
- (level (cdr (assq 'level info)))
- (bucket (cdr (assoc date new))))
- (if (and (/= (car min-max) (cdr min-max))
- (= (car min-max) level)
- (= work 0) (not bucket) date)
- (progn
- (setq info (assq-delete-all 'work info))
- (push (cons 'total-work 0) info)
- (push (cons date (list info)) new)
- (setq bucket (cdr (assoc date new))))
- (when (and date (not bucket))
- (setq bucket (list (list (cons 'date date)
- (cons 'title long-date)
- (cons 'total-work 0)
- (cons 'price 0))))
- (push (cons date bucket) new)
- (setq bucket (cdr (assoc date new))))
- (when (and date bucket)
- (setcdr (assq 'total-work (car bucket))
- (+ work (cdr (assq 'total-work (car bucket)))))
- (setcdr (assq 'price (car bucket))
- (+ price (cdr (assq 'price (car bucket)))))
- (nconc bucket (list info))))))
- (nreverse new)))
-
-(defun org-invoice-info-to-table (info)
- "Create a single org table row from the given info alist."
- (let ((title (cdr (assq 'title info)))
- (total (cdr (assq 'total-work info)))
- (work (cdr (assq 'work info)))
- (price (cdr (assq 'price info)))
- (with-price (plist-get org-invoice-table-params :price)))
- (unless total
- (setq
- org-invoice-total-time (+ org-invoice-total-time work)
- org-invoice-total-price (+ org-invoice-total-price price)))
- (setq total (and total (org-duration-from-minutes total)))
- (setq work (and work (org-duration-from-minutes work)))
- (insert-before-markers
- (concat "|" title
- (cond
- (total (concat "|" total))
- (work (concat "|" work)))
- (and with-price price (concat "|" (format "%.2f" price)))
- "|" "\n"))))
-
-(defun org-invoice-list-to-table (ls)
- "Convert a list of heading info to an org table"
- (let ((with-price (plist-get org-invoice-table-params :price))
- (with-summary (plist-get org-invoice-table-params :summary))
- (with-header (plist-get org-invoice-table-params :headers))
- (org-invoice-total-time 0)
- (org-invoice-total-price 0))
- (insert-before-markers
- (concat "| Task / Date | Time" (and with-price "| Price") "|\n"))
- (dolist (info ls)
- (insert-before-markers "|-\n")
- (mapc 'org-invoice-info-to-table (if with-header (cdr info) (cdr (cdr
info)))))
- (when with-summary
- (insert-before-markers
- (concat "|-\n|Total:|"
- (org-duration-from-minutes org-invoice-total-time)
- (and with-price (concat "|" (format "%.2f"
org-invoice-total-price)))
- "|\n")))))
-
-(defun org-invoice-collect-invoice-data ()
- "Collect all the invoice data from the current OrgMode tree and
-return it. Before you call this function, move point to the
-heading that begins the invoice data, usually using the
-`org-invoice-goto-tree' function."
- (let ((org-invoice-current-invoice
- (list (cons 'point (point)) (cons 'buffer (current-buffer))))
- (org-invoice-current-item nil))
- (save-restriction
- (org-narrow-to-subtree)
- (org-clock-sum)
- (run-hook-with-args 'org-invoice-start-hook)
- (cons org-invoice-current-invoice
- (org-invoice-collapse-list
- (org-map-entries 'org-invoice-heading-info t 'tree 'archive))))))
-
-(defun org-dblock-write:invoice (params)
- "Function called by OrgMode to write the invoice dblock. To
-create an invoice dblock you can use the `org-invoice-report'
-function.
-
-The following parameters can be given to the invoice block (for
-information about dblock parameters, please see the Org manual):
-
-:scope Allows you to override the `org-invoice-default-level'
- variable. The only supported values right now are ones
- that look like :tree1, :tree2, etc.
-
-:prices Set to nil to turn off the price column.
-
-:headers Set to nil to turn off the group headers.
-
-:summary Set to nil to turn off the final summary line."
- (let ((scope (plist-get params :scope))
- (org-invoice-table-params params)
- (zone (point-marker))
- table)
- (unless scope (setq scope 'default))
- (unless (plist-member params :price) (plist-put params :price t))
- (unless (plist-member params :summary) (plist-put params :summary t))
- (unless (plist-member params :headers) (plist-put params :headers t))
- (save-excursion
- (cond
- ((eq scope 'tree) (org-invoice-goto-tree "tree1"))
- ((eq scope 'default) (org-invoice-goto-tree))
- ((symbolp scope) (org-invoice-goto-tree (symbol-name scope))))
- (setq table (org-invoice-collect-invoice-data))
- (goto-char zone)
- (org-invoice-list-to-table (cdr table))
- (goto-char zone)
- (org-table-align)
- (move-marker zone nil))))
-
-(defun org-invoice-in-report-p ()
- "Check to see if point is inside an invoice report."
- (let ((pos (point)) start)
- (save-excursion
- (end-of-line 1)
- (and (re-search-backward "^#\\+BEGIN:[ \t]+invoice" nil t)
- (setq start (match-beginning 0))
- (re-search-forward "^#\\+END:.*" nil t)
- (>= (match-end 0) pos)
- start))))
-
-(defun org-invoice-report (&optional jump)
- "Create or update an invoice dblock report. If point is inside
-an existing invoice report, the report is updated. If point
-isn't inside an invoice report, a new report is created.
-
-When called with a prefix argument, move to the first invoice
-report after point and update it.
-
-For information about various settings for the invoice report,
-see the `org-dblock-write:invoice' function documentation.
-
-An invoice report is created by reading a heading tree and
-collecting information from various properties. It is assumed
-that all invoices start at a second level heading, but this can
-be configured using the `org-invoice-default-level' variable.
-
-Here is an example, where all invoices fall under the first-level
-heading Invoices:
-
-* Invoices
-** Client Foo (Jan 01 - Jan 15)
-*** [2008-01-01 Tue] Built New Server for Production
-*** [2008-01-02 Wed] Meeting with Team to Design New System
-** Client Bar (Jan 01 - Jan 15)
-*** [2008-01-01 Tue] Searched for Widgets on Google
-*** [2008-01-02 Wed] Billed You for Taking a Nap
-
-In this layout, invoices begin at level two, and invoice
-items (tasks) are at level three. You'll notice that each level
-three heading starts with an inactive timestamp. The timestamp
-can actually go anywhere you want, either in the heading, or in
-the text under the heading. But you must have a timestamp
-somewhere so that the invoice report can group your items by
-date.
-
-Properties are used to collect various bits of information for
-the invoice. All properties can be set on the invoice item
-headings, or anywhere in the tree. The invoice report will scan
-up the tree looking for each of the properties.
-
-Properties used:
-
-CLOCKSUM: You can use the Org clock-in and clock-out commands to
- create a CLOCKSUM property. Also see WORK.
-
-WORK: An alternative to the CLOCKSUM property. This property
- should contain the amount of work that went into this
- invoice item formatted as HH:MM (e.g. 01:30).
-
-RATE: Used to calculate the total price for an invoice item.
- Should be the price per hour that you charge (e.g. 45.00).
- It might make more sense to place this property higher in
- the hierarchy than on the invoice item headings.
-
-Using this information, a report is generated that details the
-items grouped by days. For each day you will be able to see the
-total number of hours worked, the total price, and the items
-worked on.
-
-You can place the invoice report anywhere in the tree you want.
-I place mine under a third-level heading like so:
-
-* Invoices
-** An Invoice Header
-*** [2008-11-25 Tue] An Invoice Item
-*** Invoice Report
-#+BEGIN: invoice
-#+END:"
- (interactive "P")
- (let ((report (org-invoice-in-report-p)))
- (when (and (not report) jump)
- (when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
- (org-show-entry)
- (beginning-of-line)
- (setq report (point))))
- (if report (goto-char report)
- (org-create-dblock (list :name "invoice")))
- (org-update-dblock)))
-
-(provide 'org-invoice)
diff --git a/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el
deleted file mode 100644
index 897216d..0000000
--- a/contrib/lisp/org-learn.el
+++ /dev/null
@@ -1,177 +0,0 @@
-;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
-
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-
-;; Author: John Wiegley <johnw at gnu dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 6.32trans
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; The file implements the learning algorithm described at
-;; https://supermemo.com/english/ol/sm5.htm, which is a system for reading
-;; material according to "spaced repetition". See
-;; https://en.wikipedia.org/wiki/Spaced_repetition for more details.
-;;
-;; To use, turn on state logging and schedule some piece of information you
-;; want to read. Then in the agenda buffer type
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-learn nil
- "Options concerning the learning code in Org-mode."
- :tag "Org Learn"
- :group 'org-progress)
-
-(defcustom org-learn-always-reschedule nil
- "If non-nil, always reschedule items, even if retention was \"perfect\"."
- :type 'boolean
- :group 'org-learn)
-
-(defcustom org-learn-fraction 0.5
- "Controls the rate at which EF is increased or decreased.
-Must be a number between 0 and 1 (the greater it is the faster
-the changes of the OF matrix)."
- :type 'float
- :group 'org-learn)
-
-(defun initial-optimal-factor (n ef)
- (if (= 1 n)
- 4
- ef))
-
-(defun get-optimal-factor (n ef of-matrix)
- (let ((factors (assoc n of-matrix)))
- (or (and factors
- (let ((ef-of (assoc ef (cdr factors))))
- (and ef-of (cdr ef-of))))
- (initial-optimal-factor n ef))))
-
-(defun set-optimal-factor (n ef of-matrix of)
- (let ((factors (assoc n of-matrix)))
- (if factors
- (let ((ef-of (assoc ef (cdr factors))))
- (if ef-of
- (setcdr ef-of of)
- (push (cons ef of) (cdr factors))))
- (push (cons n (list (cons ef of))) of-matrix)))
- of-matrix)
-
-(defun inter-repetition-interval (n ef &optional of-matrix)
- (let ((of (get-optimal-factor n ef of-matrix)))
- (if (= 1 n)
- of
- (* of (inter-repetition-interval (1- n) ef of-matrix)))))
-
-(defun modify-e-factor (ef quality)
- (if (< ef 1.3)
- 1.3
- (+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02)))))))
-
-(defun modify-of (of q fraction)
- (let ((temp (* of (+ 0.72 (* q 0.07)))))
- (+ (* (- 1 fraction) of) (* fraction temp))))
-
-(defun calculate-new-optimal-factor (interval-used quality used-of
- old-of fraction)
- "This implements the SM-5 learning algorithm in Lisp.
-INTERVAL-USED is the last interval used for the item in question.
-QUALITY is the quality of the repetition response.
-USED-OF is the optimal factor used in calculation of the last
-interval used for the item in question.
-OLD-OF is the previous value of the OF entry corresponding to the
-relevant repetition number and the E-Factor of the item.
-FRACTION is a number belonging to the range (0,1) determining the
-rate of modifications (the greater it is the faster the changes
-of the OF matrix).
-
-Returns the newly calculated value of the considered entry of the
-OF matrix."
- (let (;; the value proposed for the modifier in case of q=5
- (mod5 (/ (1+ interval-used) interval-used))
- ;; the value proposed for the modifier in case of q=2
- (mod2 (/ (1- interval-used) interval-used))
- ;; the number determining how many times the OF value will
- ;; increase or decrease
- modifier)
- (if (< mod5 1.05)
- (setq mod5 1.05))
- (if (< mod2 0.75)
- (setq mod5 0.75))
- (if (> quality 4)
- (setq modifier (1+ (* (- mod5 1) (- quality 4))))
- (setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality)))))
- (if (< modifier 0.05)
- (setq modifier 0.05))
- (setq new-of (* used-of modifier))
- (if (> quality 4)
- (if (< new-of old-of)
- (setq new-of old-of)))
- (if (< quality 4)
- (if (> new-of old-of)
- (setq new-of old-of)))
- (setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction))))
- (if (< new-of 1.2)
- (setq new-of 1.2)
- new-of)))
-
-(defvar initial-repetition-state '(-1 1 2.5 nil))
-
-(defun determine-next-interval (n ef quality of-matrix)
- (assert (> n 0))
- (assert (and (>= quality 0) (<= quality 5)))
- (if (< quality 3)
- (list (inter-repetition-interval n ef) (1+ n) ef nil)
- (let ((next-ef (modify-e-factor ef quality)))
- (setq of-matrix
- (set-optimal-factor n next-ef of-matrix
- (modify-of (get-optimal-factor n ef of-matrix)
- quality org-learn-fraction))
- ef next-ef)
- ;; For a zero-based quality of 4 or 5, don't repeat
- (if (and (>= quality 4)
- (not org-learn-always-reschedule))
- (list 0 (1+ n) ef of-matrix)
- (list (inter-repetition-interval n ef of-matrix) (1+ n)
- ef of-matrix)))))
-
-(defun org-smart-reschedule (quality)
- (interactive "nHow well did you remember the information (on a scale of
0-5)? ")
- (let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
- (learn-data (or (and learn-str
- (read learn-str))
- (copy-list initial-repetition-state)))
- closed-dates)
- (setq learn-data
- (determine-next-interval (nth 1 learn-data)
- (nth 2 learn-data)
- quality
- (nth 3 learn-data)))
- (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
- (if (= 0 (nth 0 learn-data))
- (org-schedule t)
- (org-schedule nil (time-add (current-time)
- (days-to-time (nth 0 learn-data)))))))
-
-(provide 'org-learn)
-
-;;; org-learn.el ends here
diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el
deleted file mode 100644
index 4d61ae3..0000000
--- a/contrib/lisp/org-license.el
+++ /dev/null
@@ -1,540 +0,0 @@
-;;; org-license.el --- Add a license to your org files
-
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
-
-;; Author: David Arroyo Menéndez <davidam@es.gnu.org>
-;; Keywords: licenses, creative commons
-;; Homepage: https://orgmode.org
-;;
-;; This file is not part of GNU Emacs, yet.
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file implements functions to add a license fast in org files.
-;; Org-mode doesn't load this module by default - if this is not what
-;; you want, configure the variable `org-modules'. Thanks to #emacs-es
-;; irc channel for your support.
-
-;;; Code:
-
-;;
-;;
-;; You can download the images from http://www.davidam/img/licenses.tar.gz
-;;
-;;; CHANGELOG:
-;; v 0.2 - add public domain functions
-;; v 0.1 - Initial release
-
-
-(defvar org-license-images-directory "")
-
-(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/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/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/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")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/eo/deed.eo";)
- (insert (concat "* Licenco
-Ĉi tiu verko estas disponebla laŭ la permesilo [[" org-license-cc-url "][Krea
Komunaĵo Atribuite 3.0 Neadaptita]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/es/deed.es";)
- (insert (concat "* Licencia
-Este documento está bajo una [[" org-license-cc-url "][Licencia Creative
Commons Atribución 3.0 España]]\n")))
- ((equal language "eu")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/es/deed.eu";)
- (insert (concat "* Licenzua
-Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz
erabil daiteke\n")))
- ((equal language "fi")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/1.0/fi/deed.fi";)
- (insert (concat "* Lisenssi
-Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]]
lisenssillä\n")))
- ((equal language "fr")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/fr/deed.fr";)
- (insert (concat "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は [[" org-license-cc-url "][Creative Commons Attribution 2.1 ]]
ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://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
- (setq org-license-cc-url
"https://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:https://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"))))
-
-(defun org-license-cc-by-sa (language)
- (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | 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";)
- (concat (insert "* Licença
-Este texto é disponibilizado nos termos da licença [[" org-license-cc-url
"][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
- ((equal language "ca")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca";)
- (insert (concat "* Licència
-El text està disponible sota la [[" org-license-cc-url
"][Reconeixement-CompartirIgual 3.0 Espanya]]\n")))
- ((equal language "de")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/de/deed.de";)
- (insert (concat "* Lizenz
-Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url
"][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/es/deed.es";)
- (concat (insert "* Licencia
-Este documento está bajo una [[" org-license-cc-url "][Licencia Creative
Commons Atribución Compartir por Igual 3.0 España]]\n")))
- ((equal language "eu")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/es/deed.eu";)
- (concat (insert "* Licenzua
-Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]]
lizentziari jarraituz erabil daiteke\n")))
- ((equal language "fi")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/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")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr";)
- (concat (insert "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les
Mêmes Conditions 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione - Condividi allo stesso modo 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は、[[" org-license-cc-url "][Creative Commons Attribution 2.1 ]]
ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding Gelijk Delen 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt";)
- (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
"https://creativecommons.org/licenses/by-sa/4.0/deed";)
- (insert (concat "* License
-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:https://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"))))
-
-(defun org-license-cc-by-nd (language)
- (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | pt ):
" language)
- (cond ((equal language "br")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR";)
- (insert (concat "* Licença
-Este texto é disponibilizado nos termos da licença [[" org-license-cc-url
"][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
- ((equal language "ca")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/es/deed.ca";)
- (insert (concat "* Licència
-El text està disponible sota la [[" org-license-cc-url
"][Reconeixement-SenseObraDerivada 3.0 Espanya]]\n")))
- ((equal language "de")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/de/deed.de";)
- (insert (concat "* Lizenz
-Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url
"][Namensnennung-Keine Bearbeitung 3.0 Deutschland]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/es/deed.es";)
- (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
"https://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
"https://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")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr";)
- (insert (concat "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution - Pas de
Modification 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は、[[" org-license-cc-url "][Creative Commons No Derivatives 2.1]]
ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding GeenAfgeleideWerken 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt";)
- (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
"https://creativecommons.org/licenses/by-nd/4.0/deed";)
- (insert (concat "* License
-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:https://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"))))
-
-
-(defun org-license-cc-by-nc (language)
- (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp |
nl | pt ): " language)
- (cond ((equal language "br")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR";)
- (insert (concat "* Licença
-Este texto é disponibilizado nos termos da licença [[" org-license-cc-url
"][Atribuição Não Comercial 3.0 Brasil]]\n")))
- ((equal language "ca")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/es/deed.ca";)
- (insert (concat "* Licència
-El text està disponible sota la [[" org-license-cc-url
"][Reconeixement-NoComercial 3.0 Espanya]]\n")))
- ((equal language "de")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/de/deed.de";)
- (insert (concat "* Lizenz
-Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url
"][Namensnennung-Nicht-kommerziell 3.0 Deutschland]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/es/deed.es";)
- (insert (concat "* Licencia
-Este documento está bajo una [[" org-license-cc-url "][Licencia Creative
Commons Reconocimiento-NoComercial 3.0]]\n")))
- ((equal language "eu")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/es/deed.eu";)
- (insert "* Licenzua
-Testua [[" org-license-cc-url "][Aitortu-EzKomertziala 3.0 Espainia]]
lizentziari jarraituz erabil daiteke\n"))
- ((equal language "fi")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi";)
- (insert (concat "* Lisenssi
-Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen 1.0
Suomi]] lisenssillä\n")))
- ((equal language "fr")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr";)
- (insert (concat "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution - Pas d'Utilisation
Commerciale 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione - Non commerciale 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は、[[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 2.1
]] ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding NietCommercieel 3.0 Nederland 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt";)
- (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
"https://creativecommons.org/licenses/by-nc/4.0/deed";)
- (insert (concat "* License
-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:https://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"))))
-
-(defun org-license-cc-by-nc-sa (language)
- (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it |
jp | nl | pt ): " language)
- (cond ((equal language "br")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR";)
- (insert (concat "* Licença
-Este texto é disponibilizado nos termos da licença [[" org-license-cc-url
"][Atribuição Não Comercial - Compartil ha Igual 3.0 Brasil]]\n")))
- ((equal language "ca")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca";)
- (insert (concat "* Licència
-El text està disponible sota la [[" org-license-cc-url
"][Reconeixement-NoComercial 3.0 Espanya]]\n")))
- ((equal language "de")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de";)
- (insert (concat "* Lizenz
-Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url
"][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es";)
- (insert (concat "* Licencia
-Este documento está bajo una [[" org-license-cc-url "][Licencia Creative
Commons Reconocimiento-NoComercial 3.0]]\n")))
- ((equal language "eu")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu";)
- (insert "* Licenzua
-Testua [[" org-license-cc-url "][Aitortu-EzKomertziala-PartekatuBerdin 3.0
Espainia]] lizentziari jarraituz erabil daiteke\n"))
- ((equal language "fi")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi";)
- (insert (concat "* Lisenssi
-Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen-JaaSamoin
1.0 Suomi]] lisenssillä\n")))
- ((equal language "fr")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr";)
- (insert (concat "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution - Pas d’Utilisation
Commerciale - Partage dans les Mêmes Conditions 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は、[[" org-license-cc-url "][License Creative Commons Attribution Non
Commercial Share Alike 2.1 ]] ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding NietCommercieel GelijkDelen 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt";)
- (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
"https://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 4.0 International]]\n"))))
- (if (string= "" org-license-images-directory)
- (insert (concat "\n[[" org-license-cc-url
"][file:https://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"))))
-
-(defun org-license-cc-by-nc-nd (language)
- (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it |
pt ): " language)
- (cond ((equal language "br")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt";)
- (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 Brasil]]\n")))
- ((equal language "ca")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca";)
- (insert (concat "* Licència
-El text està disponible sota la [[" org-license-cc-url
"][Reconeixement-NoComercial-SenseObraDerivada 3.0 Espanya]]\n")))
- ((equal language "de")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de";)
- (insert (concat "* Lizenz
-Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url
"][Namensnennung-NichtKommerziell-KeineBearbeitung 3.0 Deutschland]]\n")))
- ((equal language "es")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es";)
- (insert (concat "* Licencia
-Este documento está bajo una [[" org-license-cc-url "][Licencia Creative
Commons Reconocimiento-NoComercial-SinObraDerivada 3.0]]\n")))
- ((equal language "eu")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-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
"https://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi";)
- (insert (concat "* Lisenssi
-Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Ei
muutoksia-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
- ((equal language "fr")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr";)
- (insert (concat "* Licence
-Ce(tte) œuvre est mise à disposition selon les termes de la [["
org-license-cc-url "][Licence Creative Commons Attribution - Pas de
Modification 3.0 France]]\n")))
- ((equal language "gl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl";)
- (insert (concat "* Licenza
-Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza
Creative Commons recoñecemento compartir igual 3.0]].\n")))
- ((equal language "it")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it";)
- (insert (concat "* Licenza
-Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza
Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
- ((equal language "jp")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en";)
- (insert (concat "* ライセンス
-この文書は [[" org-license-cc-url "][License Creative Commons Attribution Non
Commercial - No Derivs 2.1]] ライセンスの下である\n")))
- ((equal language "nl")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl";)
- (insert (concat "* Licentie
-Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons
Naamsvermelding NietCommercieel GeenAfgeleideWerken 3.0 Nederland]]\n")))
- ((equal language "pt")
- (setq org-license-cc-url
"https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt";)
- (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
"https://creativecommons.org/licenses/by-nc-nd/4.0/deed";)
- (insert (concat "* License
-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:https://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"))))
-
-(defun org-license-gfdl (language)
- (interactive "MLanguage (es | en): " language)
- (cond ((equal language "es")
- (insert "* Licencia
-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) " (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;
- with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
- A copy of the license is included in
[[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation
License]].\n"))))
- (if (string= "" org-license-images-directory)
- (insert
"\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n";)
- (insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:";
org-license-images-directory "/gfdl/gfdl.png]]\n"))))
-
-(defun org-license-publicdomain-zero (language)
- (interactive "MLanguage ( en | es ): " language)
- (setq org-license-pd-url
"https://creativecommons.org/publicdomain/zero/1.0/";)
- (setq org-license-pd-file "zero/1.0/80x15.png")
- (if (equal language "es")
- (insert (concat "* Licencia
-Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain
Zero]]\n"))
- (insert (concat "* License
-This documento is under a [[" org-license-pd-url "][Public Domain Zero]]
license\n")))
- (if (string= "" org-license-images-directory)
- (insert (concat "\n[[" org-license-pd-url
"][file:https://i.creativecommons.org/p/zero/1.0/80x15.png]]\n";))
- (insert (concat "\n[[" org-license-pd-url "][file:"
org-license-images-directory org-license-pd-file "]]\n"))))
-
-(defun org-license-publicdomain-mark (language)
- (interactive "MLanguage ( en | es ): " language)
- (setq org-license-pd-url
"https://creativecommons.org/publicdomain/mark/1.0/";)
- (setq org-license-pd-file "mark/1.0/80x15.png")
- (if (equal language "es")
- (insert (concat "* Licencia
-Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de
Dominio Público 1.0]]\n"))
- (insert (concat "* License
-This documento is under a [[" org-license-pd-url "][Public Domain Mark]]
license\n")))
- (if (string= "" org-license-images-directory)
- (insert (concat "\n[[" org-license-pd-url
"][file:https://i.creativecommons.org/p/mark/1.0/80x15.png]]\n";))
- (insert (concat "\n[[" org-license-pd-url "][file:"
org-license-images-directory org-license-pd-file "]]\n"))))
-
-(defun org-license-print-all ()
-"Print all combinations of licenses and languages, it's useful to find bugs"
- (interactive)
- (org-license-gfdl "es")
- (org-license-gfdl "en")
- (org-license-publicdomain-mark "es")
- (org-license-publicdomain-mark "en")
- (org-license-publicdomain-zero "es")
- (org-license-publicdomain-zero "en")
- (org-license-cc-by "br")
- (org-license-cc-by "ca")
- (org-license-cc-by "de")
- (org-license-cc-by "es")
- (org-license-cc-by "en")
- (org-license-cc-by "eo")
- (org-license-cc-by "eu")
- (org-license-cc-by "fi")
- (org-license-cc-by "fr")
- (org-license-cc-by "gl")
- (org-license-cc-by "it")
- (org-license-cc-by "jp")
- (org-license-cc-by "nl")
- (org-license-cc-by "pt")
- (org-license-cc-by-sa "br")
- (org-license-cc-by-sa "ca")
- (org-license-cc-by-sa "de")
- (org-license-cc-by-sa "es")
- (org-license-cc-by-sa "en")
-;; (org-license-cc-by-sa "eo")
- (org-license-cc-by-sa "eu")
- (org-license-cc-by-sa "fi")
- (org-license-cc-by-sa "fr")
- (org-license-cc-by-sa "gl")
- (org-license-cc-by-sa "it")
- (org-license-cc-by-sa "jp")
- (org-license-cc-by-sa "nl")
- (org-license-cc-by-sa "pt")
- (org-license-cc-by-nd "br")
- (org-license-cc-by-nd "ca")
- (org-license-cc-by-nd "de")
- (org-license-cc-by-nd "es")
- (org-license-cc-by-nd "en")
-;; (org-license-cc-by-nd "eo")
- (org-license-cc-by-nd "eu")
- (org-license-cc-by-nd "fi")
- (org-license-cc-by-nd "fr")
- (org-license-cc-by-nd "gl")
- (org-license-cc-by-nd "it")
- (org-license-cc-by-nd "jp")
- (org-license-cc-by-nd "nl")
- (org-license-cc-by-nd "pt")
- (org-license-cc-by-nc "br")
- (org-license-cc-by-nc "ca")
- (org-license-cc-by-nc "de")
- (org-license-cc-by-nc "es")
- (org-license-cc-by-nc "en")
-;; (org-license-cc-by-nc "eo")
- (org-license-cc-by-nc "eu")
- (org-license-cc-by-nc "fi")
- (org-license-cc-by-nc "fr")
- (org-license-cc-by-nc "gl")
- (org-license-cc-by-nc "it")
- (org-license-cc-by-nc "jp")
- (org-license-cc-by-nc "nl")
- (org-license-cc-by-nc "pt")
- (org-license-cc-by-nc-sa "br")
- (org-license-cc-by-nc-sa "ca")
- (org-license-cc-by-nc-sa "de")
- (org-license-cc-by-nc-sa "es")
- (org-license-cc-by-nc-sa "en")
-;; (org-license-cc-by-nc-sa "eo")
- (org-license-cc-by-nc-sa "eu")
- (org-license-cc-by-nc-sa "fi")
- (org-license-cc-by-nc-sa "fr")
- (org-license-cc-by-nc-sa "gl")
- (org-license-cc-by-nc-sa "it")
- (org-license-cc-by-nc-sa "jp")
- (org-license-cc-by-nc-sa "nl")
- (org-license-cc-by-nc-sa "pt")
- (org-license-cc-by-nc-nd "br")
- (org-license-cc-by-nc-nd "ca")
- (org-license-cc-by-nc-nd "de")
- (org-license-cc-by-nc-nd "es")
- (org-license-cc-by-nc-nd "en")
-;; (org-license-cc-by-nc-nd "eo")
- (org-license-cc-by-nc-nd "eu")
- (org-license-cc-by-nc-nd "fi")
- (org-license-cc-by-nc-nd "fr")
- (org-license-cc-by-nc-nd "gl")
- (org-license-cc-by-nc-nd "it")
- (org-license-cc-by-nc-nd "jp")
- (org-license-cc-by-nc-nd "nl")
- (org-license-cc-by-nc-nd "pt")
-)
-
-
diff --git a/contrib/lisp/org-link-edit.el b/contrib/lisp/org-link-edit.el
deleted file mode 100644
index a27a13d..0000000
--- a/contrib/lisp/org-link-edit.el
+++ /dev/null
@@ -1,392 +0,0 @@
-;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding:
t; -*-
-
-;; Copyright (C) 2015-2020 Kyle Meyer <kyle@kyleam.com>
-
-;; Author: Kyle Meyer <kyle@kyleam.com>
-;; URL: https://git.kyleam.com/org-link-edit/about
-;; Keywords: convenience
-;; Version: 1.2.1
-;; Package-Requires: ((cl-lib "0.5") (org "9.3"))
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org Link Edit provides Paredit-inspired slurping and barfing
-;; commands for Org link descriptions.
-;;
-;; There are four slurp and barf 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")))
-;;
-;; In addition to the slurp and barf commands, the command
-;; `org-link-edit-transport-next-link' searches for the next (or
-;; previous) link and moves it to point, using the word at point or
-;; the selected region as the link's description.
-;;
-;; [1] https://github.com/abo-abo/hydra
-
-;;; Code:
-
-(require 'org)
-(require 'org-element)
-(require 'cl-lib)
-
-(defun org-link-edit--on-link-p (&optional element)
- (org-element-lineage (or element (org-element-context)) '(link) t))
-
-(defun org-link-edit--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)))
- (unless (org-link-edit--on-link-p el)
- (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-link-bracket-re)
- (list (match-beginning 0)
- (match-end 0)
- (save-match-data
- (org-link-unescape (match-string-no-properties 1)))
- (or (match-string-no-properties 2) "")))
- ((looking-at org-link-plain-re)
- (list (match-beginning 0)
- (match-end 0)
- (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 \[\[https://orgmode.org/\]\[Org mode\]\] site
-
- |
- v
-
- The \[\[https://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--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-link-make-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 \[\[https://orgmode.org/\]\[Org mode\]\] site
-
- |
- v
-
- \[\[https://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--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-link-make-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 \[\[https://orgmode.org/\]\[Org mode\]\] site
-
- |
- v
-
- The \[\[https://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--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"))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-link-make-string link new-desc))
- (when (string= new-desc "")
- (setq barfed (concat " " barfed)))
- (insert barfed)
- (goto-char beg)
- barfed)))))
-
-;;;###autoload
-(defun org-link-edit-backward-barf (&optional n)
- "Barf N leading blobs from link's description.
-
- The \[\[https://orgmode.org/\]\[Org mode\]\] site
-
- |
- v
-
- The Org \[\[https://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--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"))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-link-make-string link new-desc))
- (when (string= new-desc "")
- (setq barfed (concat barfed " ")))
- (goto-char beg)
- (insert barfed)
- barfed)))))
-
-(defun org-link-edit--next-link-data (&optional previous)
- (save-excursion
- (if (funcall (if previous #'re-search-backward #'re-search-forward)
- org-link-any-re nil t)
- (org-link-edit--link-data)
- (user-error "No %s link found" (if previous "previous" "next")))))
-
-;;;###autoload
-(defun org-link-edit-transport-next-link (&optional previous beg end overwrite)
- "Move the next link to point.
-
-If the region is active, use the selected text as the link's
-description. Otherwise, use the word at point.
-
-With prefix argument PREVIOUS, move the previous link instead of
-the next link.
-
-Non-interactively, use the text between BEG and END as the
-description, moving the next (or previous) link relative to BEG
-and END. By default, refuse to overwrite an existing
-description. If OVERWRITE is `ask', prompt for confirmation
-before overwriting; for any other non-nil value, overwrite
-without asking."
- (interactive `(,current-prefix-arg
- ,@(if (use-region-p)
- (list (region-beginning) (region-end))
- (list nil nil))
- ask))
- (let ((pt (point))
- (desc-bounds (cond
- ((and beg end)
- (cons (progn (goto-char beg)
- (point-marker))
- (progn (goto-char end)
- (point-marker))))
- ((not (looking-at-p "\\s-"))
- (progn (skip-syntax-backward "w")
- (let ((beg (point-marker)))
- (skip-syntax-forward "w")
- (cons beg (point-marker))))))))
- (when (or (and desc-bounds
- (or (progn (goto-char (car desc-bounds))
- (org-link-edit--on-link-p))
- (progn (goto-char (cdr desc-bounds))
- (org-link-edit--on-link-p))))
- (progn (goto-char pt)
- (org-link-edit--on-link-p)))
- (user-error "Cannot transport next link with point on a link"))
- (goto-char (or (car desc-bounds) pt))
- (cl-multiple-value-bind (link-beg link-end link orig-desc)
- (org-link-edit--next-link-data previous)
- (unless (or (not desc-bounds)
- (= (length orig-desc) 0)
- (if (eq overwrite 'ask)
- (y-or-n-p "Overwrite existing description?")
- overwrite))
- (user-error "Link already has a description"))
- (delete-region link-beg link-end)
- (insert (org-link-make-string
- link
- (if desc-bounds
- (delete-and-extract-region (car desc-bounds)
- (cdr desc-bounds))
- orig-desc))))))
-
-(provide 'org-link-edit)
-;;; org-link-edit.el ends here
diff --git a/contrib/lisp/org-mac-iCal.el b/contrib/lisp/org-mac-iCal.el
deleted file mode 100644
index 88e8400..0000000
--- a/contrib/lisp/org-mac-iCal.el
+++ /dev/null
@@ -1,250 +0,0 @@
-;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-
-;; Copyright (C) 2009-2014 Christopher Suckling
-
-;; Author: Christopher Suckling <suckling at gmail dot com>
-;; Version: 0.1057.104
-;; Keywords: outlines, calendar
-
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This file provides the import of events from Mac OS X 10.5 iCal.app
-;; into the Emacs diary (it is not compatible with OS X < 10.5). The
-;; function org-mac-iCal will import events in all checked iCal.app
-;; calendars for the date range org-mac-iCal-range months, centered
-;; around the current date.
-;;
-;; CAVEAT: This function is destructive; it will overwrite the current
-;; contents of the Emacs diary.
-;;
-;; Installation: add (require 'org-mac-iCal) to your .emacs.
-;;
-;; If you view Emacs diary entries in org-agenda, the following hook
-;; will ensure that all-day events are not orphaned below TODO items
-;; and that any supplementary fields to events (e.g. Location) are
-;; grouped with their parent event
-;;
-;; (add-hook 'org-agenda-cleanup-fancy-diary-hook
-;; (lambda ()
-;; (goto-char (point-min))
-;; (save-excursion
-;; (while (re-search-forward "^[a-z]" nil t)
-;; (goto-char (match-beginning 0))
-;; (insert "0:00-24:00 ")))
-;; (while (re-search-forward "^ [a-z]" nil t)
-;; (goto-char (match-beginning 0))
-;; (save-excursion
-;; (re-search-backward "^[0-9]+:[0-9]+-[0-9]+:[0-9]+ " nil t))
-;; (insert (match-string 0)))))
-
-;;; Code:
-
-(defcustom org-mac-iCal-range 2
- "The range in months to import iCal.app entries into the Emacs
-diary. The import is centered around today's date; thus a value
-of 2 imports entries for one month before and one month after
-today's date"
- :group 'org-time
- :type 'integer)
-
-(defun org-mac-iCal ()
- "Selects checked calendars in iCal.app and imports them into
-the the Emacs diary"
- (interactive)
-
- ;; kill diary buffers then empty diary files to avoid duplicates
- (setq currentBuffer (buffer-name))
- (setq openBuffers (mapcar (function buffer-name) (buffer-list)))
- (omi-kill-diary-buffer openBuffers)
- (with-temp-buffer
- (insert-file-contents diary-file)
- (delete-region (point-min) (point-max))
- (write-region (point-min) (point-max) diary-file))
-
- ;; determine available calendars
- (setq caldav-folders (directory-files "~/Library/Calendars" 1 ".*caldav$"))
- (setq caldav-calendars nil)
- (mapc
- (lambda (x)
- (setq caldav-calendars (nconc caldav-calendars (directory-files x 1
".*calendar$"))))
- caldav-folders)
-
- (setq local-calendars nil)
- (setq local-calendars (directory-files "~/Library/Calendars" 1
".*calendar$"))
-
- (setq all-calendars (append caldav-calendars local-calendars))
-
- ;; parse each calendar's Info.plist to see if calendar is checked in iCal
- (setq all-calendars (delq 'nil (mapcar
- (lambda (x)
- (omi-checked x))
- all-calendars)))
-
- ;; for each calendar, concatenate individual events into a single ics file
- (with-temp-buffer
- (shell-command "sw_vers" (current-buffer))
- (when (re-search-backward "10\\.[5678]" nil t)
- (omi-concat-leopard-ics all-calendars)))
-
- ;; move all caldav ics files to the same place as local ics files
- (mapc
- (lambda (x)
- (mapc
- (lambda (y)
- (rename-file (concat x "/" y);
- (concat "~/Library/Calendars/" y)))
- (directory-files x nil ".*ics$")))
- caldav-folders)
-
- ;; check calendar has contents and import
- (setq import-calendars (directory-files "~/Library/Calendars" 1 ".*ics$"))
- (mapc
- (lambda (x)
- (when (/= (nth 7 (file-attributes x 'string)) 0)
- (omi-import-ics x)))
- import-calendars)
-
- ;; tidy up intermediate files and buffers
- (setq usedCalendarsBuffers (mapcar (function buffer-name) (buffer-list)))
- (omi-kill-ics-buffer usedCalendarsBuffers)
- (setq usedCalendarsFiles (directory-files "~/Library/Calendars" 1 ".*ics$"))
- (omi-delete-ics-file usedCalendarsFiles)
-
- (org-pop-to-buffer-same-window currentBuffer))
-
-(defun omi-concat-leopard-ics (list)
- "Leopard stores each iCal.app event in a separate ics file.
-Whilst useful for Spotlight indexing, this is less helpful for
-icalendar-import-file. omi-concat-leopard-ics concatenates these
-individual event files into a single ics file"
- (mapc
- (lambda (x)
- (setq omi-leopard-events (directory-files (concat x "/Events") 1
".*ics$"))
- (with-temp-buffer
- (mapc
- (lambda (y)
- (insert-file-contents (expand-file-name y)))
- omi-leopard-events)
- (write-region (point-min) (point-max) (concat (expand-file-name x)
".ics"))))
- list))
-
-(defun omi-import-ics (string)
- "Imports an ics file into the Emacs diary. First tidies up the
-ics file so that it is suitable for import and selects a sensible
-date range so that Emacs calendar view doesn't grind to a halt"
- (with-temp-buffer
- (insert-file-contents string)
- (goto-char (point-min))
- (while
- (re-search-forward "^BEGIN:VCALENDAR$" nil t)
- (setq startEntry (match-beginning 0))
- (re-search-forward "^END:VCALENDAR$" nil t)
- (setq endEntry (match-end 0))
- (save-restriction
- (narrow-to-region startEntry endEntry)
- (goto-char (point-min))
- (re-search-forward
"\\(^DTSTART;.*:\\)\\([0-9][0-9][0-9][0-9]\\)\\([0-9][0-9]\\)" nil t)
- (if (or (eq (match-string 2) nil) (eq (match-string 3) nil))
- (progn
- (setq yearEntry 1)
- (setq monthEntry 1))
- (setq yearEntry (string-to-number (match-string 2)))
- (setq monthEntry (string-to-number (match-string 3))))
- (setq year (string-to-number (format-time-string "%Y")))
- (setq month (string-to-number (format-time-string "%m")))
- (setq now (list month 1 year))
- (setq entryDate (list monthEntry 1 yearEntry))
- ;; Check to see if this is a repeating event
- (goto-char (point-min))
- (setq isRepeating (re-search-forward "^RRULE:" nil t))
- ;; Delete if outside range and not repeating
- (when (and
- (not isRepeating)
- (> (abs (- (calendar-absolute-from-gregorian now)
- (calendar-absolute-from-gregorian entryDate)))
- (* (/ org-mac-iCal-range 2) 30))
- (delete-region startEntry endEntry)))
- (goto-char (point-max))))
- (while
- (re-search-forward "^END:VEVENT$" nil t)
- (delete-blank-lines))
- (goto-line 1)
- (insert "BEGIN:VCALENDAR\n\n")
- (goto-line 2)
- (while
- (re-search-forward "^BEGIN:VCALENDAR$" nil t)
- (replace-match "\n"))
- (goto-line 2)
- (while
- (re-search-forward "^END:VCALENDAR$" nil t)
- (replace-match "\n"))
- (insert "END:VCALENDAR")
- (goto-line 1)
- (delete-blank-lines)
- (while
- (re-search-forward "^END:VEVENT$" nil t)
- (delete-blank-lines))
- (goto-line 1)
- (while
- (re-search-forward "^ORG.*" nil t)
- (replace-match "\n"))
- (goto-line 1)
- (write-region (point-min) (point-max) string))
-
- (icalendar-import-file string diary-file))
-
-(defun omi-kill-diary-buffer (list)
- (mapc
- (lambda (x)
- (if (string-match "^diary" x)
- (kill-buffer x)))
- list))
-
-(defun omi-kill-ics-buffer (list)
- (mapc
- (lambda (x)
- (if (string-match "ics$" x)
- (kill-buffer x)))
- list))
-
-(defun omi-delete-ics-file (list)
- (mapc
- (lambda (x)
- (delete-file x))
- list))
-
-(defun omi-checked (directory)
- "Parse Info.plist in iCal.app calendar folder and determine
-whether Checked key is 1. If Checked key is not 1, remove
-calendar from list of calendars for import"
- (let* ((root (xml-parse-file (car (directory-files directory 1
"Info.plist"))))
- (plist (car root))
- (dict (car (xml-get-children plist 'dict)))
- (keys (cdr (xml-node-children dict)))
- (keys (mapcar
- (lambda (x)
- (cond ((listp x)
- x)))
- keys))
- (keys (delq 'nil keys)))
- (when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
- directory)))
-
-(provide 'org-mac-iCal)
-
-;;; org-mac-iCal.el ends here
diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el
deleted file mode 100644
index 6809e84..0000000
--- a/contrib/lisp/org-mac-link.el
+++ /dev/null
@@ -1,1020 +0,0 @@
-;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac
apps
-;;
-;; Copyright (c) 2010-2021 Free Software Foundation, Inc.
-;;
-;; 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
-;; Keywords: org, mac, hyperlink
-;;
-;; Version: 1.2
-;; Keywords: outlook
-;; 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
-;; 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 <https://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; This code allows you to grab either the current selected items, or
-;; the frontmost url in various mac appliations, and insert them as
-;; hyperlinks into the current org-mode document at point.
-;;
-;; This code is heavily based on, and indeed incorporates,
-;; org-mac-message.el written by John Wiegley and Christopher
-;; Suckling.
-;;
-;; Detailed comments for each application interface are inlined with
-;; the code. Here is a brief overview of how the code interacts with
-;; each application:
-;;
-;; Finder.app - grab links to the selected files in the frontmost window
-;; Mail.app - grab links to the selected messages in the message list
-;; AddressBook.app - Grab links to the selected addressbook Cards
-;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost
window
-;; Safari.app - Grab the url of the frontmost tab in the frontmost window
-;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost
window
-;; Brave.app - Grab the url of the frontmost tab in the frontmost window
-;; 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:
-;;
-;; add (require 'org-mac-link) to your .emacs, and optionally bind a
-;; key to activate the link grabber menu, like this:
-;;
-;; (add-hook 'org-mode-hook (lambda ()
-;; (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)))
-;;
-;; Usage:
-;;
-;; Type C-c g (or whatever key you defined, as above), or type M-x
-;; org-mac-grab-link RET to activate the link grabber. This will present
-;; you with a menu to choose an application from which to grab a link
-;; to insert at point. You may also type C-g to abort.
-;;
-;; Customizing:
-;;
-;; You may customize which applications appear in the grab menu by
-;; customizing the group `org-mac-link'. Changes take effect
-;; immediately.
-;;
-;;
-;;; Code:
-
-(require 'org)
-
-(defgroup org-mac-link nil
- "Options for grabbing links from Mac applications."
- :tag "Org Mac link"
- :group 'org-link)
-
-(defcustom org-mac-grab-Finder-app-p t
- "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
- "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
- "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
- "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
- "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
- "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
- "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
- "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-Brave-app-p t
- "Add menu option [b]rave to grab links from Brave.app."
- :tag "Grab Brave.app links"
- :group 'org-mac-link
- :type 'boolean)
-
-(defcustom org-mac-grab-Together-app-p nil
- "Add menu option [t]ogether to grab links from Together.app."
- :tag "Grab Together.app links"
- :group 'org-mac-link
- :type 'boolean)
-
-(defcustom org-mac-grab-Skim-app-p
- (< 0 (length (shell-command-to-string
- "mdfind kMDItemCFBundleIdentifier ==
'net.sourceforge.skim-app.skim'")))
- "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 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 foring linking to flagged Mail.app messages."
- :tag "Org Mail.app"
- :group 'org-link)
-
-(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 nil
- "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 nil
- "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))
-(unless (fboundp 'do-applescript)
- ;; Need to fake this using shell-command-to-string
- (defun do-applescript (script)
- (let (start cmd return)
- (while (string-match "\n" script)
- (setq script (replace-match "\r" t t script)))
- (while (string-match "'" script start)
- (setq start (+ 2 (match-beginning 0))
- script (replace-match "\\'" t t script)))
- (setq cmd (concat "osascript -e '" script "'"))
- (setq return (shell-command-to-string cmd))
- (concat "\"" (org-trim return) "\""))))
-
-;;;###autoload
-(defun org-mac-grab-link ()
- "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)
- ("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)
- ("b" "rave" org-mac-brave-insert-frontmost-url
,org-mac-grab-Brave-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)
- (when (elt descriptor 3)
- (setf menu-string (concat menu-string
- "[" (elt descriptor 0) "]"
- (elt descriptor 1) " "))))
- descriptors)
- (setf (elt menu-string (- (length menu-string) 1)) ?:)
-
- ;; Prompt the user, and grab the link
- (message menu-string)
- (setq input (read-char-exclusive))
- (mapc (lambda (descriptor)
- (let ((key (elt (elt descriptor 0) 0))
- (active (elt descriptor 3))
- (grab-function (elt descriptor 2)))
- (when (and active (eq input key))
- (call-interactively grab-function))))
- descriptors)))
-
-(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* ((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::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-
-;; Handle links from Firefox.app
-;;
-;; This code allows you to grab the current active url from the main
-;; Firefox.app window, and insert it as a link into an org-mode
-;; document. Unfortunately, firefox does not expose an applescript
-;; dictionary, so this is necessarily introduces some limitations.
-;;
-;; The applescript to grab the url from Firefox.app uses the System
-;; Events application to give focus to the firefox application, select
-;; the contents of the url bar, and copy it. It then uses the title of
-;; the window as the text of the link. There is no way to grab links
-;; from other open tabs, and further, if there is more than one window
-;; open, it is not clear which one will be used (though emperically it
-;; seems that it is always the last active window).
-
-(defun 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"))))
- (car (split-string result "[\r\n]+" t))))
-
-;;;###autoload
-(defun org-mac-firefox-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Firefox url...")
- (org-mac-paste-applescript-links (org-as-mac-firefox-get-frontmost-url)))
-
-;;;###autoload
-(defun org-mac-firefox-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-firefox-get-frontmost-url)))
-
-
-;; Handle links from Google Firefox.app running the Vimperator extension
-;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
-;; Firefox
-
-(defun 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)))))
-
-;;;###autoload
-(defun org-mac-vimperator-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Vimperator url...")
- (org-mac-paste-applescript-links (org-as-mac-vimperator-get-frontmost-url)))
-
-;;;###autoload
-(defun org-mac-vimperator-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-vimperator-get-frontmost-url)))
-
-
-;; Handle links from Google Chrome.app
-;; Grab the frontmost url from Google Chrome. Same limitations as
-;; 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)))))
-
-;;;###autoload
-(defun org-mac-chrome-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Chrome url...")
- (org-mac-paste-applescript-links (org-as-mac-chrome-get-frontmost-url)))
-
-;;;###autoload
-(defun org-mac-chrome-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-chrome-get-frontmost-url)))
-
-
-;; Handle links from Brave.app
-;; Grab the frontmost url from Brave. Same limitations as
-;; Firefox/Chrome because Brave doesn't publish an Applescript
-;; dictionary
-
-(defun org-as-mac-brave-get-frontmost-url ()
- (let ((result
- (do-applescript
- (concat
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Brave\"\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)))))
-
-;;;###autoload
-(defun org-mac-brave-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Brave url...")
- (org-mac-paste-applescript-links (org-as-mac-brave-get-frontmost-url)))
-
-;;;###autoload
-(defun org-mac-brave-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-brave-get-frontmost-url)))
-
-
-;; Handle links from Safari.app
-;; Grab the frontmost url from Safari.
-
-(defun org-as-mac-safari-get-frontmost-url ()
- (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")))
-
-;;;###autoload
-(defun org-mac-safari-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Safari url...")
- (org-mac-paste-applescript-links
- (org-as-mac-safari-get-frontmost-url)))
-
-;;;###autoload
-(defun org-mac-safari-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-safari-get-frontmost-url)))
-
-
-;; Handle links from together.app
-(org-link-set-parameters "x-together-item" :follow
#'org-mac-together-item-open)
-
-(defun org-mac-together-item-open (uid _)
- "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")))
-
-;;;###autoload
-(defun org-mac-together-get-selected ()
- (interactive)
- (message "Applescript: Getting Together items...")
- (org-mac-paste-applescript-links (as-get-selected-together-items)))
-
-;;;###autoload
-(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")))
-
-;;;###autoload
-(defun org-mac-finder-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Finder items...")
- (org-mac-paste-applescript-links (as-get-selected-finder-items)))
-
-;;;###autoload
-(defun org-mac-finder-insert-selected ()
- (interactive)
- (insert (org-mac-finder-item-get-selected)))
-
-
-;; Handle links from AddressBook.app
-(org-link-set-parameters "addressbook" :follow #'org-mac-addressbook-item-open)
-
-(defun org-mac-addressbook-item-open (uid _)
- "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")))
-
-;;;###autoload
-(defun org-mac-addressbook-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Address Book items...")
- (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
-
-;;;###autoload
-(defun org-mac-addressbook-insert-selected ()
- (interactive)
- (insert (org-mac-addressbook-item-get-selected)))
-
-
-;; Handle links from Skim.app
-;;
-;; Original code & idea by Christopher Suckling (org-mac-protocol)
-
-(org-link-set-parameters "skim" :follow #'org-mac-skim-open)
-
-(defun org-mac-skim-open (uri _)
- "Visit page of pdf in Skim"
- (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
- (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"))))
-
-(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
- "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")))
-
-;;;###autoload
-(defun org-mac-skim-get-page ()
- (interactive)
- (message "Applescript: Getting Skim page link...")
- (org-mac-paste-applescript-links (as-get-skim-page-link)))
-
-;;;###autoload
-(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-link-set-parameters "acrobat" :follow #'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")))
-
-;;;###autoload
-(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)))
-
-;;;###autoload
-(defun org-mac-acrobat-insert-page ()
- (interactive)
- (insert (org-mac-acrobat-get-page)))
-
-
-;; Handle links from Microsoft Outlook.app
-
-(org-link-set-parameters "mac-outlook" :follow #'org-mac-outlook-message-open)
-
-(defun org-mac-outlook-message-open (msgid _)
- "Open a message in Outlook"
- (do-applescript
- (concat
- "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 \"" org-mac-outlook-path "\"\n"
- "set msgCount to count current messages\n"
- "if (msgCount < 1) then\n"
- "return\n"
- "end if\n"
- "set theLinkList to {}\n"
- "set theSelection to (get current messages)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to id of theMessage as string\n"
- "set theURL to \"mac-outlook:\" & theID\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun org-sh-get-flagged-outlook-mail ()
- "Shell commands to create links to flagged messages in Microsoft
Outlook.app."
- (mapconcat
- (lambda (x) ""
- (concat
- "mac-outlook:"
- (mapconcat
- (lambda (y) "" y)
- (split-string
- (shell-command-to-string
- (format "mdls -raw -name com_microsoft_outlook_recordID -name
kMDItemDisplayName \"%s\"" x))
- "\000")
- "::split::")
- "\n"))
- (with-temp-buffer
- (let ((coding-system-for-read (or file-name-coding-system 'utf-8))
- (coding-system-for-write 'utf-8))
- (shell-command
- "mdfind com_microsoft_outlook_flagged==1"
- (current-buffer)))
- (split-string
- (buffer-string) "\n" t))
- ""))
-
-;;;###autoload
-(defun org-mac-outlook-message-get-links (&optional select-or-flag)
- "Create links to the messages currently selected or flagged in Microsoft
Outlook.app.
-This will use AppleScript to get the message-id and the subject of the
-messages in Microsoft Outlook.app and make a link out of it.
-When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
-the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
-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...")
- (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\"")))))
-
-;;;###autoload
-(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."
- (interactive)
- (insert (org-mac-outlook-message-get-links "s")))
-
-;;;###autoload
-(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."
- (interactive "bBuffer in which to insert links: \nsHeading after which to
insert links: ")
- (with-current-buffer org-buffer
- (goto-char (point-min))
- (let ((isearch-forward t)
- (message-re
"\\[\\[\\(mac-outlook:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
- (if (org-goto-local-search-headings org-heading nil t)
- (if (not (eobp))
- (progn
- (save-excursion
- (while (re-search-forward
- message-re (save-excursion (outline-next-heading)) t)
- (delete-region (match-beginning 0) (match-end 0)))
- (insert "\n" (org-mac-outlook-message-get-links "f")))
- (flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-outlook-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
-
-;; Handle links from Evernote.app
-
-(org-link-set-parameters "mac-evernote" :follow #'org-mac-evernote-note-open)
-
-(defun org-mac-evernote-path ()
- "Get path to evernote.
-First consider the value of ORG-MAC-EVERNOTE-PATH, then attempt to find it.
-Finding the path can be slow."
- (or org-mac-evernote-path
- (replace-regexp-in-string (rx (* (any " \t\n")) eos)
- ""
- (shell-command-to-string
- "mdfind kMDItemCFBundleIdentifier ==
'com.evernote.Evernote'"))))
-
-(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")))
-
-;;;###autoload
-(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-link-set-parameters "x-devonthink-item" :follow
#'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)))
-
-;;;###autoload
-(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-link-set-parameters "message" :follow #'org-mac-message-open)
-
-(defun org-mac-message-open (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://%3C" (substring message-id 2)
"%3E")))
-
-(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"
- "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
- ;; 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")))
-
-;;;###autoload
-(defun org-mac-message-get-links (&optional select-or-flag)
- "Create links to the messages currently selected or flagged in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-messages in Mail.app and make a link out of it.
-When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
-the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
-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...")
- (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\"")))))
-
-;;;###autoload
-(defun org-mac-message-insert-selected ()
- "Insert a link to the messages currently selected in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Mail.app and make a link out of it."
- (interactive)
- (insert (org-mac-message-get-links "s")))
-
-;; The following line is for backward compatibility
-(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
-
-;;;###autoload
-(defun org-mac-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 message:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of message:// 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))
- (let ((isearch-forward t)
- (message-re
"\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
- (if (org-goto-local-search-headings org-heading nil t)
- (if (not (eobp))
- (progn
- (save-excursion
- (while (re-search-forward
- message-re (save-excursion (outline-next-heading)) t)
- (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"))))))
-
-
-(provide 'org-mac-link)
-
-;;; org-mac-link.el ends here
diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el
deleted file mode 100644
index 66efee5..0000000
--- a/contrib/lisp/org-mairix.el
+++ /dev/null
@@ -1,333 +0,0 @@
-;;; org-mairix.el - Support for hooking mairix search into Org for different
MUAs
-;;
-;; Copyright (C) 2007-2014 Georg C. F. Greve
-;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; Author: Georg C. F. Greve <greve at fsfeurope dot org>
-;; Keywords: outlines, hypermedia, calendar, wp, email, mairix
-;; Purpose: Integrate mairix email searching into Org mode
-;; See https://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/
-;; Version: 0.5
-;;
-;; This file is Free Software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; It is distributed in the hope that it will be useful, but WITHOUT
-;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
-;; License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; USAGE NOTE
-;;
-;; You will need to configure mairix first, which involves setting up your
-;; .mairixrc in your home directory. Once it is working, you should set up
-;; your way to display results in your favorite way -- usually a MUA.
-;; Currently gnus and mutt are supported.
-;;
-;; After both steps are done, all you should need to hook mairix, org
-;; and your MUA together is to do (require 'org-mairix) in your
-;; startup file. Everything can then be configured normally through
-;; Emacs customisation.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-
-;;; The custom variables
-
-(defgroup org-mairix nil
- "Mairix support/integration in org."
- :tag "Org Mairix"
- :group 'org)
-
-(defcustom org-mairix-threaded-links t
- "Should new links be created as threaded links?
-If t, links will be stored as threaded searches.
-If nil, links will be stored as non-threaded searches."
- :group 'org-mairix
- :type 'boolean)
-
-(defcustom org-mairix-augmented-links nil
- "Should new links be created as augmenting searches?
-If t, links will be stored as augmenting searches.
-If nil, links will be stored as normal searches.
-
-Attention: When activating this option, you will need
-to remove old articles from your mairix results group
-in some other way, mairix will not do it for you."
- :group 'org-mairix
- :type 'boolean)
-
-(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results
- "Hook to call to display the results of a successful mairix search.
-Defaults to Gnus, feel free to add your own MUAs or methods."
- :group 'org-mairix
- :type 'hook)
-
-(defcustom org-mairix-open-command "mairix %args% '%search%'"
- "The mairix command-line to use. If your paths are set up
-correctly, you should not need to change this.
-
-'%search%' will get substituted with the search expression, and
-'%args%' with any additional arguments."
- :group 'org-mairix
- :type 'string)
-
-;;; The hooks to integrate mairix into org
-
-(org-link-set-parameters "mairix"
- :follow #'org-mairix-open
- :store #'org-mairix-store-gnus-link)
-
-;;; Generic org-mairix functions
-
-(defun org-mairix-construct-link (message-id)
- "Construct a mairix: hyperlink based on message-id."
- (concat "mairix:"
- (if org-mairix-threaded-links "t:")
- (if org-mairix-augmented-links "a:")
- "@@"
- (org-unbracket-string "<" ">" message-id)))
-
-(defun org-store-mairix-link-props (&rest plist)
- "Take a property list describing a mail, and add mairix link
-and description properties so that org can build a mairix link to
-it."
- ;; We have to call `org-store-link-props' twice:
- ;;
- ;; - It extracts 'fromname'/'fromaddress' from 'from' property,
- ;; and stores the updated plist to `org-store-link-plist'.
- ;;
- ;; - `org-email-link-description' uses these new properties to
- ;; build a description from the previously stored plist. I
- ;; wrote a tiny patch to `org-email-link-description' so it
- ;; could take a non-stored plist as an optional 2nd argument,
- ;; but the plist provided still needs 'fromname'/'fromaddress'.
- ;;
- ;; - Ideally we would decouple the storing bit of
- ;; `org-store-link-props' from the extraction bit, but lots of
- ;; stuff in `org-store-link' which calls it would need to be
- ;; changed. Maybe just factor out the extraction so it can be
- ;; reused separately?
- (let ((mid (plist-get plist :message-id)))
- (apply 'org-store-link-props
- (append plist
- (list :type "mairix"
- :link (org-mairix-construct-link mid))))
- (apply 'org-store-link-props
- (append org-store-link-plist
- (list :description (org-email-link-description))))))
-
-(defun org-mairix-message-send-and-exit-with-link ()
- "Function that can be assigned as an alternative sending function,
-it sends the message and then stores a mairix link to it before burying
-the buffer just like 'message-send-and-exit' does."
- (interactive)
- (message-send)
- (let* ((message-id (message-fetch-field "Message-Id"))
- (subject (message-fetch-field "Subject"))
- (link (org-mairix-construct-link message-id))
- (desc (concat "Email: '" subject "'")))
- (setq org-stored-links
- (cons (list link desc) org-stored-links)))
- (message-bury (current-buffer)))
-
-(defun org-mairix-open (search _)
- "Function to open mairix link.
-
-We first need to split it into its individual parts, and then
-extract the message-id to be passed on to the display function
-before call mairix, evaluate the number of matches returned, and
-make sure to only call display of mairix succeeded in matching."
- (let* ((args ""))
- (if (equal (substring search 0 2) "t:" )
- (progn (setq search (substring search 2 nil))
- (setq args (concat args " --threads"))))
- (if (equal (substring search 0 2) "a:")
- (progn (setq search (substring search 2 nil))
- (setq args (concat args " --augment"))))
- (let ((cmdline (org-mairix-command-substitution
- org-mairix-open-command search args)))
- (print cmdline)
- (setq retval (shell-command-to-string cmdline))
- (string-match "\[0-9\]+" retval)
- (setq matches (string-to-number (match-string 0 retval)))
- (if (eq matches 0) (message "Link failed: no matches, sorry")
- (message "Link returned %d matches" matches)
- (run-hook-with-args 'org-mairix-display-hook search args)))))
-
-(defun org-mairix-command-substitution (cmd search args)
- "Substitute '%search%' and '%args% in mairix search command."
- (while (string-match "%search%" cmd)
- (setq cmd (replace-match search 'fixedcase 'literal cmd)))
- (while (string-match "%args%" cmd)
- (setq cmd (replace-match args 'fixedcase 'literal cmd)))
- cmd)
-
-;;; Functions necessary for integration of external MUAs.
-
-;; Of course we cannot call `org-store-link' from within an external
-;; MUA, so we need some other way of storing a link for later
-;; retrieval by org-mode and/or remember-mode. To do this we use a
-;; temporary file as a kind of dedicated clipboard.
-
-(defcustom org-mairix-link-clipboard "~/.org-mairix-link"
- "Pseudo-clipboard file where mairix URLs get copied to by external
-applications in order to mimic `org-store-link'. Used by
-`org-mairix-insert-link'."
- :group 'org-mairix
- :type 'string)
-
-;; When we resolve some of the issues with `org-store-link' detailed
-;; at
<https://orgmode.org/list/20071105181739.GB13544@atlantic.linksys.moosehall
-;; we might not need org-mairix-insert-link.
-
-(defun org-mairix-insert-link ()
- "Insert link from file defined by `org-mairix-link-clipboard'."
- (interactive)
- (let ((bytes (cadr (insert-file-contents
- (expand-file-name org-mairix-link-clipboard)))))
- (forward-char bytes)
- (save-excursion
- (forward-char -1)
- (if (looking-at "\n")
- (delete-char 1)))))
-
-;;; Functions necessary for mutt integration
-
-(defgroup org-mairix-mutt nil
- "Use mutt for mairix support in org."
- :tag "Org Mairix Mutt"
- :group 'org-mairix)
-
-(defcustom org-mairix-mutt-display-command
- "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f
-~/mail/mairix -e \"push <display-message>\"' &"
- "Command to execute to display mairix search results via mutt within
-an xterm.
-
-'%search%' will get substituted with the search expression, and
-'%args%' with any additional arguments used in the search."
- :group 'org-mairix-mutt
- :type 'string)
-
-(defun org-mairix-mutt-display-results (search args)
- "Display results of mairix search in mutt, using the command line
-defined in `org-mairix-mutt-display-command'."
- ;; By default, async `shell-command' invocations display the temp
- ;; buffer, which is annoying here. We choose a deterministic
- ;; buffer name so we can hide it again immediately.
- ;; Note: `call-process' is synchronous so not useful here.
- (let ((cmd (org-mairix-command-substitution
- org-mairix-mutt-display-command search args))
- (tmpbufname (generate-new-buffer-name " *mairix-view*")))
- (shell-command cmd tmpbufname)
- (delete-windows-on (get-buffer tmpbufname))))
-
-;;; Functions necessary for gnus integration
-
-(defgroup org-mairix-gnus nil
- "Use gnus for mairix support in org."
- :tag "Org Mairix Gnus"
- :group 'org-mairix)
-
-(defcustom org-mairix-gnus-results-group "nnmaildir:mairix"
- "The group that is configured to hold the mairix search results,
-which needs to be setup independently of the org-mairix integration,
-along with general mairix configuration."
- :group 'org-mairix-gnus
- :type 'string)
-
-(defcustom org-mairix-gnus-select-display-group-function
-'org-mairix-gnus-select-display-group-function-gg
- "Hook to call to select the group that contains the matching articles.
-We should not need this, it is owed to a problem of gnus that people were
-not yet able to figure out, see
- http://article.gmane.org/gmane.emacs.gnus.general/65248
- http://article.gmane.org/gmane.emacs.gnus.general/65265
- http://article.gmane.org/gmane.emacs.gnus.user/9596
-for reference.
-
-It seems gnus needs a 'forget/ignore everything you think you
-know about that group' function. Volunteers?"
- :group 'org-mairix-gnus
- :type 'hook)
-
-(defun org-mairix-store-gnus-link ()
- "Store a link to the current gnus message as a Mairix search for its
-Message ID."
-
- ;; gnus integration
- (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
- (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
- (let* ((article (gnus-summary-article-number))
- (header (gnus-summary-article-header article))
- (from (mail-header-from header))
- (message-id (mail-header-id header))
- (subject (gnus-summary-subject-string)))
- (org-store-mairix-link-props :from from
- :subject subject
- :message-id message-id))))
-
-(defun org-mairix-gnus-display-results (search args)
- "Display results of mairix search in Gnus.
-
-Note: This does not work as cleanly as I would like it to. The
-problem being that Gnus should simply reread the group cleanly,
-without remembering anything. At the moment it seems to be unable
-to do that -- so you're likely to see zombies floating around.
-
-If you can improve this, please do!"
- (if (not (equal (substring search 0 2) "m:" ))
- (error "org-mairix-gnus-display-results: display of search other than
-message-id not implemented yet"))
- (setq message-id (substring search 2 nil))
- (require 'gnus)
- (require 'gnus-sum)
- ;; FIXME: (bzg/gg) We might need to make sure gnus is running here,
- ;; and to start it in case it isn't running already. Does
- ;; anyone know a function to do that? It seems main org mode
- ;; does not do this, either.
- (funcall (cdr (assq 'gnus org-link-frame-setup)))
- (if gnus-other-frame-object (select-frame gnus-other-frame-object))
-
- ;; FIXME: This is horribly broken. Please see
- ;; http://article.gmane.org/gmane.emacs.gnus.general/65248
- ;; http://article.gmane.org/gmane.emacs.gnus.general/65265
- ;; http://article.gmane.org/gmane.emacs.gnus.user/9596
- ;; for reference.
- ;;
- ;; It seems gnus needs a "forget/ignore everything you think you
- ;; know about that group" function. Volunteers?
- ;;
- ;; For now different methods seem to work differently well for
- ;; different people. So we're playing hook-selection here to make
- ;; it easy to play around until we found a proper solution.
- (run-hook-with-args 'org-mairix-gnus-select-display-group-function)
- (gnus-summary-select-article
- nil t t (car (gnus-find-matching-articles "message-id" message-id))))
-
-(defun org-mairix-gnus-select-display-group-function-gg ()
- "Georg's hack to select a group that gnus (falsely) believes to be
-empty to then call rebuilding of the summary. It leaves zombies of
-old searches around, though."
- (gnus-group-quick-select-group 0 org-mairix-gnus-results-group)
- (gnus-group-clear-data)
- (gnus-summary-reselect-current-group t t))
-
-(defun org-mairix-gnus-select-display-group-function-bzg ()
- "This is the classic way the org mode is using, and it seems to be
-using better for Bastien, so it may work for you."
- (gnus-group-clear-data org-mairix-gnus-results-group)
- (gnus-group-read-group t nil org-mairix-gnus-results-group))
-
-(provide 'org-mairix)
-
-;;; org-mairix.el ends here
diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el
deleted file mode 100644
index 7f9a814..0000000
--- a/contrib/lisp/org-notify.el
+++ /dev/null
@@ -1,406 +0,0 @@
-;;; org-notify.el --- Notifications for Org-mode
-
-;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
-
-;; Author: Peter Münster <pmrb@free.fr>
-;; Keywords: notification, todo-list, alarm, reminder, pop-up
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Get notifications, when there is something to do.
-;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a
-;; present for a birthday, and then another notification one hour before to
-;; have enough time to choose the right clothes.
-;; For other events, e.g. rolling the dustbin to the roadside once per week,
-;; you probably need another kind of notification strategy.
-;; This package tries to satisfy the various needs.
-
-;; In order to activate this package, you must add the following code
-;; into your .emacs:
-;;
-;; (require 'org-notify)
-;; (org-notify-start)
-
-;; Example setup:
-;;
-;; (org-notify-add 'appt
-;; '(:time "-1s" :period "20s" :duration 10
-;; :actions (-message -ding))
-;; '(:time "15m" :period "2m" :duration 100
-;; :actions -notify)
-;; '(:time "2h" :period "5m" :actions -message)
-;; '(:time "3d" :actions -email))
-;;
-;; This means for todo-items with `notify' property set to `appt': 3 days
-;; before deadline, send a reminder-email, 2 hours before deadline, start to
-;; send messages every 5 minutes, then 15 minutes before deadline, start to
-;; pop up notification windows every 2 minutes. The timeout of the window is
-;; set to 100 seconds. Finally, when deadline is overdue, send messages and
-;; make noise."
-
-;; Take also a look at the function `org-notify-add'.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'org-element)
-
-(declare-function appt-delete-window "appt" ())
-(declare-function notifications-notify "notifications" (&rest prms))
-(declare-function article-lapsed-string "gnus-art" (t &optional ms))
-
-(defgroup org-notify nil
- "Options for Org-mode notifications."
- :tag "Org Notify"
- :group 'org)
-
-(defcustom org-notify-audible t
- "Non-nil means beep to indicate notification."
- :type 'boolean
- :group 'org-notify)
-
-(defcustom org-notify-max-notifications-per-run 3
- "Maximum number of notifications per run of `org-notify-process'."
- :type 'integer
- :group 'org-notify)
-
-(defconst org-notify-actions
- '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later"
- "week" "one week later")
- "Possible actions for call-back functions.")
-
-(defconst org-notify-window-buffer-name "*org-notify-%s*"
- "Buffer-name for the `org-notify-action-window' function.")
-
-(defvar org-notify-map nil
- "Mapping between names and parameter lists.")
-
-(defvar org-notify-timer nil
- "Timer of the notification daemon.")
-
-(defvar org-notify-parse-file nil
- "Index of current file, that `org-element-parse-buffer' is parsing.")
-
-(defvar org-notify-on-action-map nil
- "Mapping between on-action identifiers and parameter lists.")
-
-(defun org-notify-string->seconds (str)
- "Convert time string STR to number of seconds."
- (when str
- (let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60))
- ("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60))
- ("M" . ,(* 30 24 60 60))))
- (letters (concat
- (mapcar (lambda (x) (string-to-char (car x))) conv)))
- (case-fold-search nil))
- (string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str)
- (* (string-to-number (match-string 2 str))
- (cdr (assoc (match-string 3 str) conv))
- (if (= (length (match-string 1 str)) 1) -1 1)))))
-
-(defun org-notify-convert-deadline (orig)
- "Convert original deadline from `org-element-parse-buffer' to
-simple timestamp string."
- (if orig
- (replace-regexp-in-string "^<\\|>$" ""
- (plist-get (plist-get orig 'timestamp)
- :raw-value))))
-
-(defun org-notify-make-todo (heading &rest ignored)
- "Create one todo item."
- (cl-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"))
- (deadline (org-notify-convert-deadline (get :deadline)))
- (heading (get :raw-value))
- result)
- (when (and (eq (get :todo-type) 'todo) heading deadline)
- (pr :heading heading) (pr :notify (intern notify))
- (pr :begin (get :begin))
- (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted)))
- (pr :timestamp deadline) (pr :uid (md5 (concat heading deadline)))
- (pr :deadline (- (org-time-string-to-seconds deadline)
- (float-time))))
- result)))
-
-(defun org-notify-todo-list ()
- "Create the todo-list for one org-agenda file."
- (let* ((files (org-agenda-files 'unrestricted))
- (max (1- (length files))))
- (when files
- (setq org-notify-parse-file
- (if (or (not org-notify-parse-file) (>= org-notify-parse-file max))
- 0
- (1+ org-notify-parse-file)))
- (save-excursion
- (with-current-buffer (find-file-noselect
- (nth org-notify-parse-file files))
- (org-element-map (org-element-parse-buffer 'headline)
- 'headline 'org-notify-make-todo))))))
-
-(defun org-notify-maybe-too-late (diff period heading)
- "Print warning message, when notified significantly later than defined by
-PERIOD."
- (if (> (/ diff period) 1.5)
- (message "Warning: notification for \"%s\" behind schedule!" heading))
- t)
-
-(cl-defun org-notify-process ()
- "Process the todo-list, and possibly notify user about upcoming or
-forgotten tasks."
- (let ((notification-cnt 0))
- (cl-macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo
,k)))
- (dolist (todo (org-notify-todo-list))
- (let* ((deadline (td :deadline)) (heading (td :heading))
- (uid (td :uid)) (last-run-sym
- (intern (concat ":last-run-" uid))))
- (cl-dolist (prms (plist-get org-notify-map (td :notify)))
- (when (< deadline (org-notify-string->seconds (prm :time)))
- (let ((period (org-notify-string->seconds (prm :period)))
- (last-run (prm last-run-sym)) (now (float-time))
- (actions (prm :actions)) diff plist)
- (when (or (not last-run)
- (and period (< period (setq diff (- now last-run)))
- (org-notify-maybe-too-late diff period
heading)))
- (setq prms (plist-put prms last-run-sym now)
- plist (append todo prms))
- (if (if (plist-member prms :audible)
- (prm :audible)
- org-notify-audible)
- (ding))
- (unless (listp actions)
- (setq actions (list actions)))
- (cl-incf notification-cnt)
- (dolist (action actions)
- (funcall (if (fboundp action) action
- (intern (concat "org-notify-action"
- (symbol-name action))))
- plist))
- (when (>= notification-cnt
org-notify-max-notifications-per-run)
- (cl-return-from org-notify-process)))
- (cl-return)))))))))
-
-(defun org-notify-add (name &rest params)
- "Add a new notification type.
-The NAME can be used in Org-mode property `notify'. If NAME is
-`default', the notification type applies for todo items without
-the `notify' property. This file predefines such a default
-notification type.
-
-Each element of PARAMS is a list with parameters for a given time
-distance to the deadline. This distance must increase from one
-element to the next.
-
-List of possible parameters:
-
- :time Time distance to deadline, when this type of notification shall
- start. It's a string: an integral value (positive or negative)
- followed by a unit (s, m, h, d, w, M).
- :actions A function or a list of functions to be called to notify the
- user. Instead of a function name, you can also supply a suffix
- of one of the various predefined `org-notify-action-xxx'
- functions.
- :period Optional: can be used to repeat the actions periodically.
- Same format as :time.
- :duration Some actions use this parameter to specify the duration of the
- notification. It's an integral number in seconds.
- :audible Overwrite the value of `org-notify-audible' for this action.
-
-For the actions, you can use your own functions or some of the predefined
-ones, whose names are prefixed with `org-notify-action-'."
- (setq org-notify-map (plist-put org-notify-map name params)))
-
-(defun org-notify-start (&optional secs)
- "Start the notification daemon.
-If SECS is positive, it's the period in seconds for processing
-the notifications of one org-agenda file, and if negative,
-notifications will be checked only when emacs is idle for -SECS
-seconds. The default value for SECS is 20."
- (interactive)
- (if org-notify-timer
- (org-notify-stop))
- (setq secs (or secs 20)
- org-notify-timer (if (< secs 0)
- (run-with-idle-timer (* -1 secs) t
- 'org-notify-process)
- (run-with-timer secs secs 'org-notify-process))))
-
-(defun org-notify-stop ()
- "Stop the notification daemon."
- (when org-notify-timer
- (cancel-timer org-notify-timer)
- (setq org-notify-timer nil)))
-
-(defun org-notify-on-action (plist key)
- "User wants to see action."
- (let ((file (plist-get plist :file))
- (begin (plist-get plist :begin)))
- (if (string-equal key "show")
- (progn
- (switch-to-buffer (find-file-noselect file))
- (org-with-wide-buffer
- (goto-char begin)
- (outline-show-entry))
- (goto-char begin)
- (search-forward "DEADLINE: <")
- (search-forward ":")
- (if (display-graphic-p)
- (x-focus-frame nil)))
- (save-excursion
- (with-current-buffer (find-file-noselect file)
- (org-with-wide-buffer
- (goto-char begin)
- (search-forward "DEADLINE: <")
- (cond
- ((string-equal key "done") (org-todo))
- ((string-equal key "hour") (org-timestamp-change 60 'minute))
- ((string-equal key "day") (org-timestamp-up-day))
- ((string-equal key "week") (org-timestamp-change 7 'day)))))))))
-
-(defun org-notify-on-action-notify (id key)
- "User wants to see action after mouse-click in notify window."
- (org-notify-on-action (plist-get org-notify-on-action-map id) key)
- (org-notify-on-close id nil))
-
-(defun org-notify-on-action-button (button)
- "User wants to see action after button activation."
- (cl-macrolet ((get (k) `(button-get button ,k)))
- (org-notify-on-action (get 'plist) (get 'key))
- (org-notify-delete-window (get 'buffer))
- (cancel-timer (get 'timer))))
-
-(defun org-notify-delete-window (buffer)
- "Delete the notification window."
- (require 'appt)
- (let ((appt-buffer-name buffer)
- (appt-audible nil))
- (appt-delete-window)))
-
-(defun org-notify-on-close (id reason)
- "Notification window has been closed."
- (setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil)))
-
-(defun org-notify-action-message (plist)
- "Print a message."
- (message "TODO: \"%s\" at %s!" (plist-get plist :heading)
- (plist-get plist :timestamp)))
-
-(defun org-notify-action-ding (plist)
- "Make noise."
- (let ((timer (run-with-timer 0 1 'ding)))
- (run-with-timer (or (plist-get plist :duration) 3) nil
- 'cancel-timer timer)))
-
-(defun org-notify-body-text (plist)
- "Make human readable string for remaining time to deadline."
- (require 'gnus-art)
- (format "%s\n(%s)"
- (replace-regexp-in-string
- " in the future" ""
- (article-lapsed-string
- (time-add (current-time)
- (seconds-to-time (plist-get plist :deadline))) 2))
- (plist-get plist :timestamp)))
-
-(defun org-notify-action-email (plist)
- "Send email to user."
- (compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading)))
- (insert (org-notify-body-text plist))
- (funcall send-mail-function)
- (cl-letf (((symbol-function 'yes-or-no-p) (lambda (x) t)))
- (kill-buffer)))
-
-(defun org-notify-select-highest-window ()
- "Select the highest window on the frame, that is not is not an
-org-notify window. Mostly copied from `appt-select-lowest-window'."
- (let ((highest-window (selected-window))
- (bottom-edge (nth 3 (window-edges)))
- next-bottom-edge)
- (walk-windows (lambda (w)
- (when (and
- (not (string-match "^\\*org-notify-.*\\*$"
- (buffer-name
- (window-buffer w))))
- (> bottom-edge (setq next-bottom-edge
- (nth 3 (window-edges w)))))
- (setq bottom-edge next-bottom-edge
- highest-window w))) 'nomini)
- (select-window highest-window)))
-
-(defun org-notify-action-window (plist)
- "Pop up a window, mostly copied from `appt-disp-window'."
- (save-excursion
- (cl-macrolet ((get (k) `(plist-get plist ,k)))
- (let ((this-window (selected-window))
- (buf (get-buffer-create
- (format org-notify-window-buffer-name (get :uid)))))
- (when (minibufferp)
- (other-window 1)
- (and (minibufferp) (display-multi-frame-p) (other-frame 1)))
- (if (cdr (assq 'unsplittable (frame-parameters)))
- (progn (set-buffer buf) (display-buffer buf))
- (unless (or (special-display-p (buffer-name buf))
- (same-window-p (buffer-name buf)))
- (org-notify-select-highest-window)
- (when (>= (window-height) (* 2 window-min-height))
- (select-window (split-window nil nil 'above))))
- (switch-to-buffer buf))
- (setq buffer-read-only nil buffer-undo-list t)
- (erase-buffer)
- (insert (format "TODO: %s, %s.\n" (get :heading)
- (org-notify-body-text plist)))
- (let ((timer (run-with-timer (or (get :duration) 10) nil
- 'org-notify-delete-window buf)))
- (dotimes (i (/ (length org-notify-actions) 2))
- (let ((key (nth (* i 2) org-notify-actions))
- (text (nth (1+ (* i 2)) org-notify-actions)))
- (insert-button text 'action 'org-notify-on-action-button
- 'key key 'buffer buf 'plist plist 'timer timer)
- (insert " "))))
- (shrink-window-if-larger-than-buffer (get-buffer-window buf t))
- (set-buffer-modified-p nil) (setq buffer-read-only t)
- (raise-frame (selected-frame)) (select-window this-window)))))
-
-(defun org-notify-action-notify (plist)
- "Pop up a notification window."
- (require 'notifications)
- (let* ((duration (plist-get plist :duration))
- (id (notifications-notify
- :title (plist-get plist :heading)
- :body (org-notify-body-text plist)
- :timeout (if duration (* duration 1000))
- :urgency (plist-get plist :urgency)
- :actions org-notify-actions
- :on-action 'org-notify-on-action-notify)))
- (setq org-notify-on-action-map
- (plist-put org-notify-on-action-map id plist))))
-
-(defun org-notify-action-notify/window (plist)
- "For a graphics display, pop up a notification window, for a text
-terminal an emacs window."
- (if (display-graphic-p)
- (org-notify-action-notify plist)
- (org-notify-action-window plist)))
-
-;;; Provide a minimal default setup.
-(org-notify-add 'default '(:time "1h" :actions -notify/window
- :period "2m" :duration 60))
-
-(provide 'org-notify)
-
-;;; org-notify.el ends here
diff --git a/contrib/lisp/org-panel.el b/contrib/lisp/org-panel.el
deleted file mode 100644
index bec913d..0000000
--- a/contrib/lisp/org-panel.el
+++ /dev/null
@@ -1,638 +0,0 @@
-;;; org-panel.el --- Simple routines for us with bad memory
-;;
-;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Created: Thu Nov 15 15:35:03 2007
-;; Version: 0.21
-;; Lxast-Updated: Wed Nov 21 03:06:03 2007 (3600 +0100)
-;; URL:
-;; Keywords:
-;; Compatibility:
-;;
-;; Features that might be required by this library:
-;;
-;; `easymenu', `font-lock', `noutline', `org', `outline', `syntax',
-;; `time-date'.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This defines a kind of control panel for `org-mode'. This control
-;; panel should make it fast to move around and edit structure etc.
-;;
-;; To bring up the control panel type
-;;
-;; M-x orgpan-panel
-;;
-;; Type ? there for help.
-;;
-;; I suggest you add the following to your .emacs for quick access of
-;; the panel:
-;;
-;; (eval-after-load 'org-mode
-;; (define-key org-mode-map [(control ?c) ?p] 'orgpan-panel))
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Change log:
-;;
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or
-;; (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Code:
-
-(require 'org)
-(require 'outline)
-
-;; Fix-me: this is for testing. A minor mode version interferes badly
-;; with emulation minor modes. On the other hand, the other version
-;; interferes badly with (interactive ...).
-(defvar orgpan-minor-mode-version t)
-
-(defface orgpan-field
- '((t (:inherit 'widget-field)))
- "Face for fields."
- :group 'winsize)
-(defvar orgpan-field-face 'orgpan-field)
-
-(defface orgpan-active-field
- '((t (:inherit 'highlight)))
- "Face for fields."
- :group 'winsize)
-(defvar orgpan-active-field-face 'orgpan-active-field)
-
-(defface orgpan-spaceline
- '((t (:height 0.2)))
- "Face for spacing lines."
- :group 'winsize)
-
-(defcustom orgpan-panel-buttons nil
- "Panel style, if non-nil use buttons.
-If there are buttons in the panel they are used to change the way
-the arrow keys work. The panel looks something like this, with
-the first button chosen:
-
- [Navigate] [Restructure] [TODO/Priority]
- ----------
- up/down, left: Go to, right: Visibility
-
-The line below the buttons try to give a short hint about what
-the arrow keys does. \(Personally I prefer the version without
-buttons since I then do not have to remember which button is
-active.)"
- :type 'boolean
- :group 'winsize)
-
-;; Fix-me: add org-mode-map
-(defconst orgpan-org-mode-commands nil)
-(defconst orgpan-org-commands
- '(
- orgpan-copy-subtree
- orgpan-cut-subtree
- orgpan-paste-subtree
- undo
- ;;
- ;orgpan-occur
- ;;
- org-cycle
- org-global-cycle
- outline-up-heading
- outline-next-visible-heading
- outline-previous-visible-heading
- outline-forward-same-level
- outline-backward-same-level
- org-todo
- org-show-todo-tree
- org-priority-up
- org-priority-down
- org-move-subtree-up
- org-move-subtree-down
- org-do-promote
- org-do-demote
- org-promote-subtree
- org-demote-subtree))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Hook functions etc
-
-(defun orgpan-delete-panel ()
- "Remove the panel."
- (interactive)
- (when (buffer-live-p orgpan-panel-buffer)
- (delete-windows-on orgpan-panel-buffer)
- (kill-buffer orgpan-panel-buffer))
- (setq orgpan-panel-buffer nil)
- (setq orgpan-panel-window nil)
- (orgpan-panel-minor-mode 0)
- (remove-hook 'post-command-hook 'orgpan-minor-post-command)
- (remove-hook 'post-command-hook 'orgpan-mode-post-command)
- ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- )
-
-(defvar orgpan-last-command-was-from-panel nil)
-(defun orgpan-mode-pre-command ()
- (setq orgpan-last-command-was-from-panel nil)
- (condition-case err
- (if (not (and (windowp orgpan-org-window)
- (window-live-p orgpan-org-window)))
- (progn
- (setq this-command 'ignore)
- (orgpan-delete-panel)
- (message "The window belonging to the panel had disappeared,
removed panel."))
- (let ((buf (window-buffer orgpan-org-window)))
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- (setq orgpan-last-org-buffer buf))
- ;; Fix me: add a list of those commands that are not
- ;; meaningful from the panel (for example org-time-stamp)
- (when (or (memq this-command orgpan-org-commands)
- (memq this-command orgpan-org-mode-commands)
- ;; For some reason not all org commands are found above:
- (string= "org-" (substring (format "%s" this-command) 0 4)))
- (if (not (with-current-buffer buf
- (derived-mode-p 'org-mode)))
- (progn
- (if (buffer-live-p orgpan-org-buffer)
- (set-window-buffer orgpan-org-window orgpan-org-buffer)
- (message "Please use `l' or `b' to choose an org-mode
buffer"))
- (setq this-command 'ignore))
- (setq orgpan-org-buffer (window-buffer orgpan-org-window))
- (setq orgpan-last-command-was-from-panel t)
- (select-window orgpan-org-window)
- ;;(when (active-minibuffer-window
- ;;(set-buffer orgpan-org-buffer)
- ))))
- (error (lwarn 't :warning "orgpan-pre: %S" err))))
-
-(defun orgpan-mode-post-command ()
- (condition-case err
- (progn
- (unless (and (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window)
- (bufferp orgpan-panel-buffer)
- (buffer-live-p orgpan-panel-buffer))
- ;;(orgpan-delete-panel)
- )
- (when (and orgpan-last-command-was-from-panel
- (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window))
- (select-window orgpan-panel-window)
- (when (derived-mode-p 'orgpan-mode)
- (setq deactivate-mark t)
- (when orgpan-panel-buttons
- (unless (and orgpan-point
- (= (point) orgpan-point))
- ;; Go backward so it is possible to click on a "button":
- (orgpan-backward-field))))))
- (error (lwarn 't :warning "orgpan-post: %S" err))))
-
-;; (defun orgpan-window-config-change ()
-;; "Check if any frame is displaying an orgpan panel.
-;; If not remove `orgpan-mode-post-command' and this function from
-;; the hooks."
-;; (condition-case err
-;; (unless (and (
-;; (let ((found-pan nil))
-;; (dolist (f (frame-list))
-;; (dolist (w (window-list f 'nomini))
-;; (with-current-buffer (window-buffer w)
-;; (when (derived-mode-p 'orgpan-mode)
-;; (setq found-pan t)))))
-;; (unless found-pan
-;; (remove-hook 'post-command-hook 'orgpan-mode-post-command)
-;; (remove-hook 'window-configuration-change-hook
'orgpan-window-config-change)))
-;; (error (lwarn 't :warning "Error in orgpan-config-change: %S" err))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Commands
-
-(defun orgpan-last-buffer ()
- "Open last org-mode buffer in panels org window."
- (interactive)
- (let ((buf (window-buffer orgpan-org-window))
- (last-buf orgpan-last-org-buffer))
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- (setq orgpan-last-org-buffer buf))
- (when (eq last-buf buf)
- (setq last-buf nil))
- (if (not last-buf)
- (orgpan-switch-buffer)
- (set-window-buffer orgpan-org-window last-buf))))
-
-(defun orgpan-switch-buffer ()
- "Switch to next org-mode buffer in panels org window."
- (interactive)
- (let ((buf (window-buffer orgpan-org-window))
- (org-buffers nil))
- (with-current-buffer buf
- (when (derived-mode-p 'org-mode)
- (bury-buffer buf)
- (setq orgpan-last-org-buffer buf)))
- (setq org-buffers (delq nil (mapcar (lambda (buf)
- (when (with-current-buffer buf
- (derived-mode-p 'org-mode))
- buf))
- (buffer-list))))
- (setq org-buffers (delq buf org-buffers))
- (set-window-buffer orgpan-org-window (car org-buffers))
- (setq orgpan-org-buffer (car org-buffers))))
-
-(defun orgpan-paste-subtree ()
- (interactive)
- (if (y-or-n-p "Paste subtree here? ")
- (org-paste-subtree)
- (message "Nothing was pasted")))
-
-(defun orgpan-cut-subtree ()
- (interactive)
- (let ((heading (progn
- (org-back-to-heading)
- (buffer-substring (point) (line-end-position))
- )))
- (if (y-or-n-p (format "Do you want to cut the subtree\n%s\n? " heading))
- (org-cut-subtree)
- (message "Nothing was cut"))))
-
-(defun orgpan-copy-subtree ()
- (interactive)
- (let ((heading (progn
- (org-back-to-heading)
- (buffer-substring (point) (line-end-position))
- )))
- (if (y-or-n-p (format "Do you want to copy the subtree\n%s\n? " heading))
- (org-copy-subtree)
- (message "Nothing was copied"))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Buttons
-
-(defvar orgpan-ovl-help nil)
-
-(defun orgpan-check-panel-mode ()
- (unless (derived-mode-p 'orgpan-mode)
- (error "Not orgpan-mode in buffer: %s" major-mode)))
-
-(defun orgpan-display-bindings-help ()
- (orgpan-check-panel-mode)
- (setq orgpan-point (point))
- (let* ((ovls (overlays-at (point)))
- (ovl (car ovls))
- (help (when ovl (overlay-get ovl 'orgpan-explain))))
- (dolist (o (overlays-in (point-min) (point-max)))
- (overlay-put o 'face orgpan-field-face))
- (overlay-put ovl 'face orgpan-active-field-face)
- (overlay-put orgpan-ovl-help 'before-string help)))
-
-(defun orgpan-forward-field ()
- (interactive)
- (orgpan-check-panel-mode)
- (let ((pos (next-overlay-change (point))))
- (unless (overlays-at pos)
- (setq pos (next-overlay-change pos)))
- (when (= pos (point-max))
- (setq pos (point-min))
- (unless (overlays-at pos)
- (setq pos (next-overlay-change pos))))
- (goto-char pos))
- (orgpan-display-bindings-help))
-
-(defun orgpan-backward-field ()
- (interactive)
- (orgpan-check-panel-mode)
- (when (= (point) (point-min))
- (goto-char (point-max)))
- (let ((pos (previous-overlay-change (point))))
- (unless (overlays-at pos)
- (setq pos (previous-overlay-change pos)))
- (goto-char pos))
- (orgpan-display-bindings-help))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Mode
-
-(defconst orgpan-mode-map
- ;; Fix-me: clean up here!
- ;; Fix-me: viper support
- (let ((map (make-sparse-keymap)))
- (define-key map [?q] 'orgpan-delete-panel)
- (define-key map [??] 'orgpan-help)
- ;; Copying etc
- (define-key map [?c] 'orgpan-copy-subtree)
- (define-key map [?x] 'orgpan-cut-subtree)
- (define-key map [?p] 'orgpan-paste-subtree)
- (define-key map [?z] 'undo)
- ;; Buffers:
- (define-key map [?b] 'orgpan-switch-buffer)
- (define-key map [?l] 'orgpan-last-buffer)
- ;; Some keys for moving between headings. Emacs keys for next/prev
- ;; line seems ok:
- (define-key map [(control ?p)] 'outline-previous-visible-heading)
- (define-key map [(control ?n)] 'outline-next-visible-heading)
- (define-key map [(shift control ?p)] 'outline-backward-same-level)
- (define-key map [(shift control ?n)] 'outline-forward-same-level)
- ;; A mnemunic for up:
- (define-key map [(control ?u)] 'outline-up-heading)
- ;; Search sparse tree:
- ;;
- ;; Fix-me: Search does not work, some problem with
- ;; interactive. Probably have to turn the whole thing around and
- ;; always be in the org buffer, but with a minor mode running
- ;; there.
- ;;
- ;;(define-key map [?s] 'org-sparse-tree)
- (define-key map [?s] 'orgpan-occur)
- ;; Same as in org-mode:
- ;;(define-key map [(control ?c)(control ?v)] 'org-show-todo-tree)
- ;; Fix-me: This leads to strange problems:
- ;;(define-key map [t] 'ignore)
- map))
-
-(defun orgpan-occur ()
- "Replacement for `org-occur'.
-Technical reasons."
- (interactive)
- (let ((rgx (read-from-minibuffer "my mini Regexp: ")))
- (setq orgpan-last-command-was-from-panel t)
- (select-window orgpan-org-window)
- (org-occur rgx)))
-
-(defvar orgpan-panel-window nil
- "The window showing `orgpan-panel-buffer'.")
-
-(defvar orgpan-panel-buffer nil
- "The panel buffer.
-There can be only one such buffer at any time.")
-
-(defvar orgpan-org-window nil)
-;;(make-variable-buffer-local 'orgpan-org-window)
-
-;; Fix-me: used?
-(defvar orgpan-org-buffer nil)
-;;(make-variable-buffer-local 'orgpan-org-buffer)
-
-(defvar orgpan-last-org-buffer nil)
-;;(make-variable-buffer-local 'orgpan-last-org-buffer)
-
-(defvar orgpan-point nil)
-;;(make-variable-buffer-local 'orgpan-point)
-
-(defvar viper-emacs-state-mode-list)
-(defvar viper-new-major-mode-buffer-list)
-
-(defun orgpan-avoid-viper-in-buffer ()
- ;; Fix-me: This is ugly. However see `this-major-mode-requires-vi-state':
- (set (make-local-variable 'viper-emacs-state-mode-list) '(orgpan-mode))
- (set (make-local-variable 'viper-new-major-mode-buffer-list) nil)
- (local-set-key [?\ ] 'ignore))
-
-(define-derived-mode orgpan-mode nil "Org-Panel"
- "Mode for org-simple.el control panel."
- (setq buffer-read-only t)
- (unless orgpan-minor-mode-version
- (add-hook 'pre-command-hook 'orgpan-mode-pre-command nil t)
- (add-hook 'post-command-hook 'orgpan-mode-post-command t))
- (orgpan-avoid-viper-in-buffer)
- (setq cursor-type nil))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Panel layout
-
-(defun orgpan-insert-field (text keymap explain)
- (insert text)
- (let* ((end (point))
- (len (length text))
- (beg (- end len))
- (ovl (make-overlay beg end)))
- (overlay-put ovl 'face orgpan-field-face)
- (overlay-put ovl 'keymap keymap)
- (overlay-put ovl 'orgpan-explain explain)))
-
-(defconst orgpan-with-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map org-mode-map)
- ;; Users are used to tabbing between fields:
- (define-key map [(tab)] 'orgpan-forward-field)
- (define-key map [(shift tab)] 'orgpan-backward-field)
- ;; Now we must use something else for visibility (first does not work if
Viper):
- (define-key map [(meta tab)] 'org-cycle)
- (define-key map [(control meta tab)] 'org-global-cycle)
- map))
-
-(defconst orgpan-without-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map org-mode-map)
- ;; Visibility (those are in org-mode-map):
- ;;(define-key map [tab] 'org-cycle)
- ;;(define-key map [(shift tab)] 'org-global-cycle)
- ;; Navigate:
- (define-key map [left] 'outline-up-heading)
- (define-key map [right] 'org-cycle)
- (define-key map [up] 'outline-previous-visible-heading)
- (define-key map [down] 'outline-next-visible-heading)
- (define-key map [(shift down)] 'outline-forward-same-level)
- (define-key map [(shift up)] 'outline-backward-same-level)
- ;; Restructure:
- (define-key map [(control up)] 'org-move-subtree-up)
- (define-key map [(control down)] 'org-move-subtree-down)
- (define-key map [(control left)] 'org-do-promote)
- (define-key map [(control right)] 'org-do-demote)
- (define-key map [(control shift left)] 'org-promote-subtree)
- (define-key map [(control shift right)] 'org-demote-subtree)
- ;; Todo etc
- (define-key map [?+] 'org-priority-up)
- (define-key map [?-] 'org-priority-down)
- (define-key map [?t] 'org-todo)
- map))
-
-(defun orgpan-make-panel-without-buttons (buf)
- (with-current-buffer buf
- (insert (propertize "Org Panel" 'face 'orgpan-active-field))
- (insert " ? for help, q quit\n")
- (insert (propertize "arrows" 'face 'font-lock-keyword-face)
- ": Go to, "
- (propertize "C-arrows" 'face 'font-lock-keyword-face)
- ": Edit tree\n"
- (propertize "cxpz" 'face 'font-lock-keyword-face)
- ": copy cut paste undo, "
- (propertize "tT+-" 'face 'font-lock-keyword-face)
- ": todo priority, "
- (propertize "s" 'face 'font-lock-keyword-face)
- " search"
- )
- (set-keymap-parent orgpan-mode-map orgpan-without-keymap)
- ))
-
-(defun orgpan-make-panel-with-buttons (buf)
- (with-current-buffer buf
- (let* ((base-map (make-sparse-keymap))
- (space-line (propertize "\n\n" 'face 'orgpan-spaceline))
- (arrow-face 'font-lock-keyword-face)
- (L (propertize "left" 'face arrow-face))
- (R (propertize "right" 'face arrow-face))
- (U (propertize "up" 'face arrow-face))
- (D (propertize "down" 'face arrow-face)))
- ;;(message D)(sit-for 2)
- (define-key base-map [left] 'ignore)
- (define-key base-map [right] 'ignore)
- (define-key base-map [up] 'ignore)
- (define-key base-map [down] 'ignore)
- (define-key base-map [?q] 'delete-window)
- (define-key base-map [??] 'orgpan-help)
- ;; Navigating
- (let ((map (copy-keymap base-map)))
- (define-key map [left] 'outline-up-heading)
- (define-key map [right] 'org-cycle)
- (define-key map [up] 'outline-previous-visible-heading)
- (define-key map [down] 'outline-next-visible-heading)
- (define-key map [(shift down)] 'outline-forward-same-level)
- (define-key map [(shift up)] 'outline-backward-same-level)
- (orgpan-insert-field "Navigate" map (concat U "/" D ", " L ": Go to, "
R ": Visibility")))
- (insert " ")
- (let ((map (copy-keymap base-map)))
- (define-key map [up] 'org-move-subtree-up)
- (define-key map [down] 'org-move-subtree-down)
- (define-key map [left] 'org-do-promote)
- (define-key map [right] 'org-do-demote)
- (define-key map [(shift left)] 'org-promote-subtree)
- (define-key map [(shift right)] 'org-demote-subtree)
- (orgpan-insert-field
- "Restructure" map
- (concat U "/" D ": "
- (propertize "Move" 'face 'font-lock-warning-face)
- ", " L "/" R ": "
- (propertize "Level (w S: Subtree Level)" 'face
'font-lock-warning-face))))
- (insert " ")
- (let ((map (copy-keymap base-map)))
- (define-key map [up] 'org-priority-up)
- (define-key map [down] 'org-priority-down)
- (define-key map [right] 'org-todo)
- (orgpan-insert-field "TODO/priority" map
- (concat R ": TODO, " U "/" D ": Priority")))
- )
- (insert " ? for help, q quit\n")
- (orgpan-display-bindings-help)
- (setq orgpan-ovl-help (make-overlay (point) (point)))
- ))
-
-(defun orgpan-make-panel-buffer ()
- "Make the panel buffer."
- (let* ((buf-name "*Org Panel*"))
- (when orgpan-panel-buffer (kill-buffer orgpan-panel-buffer))
- (setq orgpan-panel-buffer (get-buffer-create buf-name))
- (if orgpan-panel-buttons
- (orgpan-make-panel-with-buttons orgpan-panel-buffer)
- (orgpan-make-panel-without-buttons orgpan-panel-buffer))
- (with-current-buffer orgpan-panel-buffer
- (orgpan-mode)
- (goto-char (point-min)))
- orgpan-panel-buffer))
-
-(defun orgpan-help ()
- (interactive)
- (set-keymap-parent orgpan-with-keymap nil)
- (set-keymap-parent orgpan-without-keymap nil)
- (describe-function 'orgpan-panel)
- (set-keymap-parent orgpan-with-keymap org-mode-map)
- (set-keymap-parent orgpan-without-keymap org-mode-map)
- (message "Use 'l' to remove help window")
- )
-
-(defun orgpan-panel ()
- "Create a control panel for current `org-mode' buffer.
-The control panel may be used to quickly move around and change
-the headings. The idea is that when you want to to a lot of this
-kind of editing you should be able to do that with few
-keystrokes (and without having to remember the complicated
-keystrokes). A typical situation when this perhaps can be useful
-is when you are looking at your notes file \(usually ~/.notes,
-see `remember-data-file') where you have saved quick notes with
-`remember'.
-
-The keys below are defined in the panel. Note that the commands
-are carried out in the `org-mode' buffer that belongs to the
-panel.
-
-\\{orgpan-mode-map}
-
-In addition to the keys above most of the keys in `org-mode' can
-also be used from the panel.
-
-Note: There are two forms of the control panel, one with buttons
-and one without. The default is without, see
-`orgpan-panel-buttons'. If buttons are used choosing a different
-button changes the binding of the arrow keys."
- (interactive)
- (unless (derived-mode-p 'org-mode)
- (error "Buffer is not in org-mode"))
- (orgpan-delete-panel)
- (unless orgpan-org-mode-commands
- (map-keymap (lambda (ev def)
- (when (and def
- (symbolp def)
- (fboundp def))
- (setq orgpan-org-mode-commands
- (cons def orgpan-org-mode-commands))))
- org-mode-map))
- ;;(org-back-to-heading)
- ;;(remove-hook 'window-configuration-change-hook 'orgpan-window-config-change)
- (setq orgpan-org-window (selected-window))
- (setq orgpan-panel-window (split-window nil -4 'below))
- (select-window orgpan-panel-window)
- (set-window-buffer (selected-window) (orgpan-make-panel-buffer))
- ;;(set-window-dedicated-p (selected-window) t)
- ;; The minor mode version starts here:
- (when orgpan-minor-mode-version
- (select-window orgpan-org-window)
- (orgpan-panel-minor-mode 1)
- (add-hook 'post-command-hook 'orgpan-minor-post-command t)))
-
-(defun orgpan-minor-post-command ()
- (unless (and
- ;; Check org window and buffer
- (windowp orgpan-org-window)
- (window-live-p orgpan-org-window)
- (eq orgpan-org-window (selected-window))
- (derived-mode-p 'org-mode)
- ;; Check panel window and buffer
- (windowp orgpan-panel-window)
- (window-live-p orgpan-panel-window)
- (bufferp orgpan-panel-buffer)
- (buffer-live-p orgpan-panel-buffer)
- (eq (window-buffer orgpan-panel-window) orgpan-panel-buffer)
- ;; Check minor mode
- orgpan-panel-minor-mode)
- (orgpan-delete-panel)))
-
-(define-minor-mode orgpan-panel-minor-mode
- "Minor mode used in `org-mode' buffer when showing panel."
- :keymap orgpan-mode-map
- :lighter " PANEL"
- :group 'orgpan
- )
-
-
-(provide 'org-panel)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; org-panel.el ends here
diff --git a/contrib/lisp/org-passwords.el b/contrib/lisp/org-passwords.el
deleted file mode 100644
index 870483b..0000000
--- a/contrib/lisp/org-passwords.el
+++ /dev/null
@@ -1,384 +0,0 @@
-;;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file contains the code for managing your passwords with
-;; Org-mode. It is part of org/contrib (see https://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 appearance 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-registry.el b/contrib/lisp/org-registry.el
deleted file mode 100644
index 005a00a..0000000
--- a/contrib/lisp/org-registry.el
+++ /dev/null
@@ -1,272 +0,0 @@
-;;; org-registry.el --- a registry for Org links
-;;
-;; Copyright 2007-2021 Free Software Foundation, Inc.
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: org-registry.el
-;; Version: 0.1a
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Maintainer: Bastien Guerry <bzg@gnu.org>
-;; Keywords: org, wp, registry
-;; Description: Shows Org files where the current buffer is linked
-;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
-;;
-;; This 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library add a registry to your Org setup.
-;;
-;; Org files are full of links inserted with `org-store-link'. This links
-;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
-;; Actually, they come from potentially *everywhere* since Org lets you
-;; define your own storing/following functions.
-;;
-;; So, what if you are on a e-mail, webpage or whatever and want to know if
-;; this buffer has already been linked to somewhere in your agenda files?
-;;
-;; This is were org-registry comes in handy.
-;;
-;; M-x org-registry-show will tell you the name of the file
-;; C-u M-x org-registry-show will directly jump to the file
-;;
-;; In case there are several files where the link lives in:
-;;
-;; M-x org-registry-show will display them in a new window
-;; C-u M-x org-registry-show will prompt for a file to visit
-;;
-;; Add this to your Org configuration:
-;;
-;; (require 'org-registry)
-;; (org-registry-initialize)
-;;
-;; If you want to update the registry with newly inserted links in the
-;; current buffer: M-x org-registry-update
-;;
-;; If you want this job to be done each time you save an Org buffer,
-;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
-;;
-;; (org-registry-insinuate)
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-registry nil
- "A registry for Org."
- :group 'org)
-
-(defcustom org-registry-file
- (concat (getenv "HOME") "/.org-registry.el")
- "The Org registry file."
- :group 'org-registry
- :type 'file)
-
-(defcustom org-registry-find-file 'find-file-other-window
- "How to find visit files."
- :type 'function
- :group 'org-registry)
-
-(defvar org-registry-alist nil
- "An alist containing the Org registry.")
-
-;;;###autoload
-(defun org-registry-show (&optional visit)
- "Show Org files where there are links pointing to the current
-buffer."
- (interactive "P")
- (org-registry-initialize)
- (let* ((blink (or (org-remember-annotation) ""))
- (link (when (string-match org-bracket-link-regexp blink)
- (match-string-no-properties 1 blink)))
- (desc (or (and (string-match org-bracket-link-regexp blink)
- (match-string-no-properties 3 blink)) "No description"))
- (files (org-registry-assoc-all link))
- file point selection tmphist)
- (cond ((and files visit)
- ;; result(s) to visit
- (cond ((< 1 (length files))
- ;; more than one result
- (setq tmphist (mapcar (lambda(entry)
- (format "%s (%d) [%s]"
- (nth 3 entry) ; file
- (nth 2 entry) ; point
- (nth 1 entry))) files))
- (setq selection (completing-read "File: " tmphist
- nil t nil 'tmphist))
- (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
- (setq file (match-string 1 selection))
- (setq point (string-to-number (match-string 2 selection))))
- ((eq 1 (length files))
- ;; just one result
- (setq file (nth 3 (car files)))
- (setq point (nth 2 (car files)))))
- ;; visit the (selected) file
- (funcall org-registry-find-file file)
- (goto-char point)
- (unless (org-before-first-heading-p)
- (org-show-context)))
- ((and files (not visit))
- ;; result(s) to display
- (cond ((eq 1 (length files))
- ;; show one file
- (message "Link in file %s (%d) [%s]"
- (nth 3 (car files))
- (nth 2 (car files))
- (nth 1 (car files))))
- (t (org-registry-display-files files link))))
- (t (message "No link to this in org-agenda-files")))))
-
-(defun org-registry-display-files (files link)
- "Display files in a separate window."
- (switch-to-buffer-other-window
- (get-buffer-create " *Org registry info*"))
- (erase-buffer)
- (insert (format "Files pointing to %s:\n\n" link))
- (let (file)
- (while (setq file (pop files))
- (insert (format "%s (%d) [%s]\n" (nth 3 file)
- (nth 2 file) (nth 1 file)))))
- (shrink-window-if-larger-than-buffer)
- (other-window 1))
-
-(defun org-registry-assoc-all (link &optional registry)
- "Return all associated entries of LINK in the registry."
- (org-registry-find-all
- (lambda (entry) (string= link (car entry)))
- registry))
-
-(defun org-registry-find-all (test &optional registry)
- "Return all entries satisfying `test' in the registry."
- (delq nil
- (mapcar
- (lambda (x) (and (funcall test x) x))
- (or registry org-registry-alist))))
-
-;;;###autoload
-(defun org-registry-visit ()
- "If an Org file contains a link to the current location, visit
-this file."
- (interactive)
- (org-registry-show t))
-
-;;;###autoload
-(defun org-registry-initialize (&optional from-scratch)
- "Initialize `org-registry-alist'.
-If FROM-SCRATCH is non-nil or the registry does not exist yet,
-create a new registry from scratch and eval it. If the registry
-exists, eval `org-registry-file' and make it the new value for
-`org-registry-alist'."
- (interactive "P")
- (if (or from-scratch (not (file-exists-p org-registry-file)))
- ;; create a new registry
- (let ((files org-agenda-files) file)
- (while (setq file (pop files))
- (setq file (expand-file-name file))
- (mapc (lambda (entry)
- (add-to-list 'org-registry-alist entry))
- (org-registry-get-entries file)))
- (when from-scratch
- (org-registry-create org-registry-alist)))
- ;; eval the registry file
- (with-temp-buffer
- (insert-file-contents org-registry-file)
- (eval-buffer))))
-
-;;;###autoload
-(defun org-registry-insinuate ()
- "Call `org-registry-update' after saving in Org-mode.
-Use with caution. This could slow down things a bit."
- (interactive)
- (add-hook 'org-mode-hook
- (lambda() (add-hook 'after-save-hook
- 'org-registry-update t t))))
-
-(defun org-registry-get-entries (file)
- "List Org links in FILE that will be put in the registry."
- (let (bufstr result)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (while (re-search-forward org-angle-link-re nil t)
- (let* ((point (match-beginning 0))
- (link (match-string-no-properties 0))
- (desc (match-string-no-properties 0)))
- (add-to-list 'result (list link desc point file))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (let* ((point (match-beginning 0))
- (link (match-string-no-properties 1))
- (desc (or (match-string-no-properties 3) "No description")))
- (add-to-list 'result (list link desc point file)))))
- ;; return the list of new entries
- result))
-
-;;;###autoload
-(defun org-registry-update ()
- "Update the registry for the current Org file."
- (interactive)
- (unless (eq major-mode 'org-mode) (error "Not in org-mode"))
- (let* ((from-file (expand-file-name (buffer-file-name)))
- (new-entries (org-registry-get-entries from-file)))
- (with-temp-buffer
- (unless (file-exists-p org-registry-file)
- (org-registry-initialize t))
- (find-file org-registry-file)
- (goto-char (point-min))
- (while (re-search-forward (concat from-file "\")$") nil t)
- (let ((end (1+ (match-end 0)))
- (beg (progn (re-search-backward "^(\"" nil t)
- (match-beginning 0))))
- (delete-region beg end)))
- (goto-char (point-min))
- (re-search-forward "^(\"" nil t)
- (goto-char (match-beginning 0))
- (mapc (lambda (elem)
- (insert (with-output-to-string (prin1 elem)) "\n"))
- new-entries)
- (save-buffer)
- (kill-buffer (current-buffer)))
- (message (format "Org registry updated for %s"
- (file-name-nondirectory from-file)))))
-
-(defun org-registry-create (entries)
- "Create `org-registry-file' with ENTRIES."
- (let (entry)
- (with-temp-buffer
- (find-file org-registry-file)
- (erase-buffer)
- (insert
- (with-output-to-string
- (princ ";; -*- emacs-lisp -*-\n")
- (princ ";; Org registry\n")
- (princ ";; You shouldn't try to modify this buffer manually\n\n")
- (princ "(setq org-registry-alist\n'(\n")
- (while entries
- (when (setq entry (pop entries))
- (prin1 entry)
- (princ "\n")))
- (princ "))\n")))
- (save-buffer)
- (kill-buffer (current-buffer))))
- (message "Org registry created"))
-
-(provide 'org-registry)
-
-;;; User Options, Variables
-
-;;; org-registry.el ends here
diff --git a/contrib/lisp/org-screen.el b/contrib/lisp/org-screen.el
deleted file mode 100644
index e248994..0000000
--- a/contrib/lisp/org-screen.el
+++ /dev/null
@@ -1,106 +0,0 @@
-;;; org-screen.el --- Integreate Org-mode with screen.
-
-;; Copyright (c) 2008-2014 Andrew Hyatt
-;;
-;; Author: Andrew Hyatt <ahyatt at gmail dot com>
-;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
-;;
-;; This file is not yet part of GNU Emacs.
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This file contains functionality to integrate screen and org-mode.
-;; When using org-mode, it is often useful to take tasks that have
-;; some command-line work associated with them, and associate them
-;; with a screen session. Screen is used rather than a direct
-;; terminal to facilitate portability of the resulting session.
-;;
-;; To use screen in org, in your .emacs file, simply put this file in
-;; a directory in your load-path and write:
-;;
-;; (require 'org-screen)
-;;
-;; When have a task and want to start some command-line activity
-;; associated with that task, go to the end of your item and type:
-;;
-;; M-x org-screen
-;;
-;; This will prompt you for a name of a screen session. Type in a
-;; name and it will insert a link into your org file at your current
-;; location.
-;;
-;; When you want to visit the link, go to the link and type C-c C-o to
-;; open the link.
-;;
-;; You may want to get rid of the constant queries about whether you
-;; really want to execute lisp code. Do so by adding to your .emacs:
-;;
-;; (setq org-confirm-elisp-link-function nil)
-
-(require 'term)
-(require 'org)
-
-(defcustom org-screen-program-name "/usr/bin/screen"
- "Full location of the screen executable."
- :group 'org-screen
- :type 'string)
-
-(defun org-screen (name)
- "Start a screen session with name"
- (interactive "MScreen name: ")
- (save-excursion
- (org-screen-helper name "-S"))
- (insert (concat "[[screen:" name "]]")))
-
-(defun org-screen-buffer-name (name)
- "Returns the buffer name corresponding to the screen name given."
- (concat "*screen " name "*"))
-
-(defun org-screen-helper (name arg)
- "This method will create a screen session with a specified name
-and taking the specified screen arguments. Much of this function
-is copied from ansi-term method."
-
- ;; Pick the name of the new buffer.
- (let ((term-ansi-buffer-name
- (generate-new-buffer-name
- (org-screen-buffer-name name))))
- (setq term-ansi-buffer-name
- (term-ansi-make-term
- term-ansi-buffer-name org-screen-program-name nil arg name))
- (set-buffer term-ansi-buffer-name)
- (term-mode)
- (term-char-mode)
- (term-set-escape-char ?\C-x)
- term-ansi-buffer-name))
-
-(defun org-screen-goto (name)
- "Open the screen with the specified name in the window"
- (interactive "MScreen name: ")
- (let ((screen-buffer-name (org-screen-buffer-name name)))
- (if (member screen-buffer-name
- (mapcar 'buffer-name (buffer-list)))
- (org-pop-to-buffer-same-window screen-buffer-name)
- (org-pop-to-buffer-same-window (org-screen-helper name "-dr")))))
-
-(if org-link-abbrev-alist
- (add-to-list 'org-link-abbrev-alist
- '("screen" . "elisp:(org-screen-goto \"%s\")"))
- (setq org-link-abbrev-alist
- '(("screen" . "elisp:(org-screen-goto \"%s\")"))))
-
-(provide 'org-screen)
diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el
deleted file mode 100644
index 1e8e1e9..0000000
--- a/contrib/lisp/org-screenshot.el
+++ /dev/null
@@ -1,529 +0,0 @@
-;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
-;;
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-;;
-;; Author: Max Mikhanosha <max@openchat.com>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 8.0
-;;
-;; Released under the GNU General Public License version 3
-;; see: https://www.gnu.org/licenses/gpl-3.0.html
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; NOTE: This library requires external screenshot taking executable "scrot",
-;; which is available as a package from all major Linux distribution. If your
-;; distribution does not have it, source can be found at:
-;;
-;; http://freecode.com/projects/scrot
-;;
-;; org-screenshot.el have been tested with scrot version 0.8.
-;;
-;; Usage:
-;;
-;; (require 'org-screenshot)
-;;
-;; Available commands with default bindings
-;;
-;; `org-screenshot-take' C-c M-s M-t and C-c M-s M-s
-;;
-;; Take the screenshot, C-u argument delays 1 second, double C-u 2
seconds
-;; triple C-u 3 seconds, and subsequent C-u add 2 seconds to the delay.
-;;
-;; Screenshot area is selected with the mouse, or left-click on the
window
-;; for an entire window.
-;;
-;; `org-screenshot-rotate-prev' C-c M-s M-p and C-c M-s C-p
-;;
-;; Rotate screenshot before the point to one before it (sorted by date)
-;;
-;; `org-screenshot-rotate-next' C-c M-s M-n and C-c M-s C-n
-;;
-;; Rotate screenshot before the point to one after it
-;;
-;; `org-screenshot-show-unused' C-c M-s M-u and C-c M-s u
-;;
-;; Open dired buffer with screenshots that are not used in current
-;; Org buffer marked
-;;
-;; The screenshot take and rotate commands will update the inline images
-;; if they are already shown, if you are inserting first screenshot in the Org
-;; Buffer (and there are no other images shown), you need to manually display
-;; inline images with C-c C-x C-v
-;;
-;; Screenshot take and rotate commands offer user to continue by by using
single
-;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
-;; continue rotating screenshots by pressing just the last key of the binding
-;;
-;; For example: C-c M-s M-t creates the screenshot and then user can
-;; repeatedly press M-p or M-n to rotate it back and forth with
-;; previously taken ones.
-;;
-
-(require 'org)
-(require 'dired)
-
-(defgroup org-screenshot nil
- "Options for taking and managing screen-shots"
- :group 'org-link)
-
-(defcustom org-screenshot-image-directory "./images/"
- "Directory in which screenshot image files will be stored, it
-be automatically created if it doesn't already exist."
- :type 'string
- :group 'org-screenshot)
-
-(defcustom org-screenshot-file-name-format "screenshot-%2.2d.png"
- "The string used to generate screenshot file name.
-
-Any %d format string recipe will be expanded with `format'
-function with the argument of a screenshot sequence number.
-
-A sequence like %XXXX will be replaced with string of the same
-length as there are X's, consisting of random characters in the
-range of [A-Za-z]."
- :type 'string
- :group 'org-screenshot)
-
-(defcustom org-screenshot-max-tries 200
- "Number of times we will try to generate generate filename that
-does not exist. With default `org-screenshot-name-format' its the
-limit for number of screenshots, before `org-screenshot-take' is
-unable to come up with a unique name."
- :type 'integer
- :group 'org-screenshot)
-
-(defvar org-screenshot-map (make-sparse-keymap)
- "Map for OrgMode screenshot related commands")
-
-;; prefix
-(org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
-
-;; Mnemonic is Control-C Meta "Screenshot" "Take"
-(org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
-(org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
-
-;; No reason to require meta key, since its our own keymap
-(org-defkey org-screenshot-map "s" 'org-screenshot-take)
-(org-defkey org-screenshot-map "t" 'org-screenshot-take)
-
-;; Rotations, the fast rotation user hint, would prefer the modifier
-;; used by the original command that started the rotation
-(org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
-(org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
-(org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
-(org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)
-
-;; Show unused image files in Dired
-(org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
-(org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)
-
-
-(random t)
-
-(defun org-screenshot-random-string (length)
- "Generate a random string of LENGTH consisting of random upper
-case and lower case letters."
- (let ((name (make-string length ?x)))
- (dotimes (i length)
- (let ((n (random 52)))
- (aset name i (if (< n 26)
- (+ ?a n)
- (+ ?A n -26)))))
- name))
-
-(defvar org-screenshot-process nil
- "Currently running screenshot process")
-
-(defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))
-
-(defun org-screenshot-update-seq-number (directory &optional reset)
- "Set `org-screenshot-file-name-format' sequence number for the directory.
-When RESET is NIL, increments the number stored, otherwise sets
-RESET as a new number. Intended to be called if screenshot was
-successful. Updating of sequence number is done in two steps, so
-aborted/canceled screenshot attempts don't increase the number"
-
- (setq directory (file-name-as-directory directory))
- (puthash directory (if reset
- (if (numberp reset) reset 1)
- (1+ (gethash directory
- org-screenshot-directory-seq-numbers
- 0)))
- org-screenshot-directory-seq-numbers))
-
-(defun org-screenshot-generate-file-name (directory)
- "Use `org-screenshot-name-format' to generate new screenshot
-file name for a specific directory. Keeps re-generating name if
-it already exists, up to `org-screenshot-max-tries'
-times. Returns just the file, without directory part"
- (setq directory (file-name-as-directory directory))
- (when (file-exists-p directory)
- (let ((tries 0)
- name
- had-seq
- (case-fold-search nil))
- (while (and (< tries org-screenshot-max-tries)
- (not name))
- (incf tries)
- (let ((tmp org-screenshot-file-name-format)
- (seq-re "%[-0-9.]*d")
- (rand-re "%X+"))
- (when (string-match seq-re tmp)
- (let ((seq (gethash
- directory
- org-screenshot-directory-seq-numbers 1)))
- (setq tmp
- (replace-regexp-in-string
- seq-re (format (match-string 0 tmp) seq)
- tmp)
- had-seq t)))
- (when (string-match rand-re tmp)
- (setq tmp
- (replace-regexp-in-string
- rand-re (org-screenshot-random-string
- (1- (length (match-string 0 tmp))))
- tmp t)))
- (let ((fullname (concat directory tmp)))
- (if (file-exists-p fullname)
- (when had-seq (org-screenshot-update-seq-number directory))
- (setq name tmp)))))
- name)))
-
-(defun org-screenshot-image-directory ()
- "Return the `org-screenshot-image-directory', ensuring there is
-trailing slash, and that it exists"
- (let ((dir (file-name-as-directory org-screenshot-image-directory)))
- (if (file-exists-p dir)
- dir
- (make-directory dir t)
- dir)))
-
-(defvar org-screenshot-last-file nil
- "File name of the last taken or rotated screenshot file,
-without directory")
-
-(defun org-screenshot-process-done (process event file
- orig-buffer
- orig-delay
- orig-event)
- "Called when \"scrot\" process exits. PROCESS and EVENT are
-same arguments as in `set-process-sentinel'. ORIG-BUFFER,
-ORIG-DELAY and ORIG-EVENT are Org Buffer, the screenshot delay
-used, and LAST-INPUT-EVENT values from when screenshot was
-initiated.
-"
- (setq org-screenshot-process nil)
- (with-current-buffer (process-buffer process)
- (if (not (equal event "finished\n"))
- (progn
- (insert event)
- (cond ((save-excursion
- (goto-char (point-min))
- (re-search-forward "Key was pressed" nil t))
- (ding)
- (message "Key was pressed, screenshot aborted"))
- (t
- (display-buffer (process-buffer process))
- (message "Error running \"scrot\" program")
- (ding))))
- (with-current-buffer orig-buffer
- (let ((link (format "[[file:%s]]" file)))
- (setq org-screenshot-last-file (file-name-nondirectory file))
- (let ((beg (point)))
- (insert link)
- (when org-inline-image-overlays
- (org-display-inline-images nil t beg (point))))
- (unless (< orig-delay 3)
- (ding))
- (org-screenshot-rotate-continue t orig-event))))))
-
-
-;;;###autoload
-(defun org-screenshot-take (&optional delay)
- "Take a screenshot and insert link to it at point, if image
-display is already on (see \\[org-toggle-inline-images])
-screenshot will be displayed as an image
-
-Screen area for the screenshot is selected with the mouse, left
-click on a window screenshots that window, while left click and
-drag selects a region. Pressing any key cancels the screen shot
-
-With `C-u' universal argument waits one second after target is
-selected before taking the screenshot. With double `C-u' wait two
-seconds.
-
-With triple `C-u' wait 3 seconds, and also rings the bell when
-screenshot is done, any more `C-u' after that increases delay by
-2 seconds
-"
- (interactive "P")
-
- ;; probably easier way to count number of C-u C-u out there
- (setq delay
- (cond ((null delay) 0)
- ((integerp delay) delay)
- ((and (consp delay)
- (integerp (car delay))
- (plusp (car delay)))
- (let ((num 1)
- (limit (car delay))
- (cnt 0))
- (while (< num limit)
- (setq num (* num 4)
- cnt (+ cnt (if (< cnt 3) 1 2))))
- cnt))
- (t (error "Invalid delay"))))
- (when (and org-screenshot-process
- (member (process-status org-screenshot-process)
- '(run stop)))
- (error "scrot process is still running"))
- (let* ((name (org-screenshot-generate-file-name
(org-screenshot-image-directory)))
- (file (format "%s%s" (org-screenshot-image-directory)
- name))
- (path (expand-file-name file)))
- (when (get-buffer "*scrot*")
- (with-current-buffer (get-buffer "*scrot*")
- (erase-buffer)))
- (setq org-screenshot-process
- (or
- (apply 'start-process
- (append
- (list "scrot" "*scrot*" "scrot" "-s" path)
- (when (plusp delay)
- (list "-d" (format "%d" delay)))))
- (error "Unable to start scrot process")))
- (when org-screenshot-process
- (if (plusp delay)
- (message "Click on a window, or select a rectangle (delay is %d
sec)..."
- delay)
- (message "Click on a window, or select a rectangle..."))
- (set-process-sentinel
- org-screenshot-process
- `(lambda (process event)
- (org-screenshot-process-done
- process event ,file ,(current-buffer) ,delay
',last-input-event))))))
-
-(defvar org-screenshot-file-list nil
- "List of files in `org-screenshot-image-directory' used by
-`org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")
-
-(defvar org-screenshot-rotation-index -1)
-
-(make-variable-buffer-local 'org-screenshot-file-list)
-(make-variable-buffer-local 'org-screenshot-rotation-index)
-
-(defun org-screenshot-rotation-init (lastfile)
- "Initialize variable `org-screenshot-file-list' variable with
-the list of PNG files in `org-screenshot-image-directory' sorted
-by most recent first"
- (setq
- org-screenshot-rotation-index -1
- org-screenshot-file-list
- (let ((files (directory-files org-screenshot-image-directory
- t (image-file-name-regexp) t)))
- (mapcar 'file-name-nondirectory
- (sort files
- (lambda (file1 file2)
- (let ((mtime1 (nth 5 (file-attributes file1)))
- (mtime2 (nth 5 (file-attributes file2))))
- (setq mtime1 (+ (ash (first mtime1) 16)
- (second mtime1)))
- (setq mtime2 (+ (ash (first mtime2) 16)
- (second mtime2)))
- (> mtime1 mtime2)))))))
- (let ((n -1) (list org-screenshot-file-list))
- (while (and list (not (equal (pop list) lastfile)))
- (incf n))
- (setq org-screenshot-rotation-index n)))
-
-(defun org-screenshot-do-rotate (dir from-continue-rotating)
- "Rotate last screenshot with one of the previously taken
-screenshots from the same directory. If DIR is negative, in the
-other direction"
- (setq org-screenshot-last-file nil)
- (let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
- done
- (link-re
- ;; taken from `org-display-inline-images'
- (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (image-file-name-regexp) 0 -2)
- "\\)\\]"))
- newfile oldfile)
- (save-excursion
- ;; Search for link to image file in the same directory before the point
- (while (not done)
- (if (not (re-search-backward link-re (point-min) t))
- (error "Unable to find link to image from %S directory before
point" ourdir)
- (let ((file (concat (or (match-string 3) "") (match-string 4))))
- (when (equal (file-name-directory file)
- ourdir)
- (setq done t
- oldfile (file-name-nondirectory file))))))
- (when (or (null org-screenshot-file-list)
- (and (not from-continue-rotating)
- (not (member last-command
- '(org-screenshot-rotate-prev
- org-screenshot-rotate-next)))))
- (org-screenshot-rotation-init oldfile))
- (unless (> (length org-screenshot-file-list) 1)
- (error "Can't rotate a single image file"))
- (replace-match "" nil nil nil 1)
-
- (setq org-screenshot-rotation-index
- (mod (+ org-screenshot-rotation-index dir)
- (length org-screenshot-file-list))
- newfile (nth org-screenshot-rotation-index
- org-screenshot-file-list))
- ;; in case we started rotating from the file we just inserted,
- ;; advance one more time
- (when (equal oldfile newfile)
- (setq org-screenshot-rotation-index
- (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
- (length org-screenshot-file-list))
- newfile (nth org-screenshot-rotation-index
- org-screenshot-file-list)))
- (replace-match (concat "file:" ourdir
- newfile)
- t t nil 4))
- ;; out of save-excursion
- (setq org-screenshot-last-file newfile)
- (when org-inline-image-overlays
- (org-display-inline-images nil t (match-beginning 0) (point)))))
-
-;;;###autoload
-(defun org-screenshot-rotate-prev (dir)
- "Rotate last screenshot with one of the previously taken
-screenshots from the same directory. If DIR is negative, rotate
-in the other direction"
- (interactive "p")
- (org-screenshot-do-rotate dir nil)
- (when org-screenshot-last-file
- (org-screenshot-rotate-continue nil nil)))
-
-;;;###autoload
-(defun org-screenshot-rotate-next (dir)
- "Rotate last screenshot with one of the previously taken
-screenshots from the same directory. If DIR is negative, rotate
-in the other direction"
- (interactive "p")
- (org-screenshot-do-rotate (- dir) nil)
- (when org-screenshot-last-file
- (org-screenshot-rotate-continue nil nil)))
-
-(defun org-screenshot-prefer-same-modifiers (list event)
- (if (not (eventp nil)) (car list)
- (let (ret (keys list))
- (while (and (null ret) keys)
- (let ((key (car keys)))
- (if (and (= 1 (length key))
- (equal (event-modifiers event)
- (event-modifiers (elt key 0))))
- (setq ret (car keys))
- (setq keys (cdr keys)))))
- (or ret (car list)))))
-
-(defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
- "Display the message with the name of the last changed
-image-file and inform user that they can rotate by pressing keys
-bound to `org-screenshot-rotate-next' and
-`org-screenshot-rotate-prev' in `org-screenshot-map'
-
-This works similarly to `kmacro-end-or-call-macro' so that user
-can press a long key sequence to invoke the first command, and
-then uses single keys to rotate, until unregognized key is
-entered, at which point event will be unread"
-
- (let* ((event (if from-take-screenshot orig-event
- last-input-event))
- done
- (prev-key
- (org-screenshot-prefer-same-modifiers
- (where-is-internal 'org-screenshot-rotate-prev
- org-screenshot-map nil)
- event))
- (next-key
- (org-screenshot-prefer-same-modifiers
- (where-is-internal 'org-screenshot-rotate-next
- org-screenshot-map nil)
- event))
- prev-key-str next-key-str)
- (when (and (= (length prev-key) 1)
- (= (length next-key) 1))
- (setq
- prev-key-str (format-kbd-macro prev-key nil)
- next-key-str (format-kbd-macro next-key nil)
- prev-key (elt prev-key 0)
- next-key (elt next-key 0))
- (while (not done)
- (message "%S - '%s' and '%s' to rotate"
- org-screenshot-last-file prev-key-str next-key-str)
- (setq event (read-event))
- (cond ((equal event prev-key)
- (clear-this-command-keys t)
- (org-screenshot-do-rotate 1 t)
- (setq last-input-event nil))
- ((equal event next-key)
- (clear-this-command-keys t)
- (org-screenshot-do-rotate -1 t)
- (setq last-input-event nil))
- (t (setq done t))))
- (when last-input-event
- (clear-this-command-keys t)
- (setq unread-command-events (list last-input-event))))))
-
-;;;###autoload
-(defun org-screenshot-show-unused ()
- "Open A Dired buffer with unused screenshots marked"
- (interactive)
- (let ((files-in-buffer)
- dired-buffer
- had-any
- (image-re (image-file-name-regexp))
- beg end)
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char beg)
- (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (image-file-name-regexp) 0 -2)
- "\\)\\]"))
- (case-fold-search t)
- old file ov img type attrwidth width)
- (while (re-search-forward re end t)
- (setq file (concat (or (match-string 3) "") (match-string 4)))
- (when (and (file-exists-p file)
- (equal (file-name-directory file)
- (org-screenshot-image-directory)))
- (push (file-name-nondirectory file)
- files-in-buffer))))))
- (setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
- (with-current-buffer dired-buffer
- (dired-unmark-all-files ?\r)
- (dired-mark-if
- (let ((file (dired-get-filename 'no-dir t)))
- (and file (string-match image-re file)
- (not (member file files-in-buffer))
- (setq had-any t)))
- "Unused screenshot"))
- (when had-any (pop-to-buffer dired-buffer))))
-
-(provide 'org-screenshot)
diff --git a/contrib/lisp/org-secretary.el b/contrib/lisp/org-secretary.el
deleted file mode 100644
index bba5e8b..0000000
--- a/contrib/lisp/org-secretary.el
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; org-secretary.el --- Team management with org-mode
-;; Copyright (C) 2010-2014 Juan Reyero
-;;
-;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
-;; Keywords: outlines, tasks, team, management
-;; Homepage: http://juanreyero.com/article/emacs/org-teams.html
-;; Version: 0.02
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This file is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; THis file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This module implements helper functions for team management. It
-;; makes it easy to keep track of the work of several people. It
-;; keeps context (with whom and where you are) and allows you to use
-;; it to metadata to your notes, and to query the tasks associated
-;; with the people you are with and the place.
-;;
-;; See http://juanreyero.com/article/emacs/org-teams.html for a full
-;; explanation and configuration instructions.
-;;
-;;; Configuration
-;;;;;;;;;;;;;;;;;
-;;
-;; In short; your todos use the TODO keyword, your team's use TASK.
-;; Your org-todo-keywords should look something like this:
-;;
-;; (setq org-todo-keywords
-;; '((sequence "TODO(t)" "|" "DONE(d)" "CANCELLED(c)")
-;; (sequence "TASK(f)" "|" "DONE(d)")
-;; (sequence "MAYBE(m)" "|" "CANCELLED(c)")))
-;;
-;; It helps to distinguish them by color, like this:
-;;
-;; (setq org-todo-keyword-faces
-;; '(("TODO" . (:foreground "DarkOrange1" :weight bold))
-;; ("MAYBE" . (:foreground "sea green"))
-;; ("DONE" . (:foreground "light sea green"))
-;; ("CANCELLED" . (:foreground "forest green"))
-;; ("TASK" . (:foreground "blue"))))
-;;
-;; If you want to keep track of stuck projects you should tag your
-;; projects with :prj:, and define:
-;;
-;; (setq org-tags-exclude-from-inheritance '("prj")
-;; org-stuck-projects '("+prj/-MAYBE-DONE"
-;; ("TODO" "TASK") ()))
-;;
-;; Define a tag that marks TASK entries as yours:
-;;
-;; (setq org-sec-me "juanre")
-;;
-;; Finally, you add the special views to your org-agenda-custom-commands:
-;;
-;; (setq org-agenda-custom-commands
-;; '(("h" "Work todos" tags-todo
-;; "-personal-doat={.+}-dowith={.+}/!-TASK"
-;; ((org-agenda-todo-ignore-scheduled t)))
-;; ("H" "All work todos" tags-todo "-personal/!-TASK-MAYBE"
-;; ((org-agenda-todo-ignore-scheduled nil)))
-;; ("A" "Work todos with doat or dowith" tags-todo
-;; "-personal+doat={.+}|dowith={.+}/!-TASK"
-;; ((org-agenda-todo-ignore-scheduled nil)))
-;; ("j" "TODO dowith and TASK with"
-;; ((org-sec-with-view "TODO dowith")
-;; (org-sec-where-view "TODO doat")
-;; (org-sec-assigned-with-view "TASK with")
-;; (org-sec-stuck-with-view "STUCK with")))
-;; ("J" "Interactive TODO dowith and TASK with"
-;; ((org-sec-who-view "TODO dowith")))))
-;;
-;;; Usage
-;;;;;;;;;
-;;
-;; Do C-c w to say with whom you are meeting (a space-separated list
-;; of names). Maybe do also C-c W to say where you are. Then do C-c a
-;; j to see:
-;; - Todo items defined with TODO (ie, mine) in which the
-;; =dowith= property matches any of the people with me.
-;; - Todo items defined with TODO in which the =doat= property
-;; matches my current location.
-;; - Todo items defined with TASK that are tagged with the name
-;; of any of the people with me (this is, assigned to them).
-;; - Stuck projects tagged with the name of the people with me.
-;;
-;; Use C-c j to add meta-data with the people with me, the
-;; location and the time to entries.
-
-(require 'org)
-
-(defvar org-sec-me nil
- "Tag that defines TASK todo entries associated to me")
-
-(defvar org-sec-with nil
- "Value of the :with: property when doing an
- org-sec-tag-entry. Change it with org-sec-set-with,
- set to C-c w. Defaults to org-sec-me")
-
-(defvar org-sec-where ""
- "Value of the :at: property when doing an
- org-sec-tag-entry. Change it with org-sec-set-with,
- set to C-c W")
-
-(defvar org-sec-with-history '()
- "History list of :with: properties")
-
-(defvar org-sec-where-history '()
- "History list of :where: properties")
-
-(defun org-sec-set-with ()
- "Changes the value of the org-sec-with variable for use in the
- next call of org-sec-tag-entry. Leave it empty to default to
- org-sec-me (you)."
- (interactive)
- (setq org-sec-with (let ((w (read-string "With: " nil
- 'org-sec-with-history "")))
- (if (string= w "")
- nil
- w))))
-(global-set-key "\C-cw" 'org-sec-set-with)
-
-(defun org-sec-set-where ()
- "Changes the value of the org-sec-where variable for use
- in the next call of org-sec-tag-entry."
- (interactive)
- (setq org-sec-where
- (read-string "Where: " nil
- 'org-sec-where-history "")))
-(global-set-key "\C-cW" 'org-sec-set-where)
-
-(defun org-sec-set-dowith ()
- "Sets the value of the dowith property."
- (interactive)
- (let ((do-with
- (read-string "Do with: "
- nil 'org-sec-dowith-history "")))
- (unless (string= do-with "")
- (org-entry-put nil "dowith" do-with))))
-(global-set-key "\C-cd" 'org-sec-set-dowith)
-
-(defun org-sec-set-doat ()
- "Sets the value of the doat property."
- (interactive)
- (let ((do-at (read-string "Do at: "
- nil 'org-sec-doat-history "")))
- (unless (string= do-at "")
- (org-entry-put nil "doat" do-at))))
-(global-set-key "\C-cD" 'org-sec-set-doat)
-
-(defun org-sec-tag-entry ()
- "Adds a :with: property with the value of org-sec-with if
- defined, an :at: property with the value of org-sec-where
- if defined, and an :on: property with the current time."
- (interactive)
- (save-excursion
- (org-entry-put nil "on" (format-time-string
- (org-time-stamp-format 'long)
- (current-time)))
- (unless (string= org-sec-where "")
- (org-entry-put nil "at" org-sec-where))
- (if org-sec-with
- (org-entry-put nil "with" org-sec-with))))
-(global-set-key "\C-cj" 'org-sec-tag-entry)
-
-(defun join (lst sep &optional pre post)
- (mapconcat (lambda (x) (concat pre x post)) lst sep))
-
-(defun org-sec-get-with ()
- (if org-sec-with
- org-sec-with
- org-sec-me))
-
-(defun org-sec-with-view (par &optional who)
- "Select tasks marked as dowith=who, where who
- defaults to the value of org-sec-with."
- (org-tags-view '(4) (join (split-string (if who
- who
- (org-sec-get-with)))
- "|" "dowith=\"" "\"")))
-
-(defun org-sec-where-view (par)
- "Select tasks marked as doat=org-sec-where."
- (org-tags-view '(4) (concat "doat={" org-sec-where "}")))
-
-(defun org-sec-assigned-with-view (par &optional who)
- "Select tasks assigned to who, by default org-sec-with."
- (org-tags-view '(4)
- (concat (join (split-string (if who
- who
- (org-sec-get-with)))
- "|")
- "/TASK")))
-
-(defun org-sec-stuck-with-view (par &optional who)
- "Select stuck projects assigned to who, by default
- org-sec-with."
- (let ((org-stuck-projects
- `(,(concat "+prj+"
- (join (split-string (if who
- who
- (org-sec-get-with))) "|")
- "/-MAYBE-DONE")
- ("TODO" "TASK") ())))
- (org-agenda-list-stuck-projects)))
-
-(defun org-sec-who-view (par)
- "Builds agenda for a given user. Queried. "
- (let ((who (read-string "Build todo for user/tag: "
- "" "" "")))
- (org-sec-with-view "TODO dowith" who)
- (org-sec-assigned-with-view "TASK with" who)
- (org-sec-stuck-with-view "STUCK with" who)))
-
-(provide 'org-secretary)
-
-;;; org-secretary.el ends here
diff --git a/contrib/lisp/org-static-mathjax.el
b/contrib/lisp/org-static-mathjax.el
deleted file mode 100644
index aed3e30..0000000
--- a/contrib/lisp/org-static-mathjax.el
+++ /dev/null
@@ -1,187 +0,0 @@
-;;; org-static-mathjax.el --- Muse-like tags in Org-mode
-;;
-;; Author: Jan Böker <jan dot boecker at jboecker dot de>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This elisp code integrates Static MathJax into the
-;; HTML export process of Org-mode.
-;;
-;; The supporting files for this package are in contrib/scripts/staticmathjax
-;; Please read the README.org file in that directory for more information.
-
-;; To use it, evaluate it on startup, add the following to your .emacs:
-
-;; (require 'org-static-mathjax)
-;;
-;; You will then have to customize the following two variables:
-;; - org-static-mathjax-app-ini-path
-;; - org-static-mathjax-local-mathjax-path
-;;
-;; If xulrunner is not in your $PATH, you will also need to customize
-;; org-static-mathjax-xulrunner-path.
-;;
-;; If everything is setup correctly, you can trigger Static MathJax on
-;; export to HTML by adding the following line to your Org file:
-;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html"
-;;
-;; You can omit either argument.
-;; embed-fonts defaults to nil. If you do not specify output-file-name,
-;; the exported file is overwritten with the static version.
-;;
-;; If embed-fonts is non-nil, the fonts are embedded directly into the
-;; output file using data: URIs.
-;;
-;; output-file-name specifies the file name of the static version. You
-;; can use any arbitrary lisp form here, for example:
-;; output-file-name:(concat (file-name-sans-extension buffer-file-name)
"-static.html")
-;;
-;; The StaticMathJax XULRunner application expects a UTF-8 encoded
-;; input file. If the static version displays random characters instead
-;; of your math, add the following line at the top of your Org file:
-;; -*- coding: utf-8; -*-
-;;
-;;; Code:
-
-(defcustom org-static-mathjax-app-ini-path
- (or (expand-file-name
- "../scripts/staticmatchjax/application.ini"
- (file-name-directory (or load-file-name buffer-file-name)))
- "")
- "Path to \"application.ini\" of the Static MathJax XULRunner application.
-If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set
-this to ~/.local/staticmathjax/application.ini"
- :type 'string)
-
-(defcustom org-static-mathjax-xulrunner-path
- "xulrunner"
- "Path to your xulrunner binary"
- :type 'string)
-
-(defcustom org-static-mathjax-local-mathjax-path
- ""
- "Extract the MathJax zip file somewhere on your local
-hard drive and specify the path here.
-
-The directory has to be writeable, as org-static-mathjax
-creates a temporary file there during export."
- :type 'string)
-
-(defvar org-static-mathjax-debug
- nil
- "If non-nil, org-static-mathjax will print some debug messages")
-
-(defun org-static-mathjax-hook-installer ()
- "Installs org-static-mathjax-process in after-save-hook.
-
-Sets the following buffer-local variables for org-static-mathjax-process to
pick up:
-org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML
export
-org-static-mathjax-options: The string given with #+STATICMATHJAX: in the
file"
- (let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax)))
- (if static-mathjax-option-string
- (progn (set (make-local-variable 'org-static-mathjax-options)
static-mathjax-option-string)
- (set (make-local-variable
'org-static-mathjax-mathjax-path)
- (nth 1 (assq 'path
org-export-html-mathjax-options)))
- (let ((mathjax-options (plist-get opt-plist
:mathjax)))
- (if mathjax-options
- (if (string-match "\\<path:"
mathjax-options)
- (set
'org-static-mathjax-mathjax-path
- (car (read-from-string
-
(substring mathjax-options (match-end 0))))))))
- (add-hook 'after-save-hook
- 'org-static-mathjax-process
- nil t)))))
-
-
-(defun org-static-mathjax-process ()
- (save-excursion
- ; some sanity checking
- (if (or (string= org-static-mathjax-app-ini-path "")
- (not (file-exists-p org-static-mathjax-app-ini-path)))
- (error "Static MathJax: You must customize
org-static-mathjax-app-ini-path!"))
- (if (or (string= org-static-mathjax-local-mathjax-path "")
- (not (file-exists-p
org-static-mathjax-local-mathjax-path)))
- (error "Static MathJax: You must customize
org-static-mathjax-local-mathjax-path!"))
-
- ; define variables
- (let* ((options org-static-mathjax-options)
- (output-file-name buffer-file-name)
- (input-file-name (let ((temporary-file-directory
(file-name-directory org-static-mathjax-local-mathjax-path)))
- (make-temp-file
"org-static-mathjax-" nil ".html")))
- (html-code (buffer-string))
- (mathjax-oldpath (concat "src=\""
org-static-mathjax-mathjax-path))
- (mathjax-newpath (concat "src=\""
org-static-mathjax-local-mathjax-path))
- embed-fonts)
- ; read file-local options
- (mapc
- (lambda (symbol)
- (if (string-match (concat "\\<" (symbol-name symbol) ":")
options)
- (set symbol (eval (car (read-from-string
-
(substring options (match-end 0))))))))
- '(embed-fonts output-file-name))
-
- ; debug
- (when org-static-mathjax-debug
- (message "output file name, embed-fonts")
- (print output-file-name)
- (print embed-fonts))
-
- ; open (temporary) input file, copy contents there, replace MathJax
path with local installation
- (with-temp-buffer
- (insert html-code)
- (goto-char 1)
- (replace-regexp mathjax-oldpath mathjax-newpath)
- (write-file input-file-name))
-
- ; prepare argument list for call-process
- (let ((call-process-args (list org-static-mathjax-xulrunner-path
- nil
nil nil
-
org-static-mathjax-app-ini-path
-
input-file-name
-
output-file-name)))
- ; if fonts are embedded, just append the --embed-fonts flag
- (if embed-fonts
- (add-to-list 'call-process-args "--embed-fonts" t))
- ; if fonts are not embedded, the XULRunner app must replace all
references
- ; to the font files with the real location (Firefox inserts
file:// URLs there,
- ; because we are using a local MathJax installation here)
- (if (not embed-fonts)
- (progn
- (add-to-list 'call-process-args "--final-mathjax-url"
t)
- (add-to-list 'call-process-args
- (file-name-directory
org-static-mathjax-mathjax-path)
- t)))
-
- ; debug
- (when org-static-mathjax-debug
- (print call-process-args))
- ; call it
- (apply 'call-process call-process-args)
- ; delete our temporary input file
- (kill-buffer)
- (delete-file input-file-name)
- (let ((backup-file (concat input-file-name "~")))
- (if (file-exists-p backup-file)
- (delete-file backup-file)))))))
-
-(add-to-list 'org-export-inbuffer-options-extra
-'("STATICMATHJAX" :static-mathjax))
-
-(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer)
-
-
-(provide 'org-static-mathjax)
diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el
deleted file mode 100644
index ca6eb4e..0000000
--- a/contrib/lisp/org-sudoku.el
+++ /dev/null
@@ -1,288 +0,0 @@
-;;; org-sudoku.el --- Create and solve SUDOKU games in Org tables
-
-;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp, games
-;; Homepage: https://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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; This is a quick hack to create and solve SUDOKU games in org tables.
-;;
-;; Commands:
-;;
-;; org-sudoku-create Create a new SUDOKU game
-;; org-sudoku-solve-field Solve the field at point in a SUDOKU game
-;; (this is for cheeting when you are stuck)
-;; org-sudoku-solve Solve the entire game
-;;
-
-;;; Code
-
-(require 'org)
-(require 'org-table)
-
-;;; Customization
-
-(defvar org-sudoku-size 9
- "The size of the sudoku game, 9 for a 9x9 game and 4 for a 4x4 game.
-Larger games do not seem to work because of limited resources - even though
-the algorithm is general.")
-
-(defvar org-sudoku-timeout 2.0
- "Timeout for finding a solution when creating a new game.
-After this timeout, the program starts over from scratch to create
-a game.")
-
-;;; Interactive commands
-
-(defun org-sudoku-create (nfilled)
- "Create a sudoku game."
- (interactive "nNumber of pre-filled fields: ")
- (let ((sizesq org-sudoku-size)
- game)
- (loop for i from 1 to org-sudoku-size do
- (loop for j from 1 to org-sudoku-size do
- (push (list (cons i j) 0) game)))
- (setq game (nreverse game))
- (random t)
- (setq game (org-sudoku-build-allowed game))
- (setq game (org-sudoku-set-field game (cons 1 1)
- (1+ (random org-sudoku-size))))
- (catch 'solved
- (let ((cnt 0))
- (while t
- (catch 'abort
- (message "Attempt %d to create a game" (setq cnt (1+ cnt)))
- (setq game1 (org-sudoku-deep-copy game))
- (setq game1 (org-sudoku-solve-game
- game1 'random (+ (float-time) org-sudoku-timeout)))
- (when game1
- (setq game game1)
- (throw 'solved t))))))
- (let ((sqrtsize (floor (sqrt org-sudoku-size))))
- (loop for i from 1 to org-sudoku-size do
- (insert "| |\n")
- (if (and (= (mod i sqrtsize) 0) (< i org-sudoku-size))
- (insert "|-\n")))
- (backward-char 5)
- (org-table-align))
- (while (> (length game) nfilled)
- (setq game (delete (nth (1+ (random (length game))) game) game)))
- (mapc (lambda (e)
- (org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
- game)
- (org-table-align)
- (org-table-goto-line 1)
- (org-table-goto-column 1)
- (message "Enjoy!")))
-
-(defun org-sudoku-solve ()
- "Solve the sudoku game in the table at point."
- (interactive)
- (unless (org-at-table-p)
- (error "not at a table"))
- (let (game)
- (setq game (org-sudoku-get-game))
- (setq game (org-sudoku-build-allowed game))
- (setq game (org-sudoku-solve-game game))
- ;; Insert the values
- (mapc (lambda (e)
- (org-table-put (caar e) (cdar e) (int-to-string (nth 1 e))))
- game)
- (org-table-align)))
-
-(defun org-sudoku-solve-field ()
- "Just solve the field at point.
-This works by solving the whole game, then inserting only the single field."
- (interactive)
- (unless (org-at-table-p)
- (error "Not at a table"))
- (org-table-check-inside-data-field)
- (let ((i (org-table-current-dline))
- (j (org-table-current-column))
- game)
- (setq game (org-sudoku-get-game))
- (setq game (org-sudoku-build-allowed game))
- (setq game (org-sudoku-solve-game game))
- (if game
- (progn
- (org-table-put i j (number-to-string
- (nth 1 (assoc (cons i j) game)))
- 'align)
- (org-table-goto-line i)
- (org-table-goto-column j))
- (error "No solution"))))
-
-;;; Internal functions
-
-(defun org-sudoku-get-game ()
- "Interpret table at point as sudoku game and read it.
-A game structure is returned."
- (let (b e g i j game)
-
- (org-table-goto-line 1)
- (org-table-goto-column 1)
- (setq b (point))
- (org-table-goto-line org-sudoku-size)
- (org-table-goto-column org-sudoku-size)
- (setq e (point))
- (setq g (org-table-copy-region b e))
- (setq i 0 j 0)
- (mapc (lambda (c)
- (setq i (1+ i) j 0)
- (mapc
- (lambda (v)
- (setq j (1+ j))
- (push (list (cons i j)
- (string-to-number v))
- game))
- c))
- g)
- (nreverse game)))
-
-(defun org-sudoku-build-allowed (game)
- (let (i j v numbers)
- (loop for i from 1 to org-sudoku-size do
- (push i numbers))
- (setq numbers (nreverse numbers))
- ;; add the lists of allowed values for each entry
- (setq game (mapcar
- (lambda (e)
- (list (car e) (nth 1 e)
- (if (= (nth 1 e) 0)
- (copy-sequence numbers)
- nil)))
- game))
- ;; remove the known values from the list of allowed values
- (mapc
- (lambda (e)
- (setq i (caar e) j (cdar e) v (cadr e))
- (when (> v 0)
- ;; We do have a value here
- (mapc
- (lambda (f)
- (setq a (assoc f game))
- (setf (nth 2 a) (delete v (nth 2 a))))
- (cons (cons i j) (org-sudoku-rel-fields i j)))))
- game)
- game))
-
-(defun org-sudoku-find-next-constrained-field (game)
- (setq game (mapcar (lambda (e) (if (nth 2 e) e nil)) game))
- (setq game (delq nil game))
- (let (va vb la lb)
- (setq game
- (sort game (lambda (a b)
- (setq va (nth 1 a) vb (nth 1 b)
- la (length (nth 2 a)) lb (length (nth 2 b)))
- (cond
- ((and (= va 0) (> vb 0)) t)
- ((and (> va 0) (= vb 0)) nil)
- ((not (= (* va vb) 0)) nil)
- (t (< la lb))))))
- (if (or (not game) (> 0 (nth 1 (car game))))
- nil
- (caar game))))
-
-(defun org-sudoku-solve-game (game &optional random stop-at)
- "Solve GAME.
-If RANDOM is non-nit, select candidates randomly from a fields option.
-If RANDOM is nil, always start with the first allowed value and try
-solving from there.
-STOP-AT can be a float time, the solver will abort at that time because
-it is probably stuck."
- (let (e v v1 allowed next g)
- (when (and stop-at
- (> (float-time) stop-at))
- (setq game nil)
- (throw 'abort nil))
- (while (setq next (org-sudoku-find-next-constrained-field game))
- (setq e (assoc next game)
- v (nth 1 e)
- allowed (nth 2 e))
- (catch 'solved
- (if (= (length allowed) 1)
- (setq game (org-sudoku-set-field game next (car allowed)))
- (while allowed
- (setq g (org-sudoku-deep-copy game))
- (if (not random)
- (setq v1 (car allowed))
- (setq v1 (nth (random (length allowed)) allowed)))
- (setq g (org-sudoku-set-field g next v1))
- (setq g (org-sudoku-solve-game g random stop-at))
- (when g
- (setq game g)
- (throw 'solved g)))
- (setq game nil))))
- (if (or (not game)
- (org-sudoku-unknown-field-p game))
- nil
- game)))
-
-(defun org-sudoku-unknown-field-p (game)
- "Are there still unknown fields in the game?"
- (delq nil (mapcar (lambda (e) (if (> (nth 1 e) 0) nil t)) game)))
-
-(defun org-sudoku-deep-copy (game)
- "Make a copy of the game so that manipulating the copy does not change the
parent."
- (mapcar (lambda(e)
- (list (car e) (nth 1 e) (copy-sequence (nth 2 e))))
- game))
-
-(defun org-sudoku-set-field (game field value)
- "Put VALUE into FIELD, and tell related fields that they cannot be VALUE."
- (let (i j)
- (setq i (car field) j (cdr field))
- (setq a (assoc field game))
- (setf (nth 1 a) value)
- (setf (nth 2 a) nil)
-
- ;; Remove value from all related fields
- (mapc
- (lambda (f)
- (setq a (assoc f game))
- (setf (nth 2 a) (delete value (nth 2 a))))
- (org-sudoku-rel-fields i j))
- game))
-
-(defun org-sudoku-rel-fields (i j)
- "Compute the list of related fields for field (i j)."
- (let ((sqrtsize (floor (sqrt org-sudoku-size)))
- ll imin imax jmin jmax f)
- (setq f (cons i j))
- (loop for ii from 1 to org-sudoku-size do
- (or (= ii i) (push (cons ii j) ll)))
- (loop for jj from 1 to org-sudoku-size do
- (or (= jj j) (push (cons i jj) ll)))
- (setq imin (1+ (* sqrtsize (/ (1- i) sqrtsize)))
- imax (+ imin sqrtsize -1))
- (setq jmin (1+ (* sqrtsize (/ (1- j) sqrtsize)))
- jmax (+ jmin sqrtsize -1))
- (loop for ii from imin to imax do
- (loop for jj from jmin to jmax do
- (setq ff (cons ii jj))
- (or (equal ff f)
- (member ff ll)
- (push ff ll))))
- ll))
-
-;;; org-sudoku ends here
diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el
deleted file mode 100644
index 62b8b18..0000000
--- a/contrib/lisp/org-toc.el
+++ /dev/null
@@ -1,508 +0,0 @@
-;;; org-toc.el --- Table of contents for Org-mode buffer
-
-;; Copyright 2007-2021 Free Software Foundation, Inc.
-;;
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Keywords: Org table of contents
-;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-toc.el
-;; Version: 0.8
-
-;; 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. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This library implements a browsable table of contents for Org files.
-
-;; Put this file into your load-path and the following into your ~/.emacs:
-;; (require 'org-toc)
-
-;;; Code:
-
-(provide 'org-toc)
-(eval-when-compile
- (require 'cl))
-
-;;; Custom variables:
-(defvar org-toc-base-buffer nil)
-(defvar org-toc-columns-shown nil)
-(defvar org-toc-odd-levels-only nil)
-(defvar org-toc-config-alist nil)
-(defvar org-toc-cycle-global-status nil)
-(defalias 'org-show-table-of-contents 'org-toc-show)
-
-(defgroup org-toc nil
- "Options concerning the browsable table of contents of Org-mode."
- :tag "Org TOC"
- :group 'org)
-
-(defcustom org-toc-default-depth 1
- "Default depth when invoking `org-toc-show' without argument."
- :group 'org-toc
- :type '(choice
- (const :tag "same as base buffer" nil)
- (integer :tag "level")))
-
-(defcustom org-toc-follow-mode nil
- "Non-nil means navigating through the table of contents will
-move the point in the Org buffer accordingly."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-info-mode nil
- "Non-nil means navigating through the table of contents will
-show the properties for the current headline in the echo-area."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-show-subtree-mode nil
- "Non-nil means show subtree when going to headline or following
-it while browsing the table of contents."
- :group 'org-toc
- :type '(choice
- (const :tag "show subtree" t)
- (const :tag "show entry" nil)))
-
-(defcustom org-toc-recenter-mode t
- "Non-nil means recenter the Org buffer when following the
-headlines in the TOC buffer."
- :group 'org-toc
- :type 'boolean)
-
-(defcustom org-toc-recenter 0
- "Where to recenter the Org buffer when unfolding a subtree.
-This variable is only used when `org-toc-recenter-mode' is set to
-'custom. A value >=1000 will call recenter with no arg."
- :group 'org-toc
- :type 'integer)
-
-(defcustom org-toc-info-exclude '("ALLTAGS")
- "A list of excluded properties when displaying info in the
-echo-area. The COLUMNS property is always excluded."
- :group 'org-toc
- :type 'lits)
-
-;;; Org TOC mode:
-(defvar org-toc-mode-map (make-sparse-keymap)
- "Keymap for `org-toc-mode'.")
-
-(defun org-toc-mode ()
- "A major mode for browsing the table of contents of an Org buffer.
-
-\\{org-toc-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map org-toc-mode-map)
- (setq mode-name "Org TOC")
- (setq major-mode 'org-toc-mode))
-
-;; toggle modes
-(define-key org-toc-mode-map "F" 'org-toc-follow-mode)
-(define-key org-toc-mode-map "S" 'org-toc-show-subtree-mode)
-(define-key org-toc-mode-map "s" 'org-toc-store-config)
-(define-key org-toc-mode-map "g" 'org-toc-restore-config)
-(define-key org-toc-mode-map "i" 'org-toc-info-mode)
-(define-key org-toc-mode-map "r" 'org-toc-recenter-mode)
-
-;; navigation keys
-(define-key org-toc-mode-map "p" 'org-toc-previous)
-(define-key org-toc-mode-map "n" 'org-toc-next)
-(define-key org-toc-mode-map "f" 'org-toc-forward)
-(define-key org-toc-mode-map "b" 'org-toc-back)
-(define-key org-toc-mode-map [(left)] 'org-toc-back)
-(define-key org-toc-mode-map [(right)] 'org-toc-forward)
-(define-key org-toc-mode-map [(up)] 'org-toc-previous)
-(define-key org-toc-mode-map [(down)] 'org-toc-next)
-(define-key org-toc-mode-map "1" (lambda() (interactive) (org-toc-show 1
(point))))
-(define-key org-toc-mode-map "2" (lambda() (interactive) (org-toc-show 2
(point))))
-(define-key org-toc-mode-map "3" (lambda() (interactive) (org-toc-show 3
(point))))
-(define-key org-toc-mode-map "4" (lambda() (interactive) (org-toc-show 4
(point))))
-(define-key org-toc-mode-map " " 'org-toc-goto)
-(define-key org-toc-mode-map "q" 'org-toc-quit)
-(define-key org-toc-mode-map "x" 'org-toc-quit)
-;; go to the location and stay in the base buffer
-(define-key org-toc-mode-map [(tab)] 'org-toc-jump)
-(define-key org-toc-mode-map "v" 'org-toc-jump)
-;; go to the location and delete other windows
-(define-key org-toc-mode-map [(return)]
- (lambda() (interactive) (org-toc-jump t)))
-
-;; special keys
-(define-key org-toc-mode-map "c" 'org-toc-columns)
-(define-key org-toc-mode-map "?" 'org-toc-help)
-(define-key org-toc-mode-map ":" 'org-toc-cycle-subtree)
-(define-key org-toc-mode-map "\C-c\C-o" 'org-open-at-point)
-;; global cycling in the base buffer
-(define-key org-toc-mode-map (kbd "C-S-<iso-lefttab>")
- 'org-toc-cycle-base-buffer)
-;; subtree cycling in the base buffer
-(define-key org-toc-mode-map [(control tab)]
- (lambda() (interactive) (org-toc-goto nil t)))
-
-;;; Toggle functions:
-(defun org-toc-follow-mode ()
- "Toggle follow mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-follow-mode (not org-toc-follow-mode))
- (message "Follow mode is %s"
- (if org-toc-follow-mode "on" "off")))
-
-(defun org-toc-info-mode ()
- "Toggle info mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-info-mode (not org-toc-info-mode))
- (message "Info mode is %s"
- (if org-toc-info-mode "on" "off")))
-
-(defun org-toc-show-subtree-mode ()
- "Toggle show subtree mode in a `org-toc-mode' buffer."
- (interactive)
- (setq org-toc-show-subtree-mode (not org-toc-show-subtree-mode))
- (message "Show subtree mode is %s"
- (if org-toc-show-subtree-mode "on" "off")))
-
-(defun org-toc-recenter-mode (&optional line)
- "Toggle recenter mode in a `org-toc-mode' buffer. If LINE is
-specified, then make `org-toc-recenter' use this value."
- (interactive "P")
- (setq org-toc-recenter-mode (not org-toc-recenter-mode))
- (when (numberp line)
- (setq org-toc-recenter-mode t)
- (setq org-toc-recenter line))
- (message "Recenter mode is %s"
- (if org-toc-recenter-mode
- (format "on, line %d" org-toc-recenter) "off")))
-
-(defun org-toc-cycle-subtree ()
- "Locally cycle a headline through two states: 'children and
-'folded"
- (interactive)
- (let ((beg (point))
- (end (save-excursion (end-of-line) (point)))
- (ov (car (overlays-at (point))))
- status)
- (if ov (setq status (overlay-get ov 'status))
- (setq ov (make-overlay beg end)))
- ;; change the folding status of this headline
- (cond ((or (null status) (eq status 'folded))
- (org-show-children)
- (message "CHILDREN")
- (overlay-put ov 'status 'children))
- ((eq status 'children)
- (show-branches)
- (message "BRANCHES")
- (overlay-put ov 'status 'branches))
- (t (hide-subtree)
- (message "FOLDED")
- (overlay-put ov 'status 'folded)))))
-
-;;; Main show function:
-;; FIXME name this org-before-first-heading-p?
-(defun org-toc-before-first-heading-p ()
- "Before first heading?"
- (save-excursion
- (null (re-search-backward org-outline-regexp-bol nil t))))
-
-;;;###autoload
-(defun org-toc-show (&optional depth position)
- "Show the table of contents of the current Org-mode buffer."
- (interactive "P")
- (if (eq major-mode 'org-mode)
- (progn (setq org-toc-base-buffer (current-buffer))
- (setq org-toc-odd-levels-only org-odd-levels-only))
- (if (eq major-mode 'org-toc-mode)
- (org-pop-to-buffer-same-window org-toc-base-buffer)
- (error "Not in an Org buffer")))
- ;; create the new window display
- (let ((pos (or position
- (save-excursion
- (if (org-toc-before-first-heading-p)
- (progn (re-search-forward org-outline-regexp-bol nil t)
- (match-beginning 0))
- (point))))))
- (setq org-toc-cycle-global-status org-cycle-global-status)
- (delete-other-windows)
- (and (get-buffer "*org-toc*") (kill-buffer "*org-toc*"))
- (switch-to-buffer-other-window
- (make-indirect-buffer org-toc-base-buffer "*org-toc*"))
- ;; make content before 1st headline invisible
- (goto-char (point-min))
- (let* ((beg (point-min))
- (end (and (re-search-forward "^\\*" nil t)
- (1- (match-beginning 0))))
- (ov (make-overlay beg end))
- (help (format "Table of contents for %s (press ? for a quick
help):\n"
- (buffer-name org-toc-base-buffer))))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'before-string help))
- ;; build the browsable TOC
- (cond (depth
- (let* ((dpth (if org-toc-odd-levels-only
- (1- (* depth 2)) depth)))
- (org-content dpth)
- (setq org-toc-cycle-global-status
- `(org-content ,dpth))))
- ((null org-toc-default-depth)
- (if (eq org-toc-cycle-global-status 'overview)
- (progn (org-overview)
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))
- (progn (org-overview)
- ;; FIXME org-content to show only headlines?
- (org-content)
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents))))
- (t (let* ((dpth0 org-toc-default-depth)
- (dpth (if org-toc-odd-levels-only
- (1- (* dpth0 2)) dpth0)))
- (org-content dpth)
- (setq org-toc-cycle-global-status
- `(org-content ,dpth)))))
- (goto-char pos))
- (move-beginning-of-line nil)
- (org-toc-mode)
- (shrink-window-if-larger-than-buffer)
- (setq buffer-read-only t))
-
-;;; Navigation functions:
-(defun org-toc-goto (&optional jump cycle)
- "From Org TOC buffer, follow the targeted subtree in the Org window.
-If JUMP is non-nil, go to the base buffer.
-If JUMP is 'delete, go to the base buffer and delete other windows.
-If CYCLE is non-nil, cycle the targeted subtree in the Org window."
- (interactive)
- (let ((pos (point))
- (toc-buf (current-buffer)))
- (switch-to-buffer-other-window org-toc-base-buffer)
- (goto-char pos)
- (if cycle (org-cycle)
- (progn (org-overview)
- (if org-toc-show-subtree-mode
- (org-show-subtree)
- (org-show-entry))
- (org-show-context)))
- (if org-toc-recenter-mode
- (if (>= org-toc-recenter 1000) (recenter)
- (recenter org-toc-recenter)))
- (cond ((null jump)
- (switch-to-buffer-other-window toc-buf))
- ((eq jump 'delete)
- (delete-other-windows)))))
-
-(defun org-toc-cycle-base-buffer ()
- "Call `org-cycle' with a prefix argument in the base buffer."
- (interactive)
- (switch-to-buffer-other-window org-toc-base-buffer)
- (org-cycle t)
- (other-window 1))
-
-(defun org-toc-jump (&optional delete)
- "From Org TOC buffer, jump to the targeted subtree in the Org window.
-If DELETE is non-nil, delete other windows when in the Org buffer."
- (interactive "P")
- (if delete (org-toc-goto 'delete)
- (org-toc-goto t)))
-
-(defun org-toc-previous ()
- "Go to the previous headline of the TOC."
- (interactive)
- (if (save-excursion
- (beginning-of-line)
- (re-search-backward "^\\*" nil t))
- (outline-previous-visible-heading 1)
- (message "No previous heading"))
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-next ()
- "Go to the next headline of the TOC."
- (interactive)
- (outline-next-visible-heading 1)
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-forward ()
- "Go to the next headline at the same level in the TOC."
- (interactive)
- (condition-case nil
- (outline-forward-same-level 1)
- (error (message "No next headline at this level")))
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-back ()
- "Go to the previous headline at the same level in the TOC."
- (interactive)
- (condition-case nil
- (outline-backward-same-level 1)
- (error (message "No previous headline at this level")))
- (if org-toc-info-mode (org-toc-info))
- (if org-toc-follow-mode (org-toc-goto)))
-
-(defun org-toc-quit ()
- "Quit the current Org TOC buffer."
- (interactive)
- (kill-buffer)
- (other-window 1)
- (delete-other-windows))
-
-;;; Special functions:
-(defun org-toc-columns ()
- "Toggle columns view in the Org buffer from Org TOC."
- (interactive)
- (let ((indirect-buffer (current-buffer)))
- (org-pop-to-buffer-same-window org-toc-base-buffer)
- (if (not org-toc-columns-shown)
- (progn (org-columns)
- (setq org-toc-columns-shown t))
- (progn (org-columns-remove-overlays)
- (setq org-toc-columns-shown nil)))
- (org-pop-to-buffer-same-window indirect-buffer)))
-
-(defun org-toc-info ()
- "Show properties of current subtree in the echo-area."
- (interactive)
- (let ((pos (point))
- (indirect-buffer (current-buffer))
- props prop msg)
- (org-pop-to-buffer-same-window org-toc-base-buffer)
- (goto-char pos)
- (setq props (org-entry-properties))
- (while (setq prop (pop props))
- (unless (or (equal (car prop) "COLUMNS")
- (member (car prop) org-toc-info-exclude))
- (let ((p (car prop))
- (v (cdr prop)))
- (if (equal p "TAGS")
- (setq v (mapconcat 'identity (split-string v ":" t) " ")))
- (setq p (concat p ":"))
- (add-text-properties 0 (length p) '(face org-special-keyword) p)
- (setq msg (concat msg p " " v " ")))))
- (org-pop-to-buffer-same-window indirect-buffer)
- (message msg)))
-
-;;; Store and restore TOC configuration:
-(defun org-toc-store-config ()
- "Store the current status of the tables of contents in
-`org-toc-config-alist'."
- (interactive)
- (let ((file (buffer-file-name org-toc-base-buffer))
- (pos (point))
- (hlcfg (org-toc-get-headlines-status)))
- (setq org-toc-config-alist
- (delete (assoc file org-toc-config-alist)
- org-toc-config-alist))
- (add-to-list 'org-toc-config-alist
- `(,file ,pos ,org-toc-cycle-global-status ,hlcfg))
- (message "TOC configuration saved: (%s)"
- (if (listp org-toc-cycle-global-status)
- (concat "org-content "
- (number-to-string
- (cadr org-toc-cycle-global-status)))
- (symbol-name org-toc-cycle-global-status)))))
-
-(defun org-toc-restore-config ()
- "Get the stored status in `org-toc-config-alist' and set the
-current table of contents to it."
- (interactive)
- (let* ((file (buffer-file-name org-toc-base-buffer))
- (conf (cdr (assoc file org-toc-config-alist)))
- (pos (car conf))
- (status (cadr conf))
- (hlcfg (caddr conf)) hlcfg0 ov)
- (cond ((listp status)
- (org-toc-show (cadr status) (point)))
- ((eq status 'overview)
- (org-overview)
- (setq org-cycle-global-status 'overview)
- (run-hook-with-args 'org-cycle-hook 'overview))
- (t
- (org-overview)
- (org-content)
- (setq org-cycle-global-status 'contents)
- (run-hook-with-args 'org-cycle-hook 'contents)))
- (while (setq hlcfg0 (pop hlcfg))
- (save-excursion
- (goto-char (point-min))
- (when (search-forward (car hlcfg0) nil t)
- (unless (overlays-at (match-beginning 0))
- (setq ov (make-overlay (match-beginning 0)
- (match-end 0))))
- (cond ((eq (cdr hlcfg0) 'children)
- (org-show-children)
- (message "CHILDREN")
- (overlay-put ov 'status 'children))
- ((eq (cdr hlcfg0) 'branches)
- (show-branches)
- (message "BRANCHES")
- (overlay-put ov 'status 'branches))))))
- (goto-char pos)
- (if org-toc-follow-mode (org-toc-goto))
- (message "Last TOC configuration restored")
- (sit-for 1)
- (if org-toc-info-mode (org-toc-info))))
-
-(defun org-toc-get-headlines-status ()
- "Return an alist of headlines and their associated folding
-status."
- (let (output ovs)
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp))
- (goto-char (next-overlay-change (point))))
- (when (looking-at org-outline-regexp-bol)
- (add-to-list
- 'output
- (cons (buffer-substring-no-properties
- (match-beginning 0)
- (save-excursion
- (end-of-line) (point)))
- (overlay-get
- (car (overlays-at (point))) 'status))))))
- ;; return an alist like (("* Headline" . 'status))
- output))
-
-;; In Org TOC buffer, hide headlines below the first level.
-(defun org-toc-help ()
- "Display a quick help message in the echo-area for `org-toc-mode'."
- (interactive)
- (let ((st-start 0)
- (help-message
- "\[space\] show heading \[1-4\] hide headlines
below this level
-\[TAB\] jump to heading \[F\] toggle follow mode
(currently %s)
-\[return\] jump and delete others windows \[i\] toggle info mode
(currently %s)
-\[S-TAB\] cycle subtree (in Org) \[S\] toggle show subtree mode
(currently %s)
-\[C-S-TAB\] global cycle (in Org) \[r\] toggle recenter mode
(currently %s)
-\[:\] cycle subtree (in TOC) \[c\] toggle column view
(currently %s)
-\[n/p\] next/previous heading \[s\] save TOC configuration
-\[f/b\] next/previous heading of same level
-\[q\] quit the TOC \[g\] restore last TOC
configuration"))
- (while (string-match "\\[[^]]+\\]" help-message st-start)
- (add-text-properties (match-beginning 0)
- (match-end 0) '(face bold) help-message)
- (setq st-start (match-end 0)))
- (message help-message
- (if org-toc-follow-mode "on" "off")
- (if org-toc-info-mode "on" "off")
- (if org-toc-show-subtree-mode "on" "off")
- (if org-toc-recenter-mode (format "on, line %s" org-toc-recenter) "off")
- (if org-toc-columns-shown "on" "off"))))
-
-
-;;;;##########################################################################
-;;;; User Options, Variables
-;;;;##########################################################################
-
-;;; org-toc.el ends here
diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el
deleted file mode 100644
index e0913a3..0000000
--- a/contrib/lisp/org-track.el
+++ /dev/null
@@ -1,211 +0,0 @@
-;;; org-track.el --- Track the most recent Org-mode version available.
-;;
-;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
-;;
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Eric S Fraga <e.fraga at ucl.ac dot uk>
-;; Sebastian Rose <sebastian_rose at gmx dot de>
-;; The Worg people https://orgmode.org/worg/
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 6.29a
-;;
-;; Released under the GNU General Public License version 3
-;; see: https://www.gnu.org/licenses/gpl-3.0.html
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-;;
-;; WARNING: This library is obsolete, you should use the make targets
-;; to keep track of Org latest developments.
-;;
-;; Download the latest development tarball, unpack and optionally compile it
-;;
-;; Usage:
-;;
-;; (require 'org-track)
-;;
-;; ;; ... somewhere in your setup (use customize):
-;;
-;; (setq org-track-directory "~/test/")
-;; (setq org-track-compile-sources nil)
-;; (setq org-track-remove-package t)
-;;
-;; M-x org-track-update RET
-
-(require 'url-parse)
-(require 'url-handlers)
-(autoload 'url-file-local-copy "url-handlers")
-(autoload 'url-generic-parse-url "url-parse")
-
-
-
-;;; Variables:
-
-(defgroup org-track nil
- "Track the most recent Org-mode version available.
-
-To use org-track, adjust `org-track-directory'.
-Org will download the archived latest git version for you,
-unpack it into that directory (i.e. a subdirectory
-`org-mode/' is added), create the autoloads file
-`org-loaddefs.el' for you and, optionally, compile the
-sources.
-All you'll have to do is call `M-x org-track-update' from
-time to time."
- :group 'org)
-
-(defcustom org-track-directory (concat user-emacs-directory "org/lisp")
- "Directory where your org-mode/ directory lives.
-If that directory does not exist, it will be created."
- :type 'directory)
-
-(defcustom org-track-compile-sources t
- "If `nil', never compile org-sources.
-Org will only create the autoloads file `org-loaddefs.el' for
-you then. If `t', compile the sources, too.
-Note, that emacs preferes compiled elisp files over
-non-compiled ones."
- :type 'boolean)
-
-(defcustom org-track-org-url "https://orgmode.org/";
- "The URL where the package to download can be found.
-Please append a slash."
- :type 'string)
-
-(defcustom org-track-org-package "org-latest.tar.gz"
- "The basename of the package you use.
-Defaults to the development version of Org-mode.
-This should be a *.tar.gz package, since emacs provides all
-you need to unpack it."
- :type 'string)
-
-(defcustom org-track-remove-package nil
- "Remove org-latest.tar.gz after updates?"
- :type 'boolean)
-
-
-
-;;; Frontend
-
-(defun org-track-update ()
- "Update to current Org-mode version.
-Also, generate autoloads and evtl. compile the sources."
- (interactive)
- (let* ((base (file-truename org-track-directory))
- (org-exists (file-exists-p
- (file-truename
- (concat base "/org-mode/lisp/org.el"))))
- (nobase (not (file-directory-p
- (file-truename org-track-directory)))))
- (if nobase
- (when (y-or-n-p
- (format "Directory %s does not exist. Create it?" base))
- (make-directory base t)
- (setq nobase nil)))
- (if nobase
- (message "Not creating %s - giving up." org-track-directory)
- (condition-case err
- (progn
- (org-track-fetch-package)
- (org-track-compile-org))
- (error (message "%s" (error-message-string err)))))))
-
-
-
-;;; tar related functions
-
-;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure
-;; that? If the maintainers of that package decide, that an assynchronous
-;; download might be better??? (used by `url-file-local-copy')
-
-;;;###autoload
-(defun org-track-fetch-package (&optional directory)
- "Fetch Org package depending on `org-track-fetch-package-extension'.
-If DIRECTORY is defined, unpack the package there, i.e. add the
-subdirectory org-mode/ to DIRECTORY."
- (interactive "Dorg-track directory: ")
- (let* ((pack (concat
- (if (string-match "/$" org-track-org-url)
- org-track-org-url
- (concat org-track-org-url "/"))
- org-track-org-package))
- (base (file-truename
- (or directory org-track-directory)))
- (target (file-truename
- (concat base "/" org-track-org-package)))
- url download tarbuff)
- (message "Fetching to %s - this might take some time..." base)
- (setq url (url-generic-parse-url pack))
- (setq download (url-file-local-copy url)) ;; errors if fail
- (copy-file download target t)
- (delete-file download)
- ;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to
- ;; ensure tar-mode is used:
- (add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode))
- (setq tarbuff (find-file target))
- (with-current-buffer tarbuff ;; with-temp-buffer does not work with
tar-mode??
- (tar-untar-buffer))
- (kill-buffer tarbuff)
- (if org-track-remove-package
- (delete-file target))))
-
-
-
-;;; Compile Org-mode sources
-
-
-;;;###autoload
-(defun org-track-compile-org (&optional directory)
- "Compile all *.el files that come with org-mode.
-Generate the autoloads file `org-loaddefs.el'.
-
-DIRECTORY is where the directory org-mode/ lives (i.e. the
- parent directory of your local repo."
- (interactive)
- ;; file-truename expands the filename and removes double slash, if exists:
- (setq directory (file-truename
- (concat
- (or directory
- (file-truename (concat org-track-directory
"/org-mode/lisp")))
- "/")))
- (add-to-list 'load-path directory)
- (let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
- ;; create the org-loaddefs file
- (require 'autoload)
- (setq esf/org-install-file (concat directory "org-loaddefs.el"))
- (find-file esf/org-install-file)
- (erase-buffer)
- (mapc (lambda (x)
- (generate-file-autoloads x))
- list-of-org-files)
- (insert "\n(provide (quote org-loaddefs))\n")
- (save-buffer)
- (kill-buffer)
- (byte-compile-file esf/org-install-file t)
-
- (mapc (lambda (f)
- (if (file-exists-p (concat f "c"))
- (delete-file (concat f "c"))))
- list-of-org-files)
- (if org-track-compile-sources
- (mapc (lambda (f) (byte-compile-file f)) list-of-org-files))))
-
-(provide 'org-track)
-
-;;; org-track.el ends here
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
deleted file mode 100644
index f1b12c3..0000000
--- a/contrib/lisp/org-velocity.el
+++ /dev/null
@@ -1,819 +0,0 @@
-;;; 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: 4.1
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; Org-Velocity.el is an interface for Org inspired by the minimalist
-;; notetaking program Notational Velocity. The idea is to let you
-;; amass and access brief notes on many subjects with minimal fuss.
-;; Each note is an entry in an ordinary Org file.
-
-;; Org-Velocity can be used in two ways: when called outside Org, to
-;; store and access notes in a designated bucket file; or, when called
-;; inside Org, as a method for navigating any Org file. (Setting the
-;; option `org-velocity-always-use-bucket' disables navigation inside
-;; Org files by default, although you can still force this behavior by
-;; calling `org-velocity-read' with an argument.)
-
-;; Org-Velocity prompts for search terms in the minibuffer. A list of
-;; headings of entries whose text matches your search is updated as
-;; you type; you can end the search and visit an entry at any time by
-;; clicking on its heading.
-
-;; RET displays the results. If there are no matches, Org-Velocity
-;; offers to create a new entry with your search string as its
-;; heading. If there are matches, it displays a list of results where
-;; the heading of each matching entry is hinted with a number or
-;; letter; clicking a result, or typing the matching hint, opens the
-;; entry for editing in an indirect buffer. 0 forces a new entry; RET
-;; reopens the search for editing.
-
-;; You can customize every step in this process, including the search
-;; method, completion for search terms, and templates for creating new
-;; entries; M-x customize-group RET org-velocity RET to see all the
-;; options.
-
-;; Thanks to Richard Riley, Carsten Dominik, Bastien Guerry, and Jeff
-;; Horn for their suggestions.
-
-;;; Usage:
-;; (require 'org-velocity)
-;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory))
-;; (global-set-key (kbd "C-c v") 'org-velocity)
-
-;;; Code:
-(require 'org)
-(require 'button)
-(require 'electric)
-(require 'dabbrev)
-(require 'cl-lib)
-
-(defgroup org-velocity nil
- "Notational Velocity-style interface for Org."
- :tag "Org-Velocity"
- :group 'outlines
- :group 'hypermedia
- :group 'org)
-
-(defcustom org-velocity-bucket ""
- "Where is the bucket file?"
- :group 'org-velocity
- :type 'file)
-
-(defcustom org-velocity-show-previews t
- "Show previews of the text of each heading?"
- :group 'velocity
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom org-velocity-exit-on-match nil
- "When searching incrementally, exit on a single match?"
- :group 'org-velocity
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom org-velocity-force-new nil
- "Should exiting the minibuffer with C-j force a new entry?"
- :group 'org-velocity
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom org-velocity-use-search-ring t
- "Push search to `search-ring' when visiting an entry?
-
-This means that C-s C-s will take you directly to the first
-instance of the search string."
- :group 'org-velocity
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom org-velocity-always-use-bucket nil
- "Use bucket file even when called from an Org buffer?"
- :group 'org-velocity
- :type 'boolean
- :safe 'booleanp)
-
-(defcustom org-velocity-use-completion nil
- "Use completion?
-
-Notwithstanding the value of this option, calling
-`dabbrev-expand' always completes against the text of the bucket
-file."
- :group 'org-velocity
- :type '(choice
- (const :tag "Do not use completion" nil)
- (const :tag "Use completion" t))
- :safe 'booleanp)
-
-(defcustom org-velocity-search-method 'phrase
- "Match on whole phrase, any word, or all words?"
- :group 'org-velocity
- :type '(choice
- (const :tag "Match whole phrase" phrase)
- (const :tag "Match any word" any)
- (const :tag "Match all words" all)
- (const :tag "Match a regular expression" regexp))
- :safe (lambda (v) (memq v '(phrase any all regexp))))
-
-(defcustom org-velocity-capture-templates
- '(("v"
- "Velocity entry"
- entry
- (file "")
- "* %:search\n\n%i%?"))
- "Use these template with `org-capture'.
-Meanwhile `org-default-notes-file' is bound to `org-velocity-bucket-file'.
-The keyword :search inserts the current search.
-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)))))
- (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))
- (let ((components (org-heading-components)))
- (make-org-velocity-heading
- :buffer (current-buffer)
- :position (point)
- :name (nth 4 components)
- :level (nth 0 components)
- :preview (if org-velocity-show-previews
- (org-velocity-grab-preview))))))
-
-(defconst org-velocity-index
- (eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
- (number-sequence 97 122) ;lowercase letters
- (number-sequence 65 90))) ;uppercase letters
- "List of chars for indexing results.")
-
-(defconst org-velocity-match-buffer-name "*Velocity matches*")
-
-(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.")
-
-(defun org-velocity-buffer-file-name (&optional buffer)
- "Return the name of the file BUFFER saves to.
-Same as function `buffer-file-name' unless BUFFER is an indirect
-buffer or a minibuffer. In the former case, return the file name
-of the base buffer; in the latter, return the file name of
-`minibuffer-selected-window' (or its base buffer)."
- (let ((buffer (if (minibufferp buffer)
- (window-buffer (minibuffer-selected-window))
- buffer)))
- (buffer-file-name
- (or (buffer-base-buffer buffer)
- buffer))))
-
-(defun org-velocity-minibuffer-contents ()
- "Return the contents of the minibuffer when it is active."
- (when (active-minibuffer-window)
- (with-current-buffer (window-buffer (active-minibuffer-window))
- (minibuffer-contents))))
-
-(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.
-If `org-velocity-always-use-bucket' is t, use bucket file;
-complain if missing. Otherwise, if an Org file is current, then
-use it."
- (let ((org-velocity-bucket
- (when org-velocity-bucket (expand-file-name org-velocity-bucket)))
- (buffer
- (let ((buffer-file (org-velocity-buffer-file-name)))
- (when buffer-file
- ;; Use the target in capture buffers.
- (org-find-base-buffer-visiting buffer-file)))))
- (if org-velocity-always-use-bucket
- (or org-velocity-bucket (error "Bucket required but not defined"))
- (if (and (eq (buffer-local-value 'major-mode (or buffer
(current-buffer)))
- 'org-mode)
- (org-velocity-buffer-file-name))
- (org-velocity-buffer-file-name)
- (or org-velocity-bucket
- (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
- (find-file-noselect (org-velocity-bucket-file))))
-
-(defsubst org-velocity-match-buffer ()
- "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))))
-
-(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)))
- (if (and existing (buffer-base-buffer existing)
- (equal (buffer-base-buffer existing) bucket))
- existing
- (make-indirect-buffer
- bucket
- (generate-new-buffer-name (org-velocity-heading-name heading))
- t))))
-
-(defun org-velocity-capture ()
- "Record a note with `org-capture'."
- (let ((org-capture-templates
- org-velocity-capture-templates))
- (org-capture nil
- ;; This is no longer automatically selected.
- (when (null (cdr org-capture-templates))
- (caar org-capture-templates)))
- (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))
- (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."
- (let ((winconf org-velocity-saved-winconf))
- (prog1 t ;Tell hook we're done.
- (save-buffer)
- (kill-buffer)
- (when (window-configuration-p winconf)
- (set-window-configuration winconf)))))
-
-(defun org-velocity-visit-button (button)
- (run-hooks 'mouse-leave-buffer-hook)
- (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
- 'follow-link 'mouse-face)
-
-(defsubst org-velocity-buttonize (heading)
- "Insert HEADING as a text button with no hints."
- (insert-text-button
- (propertize (org-velocity-heading-name heading) 'face 'link)
- :type 'org-velocity-button
- 'match heading
- 'search org-velocity-search))
-
-(defsubst org-velocity-insert-preview (heading)
- (when org-velocity-show-previews
- (insert-char ?\ 1)
- (insert
- (propertize
- (org-velocity-heading-preview heading)
- 'face 'shadow))))
-
-(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-present-search (style search hide-hints)
- (let ((hints org-velocity-index) matches)
- (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-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."
- (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'."
- (if org-velocity-search
- (org-store-link-props
- :search org-velocity-search)))
-
-(add-hook 'org-store-link-functions 'org-velocity-store-link)
-
-(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-velocity-capture))
- search))
-
-(defun org-velocity-engine (search)
- "Display a list of headings where SEARCH occurs."
- (let ((org-velocity-search search))
- (unless (or
- (not (stringp search))
- (string= "" search)) ;exit on empty string
- (cl-case
- (if (and org-velocity-force-new (eq last-command-event ?\C-j))
- :force
- (let* ((org-velocity-index (org-velocity-adjust-index))
- (matches (org-velocity-present search)))
- (cond ((null matches) :new)
- ((null (cdr matches)) :follow)
- (t :prompt))))
- (:prompt (progn
- (pop-to-buffer (org-velocity-match-buffer))
- (let ((hint (org-velocity-electric-read-hint)))
- (when hint (cl-case hint
- (:edit (org-velocity-read nil search))
- (:force (org-velocity-create search))
- (otherwise (org-velocity-activate-button
hint)))))))
- (:new (unless (org-velocity-create search :ask t)
- (org-velocity-read nil search)))
- (:force (org-velocity-create search))
- (:follow (if (y-or-n-p "One match, follow? ")
- (progn
- (set-buffer (org-velocity-match-buffer))
- (goto-char (point-min))
- (button-activate (next-button (point))))
- (org-velocity-read nil search)))))))
-
-(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 (cl-position char org-velocity-index))
- (goto-char
- (button-start
- (next-button (point))))
- (message "%s" (button-label (button-at (point))))
- (button-activate (button-at (point))))
-
-(defun org-velocity-electric-undefined ()
- "Complain about an undefined key."
- (interactive)
- (message "%s"
- (substitute-command-keys
- "\\[org-velocity-electric-new] for new entry,
-\\[org-velocity-electric-edit] to edit search,
-\\[scroll-up] to scroll up,
-\\[scroll-down] to scroll down,
-\\[keyboard-quit] to quit."))
- (sit-for 4))
-
-(defun org-velocity-electric-follow (ev)
- "Follow a hint indexed by keyboard event EV."
- (interactive (list last-command-event))
- (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-edit ()
- "Edit the search string."
- (interactive)
- (throw 'org-velocity-select :edit))
-
-(defun org-velocity-electric-new ()
- "Force a new entry."
- (interactive)
- (throw 'org-velocity-select :force))
-
-(defvar org-velocity-electric-map
- (let ((map (make-sparse-keymap)))
- (define-key map [t] 'org-velocity-electric-undefined)
- (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] nil)
- (define-key map [mouse-2] nil)
- (define-key map [escape] 'keyboard-quit)
- (define-key map "\C-h" 'help-command)
- map))
-
-(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 "\C-v" 'scroll-up)
- (define-key map "\M-v" 'scroll-down)
- map))
-
-(defun org-velocity-displaying-completions-p ()
- "Is there a *Completions* buffer showing?"
- (get-window-with-predicate
- (lambda (w)
- (eq (buffer-local-value 'major-mode (window-buffer w))
- 'completion-list-mode))))
-
-(defun org-velocity-update ()
- "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) (= (length search) 0))
- (minibuffer-message "No match; RET to create")))
- ((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-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-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'.")
-
-(defun org-velocity-read-with-completion (prompt)
- "Completing read with PROMPT."
- (let ((minibuffer-local-completion-map
- org-velocity-local-completion-map)
- (completion-no-auto-exit t)
- (crm-separator " "))
- (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.
-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 (org-velocity-adjust-index
match-window)))
- (catch 'click
- (add-hook 'post-command-hook 'org-velocity-update)
- (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)))
-
-(defun org-velocity (arg &optional search)
- "Read a search string SEARCH for Org-Velocity interface.
-This means that a buffer will display all headings where SEARCH
-occurs, where one can be selected by a mouse click or by typing
-its index. If SEARCH does not occur, then a new heading may be
-created named SEARCH.
-
-If `org-velocity-bucket' is defined and
-`org-velocity-always-use-bucket' is non-nil, then the bucket file
-will be used; otherwise, this will work when called in any Org
-file.
-
-Calling with ARG 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 org-velocity-always-use-bucket
- (not arg)
- arg)))
- ;; complain if inappropriate
- (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 ((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)
-
-(provide 'org-velocity)
-
-;;; org-velocity.el ends here
diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el
deleted file mode 100644
index e45654c..0000000
--- a/contrib/lisp/org-wikinodes.el
+++ /dev/null
@@ -1,327 +0,0 @@
-;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
-
-;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
-
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: https://orgmode.org
-;; Version: 7.01trans
-;;
-;; 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 <https://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(require 'org)
-(eval-when-compile
- (require 'cl))
-
-(defgroup org-wikinodes nil
- "Wiki-like CamelCase links words to outline nodes in Org mode."
- :tag "Org WikiNodes"
- :group 'org)
-
-(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
- "Regular expression matching CamelCase words.")
-
-(defcustom org-wikinodes-active t
- "Should CamelCase links be active in the current file?"
- :group 'org-wikinodes
- :type 'boolean)
-(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
-
-(defcustom org-wikinodes-scope 'file
- "The scope of searches for wiki targets.
-Allowed values are:
-
-file Search for targets in the current file only
-directory Search for targets in all org files in the current directory"
- :group 'org-wikinodes
- :type '(choice
- (const :tag "Find targets in current file" file)
- (const :tag "Find targets in current directory" directory)))
-
-(defcustom org-wikinodes-create-targets 'query
- "Non-nil means create Wiki target when following a wiki link fails.
-Allowed values are:
-
-nil never create node, just throw an error if the target does not exist
-query ask the user what to do
-t create the node in the current buffer
-\"file.org\" create the node in the file \"file.org\", in the same directory
-
-If you are using wiki links across files, you need to set `org-wikinodes-scope'
-to `directory'."
- :group 'org-wikinodes
- :type '(choice
- (const :tag "Never automatically create node" nil)
- (const :tag "In current file" t)
- (file :tag "In one special file\n")
- (const :tag "Query the user" query)))
-
-;;; Link activation
-
-(defun org-wikinodes-activate-links (limit)
- "Activate CamelCase words as links to Wiki targets."
- (when org-wikinodes-active
- (let (case-fold-search)
- (if (re-search-forward org-wikinodes-camel-regexp limit t)
- (if (equal (char-after (point-at-bol)) ?*)
- (progn
- ;; in heading - deactivate flyspell
- (org-remove-flyspell-overlays-in (match-beginning 0)
- (match-end 0))
- t)
- ;; this is a wiki link
- (org-remove-flyspell-overlays-in (match-beginning 0)
- (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'face 'org-link
- 'keymap org-mouse-map
- 'help-echo "Wiki Link"))
- t)))))
-
-;;; Following links and creating non-existing target nodes
-
-(defun org-wikinodes-open-at-point ()
- "Check if the cursor is on a Wiki link and follow the link.
-
-This function goes into `org-open-at-point-functions'."
- (and org-wikinodes-active
- (not (org-at-heading-p))
- (let (case-fold-search) (org-in-regexp org-wikinodes-camel-regexp))
- (progn (org-wikinodes-follow-link (match-string 0)) t)))
-
-(defun org-wikinodes-follow-link (target)
- "Follow a wiki link to TARGET.
-
-This need to be found as an exact headline match, either in the current
-buffer, or in any .org file in the current directory, depending on the
-variable `org-wikinodes-scope'.
-
-If a target headline is not found, it may be created according to the
-setting of `org-wikinodes-create-targets'."
- (if current-prefix-arg (org-wikinodes-clear-directory-targets-cache))
- (let ((create org-wikinodes-create-targets)
- visiting buffer m pos file rpl)
- (setq pos
- (or (org-find-exact-headline-in-buffer target (current-buffer))
- (and (eq org-wikinodes-scope 'directory)
- (setq file (org-wikinodes-which-file
- target (file-name-directory (buffer-file-name))))
- (org-find-exact-headline-in-buffer
- target (or (get-file-buffer file)
- (find-file-noselect file))))))
- (if pos
- (progn
- (org-mark-ring-push (point))
- (org-goto-marker-or-bmk pos)
- (move-marker pos nil))
- (when (eq create 'query)
- (if (eq org-wikinodes-scope 'directory)
- (progn
- (message "Node \"%s\" does not exist. Should it be created?
-\[RET] in this buffer [TAB] in another file [q]uit" target)
- (setq rpl (read-char-exclusive))
- (cond
- ((member rpl '(?\C-g ?q)) (error "Abort"))
- ((equal rpl ?\C-m) (setq create t))
- ((equal rpl ?\C-i)
- (setq create (file-name-nondirectory
- (read-file-name "Create in file: "))))
- (t (error "Invalid selection"))))
- (if (y-or-n-p (format "Create new node \"%s\" in current buffer? "
- target))
- (setq create t)
- (error "Abort"))))
-
- (cond
- ((not create)
- ;; We are not allowed to create the new node
- (error "No match for link to \"%s\"" target))
- ((stringp create)
- ;; Make new node in another file
- (org-mark-ring-push (point))
- (org-pop-to-buffer-same-window (find-file-noselect create))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "\n* " target "\n")
- (backward-char 1)
- (org-wikinodes-add-target-to-cache target)
- (message "New Wiki target `%s' created in file \"%s\""
- target create))
- (t
- ;; Make new node in current buffer
- (org-mark-ring-push (point))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "* " target "\n")
- (backward-char 1)
- (org-wikinodes-add-target-to-cache target)
- (message "New Wiki target `%s' created in current buffer"
- target))))))
-
-;;; The target cache
-
-(defvar org-wikinodes-directory-targets-cache nil)
-
-(defun org-wikinodes-clear-cache-when-on-target ()
- "When on a headline that is a Wiki target, clear the cache."
- (when (and (org-at-heading-p)
- (org-in-regexp (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp))
- (org-in-regexp org-wikinodes-camel-regexp))
- (org-wikinodes-clear-directory-targets-cache)
- t))
-
-(defun org-wikinodes-clear-directory-targets-cache ()
- "Clear the cache where to find wiki targets."
- (interactive)
- (setq org-wikinodes-directory-targets-cache nil)
- (message "Wiki target cache cleared, so that it will update when used
again"))
-
-(defun org-wikinodes-get-targets ()
- "Return a list of all wiki targets in the current buffer."
- (let ((re (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp))
- (case-fold-search nil)
- targets)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (push (match-string-no-properties 4) targets))))
- (nreverse targets)))
-
-(defun org-wikinodes-get-links-for-directory (dir)
- "Return an alist that connects wiki links to files in directory DIR."
- (let ((files (directory-files dir nil "\\`[^.#].*\\.org\\'"))
- (org-inhibit-startup t)
- target-file-alist file visiting m buffer)
- (while (setq file (pop files))
- (setq visiting (org-find-base-buffer-visiting file))
- (setq buffer (or visiting (find-file-noselect file)))
- (with-current-buffer buffer
- (mapc
- (lambda (target)
- (setq target-file-alist (cons (cons target file) target-file-alist)))
- (org-wikinodes-get-targets)))
- (or visiting (kill-buffer buffer)))
- target-file-alist))
-
-(defun org-wikinodes-add-target-to-cache (target &optional file)
- (setq file (or file buffer-file-name (error "No file for new wiki target")))
- (set-text-properties 0 (length target) nil target)
- (let ((dir (file-name-directory (expand-file-name file)))
- a)
- (setq a (assoc dir org-wikinodes-directory-targets-cache))
- (if a
- ;; Push the new target onto the existing list
- (push (cons target (expand-file-name file)) (cdr a))
- ;; Call org-wikinodes-which-file so that the cache will be filled
- (org-wikinodes-which-file target dir))))
-
-(defun org-wikinodes-which-file (target &optional directory)
- "Return the file for wiki headline TARGET DIRECTORY.
-If there is no such wiki target, return nil."
- (let* ((directory (expand-file-name (or directory default-directory)))
- (founddir (assoc directory org-wikinodes-directory-targets-cache))
- (foundfile (cdr (assoc target (cdr founddir)))))
- (or foundfile
- (and (push (cons directory (org-wikinodes-get-links-for-directory
directory))
- org-wikinodes-directory-targets-cache)
- (cdr (assoc target (cdr (assoc directory
-
org-wikinodes-directory-targets-cache))))))))
-
-;;; Exporting Wiki links
-
-(defvar target)
-(defvar target-alist)
-(defvar last-section-target)
-(defvar org-export-target-aliases)
-(defun org-wikinodes-set-wiki-targets-during-export (_)
- (let ((line (buffer-substring (point-at-bol) (point-at-eol)))
- (case-fold-search nil)
- wtarget a)
- (when (string-match (format org-complex-heading-regexp-format
- org-wikinodes-camel-regexp)
- line)
- (setq wtarget (match-string 4 line))
- (push (cons wtarget target) target-alist)
- (setq a (or (assoc last-section-target org-export-target-aliases)
- (progn
- (push (list last-section-target)
- org-export-target-aliases)
- (car org-export-target-aliases))))
- (push (caar target-alist) (cdr a)))))
-
-(defun org-wikinodes-process-links-for-export (_)
- "Process Wiki links in the export preprocess buffer.
-Try to find target matches in the wiki scope and replace CamelCase words
-with working links."
- (let ((re org-wikinodes-camel-regexp)
- (case-fold-search nil)
- link file)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (unless (save-match-data
- (or (org-at-heading-p)
- (org-in-regexp org-bracket-link-regexp)
- (org-in-regexp org-plain-link-re)
- (org-in-regexp "<<[^<>]+>>")))
- (setq link (match-string 0))
- (delete-region (match-beginning 0) (match-end 0))
- (save-match-data
- (cond
- ((org-find-exact-headline-in-buffer link (current-buffer))
- ;; Found in current buffer
- (insert (format "[[*%s][%s]]" link link)))
- ((eq org-wikinodes-scope 'file)
- ;; No match in file, and other files are not allowed
- (insert (format "%s" link)))
- (t ;; No match for this link
- (insert (format "%s" link)))))))))
-
-;;; Hook the WikiNode mechanism into Org
-
-;; `C-c C-o' should follow wiki links
-(add-hook 'org-open-at-point-functions 'org-wikinodes-open-at-point)
-
-;; `C-c C-c' should clear the cache
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target)
-
-;; Make Wiki haeding create additional link names for headlines
-(add-hook 'org-export-before-parsing-hook
- 'org-wikinodes-set-wiki-targets-during-export)
-
-;; Turn Wiki links into links the exporter will treat correctly
-(add-hook 'org-export-before-parsing-hook
- 'org-wikinodes-process-links-for-export)
-
-;; Activate CamelCase words as part of Org mode font lock
-
-(defun org-wikinodes-add-to-font-lock-keywords ()
- "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'."
- (let ((m (member '(org-activate-links) 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)
-
-(provide 'org-wikinodes)
-
-;;; org-wikinodes.el ends here
diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el
deleted file mode 100644
index 66cc133..0000000
--- a/contrib/lisp/orgtbl-sqlinsert.el
+++ /dev/null
@@ -1,118 +0,0 @@
-;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
-
-;; Copyright (C) 2008-2021 Free Software Foundation
-
-;; Author: Jason Riedy <jason@acm.org>
-;; Keywords: org, tables, sql
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Converts an orgtbl to a sequence of SQL insertion commands.
-;; Table cells are quoted and escaped very conservatively.
-
-;;; Code:
-
-(defun orgtbl-to-sqlinsert (table params)
- "Convert the orgtbl-mode TABLE to SQL insert statements.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-
-Names and strings are modified slightly by default. Single-ticks
-are doubled as per SQL's standard mechanism. Backslashes and
-dollar signs are deleted. And tildes are changed to spaces.
-These modifications were chosen for use with TeX. See
-ORGTBL-SQL-STRIP-AND-QUOTE.
-
-Supports all parameters from ORGTBL-TO-GENERIC. New to this function
-are:
-
-:sqlname The name of the database table; defaults to the name of the
- target region.
-
-:nowebname If not nil, used as a wrapping noweb fragment name.
-
-The most important parameters of ORGTBL-TO-GENERIC for SQL are:
-
-:splice When set to t, return only insert statements, don't wrap
- them in a transaction. Default is nil.
-
-:tstart, :tend
- The strings used to begin and commit the transaction.
-
-:hfmt A function that gathers the quoted header names into a
- dynamically scoped variable HDRLIST. Probably should
- not be changed by the user.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* (hdrlist
- (alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (nowebname (plist-get params :nowebname))
- (breakvals (plist-get params :breakvals))
- (firstheader t)
- (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
- (params2
- (list
- :sqlname (plist-get params :sqlname)
- :tstart (lambda () (concat (if nowebname
- (format "<<%s>>= \n" nowebname)
- "")
- "BEGIN TRANSACTION;"))
- :tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
- :hfmt (lambda (f) (progn (if firstheader (push f hdrlist) "")))
- :hlfmt (lambda (&rest cells) (setq firstheader nil))
- :lstart (lambda () (concat "INSERT INTO "
- sqlname "( "
- (mapconcat 'identity (reverse hdrlist)
- ", ")
- " )" (if breakvals "\n" " ")
- "VALUES ( "))
- :lend " );"
- :sep " , "
- :hline nil
- :remove-nil-lines t))
- (params (org-combine-plists params2 params))
- (sqlname (plist-get params :sqlname)))
- (orgtbl-to-generic table params)))
-
-(defun orgtbl-sql-quote (str)
- "Convert single ticks to doubled single ticks and wrap in single ticks."
- (concat "'" (mapconcat 'identity (split-string str "'") "''") "'"))
-
-(defun orgtbl-sql-strip-dollars-escapes-tildes (str)
- "Strip dollarsigns and backslash escapes, replace tildes with spaces."
- (mapconcat 'identity
- (split-string (mapconcat 'identity
- (split-string str "\\$\\|\\\\")
- "")
- "~")
- " "))
-
-(defun orgtbl-sql-strip-and-quote (str)
- "Apply ORGBTL-SQL-QUOTE and ORGTBL-SQL-STRIP-DOLLARS-ESCAPES-TILDES
-to sanitize STR for use in SQL statements."
- (cond ((stringp str)
- (orgtbl-sql-quote (orgtbl-sql-strip-dollars-escapes-tildes str)))
- ((sequencep str) (mapcar 'orgtbl-sql-strip-and-quote str))
- (t nil)))
-
-(provide 'orgtbl-sqlinsert)
-
-;;; orgtbl-sqlinsert.el ends here
diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el
deleted file mode 100644
index c7096cc..0000000
--- a/contrib/lisp/ox-bibtex.el
+++ /dev/null
@@ -1,430 +0,0 @@
-;;; ox-bibtex.el --- Export bibtex fragments
-
-;; Copyright (C) 2009-2014 Taru Karttunen
-
-;; Author: Taru Karttunen <taruti@taruti.net>
-;; Nicolas Goaziou <n dot goaziou at gmail dot com>
-;; This file is not currently part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program ; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; This is an utility to handle BibTeX export to LaTeX, html and ascii
-;; exports. For HTML and ascii it uses the bibtex2html software from:
-;;
-;; https://www.lri.fr/~filliatr/bibtex2html/
-;;
-;; For ascii it uses the pandoc software from:
-;;
-;; https://pandoc.org/
-;;
-;; It also introduces "cite" syntax for Org links.
-;;
-;; The usage is as follows:
-;;
-;; #+BIBLIOGRAPHY: bibfilename stylename optional-options
-;;
-;; e.g. given foo.bib and using style plain:
-;;
-;; #+BIBLIOGRAPHY: foo plain option:-d
-;;
-;; "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
-;;
-;; e.g.,
-;;
-;; option:-d sort by date
-;; option:-a sort as BibTeX (usually by author) *default*
-;; option:-u unsorted i.e. same order as in .bib file
-;; option:-r reverse the sort
-;;
-;; See the bibtex2html man page for more. Multiple options can be
-;; combined like:
-;;
-;; option:-d option:-r
-;;
-;; Limiting to only the entries cited in the document:
-;;
-;; limit:t
-;;
-;; For LaTeX export this simply inserts the lines
-;;
-;; \bibliographystyle{plain}
-;; \bibliography{foo}
-;;
-;; into the TeX file when exporting.
-;;
-;; For HTML export it:
-;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
-;; bibliography,
-;; 2) creates a foo.html and foo_bib.html,
-;; 3) includes the contents of foo.html in the exported HTML file.
-;;
-;; For ascii export it:
-;; 1) converts all \cite{foo} and [[cite:foo]] to links to the
-;; bibliography,
-;; 2) creates a foo.txt and foo_bib.html,
-;; 3) includes the contents of foo.txt in the exported ascii file.
-;;
-;; For LaTeX export it:
-;; 1) converts all [[cite:foo]] to \cite{foo}.
-
-;; Initialization
-
-(require 'cl-lib)
-
-;;; Internal Functions
-
-(defun org-bibtex-get-file (keyword)
- "Return bibliography file as a string.
-KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no file is found,
-return nil instead."
- (let ((value (org-element-property :value keyword)))
- (and value
- (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
- (match-string 1 value))))
-
-(defun org-bibtex-get-style (keyword)
- "Return bibliography style as a string.
-KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no style is found,
-return nil instead."
- (let ((value (org-element-property :value keyword)))
- (and value
- (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
- (match-string 2 value))))
-
-(defun org-bibtex-get-arguments (keyword)
- "Return \"bibtex2html\" arguments specified by the user.
-KEYWORD is a \"BIBLIOGRAPHY\" keyword. Return value is a plist
-containing `:options' and `:limit' properties. The former
-contains a list of strings to be passed as options to
-\"bibtex2html\" process. The latter contains a boolean."
- (let ((value (org-element-property :value keyword)))
- (and value
- (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
- (let (options limit)
- (dolist (arg (split-string (match-string 3 value))
- ;; Return value.
- (list :options (nreverse options) :limit limit))
- (let* ((s (split-string arg ":"))
- (key (car s))
- (value (nth 1 s)))
- (cond ((equal "limit" key)
- (setq limit (not (equal "nil" value))))
- ((equal "option" key) (push value options)))))))))
-
-(defun org-bibtex-citation-p (object)
- "Non-nil when OBJECT is a citation."
- (cl-case (org-element-type object)
- (link (equal (org-element-property :type object) "cite"))
- (latex-fragment
- (string-match "\\`\\\\cite{" (org-element-property :value object)))))
-
-(defun org-bibtex-get-citation-key (citation)
- "Return key for a given citation, as a string.
-CITATION is a `latex-fragment' or `link' type object satisfying
-to `org-bibtex-citation-p' predicate."
- (if (eq (org-element-type citation) 'link)
- (org-element-property :path citation)
- (let ((value (org-element-property :value citation)))
- (and (string-match "\\`\\\\cite{" value)
- (substring value (match-end 0) -1)))))
-
-
-;;; Follow cite: links
-
-(defvar org-bibtex-file nil
- "Org 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")))
- (let ((position (org-find-property "CUSTOM_ID" citation)))
- (and position (progn (goto-char position) t)))))
-
-(let ((jump-fn (car (cl-remove-if-not #'fboundp '(ebib
org-bibtex-goto-citation)))))
- (org-add-link-type "cite" jump-fn))
-
-
-
-;;; Filters
-
-(defun org-bibtex-process-bib-files (tree backend info)
- "Send each bibliography in parse tree to \"bibtex2html\" process.
-Return new parse tree."
- (when (org-export-derived-backend-p backend 'ascii 'html)
- ;; Initialize dynamically scoped variables. The first one
- ;; contain an alist between keyword objects and their HTML
- ;; translation. The second one will contain an alist between
- ;; citation keys and names in the output (according to style).
- (setq org-bibtex-html-entries-alist nil
- org-bibtex-html-keywords-alist nil)
- (org-element-map tree 'keyword
- (lambda (keyword)
- (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
- (let ((arguments (org-bibtex-get-arguments keyword))
- (file (org-bibtex-get-file keyword))
- 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.
- (when (plist-get arguments :limit)
- (let ((citations
- (org-element-map tree '(latex-fragment link)
- (lambda (object)
- (and (org-bibtex-citation-p object)
- (org-bibtex-get-citation-key object))))))
- (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
- (insert (mapconcat 'identity citations "\n")))
- (setq arguments
- (plist-put arguments
- :options
- (append (plist-get arguments :options)
- (list "-citefile" temp-file))))))
- ;; Call "bibtex2html" on specified file.
- (unless (eq 0 (apply
- 'call-process
- (append '("bibtex2html" nil nil nil)
- '("-a" "-nodoc" "-noheader" "-nofooter")
- (let ((style
- (org-not-nil
- (org-bibtex-get-style keyword))))
- (and style (list "--style" style)))
- (plist-get arguments :options)
- (list (concat file ".bib")))))
- (error "Executing bibtex2html failed"))
- (and temp-file (delete-file temp-file))
- ;; Open produced HTML file, and collect Bibtex key names
- (with-temp-buffer
- (insert-file-contents (concat out-file ".html"))
- ;; Update `org-bibtex-html-entries-alist'.
- (goto-char (point-min))
- (while (re-search-forward
- "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\([^<]+\\)" nil t)
- (push (cons (match-string 1) (match-string 2))
- org-bibtex-html-entries-alist)))
- ;; Open produced HTML file, wrap references within a block and
- ;; return it.
- (with-temp-buffer
- (cond
- ((org-export-derived-backend-p backend '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 out-file ".html")
- "-o"
- (concat out-file ".txt")))
- (error "Executing pandoc failed"))
- (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)
- (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "\\( \\]\\| \\]\\| |\\)" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "[\n\r]\\([\n\r][\n\r]\\)" nil t)
- (replace-match "\\1"))))
- ;; Update `org-bibtex-html-keywords-alist'.
- (push (cons keyword (buffer-string))
- org-bibtex-html-keywords-alist)))))))
- ;; Return parse tree unchanged.
- 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 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)
- (when (org-bibtex-citation-p object)
- (let ((new-citation (list 'latex-fragment
- (list :value ""
- :post-blank (org-element-property
- :post-blank object))))
- option)
- ;; Insert NEW-CITATION right before OBJECT.
- (org-element-insert-before new-citation object)
- ;; Remove all subsequent contiguous citations from parse
- ;; tree, keeping only their citation key.
- (let ((keys (list (org-bibtex-get-citation-key object)))
- next)
- (while (and (setq next (org-export-get-next-element object info))
- (or (and (stringp next)
- (not (string-match-p "\\S-" next)))
- (org-bibtex-citation-p next)))
- (unless (stringp next)
- (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
- ;; as the last citation removed.
- (org-element-put-property
- new-citation
- :post-blank (org-element-property :post-blank object))
- (org-element-put-property
- new-citation
- :value (format "\\cite%s{%s}"
- (or option "")
- (mapconcat 'identity (nreverse keys) ",")))))))))
- tree)
-
-(eval-after-load 'ox
- '(progn (add-to-list 'org-export-filter-parse-tree-functions
- 'org-bibtex-process-bib-files)
- (add-to-list 'org-export-filter-parse-tree-functions
- 'org-bibtex-merge-contiguous-citations)))
-
-
-
-;;; LaTeX Part
-
-(defadvice org-latex-keyword (around bibtex-keyword)
- "Translate \"BIBLIOGRAPHY\" keywords into LaTeX syntax.
-Fallback to `latex' back-end for other keywords."
- (let ((keyword (ad-get-arg 0)))
- (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
- ad-do-it
- (let ((file (org-bibtex-get-file keyword))
- (style (org-not-nil (org-bibtex-get-style keyword))))
- (setq ad-return-value
- (when file
- (concat (and style (format "\\bibliographystyle{%s}\n" style))
- (format "\\bibliography{%s}" file))))))))
-
-(ad-activate 'org-latex-keyword)
-
-
-
-;;; HTML Part
-
-(defvar org-bibtex-html-entries-alist nil) ; Dynamically scoped.
-(defvar org-bibtex-html-keywords-alist nil) ; Dynamically scoped.
-
-
-;;;; Advices
-
-(defadvice org-html-keyword (around bibtex-keyword)
- "Translate \"BIBLIOGRAPHY\" keywords into HTML syntax.
-Fallback to `html' back-end for other keywords."
- (let ((keyword (ad-get-arg 0)))
- (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
- ad-do-it
- (setq ad-return-value
- (cdr (assq keyword org-bibtex-html-keywords-alist))))))
-
-(defadvice org-html-latex-fragment (around bibtex-citation)
- "Translate \"\\cite\" LaTeX fragments into HTML syntax.
-Fallback to `html' back-end for other keywords."
- (let ((fragment (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p fragment)) ad-do-it
- (setq ad-return-value
- (format "[%s]"
- (mapconcat
- (lambda (key)
- (format "<a href=\"#%s\">%s</a>"
- key
- (or (cdr (assoc key
org-bibtex-html-entries-alist))
- key)))
- (org-split-string
- (org-bibtex-get-citation-key fragment) ",") ","))))))
-
-(ad-activate 'org-html-keyword)
-(ad-activate 'org-html-latex-fragment)
-
-
-;;; Ascii Part
-(defadvice org-ascii-keyword (around bibtex-keyword)
- "Translate \"BIBLIOGRAPHY\" keywords into ascii syntax.
-Fallback to `ascii' back-end for other keywords."
- (let ((keyword (ad-get-arg 0)))
- (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
- ad-do-it
- (setq ad-return-value
- (cdr (assq keyword org-bibtex-html-keywords-alist))))))
-
-(defadvice org-ascii-latex-fragment (around bibtex-citation)
- "Translate \"\\cite\" LaTeX fragments into ascii syntax.
-Fallback to `ascii' back-end for other keywords."
- (let ((fragment (ad-get-arg 0)))
- (if (not (org-bibtex-citation-p fragment)) ad-do-it
- (setq ad-return-value
- (format "[%s]"
- (mapconcat
- (lambda (key)
- (or (cdr (assoc key org-bibtex-html-entries-alist))
- key))
- (org-split-string
- (org-bibtex-get-citation-key fragment) ",") ","))))))
-
-(ad-activate 'org-ascii-keyword)
-(ad-activate 'org-ascii-latex-fragment)
-
-(provide 'ox-bibtex)
-
-;;; ox-bibtex.el ends here
diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el
deleted file mode 100644
index 2abd155..0000000
--- a/contrib/lisp/ox-confluence.el
+++ /dev/null
@@ -1,258 +0,0 @@
-;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine
-
-;; Copyright (C) 2012, 2014 Sébastien Delafond
-
-;; Author: Sébastien Delafond <sdelafond@gmail.com>
-;; Keywords: outlines, confluence, wiki
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; ox-confluence.el lets you convert Org files to confluence files
-;; using the ox.el export engine.
-;;
-;; Put this file into your load-path and the following into your ~/.emacs:
-;; (require 'ox-confluence)
-;;
-;; Export Org files to confluence:
-;; M-x org-confluence-export-as-confluence RET
-;;
-;;; Code:
-
-(require 'ox)
-(require 'ox-ascii)
-
-;; Define the backend itself
-(org-export-define-derived-backend 'confluence 'ascii
- :translate-alist '((bold . org-confluence-bold)
- (code . org-confluence-code)
- (example-block . org-confluence-example-block)
- (fixed-width . org-confluence-fixed-width)
- (footnote-definition . org-confluence-empty)
- (footnote-reference . org-confluence-empty)
- (headline . org-confluence-headline)
- (italic . org-confluence-italic)
- (item . org-confluence-item)
- (link . org-confluence-link)
- (paragraph . org-confluence-paragraph)
- (property-drawer . org-confluence-property-drawer)
- (quote-block . org-confluence-quote-block)
- (section . org-confluence-section)
- (src-block . org-confluence-src-block)
- (strike-through . org-confluence-strike-through)
- (table . org-confluence-table)
- (table-cell . org-confluence-table-cell)
- (table-row . org-confluence-table-row)
- (template . org-confluence-template)
- (timestamp . org-confluence-timestamp)
- (underline . org-confluence-underline)
- (verbatim . org-confluence-verbatim))
- :menu-entry
- '(?f "Export to Confluence"
- ((?f "As Confluence buffer" org-confluence-export-as-confluence))))
-
-(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))
-
-(defun org-confluence-empty (empty contents info)
- "")
-
-(defun org-confluence-example-block (example-block contents info)
- ;; FIXME: provide a user-controlled variable for theme
- (let ((content (org-export-format-code-default example-block info)))
- (org-confluence--block "none" "Confluence" content)))
-
-(defun org-confluence-italic (italic contents info)
- (format "_%s_" contents))
-
-(defun org-confluence-item (item contents info)
- (let ((list-type (org-element-property :type (org-export-get-parent item))))
- (concat
- (make-string (1+ (org-confluence--li-depth item))
- (if (eq list-type 'ordered) ?\# ?\-))
- " "
- (pcase (org-element-property :checkbox item)
- (`on "*{{(X)}}* ")
- (`off "*{{( )}}* ")
- (`trans "*{{(\\-)}}* "))
- (when (eq list-type 'descriptive)
- (concat "*"
- (org-export-data (org-element-property :tag item) info)
- "* - "))
- (org-trim contents))))
-
-(defun org-confluence-fixed-width (fixed-width contents info)
- (org-confluence--block
- "none"
- "Confluence"
- (org-trim (org-element-property :value fixed-width))))
-
-(defun org-confluence-verbatim (verbatim contents info)
- (format "\{\{%s\}\}" (org-element-property :value verbatim)))
-
-(defun org-confluence-code (code contents info)
- (format "\{\{%s\}\}" (org-element-property :value code)))
-
-(defun org-confluence-headline (headline contents info)
- (let* ((low-level-rank (org-export-low-level-p headline info))
- (text (org-export-data (org-element-property :title headline)
- info))
- (todo (org-export-data (org-element-property :todo-keyword headline)
- info))
- (level (org-export-get-relative-level headline info))
- (todo-text (if (or (not (plist-get info :with-todo-keywords))
- (string= todo ""))
- ""
- (format "*{{%s}}* " todo))))
- (format "h%s. %s%s\n%s" level todo-text text
- (if (org-string-nw-p contents) contents ""))))
-
-(defun org-confluence-link (link desc info)
- (if (string= "radio" (org-element-property :type link))
- desc
- (let ((raw-link (org-element-property :raw-link link)))
- (concat "["
- (when (org-string-nw-p desc) (format "%s|" desc))
- (cond
- ((string-match "^confluence:" raw-link)
- (replace-regexp-in-string "^confluence:" "" raw-link))
- (t
- 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)))
-
-(defun org-confluence-quote-block (quote-block contents info)
- (format "{quote}\n%s{quote}" contents))
-
-(defun org-confluence-section (section contents info)
- contents)
-
-(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 (or (cdr (assoc lang org-confluence-lang-alist)) lang))
- (content (org-export-format-code-default src-block info)))
- (org-confluence--block language "Emacs" content)))
-
-(defun org-confluence-strike-through (strike-through contents info)
- (format "-%s-" contents))
-
-(defun org-confluence-table (table contents info)
- contents)
-
-(defun org-confluence-table-row (table-row contents info)
- (concat
- (if (org-string-nw-p contents) (format "|%s" contents)
- "")
- (when (org-export-table-row-ends-header-p table-row info)
- "|")))
-
-(defun org-confluence-table-cell (table-cell contents info)
- (let ((table-row (org-export-get-parent table-cell)))
- (concat (and (org-export-table-row-starts-header-p table-row info) "|")
- (if (= (length contents) 0) " " contents)
- "|")))
-
-(defun org-confluence-template (contents info)
- (let ((depth (plist-get info :with-toc)))
- (concat (when depth "\{toc\}\n\n") contents)))
-
-(defun org-confluence-timestamp (timestamp _contents _info)
- "Transcode a TIMESTAMP object from Org to Confluence.
-CONTENTS and INFO are ignored."
- (let ((translated (org-trim (org-timestamp-translate timestamp))))
- (if (string-prefix-p "[" translated)
- (concat "(" (substring translated 1 -1) ")")
- translated)))
-
-(defun org-confluence-underline (underline contents info)
- (format "+%s+" contents))
-
-(defun org-confluence--block (language theme contents)
- (concat "\{code:theme=" theme
- (when language (format "|language=%s" language))
- "}\n"
- contents
- "\{code\}\n"))
-
-(defun org-confluence--li-depth (item)
- "Return depth of a list item; -1 means not a list item"
- ;; FIXME check whether it's worth it to cache depth
- ;; (it gets recalculated quite a few times while
- ;; traversing a list)
- (let ((depth -1)
- (tag))
- (while (and item
- (setq tag (car item))
- (or (eq tag 'item) ; list items interleave with plain-list
- (eq tag 'plain-list)))
- (when (eq tag 'item)
- (cl-incf depth))
- (setq item (org-export-get-parent item)))
- depth))
-
-;; main interactive entrypoint
-(defun org-confluence-export-as-confluence
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to a text 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.
-
-When optional argument BODY-ONLY is non-nil, strip title, table
-of contents and footnote definitions from output.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Export is done in a buffer named \"*Org CONFLUENCE Export*\", which
-will be displayed when `org-export-show-temporary-export-buffer'
-is non-nil."
- (interactive)
- (org-export-to-buffer 'confluence "*org CONFLUENCE Export*"
- async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
-
-(provide 'ox-confluence)
diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el
deleted file mode 100644
index a1d67b7..0000000
--- a/contrib/lisp/ox-deck.el
+++ /dev/null
@@ -1,585 +0,0 @@
-;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine
-
-;; Copyright (C) 2013, 2014 Rick Frankel
-
-;; Author: Rick Frankel <emacs at rickster dot com>
-;; Keywords: outlines, hypermedia, slideshow
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This library implements a deck.js presentation back-end for the Org
-;; generic exporter.
-
-;; Installation
-;; -------------
-;; Get a copy of deck.js from http://imakewebthings.com/deck.js/ or
-;; the gitub repository at https://github.com/imakewebthings/deck.js.
-;;
-;; Add the path to the extracted code to the variable
-;; `org-deck-directories' There are a number of customization in the
-;; org-export-deck group, most of which can be overridden with buffer
-;; local customization (starting with DECK_.)
-
-;; 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))
-
-(org-export-define-derived-backend 'deck 'html
- :menu-entry
- '(?d "Export to deck.js HTML Presentation"
- ((?H "To temporary buffer" org-deck-export-as-html)
- (?h "To file" org-deck-export-to-html)
- (?o "To file and open"
- (lambda (a s v b)
- (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
- '((: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)
- (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE"
"html-style" nil)
- (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
- (:deck-base-url "DECK_BASE_URL" nil org-deck-base-url)
- (:deck-theme "DECK_THEME" nil org-deck-theme)
- (:deck-transition "DECK_TRANSITION" nil org-deck-transition)
- (:deck-include-extensions "DECK_INCLUDE_EXTENSIONS" nil
- org-deck-include-extensions split)
- (:deck-exclude-extensions "DECK_EXCLUDE_EXTENSIONS" nil
- org-deck-exclude-extensions split))
- :translate-alist
- '((headline . org-deck-headline)
- (inner-template . org-deck-inner-template)
- (item . org-deck-item)
- (link . org-deck-link)
- (template . org-deck-template)))
-
-(defgroup org-export-deck nil
- "Options for exporting Org mode files to deck.js HTML Presentations."
- :tag "Org Export DECK"
- :group 'org-export-html)
-
-(defcustom org-deck-directories '("./deck.js")
- "Directories to search for deck.js components (jquery,
-modernizr; core, extensions and themes directories.)"
- :group 'org-export-deck
- :type '(repeat (string :tag "Directory")))
-
-(defun org-deck--cleanup-components (components)
- (remove-duplicates
- (car (remove 'nil components))
- :test (lambda (x y)
- (string= (file-name-nondirectory x)
- (file-name-nondirectory y)))))
-
-(defun org-deck--find-extensions ()
- "Returns a unique list of all extensions found in
-in the extensions directories under `org-deck-directories'"
- (org-deck--cleanup-components
- (mapcar ; extensions under existing dirs
- (lambda (dir)
- (when (file-directory-p dir) (directory-files dir t "^[^.]")))
- (mapcar ; possible extension directories
- (lambda (x) (expand-file-name "extensions" x))
- org-deck-directories))))
-
-(defun org-deck--find-css (type)
- "Return a unique list of all the css stylesheets in the themes/TYPE
-directories under `org-deck-directories'."
- (org-deck--cleanup-components
- (mapcar
- (lambda (dir)
- (let ((css-dir (expand-file-name
- (concat (file-name-as-directory "themes") type) dir)))
- (when (file-directory-p css-dir)
- (directory-files css-dir t "\\.css$"))))
- org-deck-directories)))
-
-(defun org-deck-list-components ()
- "List all available deck extensions, styles and
-transitions (with full paths) to a temporary buffer."
- (interactive)
- (let ((outbuf (get-buffer-create "*deck.js Extensions*")))
- (with-current-buffer outbuf
- (erase-buffer)
- (insert "Extensions\n----------\n")
- (insert (mapconcat 'identity (org-deck--find-extensions) "\n"))
- (insert "\n\nStyles\n------\n")
- (insert (mapconcat 'identity (org-deck--find-css "style") "\n"))
- (insert "\n\nTransitions\n----------\n")
- (insert (mapconcat 'identity (org-deck--find-css "transition") "\n")))
- (switch-to-buffer-other-window outbuf)))
-
-(defcustom org-deck-include-extensions nil
- "If non-nil, list of extensions to include instead of all available.
-Can be overridden or set with the DECK_INCLUDE_EXTENSIONS property.
-During output generation, the extensions found by
-`org-deck--find-extensions' are searched for the appropriate
-files (scripts and/or stylesheets) to include in the generated
-html. The href/src attributes are created relative to `org-deck-base-url'."
- :group 'org-export-deck
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-deck-exclude-extensions nil
- "If non-nil, list of extensions to exclude.
-Can be overridden or set with the DECK_EXCLUDE_EXTENSIONS property."
- :group 'org-export-deck
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-deck-theme "swiss.css"
- "deck.js theme. Can be overridden with the DECK_THEME property.
-If this value contains a path component (\"/\"), it is used as a
-literal path (url). Otherwise it is prepended with
-`org-deck-base-url'/themes/style/."
- :group 'org-export-deck
- :type 'string)
-
-(defcustom org-deck-transition "fade.css"
- "deck.js transition theme. Can be overridden with the
-DECK_TRANSITION property.
-If this value contains a path component (\"/\"), it is used as a
-literal path (url). Otherwise it is prepended with
-`org-deck-base-url'/themes/transition/."
- :group 'org-export-deck
- :type 'string)
-
-(defcustom org-deck-base-url "deck.js"
- "Url prefix to deck.js base directory containing the core, extensions
-and themes directories.
-Can be overridden with the DECK_BASE_URL property."
- :group 'org-export-deck
- :type 'string)
-
-(defvar org-deck-pre/postamble-styles
- `((both "left: 5px; width: 100%;")
- (preamble "position: absolute; top: 10px;")
- (postamble ""))
- "Alist of css styles for the preamble, postamble and both respectively.
-Can be overridden in `org-deck-styles'. See also `org-html-divs'.")
-
-(defcustom org-deck-postamble "<h1>%a - %t</h1>"
- "Non-nil means insert a postamble in HTML export.
-
-When set to a string, use this string
-as the postamble. When t, insert a string as defined by the
-formatting string in `org-html-postamble-format'.
-
-When set to a function, apply this function and insert the
-returned string. The function takes the property list of export
-options as its only argument.
-
-This is included in the document at the bottom of the content
-section, and uses the postamble element and id from
-`org-html-divs'. The default places the author and presentation
-title at the bottom of each slide.
-
-The css styling is controlled by `org-deck-pre/postamble-styles'.
-
-Setting :deck-postamble in publishing projects will take
-precedence over this variable."
- :group 'org-export-deck
- :type '(choice (const :tag "No postamble" nil)
- (const :tag "Default formatting string" t)
- (string :tag "Custom formatting string")
- (function :tag "Function (must return a string)")))
-
-(defcustom org-deck-preamble nil
- "Non-nil means insert a preamble in HTML export.
-
-When set to a string, use this string
-as the preamble. When t, insert a string as defined by the
-formatting string in `org-html-preamble-format'.
-
-When set to a function, apply this function and insert the
-returned string. The function takes the property list of export
-options as its only argument.
-
-This is included in the document at the top of content section, and
-uses the preamble element and id from `org-html-divs'. The css
-styling is controlled by `org-deck-pre/postamble-styles'.
-
-Setting :deck-preamble in publishing projects will take
-precedence over this variable."
- :group 'org-export-deck
- :type '(choice (const :tag "No preamble" nil)
- (const :tag "Default formatting string" t)
- (string :tag "Custom formatting string")
- (function :tag "Function (must return a string)")))
-
-(defvar org-deck-toc-styles
- (mapconcat
- 'identity
- (list
- "#table-of-contents a {color: inherit;}"
- "#table-of-contents ul {margin-bottom: 0;}"
- "#table-of-contents li {padding: 0;}") "\n")
- "Default css styles used for formatting a table of contents slide.
-Can be overridden in `org-deck-styles'.
-Note that when the headline numbering option is true, a \"list-style: none\"
-is automatically added to avoid both numbers and bullets on the toc entries.")
-
-(defcustom org-deck-styles
- "
-#title-slide h1 {
- position: static; padding: 0;
- margin-top: 10%;
- -webkit-transform: none;
- -moz-transform: none;
- -ms-transform: none;
- -o-transform: none;
- transform: none;
-}
-#title-slide h2 {
- text-align: center;
- border:none;
- padding: 0;
- margin: 0;
-}"
- "Deck specific CSS styles to include in exported html.
-Defaults to styles for the title page."
- :group 'org-export-deck
- :type 'string)
-
-(defcustom org-deck-title-slide-template
- "<h1>%t</h1>
-<h2>%s</h2>
-<h2>%a</h2>
-<h2>%e</h2>
-<h2>%d</h2>"
- "Format template to specify title page section.
-See `org-html-postamble-format' for the valid elements which
-can be included.
-
-It will be wrapped in the element defined in the :html-container
-property, and defaults to the value of `org-html-container-element',
-and have the id \"title-slide\"."
- :group 'org-export-deck
- :type 'string)
-
-(defun org-deck-toc (depth info)
- (concat
- (format "<%s id='table-of-contents' class='slide'>\n"
- (plist-get info :html-container))
- (format "<h2>%s</h2>\n" (org-html--translate "Table of Contents" info))
- (org-html--toc-text
- (mapcar
- (lambda (headline)
- (let* ((class (org-element-property :HTML_CONTAINER_CLASS headline))
- (section-number
- (when
- (and (not (org-export-low-level-p headline info))
- (org-export-numbered-headline-p headline info))
- (concat
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number headline info) ".") ". ")))
- (title
- (concat
- section-number
- (replace-regexp-in-string ; remove any links in headline...
- "</?a[^>]*>" ""
- (org-export-data
- (org-element-property :title headline) info)))))
- (cons
- (if (and class (string-match-p "\\<slide\\>" class))
- (format
- "<a href='#outline-container-%s'>%s</a>"
- (or (org-element-property :CUSTOM_ID headline)
- (concat
- "sec-"
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number headline info) "-")))
- title)
- title)
- (org-export-get-relative-level headline info))))
- (org-export-collect-headlines info depth)))
- (format "</%s>\n" (plist-get info :html-container))))
-
-(defun org-deck--get-packages (info)
- (let ((prefix (concat (plist-get info :deck-base-url) "/"))
- (theme (plist-get info :deck-theme))
- (transition (plist-get info :deck-transition))
- (include (plist-get info :deck-include-extensions))
- (exclude (plist-get info :deck-exclude-extensions))
- (scripts '()) (sheets '()) (snippets '()))
- (add-to-list 'scripts (concat prefix "jquery.min.js"))
- (add-to-list 'scripts (concat prefix "core/deck.core.js"))
- (add-to-list 'scripts (concat prefix "modernizr.custom.js"))
- (add-to-list 'sheets (concat prefix "core/deck.core.css"))
- (mapc
- (lambda (extdir)
- (let* ((name (file-name-nondirectory extdir))
- (dir (file-name-as-directory extdir))
- (path (concat prefix "extensions/" name "/"))
- (base (format "deck.%s." name)))
- (when (and (or (eq nil include) (member name include))
- (not (member name exclude)))
- (when (file-exists-p (concat dir base "js"))
- (add-to-list 'scripts (concat path base "js")))
- (when (file-exists-p (concat dir base "css"))
- (add-to-list 'sheets (concat path base "css")))
- (when (file-exists-p (concat dir base "html"))
- (add-to-list 'snippets (concat dir base "html"))))))
- (org-deck--find-extensions))
- (if (not (string-match-p "^[[:space:]]*$" theme))
- (add-to-list 'sheets
- (if (file-name-directory theme) theme
- (format "%sthemes/style/%s" prefix theme))))
- (if (not (string-match-p "^[[:space:]]*$" transition))
- (add-to-list
- 'sheets
- (if (file-name-directory transition) transition
- (format "%sthemes/transition/%s" prefix transition))))
- (list :scripts (nreverse scripts) :sheets (nreverse sheets)
- :snippets snippets)))
-
-(defun org-deck-inner-template (contents info)
- "Return body of document string after HTML conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (concat contents "\n"))
-
-(defun org-deck-headline (headline contents info)
- (let ((org-html-toplevel-hlevel 2)
- (class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
- (level (org-export-get-relative-level headline info)))
- (when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
- (org-element-put-property headline :HTML_CONTAINER_CLASS (concat class "
slide")))
- (org-html-headline headline contents info)))
-
-(defun org-deck-item (item contents info)
- "Transcode an ITEM element from Org to HTML.
-CONTENTS holds the contents of the item. INFO is a plist holding
-contextual information.
-If the containing headline has the property :STEP, then
-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)
- (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-export-with-backend 'html link desc info)))
-
-(defun org-deck-template (contents info)
- "Return complete document string after HTML conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (let ((pkg-info (org-deck--get-packages info))
- (org-html--pre/postamble-class "deck-status")
- (info (plist-put
- (plist-put info :html-preamble (plist-get info :deck-preamble))
- :html-postamble (plist-get info :deck-postamble))))
- (mapconcat
- 'identity
- (list
- (org-html-doctype info)
- (let ((lang (plist-get info :language)))
- (mapconcat
- (lambda (x)
- (apply
- 'format
- "<!--%s <html %s lang='%s' xmlns='http://www.w3.org/1999/xhtml'>
%s<![endif]-->"
- x))
- (list `("[if lt IE 7]>" "class='no-js ie6'" ,lang "")
- `("[if IE 7]>" "class='no-js ie7'" ,lang "")
- `("[if IE 8]>" "class='no-js ie8'" ,lang "")
- `("[if gt IE 8]><!-->" "" ,lang "<!--")) "\n"))
- "<head>"
- (org-deck--build-meta-info info)
- (mapconcat
- (lambda (sheet)
- (format
- "<link rel='stylesheet' href='%s' type='text/css' />" sheet))
- (plist-get pkg-info :sheets) "\n")
- (mapconcat
- (lambda (script)
- (format
- "<script src='%s'></script>" script))
- (plist-get pkg-info :scripts) "\n")
- (org-html--build-mathjax-config info)
- "<script>"
- " $(document).ready(function () { $.deck('.slide'); });"
- "</script>"
- (org-html--build-head info)
- "<style type='text/css'>"
- org-deck-toc-styles
- (when (plist-get info :section-numbers)
- "#table-of-contents ul li {list-style-type: none;}")
- (format "#%s, #%s {%s}"
- (nth 2 (assq 'preamble org-html-divs))
- (nth 2 (assq 'postamble org-html-divs))
- (nth 1 (assq 'both org-deck-pre/postamble-styles)))
- (format "#%s {%s}"
- (nth 2 (assq 'preamble org-html-divs))
- (nth 1 (assq 'preamble org-deck-pre/postamble-styles)))
- (format "#%s {%s}"
- (nth 2 (assq 'postamble org-html-divs))
- (nth 1 (assq 'postamble org-deck-pre/postamble-styles)))
- org-deck-styles
- "</style>"
- "</head>"
- "<body>"
- (format "<%s id='%s' class='deck-container'>"
- (nth 1 (assq 'content org-html-divs))
- (nth 2 (assq 'content org-html-divs)))
- (org-html--build-pre/postamble 'preamble info)
- ;; title page
- (format "<%s id='title-slide' class='slide'>"
- (plist-get info :html-container))
- (format-spec org-deck-title-slide-template (org-html-format-spec info))
- (format "</%s>" (plist-get info :html-container))
- ;; toc page
- (let ((depth (plist-get info :with-toc)))
- (when depth (org-deck-toc depth info)))
- contents
- (mapconcat
- (lambda (snippet)
- (with-temp-buffer (insert-file-contents snippet)
- (buffer-string)))
- (plist-get pkg-info :snippets) "\n")
- (org-html--build-pre/postamble 'postamble info)
- (format "</%s>" (nth 1 (assq 'content org-html-divs)))
- "</body>"
- "</html>\n") "\n")))
-
-(defun org-deck--build-meta-info (info)
- "Return meta tags for exported document.
-INFO is a plist used as a communication channel."
- (let* ((title (org-export-data (plist-get info :title) info))
- (author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- (and auth (org-export-data auth info)))))
- (date (and (plist-get info :with-date)
- (let ((date (org-export-get-date info)))
- (and date (org-export-data date info)))))
- (description (plist-get info :description))
- (keywords (plist-get info :keywords)))
- (mapconcat
- 'identity
- (list
- (format "<title>%s</title>" title)
- (format "<meta http-equiv='Content-Type' content='text/html;
charset=%s'/>"
- (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get
- org-html-coding-system 'mime-charset))
- "iso-8859-1"))
- (mapconcat
- (lambda (attr)
- (when (< 0 (length (car attr)))
- (format "<meta name='%s' content='%s'/>\n"
- (nth 1 attr) (car attr))))
- (list '("Org-mode" "generator")
- `(,author "author")
- `(,description "description")
- `(,keywords "keywords")) "")) "\n")))
-(defun org-deck-export-as-html
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to an HTML 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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"<body>\" and \"</body>\" tags.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Export is done in a buffer named \"*Org deck.js Export*\", which
-will be displayed when `org-export-show-temporary-export-buffer'
-is non-nil."
- (interactive)
- (org-export-to-buffer 'deck "*Org deck.js Export*"
- async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
-
-(defun org-deck-export-to-html
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to a deck.js HTML 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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"<body>\" and \"</body>\" tags.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return output file's name."
- (interactive)
- (let* ((extension (concat "." org-html-extension))
- (file (org-export-output-file-name extension subtreep))
- (org-export-coding-system org-html-coding-system))
- (org-export-to-file 'deck file
- async subtreep visible-only body-only ext-plist)))
-
-(defun org-deck-publish-to-html (plist filename pub-dir)
- "Publish an org file to deck.js HTML Presentation.
-FILENAME is the filename of the Org file to be published. PLIST
-is the property list for the given project. PUB-DIR is the
-publishing directory. Returns output file name."
- (org-publish-org-to 'deck filename ".html" plist pub-dir))
-
-(provide 'ox-deck)
-
-;;; ox-deck.el ends here
diff --git a/contrib/lisp/ox-extra.el b/contrib/lisp/ox-extra.el
deleted file mode 100644
index e8728b2..0000000
--- a/contrib/lisp/ox-extra.el
+++ /dev/null
@@ -1,211 +0,0 @@
-;;; 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 <https://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)
-(require 'cl-lib)
-
-(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))
- (cl-destructuring-bind
- (beg end &rest ignore)
- ;; FIXME: `org-edit-src-find-region-and-lang' was
- ;; removed in 9c06f8cce (2014-11-11).
- (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)
- (org-extra--merge-sections data backend info)
- data)
-
-(defun org-extra--merge-sections (data _backend info)
- (org-element-map data 'headline
- (lambda (hl)
- (let ((sections
- (cl-loop
- for el in (org-element-map (org-element-contents hl)
- '(headline section) #'identity info)
- until (eq (org-element-type el) 'headline)
- collect el)))
- (when (and sections
- (> (length sections) 1))
- (apply #'org-element-adopt-elements
- (car sections)
- (cl-mapcan (lambda (s) (org-element-contents s))
- (cdr sections)))
- (mapc #'org-element-extract-element (cdr sections)))))
- info))
-
-(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
deleted file mode 100644
index 21ce731..0000000
--- a/contrib/lisp/ox-freemind.el
+++ /dev/null
@@ -1,527 +0,0 @@
-;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
-
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
-
-;; Author: Jambunathan K <kjambunathan at gmail dot com>
-;; Keywords: outlines, hypermedia, calendar, wp
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This library implements a Freemind Mindmap back-end for Org generic
-;; exporter.
-
-;; To test it, run:
-;;
-;; M-x org-freemind-export-to-freemind
-;;
-;; in an Org mode buffer. See ox.el for more details on how this
-;; exporter works.
-
-;;; Code:
-
-;;; Dependencies
-
-(require 'ox-html)
-
-
-
-;;; Define Back-End
-
-(org-export-define-derived-backend 'freemind 'html
- :menu-entry
- '(?f "Export to Freemind Mindmap"
- ((?f "As Freemind Mindmap file" org-freemind-export-to-freemind)
- (?o "As Freemind Mindmap file and open"
- (lambda (a s v b)
- (if a (org-freemind-export-to-freemind t s v b)
- (org-open-file (org-freemind-export-to-freemind nil s v b)))))))
- :translate-alist '((headline . org-freemind-headline)
- (template . org-freemind-template)
- (inner-template . org-freemind-inner-template)
- (section . org-freemind-section)
- (entity . org-freemind-entity))
- :filters-alist '((:filter-options . org-freemind-options-function)
- (:filter-final-output . org-freemind-final-function)))
-
-
-
-;;; User Configuration Variables
-
-(defgroup org-export-freemind nil
- "Options for exporting Org mode files to Freemind Mindmap."
- :tag "Org Export Freemind Mindmap"
- :group 'org-export)
-
-(defcustom org-freemind-styles
- '((default . "<node>\n</node>")
- (0 . "<node COLOR=\"#000000\">\n<font NAME=\"SansSerif\"
SIZE=\"20\"/>\n</node>")
- (1 . "<node COLOR=\"#0033ff\">\n<edge STYLE=\"sharp_bezier\"
WIDTH=\"8\"/>\n<font NAME=\"SansSerif\" SIZE=\"18\"/>\n</node>")
- (2 . "<node COLOR=\"#00b439\">\n<edge STYLE=\"bezier\"
WIDTH=\"thin\"/>\n<font NAME=\"SansSerif\" SIZE=\"16\"/>\n</node>")
- (3 . "<node COLOR=\"#990000\" FOLDED=\"true\">\n<font NAME=\"SansSerif\"
SIZE=\"14\"/>\n</node>")
- (4 . "<node COLOR=\"#111111\">\n</node>"))
- "List of Freemind node styles.
-Each entry is of the form (STYLE-NAME . STYLE-SPEC). STYLE-NAME
-can be one of an integer (signifying an outline level), a string
-or the symbol `default'. STYLE-SPEC, a string, is a Freemind
-node style."
- :type '(alist :options (default 0 1 2 3)
- :key-type (choice :tag "Style tag"
- (integer :tag "Outline level")
- (const :tag "Default value" default)
- (string :tag "Node style"))
- :value-type (string :tag "Style spec"))
- :group 'org-export-freemind)
-
-(defcustom org-freemind-style-map-function 'org-freemind-style-map--automatic
- "Function to map an Org element to it's node style.
-The mapping function takes two arguments an Org ELEMENT and INFO.
-ELEMENT can be one of the following types - `org-data',
-`headline' or `section'. INFO is a plist holding contextual
-information during export. The function must return a STYLE-SPEC
-to be applied to ELEMENT.
-
-See `org-freemind-style-map--automatic' for a sample style
-function. See `org-freemind-styles' for a list of named styles."
- :type '(radio
- (function-item org-freemind-style-map--automatic)
- (function-item org-freemind-style-map--default)
- function)
- :group 'org-export-freemind)
-
-(defcustom org-freemind-section-format 'note
- "Specify how outline sections are to be formatted.
-If `inline', append it to the contents of it's heading node. If
-`note', attach it as a note to it's heading node. If `node',
-attach it as a separate node to it's heading node.
-
-Use `note', if the input Org file contains large sections. Use
-`node', if the Org file contains mid-sized sections that need to
-stand apart. Otherwise, use `inline'."
- :type '(choice
- (const :tag "Append to outline title" inline)
- (const :tag "Attach as a note" note)
- (const :tag "Create a separate node" node))
- :group 'org-export-freemind)
-
-;;;; Debugging
-
-(defcustom org-freemind-pretty-output nil
- "Enable this to generate pretty Freemind Mindmap."
- :type 'boolean
- :group 'org-export-freemind)
-
-
-;;; Internal Functions
-
-;;;; XML Manipulation
-
-(defun org-freemind--serialize (parsed-xml &optional contents)
- "Convert PARSED-XML in to XML string.
-PARSED-XML is a parse tree as returned by
-`libxml-parse-xml-region'. CONTENTS is an optional string.
-
-Ignore CONTENTS, if PARSED-XML is not a sole XML element.
-Otherwise, append CONTENTS to the contents of top-level element
-in PARSED-XML.
-
-This is an inverse function of `libxml-parse-xml-region'.
-
-For purposes of Freemind export, PARSED-XML is a node style
-specification - \"<node ...>...</node>\" - as a parse tree."
- (when contents
- (assert (symbolp (car parsed-xml))))
- (cond
- ((null parsed-xml) "")
- ((stringp parsed-xml) parsed-xml)
- ((symbolp (car parsed-xml))
- (let ((attributes (mapconcat
- (lambda (av)
- (format "%s=\"%s\"" (car av) (cdr av)))
- (cadr parsed-xml) " ")))
- (if (or (cddr parsed-xml) contents)
- (format "\n<%s%s>%s\n</%s>"
- (car parsed-xml)
- (if (string= attributes "") "" (concat " " attributes))
- (concat (org-freemind--serialize (cddr parsed-xml))
- contents )
- (car parsed-xml))
- (format "\n<%s%s/>"
- (car parsed-xml)
- (if (string= attributes "") "" (concat " " attributes))))))
- (t (mapconcat #'org-freemind--serialize parsed-xml ""))))
-
-(defun org-freemind--parse-xml (xml-string)
- "Return parse tree for XML-STRING using `libxml-parse-xml-region'.
-For purposes of Freemind export, XML-STRING is a node style
-specification - \"<node ...>...</node>\" - as a string."
- (with-temp-buffer
- (insert (or xml-string ""))
- (libxml-parse-xml-region (point-min) (point-max))))
-
-
-;;;; Style mappers :: Default and Automatic layout
-
-(defun org-freemind-style-map--automatic (element info)
- "Return a node style corresponding to relative outline level of ELEMENT.
-ELEMENT can be any of the following types - `org-data',
-`headline' or `section'. See `org-freemind-styles' for style
-mappings of different outline levels."
- (let ((style-name
- (case (org-element-type element)
- (headline
- (org-export-get-relative-level element info))
- (section
- (let ((parent (org-export-get-parent-headline element)))
- (if (not parent) 1
- (1+ (org-export-get-relative-level parent info)))))
- (t 0))))
- (or (assoc-default style-name org-freemind-styles)
- (assoc-default 'default org-freemind-styles)
- "<node></node>")))
-
-(defun org-freemind-style-map--default (element info)
- "Return the default style for all ELEMENTs.
-ELEMENT can be any of the following types - `org-data',
-`headline' or `section'. See `org-freemind-styles' for current
-value of default style."
- (or (assoc-default 'default org-freemind-styles)
- "<node></node>"))
-
-
-;;;; Helpers :: Retrieve, apply Freemind styles
-
-(defun org-freemind--get-node-style (element info)
- "Return Freemind node style applicable for HEADLINE.
-ELEMENT is an Org element of type `org-data', `headline' or
-`section'. INFO is a plist holding contextual information."
- (unless (fboundp org-freemind-style-map-function)
- (setq org-freemind-style-map-function 'org-freemind-style-map--default))
- (let ((style (funcall org-freemind-style-map-function element info)))
- ;; Sanitize node style.
-
- ;; Loop through the attributes of node element and purge those
- ;; attributes that look suspicious. This is an extra bit of work
- ;; that allows one to copy verbatim node styles from an existing
- ;; Freemind Mindmap file without messing with the exported data.
- (let* ((data (org-freemind--parse-xml style))
- (attributes (cadr data))
- (ignored-attrs '(POSITION FOLDED TEXT CREATED ID
- MODIFIED)))
- (let (attr)
- (while (setq attr (pop ignored-attrs))
- (setq attributes (assq-delete-all attr attributes))))
- (when data (setcar (cdr data) attributes))
- (org-freemind--serialize data))))
-
-(defun org-freemind--build-stylized-node (style-1 style-2 &optional contents)
- "Build a Freemind node with style STYLE-1 + STYLE-2 and add CONTENTS to it.
-STYLE-1 and STYLE-2 are Freemind node styles as a string.
-STYLE-1 is the base node style and STYLE-2 is the overriding
-style that takes precedence over STYLE-1. CONTENTS is a string.
-
-Return value is a Freemind node with following properties:
-
- 1. The attributes of \"<node ...> </node>\" element is the union
- of corresponding attributes of STYLE-1 and STYLE-2. When
- STYLE-1 and STYLE-2 specify values for the same attribute
- name, choose the attribute value from STYLE-2.
-
- 2. The children of \"<node ...> </node>\" element is the union of
- top-level children of STYLE-1 and STYLE-2 with CONTENTS
- appended to it. When STYLE-1 and STYLE-2 share a child
- element of same type, the value chosen is that from STYLE-2.
-
-For example, merging with following parameters
-
- STYLE-1 =>
- <node COLOR=\"#00b439\" STYLE=\"Bubble\">
- <edge STYLE=\"bezier\" WIDTH=\"thin\"/>
- <font NAME=\"SansSerif\" SIZE=\"16\"/>
- </node>
-
- STYLE-2 =>
- <node COLOR=\"#990000\" FOLDED=\"true\">
- <font NAME=\"SansSerif\" SIZE=\"14\"/>
- </node>
-
- CONTENTS =>
- <attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
-
-will result in following node:
-
- RETURN =>
- <node STYLE=\"Bubble\" COLOR=\"#990000\" FOLDED=\"true\">
- <edge STYLE=\"bezier\" WIDTH=\"thin\"/>
- <font NAME=\"SansSerif\" SIZE=\"14\"/>
- <attribute NAME=\"ORGTAG\" VALUE=\"@home\"/>
- </node>."
- (let* ((data1 (org-freemind--parse-xml (or style-1 "")))
- (data2 (org-freemind--parse-xml (or style-2 "")))
- (attr1 (cadr data1))
- (attr2 (cadr data2))
- (merged-attr attr2)
- (children1 (cddr data1))
- (children2 (cddr data2))
- (merged-children children2))
- (let (attr)
- (while (setq attr (pop attr1))
- (unless (assq (car attr) merged-attr)
- (push attr merged-attr))))
- (let (child)
- (while (setq child (pop children1))
- (when (or (stringp child) (not (assq (car child) merged-children)))
- (push child merged-children))))
- (let ((merged-data (nconc (list 'node merged-attr) merged-children)))
- (org-freemind--serialize merged-data contents))))
-
-
-;;;; Helpers :: Node contents
-
-(defun org-freemind--richcontent (type contents &optional css-style)
- (let* ((type (case type
- (note "NOTE")
- (node "NODE")
- (t "NODE")))
- (contents (org-trim contents)))
- (if (string= (org-trim contents) "") ""
- (format "\n<richcontent TYPE=\"%s\">%s\n</richcontent>"
- type
- (format "\n<html>\n<head>%s\n</head>\n%s\n</html>"
- (or css-style "")
- (format "<body>\n%s\n</body>" contents))))))
-
-(defun org-freemind--build-node-contents (element contents info)
- (let* ((title (case (org-element-type element)
- (headline
- (org-element-property :title element))
- (org-data
- (plist-get info :title))
- (t (error "Shouldn't come here"))))
- (element-contents (org-element-contents element))
- (section (assq 'section element-contents))
- (section-contents
- (let ((backend (org-export-create-backend
- :parent (org-export-backend-name
- (plist-get info :back-end))
- :transcoders '((section . (lambda (e c i) c))))))
- (org-export-data-with-backend section backend info)))
- (itemized-contents-p (let ((first-child-headline
- (org-element-map element-contents
- 'headline 'identity info t)))
- (when first-child-headline
- (org-export-low-level-p first-child-headline
- info))))
- (node-contents (concat section-contents
- (when itemized-contents-p
- contents))))
- (concat (let ((title (org-export-data title info)))
- (case org-freemind-section-format
- (inline
- (org-freemind--richcontent
- 'node (concat (format "\n<h2>%s</h2>" title)
- node-contents) ))
- (note
- (concat (org-freemind--richcontent
- 'node (format "\n<p>%s\n</p>" title))
- (org-freemind--richcontent
- 'note node-contents)))
- (node
- (concat
- (org-freemind--richcontent
- 'node (format "\n<p>%s\n</p>" title))
- (when section
- (org-freemind--build-stylized-node
- (org-freemind--get-node-style section info) nil
- (org-freemind--richcontent 'node node-contents)))))))
- (unless itemized-contents-p
- contents))))
-
-
-
-;;; Template
-
-(defun org-freemind-template (contents info)
- "Return complete document string after Freemind Mindmap conversion.
-CONTENTS is the transcoded contents string. RAW-DATA is the
-original parsed data. INFO is a plist holding export options."
- (format
- "<map version=\"0.9.0\">\n%s\n</map>"
- (org-freemind--build-stylized-node
- (org-freemind--get-node-style nil info) nil
- (let ((org-data (plist-get info :parse-tree)))
- (org-freemind--build-node-contents org-data contents info)))))
-
-(defun org-freemind-inner-template (contents info)
- "Return body of document string after Freemind Mindmap conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- contents)
-
-;;;; Tags
-
-(defun org-freemind--tags (tags)
- (mapconcat (lambda (tag)
- (format "\n<attribute NAME=\"%s\" VALUE=\"%s\"/>" tag ""))
- tags "\n"))
-
-
-
-;;; Transcode Functions
-
-;;;; Entity
-
-(defun org-freemind-entity (entity contents info)
- "Transcode an ENTITY object from Org to Freemind Mindmap.
-CONTENTS are the definition itself. INFO is a plist holding
-contextual information."
- (org-element-property :utf-8 entity))
-
-;;;; Headline
-
-(defun org-freemind-headline (headline contents info)
- "Transcode a HEADLINE element from Org to Freemind Mindmap.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- ;; Empty contents?
- (setq contents (or contents ""))
- (let* ((numberedp (org-export-numbered-headline-p headline info))
- (level (org-export-get-relative-level headline info))
- (text (org-export-data (org-element-property :title headline) info))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (section-number (and (not (org-export-low-level-p headline info))
- (org-export-numbered-headline-p headline info)
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) ".")))
- ;; Create the headline text.
- (full-text (org-export-data (org-element-property :title headline)
- info))
- ;; Headline order (i.e, first digit of the section number)
- (headline-order (car (org-export-get-headline-number headline info))))
- (cond
- ;; Case 1: This is a footnote section: ignore it.
- ((org-element-property :footnote-section-p headline) nil)
- ;; Case 2. This is a deep sub-tree, export it as a list item.
- ;; Delegate the actual export to `html' backend.
- ((org-export-low-level-p headline info)
- (org-html-headline headline contents info))
- ;; Case 3. Standard headline. Export it as a section.
- (t
- (let* ((section-number (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) "-"))
- (ids (remove 'nil
- (list (org-element-property :CUSTOM_ID headline)
- (concat "sec-" section-number)
- (org-element-property :ID headline))))
- (preferred-id (car ids))
- (extra-ids (cdr ids))
- (left-p (zerop (% headline-order 2))))
- (org-freemind--build-stylized-node
- (org-freemind--get-node-style headline info)
- (format "<node ID=\"%s\" POSITION=\"%s\" FOLDED=\"%s\">\n</node>"
- preferred-id
- (if left-p "left" "right")
- (if (= level 1) "true" "false"))
- (concat (org-freemind--build-node-contents headline contents info)
- (org-freemind--tags tags))))))))
-
-
-;;;; Section
-
-(defun org-freemind-section (section contents info)
- "Transcode a SECTION element from Org to Freemind Mindmap.
-CONTENTS holds the contents of the section. INFO is a plist
-holding contextual information."
- (let ((parent (org-export-get-parent-headline section)))
- (when (and parent (org-export-low-level-p parent info))
- contents)))
-
-
-
-;;; Filter Functions
-
-(defun org-freemind-final-function (contents backend info)
- "Return CONTENTS as pretty XML using `indent-region'."
- (if (not org-freemind-pretty-output) contents
- (with-temp-buffer
- (nxml-mode)
- (insert contents)
- (indent-region (point-min) (point-max))
- (buffer-substring-no-properties (point-min) (point-max)))))
-
-(defun org-freemind-options-function (info backend)
- "Install script in export options when appropriate.
-EXP-PLIST is a plist containing export options. BACKEND is the
-export back-end currently used."
- ;; Freemind/Freeplane doesn't seem to like named html entities in
- ;; richcontent. For now, turn off smart quote processing so that
- ;; entities like "’" & friends are avoided in the exported
- ;; output.
- (plist-put info :with-smart-quotes nil))
-
-
-
-;;; End-user functions
-
-;;;###autoload
-(defun org-freemind-export-to-freemind
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to a Freemind Mindmap 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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"<body>\" and \"</body>\" tags.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return output file's name."
- (interactive)
- (let* ((extension (concat ".mm" ))
- (file (org-export-output-file-name extension subtreep))
- (org-export-coding-system 'utf-8))
- (org-export-to-file 'freemind file
- async subtreep visible-only body-only ext-plist)))
-
-(provide 'ox-freemind)
-
-;;; ox-freemind.el ends here
diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
deleted file mode 100644
index 5c18085..0000000
--- a/contrib/lisp/ox-groff.el
+++ /dev/null
@@ -1,1960 +0,0 @@
-;;; ox-groff.el --- Groff Back-End for Org Export Engine
-
-;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
-
-;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
-;; Author: Luis R Anaya <papoanaya aroba hot mail punto com>
-;; Keywords: outlines, hypermedia, calendar, wp
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-;;; Commentary:
-;;
-;; This library implements a Groff Memorandum Macro back-end for Org
-;; generic exporter.
-;;
-;; To test it, run
-;;
-;; M-: (org-export-to-buffer 'groff "*Test Groff*") RET
-;;
-;; in an org-mode buffer then switch to the buffer to see the Groff
-;; export. See ox.el for more details on how this exporter works.
-;;
-;; It introduces two new buffer keywords: "GROFF_CLASS" and
-;; "GROFF_CLASS_OPTIONS".
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'ox)
-
-(defvar orgtbl-exp-regexp)
-
-
-;;; Define Back-End
-
-(org-export-define-backend 'groff
- '((bold . org-groff-bold)
- (center-block . org-groff-center-block)
- (clock . org-groff-clock)
- (code . org-groff-code)
- (drawer . org-groff-drawer)
- (dynamic-block . org-groff-dynamic-block)
- (entity . org-groff-entity)
- (example-block . org-groff-example-block)
- (export-block . org-groff-export-block)
- (export-snippet . org-groff-export-snippet)
- (fixed-width . org-groff-fixed-width)
- (footnote-definition . org-groff-footnote-definition)
- (footnote-reference . org-groff-footnote-reference)
- (headline . org-groff-headline)
- (horizontal-rule . org-groff-horizontal-rule)
- (inline-src-block . org-groff-inline-src-block)
- (inlinetask . org-groff-inlinetask)
- (italic . org-groff-italic)
- (item . org-groff-item)
- (keyword . org-groff-keyword)
- (line-break . org-groff-line-break)
- (link . org-groff-link)
- (node-property . org-groff-node-property)
- (paragraph . org-groff-paragraph)
- (plain-list . org-groff-plain-list)
- (plain-text . org-groff-plain-text)
- (planning . org-groff-planning)
- (property-drawer . org-groff-property-drawer)
- (quote-block . org-groff-quote-block)
- (radio-target . org-groff-radio-target)
- (section . org-groff-section)
- (special-block . org-groff-special-block)
- (src-block . org-groff-src-block)
- (statistics-cookie . org-groff-statistics-cookie)
- (strike-through . org-groff-strike-through)
- (subscript . org-groff-subscript)
- (superscript . org-groff-superscript)
- (table . org-groff-table)
- (table-cell . org-groff-table-cell)
- (table-row . org-groff-table-row)
- (target . org-groff-target)
- (template . org-groff-template)
- (timestamp . org-groff-timestamp)
- (underline . org-groff-underline)
- (verbatim . org-groff-verbatim)
- (verse-block . org-groff-verse-block))
- :menu-entry
- '(?g "Export to GROFF"
- ((?g "As GROFF file" org-groff-export-to-groff)
- (?p "As PDF file" org-groff-export-to-pdf)
- (?o "As PDF file and open"
- (lambda (a s v b)
- (if a (org-groff-export-to-pdf t s v b)
- (org-open-file (org-groff-export-to-pdf nil s v b)))))))
- :options-alist
- '((:groff-class "GROFF_CLASS" nil org-groff-default-class t)
- (:groff-class-options "GROFF_CLASS_OPTIONS" nil nil t)
- (:groff-header-extra "GROFF_HEADER" nil nil newline)))
-
-
-
-;;; User Configurable Variables
-
-(defgroup org-export-groff nil
- "Options for exporting Org mode files to Groff."
- :tag "Org Export Groff"
- :group 'org-export)
-
-;;; Preamble
-
-(defcustom org-groff-default-class "internal"
- "The default Groff class."
- :group 'org-export-groff
- :type '(string :tag "Groff class"))
-
-(defcustom org-groff-classes
- '(("file" ".MT 1"
- (:heading 'default :type "memo" :last-section "toc"))
- ("internal" ".MT 0"
- (:heading 'default :type "memo" :last-section "toc"))
- ("programmer" ".MT 2"
- (:heading 'default :type "memo" :last-section "toc"))
- ("engineer" ".MT 3"
- (:heading 'default :type "memo" :last-section "toc"))
- ("external" ".MT 4"
- (:heading 'default :type "memo" :last-section "toc"))
- ("letter" ".MT 5"
- (:heading 'default :type "memo" :last-section "sign"))
- ("custom" ".so file"
- (:heading custom-function :type "custom" :last-section "toc"))
- ("dummy" ""
- (:heading 'default :type "memo"))
- ("ms" "ms"
- (:heading 'default :type "cover" :last-section "toc"))
- ("se_ms" "se_ms"
- (:heading 'default :type "cover" :last-section "toc"))
- ("block" "BL"
- (:heading 'default :type "letter" :last-section "sign"))
- ("semiblock" "SB"
- (:heading 'default :type "letter" :last-section "sign"))
- ("fullblock" "FB"
- (:heading 'default :type "letter" :last-section "sign"))
- ("simplified" "SP"
- (:heading 'default :type "letter" :last-section "sign"))
- ("none" "" (:heading 'default :type "custom")))
-
- ;; none means, no Cover or Memorandum Type and no calls to AU, AT, ND and TL
- ;; This is to facilitate the creation of custom pages.
-
- ;; dummy means, no Cover or Memorandum Type but calls to AU, AT, ND and TL
- ;; are made. This is to facilitate Abstract Insertion.
-
- "This list describes the attributes for the documents being created.
- It allows for the creation of new "
- :group 'org-export-groff
- :type '(repeat
- (list (string :tag "Document Type")
- (string :tag "Header")
- (repeat :tag "Options" :inline t
- (choice
- (list :tag "Heading")
- (function :tag "Hook computing sectioning"))))))
-
-;;; Headline
-
-(defconst org-groff-special-tags
- '("FROM" "TO" "ABSTRACT" "APPENDIX" "BODY" "NS"))
-
-(defcustom org-groff-format-headline-function nil
- "Function to format headline text.
-
-This function will be called with 5 arguments:
-TODO the todo keyword (string or nil).
-TODO-TYPE the type of todo (symbol: `todo', `done', nil)
-PRIORITY the priority of the headline (integer or nil)
-TEXT the main headline text (string).
-TAGS the tags as a list of strings (list of strings or nil).
-
-The function result will be used in the section format string.
-
-As an example, one could set the variable to the following, in
-order to reproduce the default set-up:
-
-\(defun org-groff-format-headline (todo todo-type priority text tags)
- \"Default format function for a headline.\"
- \(concat (when todo
- \(format \"\\fB%s\\fP \" todo))
- \(when priority
- \(format \"[\\#%c] \" priority))
- text
- \(when tags
- \(format \" %s \"
- \(mapconcat 'identity tags \":\"))))"
- :group 'org-export-groff
- :type 'function)
-
-;;; Timestamps
-
-(defcustom org-groff-active-timestamp-format "\\fI%s\\fP"
- "A printf format string to be applied to active timestamps."
- :group 'org-export-groff
- :type 'string)
-
-(defcustom org-groff-inactive-timestamp-format "\\fI%s\\fP"
- "A printf format string to be applied to inactive timestamps."
- :group 'org-export-groff
- :type 'string)
-
-(defcustom org-groff-diary-timestamp-format "\\fI%s\\fP"
- "A printf format string to be applied to diary timestamps."
- :group 'org-export-groff
- :type 'string)
-
-;;; Links
-
-(defcustom org-groff-inline-image-rules
- '(("file" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'")
- ("fuzzy" . "\\.\\(jpg\\|png\\|pdf\\|ps\\|eps\\|pic\\)\\'"))
- "Rules characterizing image files that can be inlined into Groff.
-
-A rule consists in an association whose key is the type of link
-to consider, and value is a regexp that will be matched against
-link's path.
-
-Note that, by default, the image extensions actually allowed
-depend on the way the Groff file is processed. When used with
-pdfgroff, pdf, jpg and png images are OK. When processing
-through dvi to Postscript, only ps and eps are allowed. The
-default we use here encompasses both."
- :group 'org-export-groff
- :type '(alist :key-type (string :tag "Type")
- :value-type (regexp :tag "Path")))
-
-(defcustom org-groff-link-with-unknown-path-format "\\fI%s\\fP"
- "Format string for links with unknown path type."
- :group 'org-export-groff
- :type 'string)
-
-;;; Tables
-
-(defcustom org-groff-tables-centered t
- "When non-nil, tables are exported in a center environment."
- :group 'org-export-groff
- :type 'boolean)
-
-(defcustom org-groff-tables-verbatim nil
- "When non-nil, tables are exported verbatim."
- :group 'org-export-groff
- :type 'boolean)
-
-(defcustom org-groff-table-scientific-notation "%sE%s"
- "Format string to display numbers in scientific notation.
-The format should have \"%s\" twice, for mantissa and exponent
-\(i.e. \"%s\\\\times10^{%s}\").
-
-When nil, no transformation is made."
- :group 'org-export-groff
- :type '(choice
- (string :tag "Format string")
- (const :tag "No formatting")))
-
-;;; Text markup
-
-(defcustom org-groff-text-markup-alist
- '((bold . "\\fB%s\\fP")
- (code . "\\fC%s\\fP")
- (italic . "\\fI%s\\fP")
- (strike-through . "\\fC%s\\fP") ; Strike through and underline
- (underline . "\\fI%s\\fP") ; need to be revised.
- (verbatim . "protectedtexttt"))
- "Alist of Groff expressions to convert text markup.
-
-The key must be a symbol among `bold', `code', `italic',
-`strike-through', `underline' and `verbatim'. The value is
-a formatting string to wrap fontified text with it.
-
-If no association can be found for a given markup, text will be
-returned as-is."
- :group 'org-export-groff
- :type 'alist
- :options '(bold code italic strike-through underline verbatim))
-
-;;; Drawers
-
-(defcustom org-groff-format-drawer-function nil
- "Function called to format a drawer in Groff code.
-
-The function must accept two parameters:
- NAME the drawer name, like \"LOGBOOK\"
- CONTENTS the contents of the drawer.
-
-The function should return the string to be exported.
-
-For example, the variable could be set to the following function
-in order to mimic default behaviour:
-
-\(defun org-groff-format-drawer-default \(name contents\)
- \"Format a drawer element for Groff export.\"
- contents\)"
- :group 'org-export-groff
- :type 'function)
-
-;;; Inlinetasks
-
-(defcustom org-groff-format-inlinetask-function nil
- "Function called to format an inlinetask in Groff code.
-
-The function must accept six parameters:
- TODO the todo keyword, as a string
- TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
- PRIORITY the inlinetask priority, as a string
- NAME the inlinetask name, as a string.
- TAGS the inlinetask tags, as a list of strings.
- CONTENTS the contents of the inlinetask, as a string.
-
-The function should return the string to be exported.
-
-For example, the variable could be set to the following function
-in order to mimic default behaviour:
-
-\(defun org-groff-format-inlinetask \(todo type priority name tags contents\)
-\"Format an inline task element for Groff export.\"
- \(let ((full-title
- \(concat
- \(when todo
- \(format \"\\fB%s\\fP \" todo))
- \(when priority (format \"[\\#%c] \" priority))
- title
- \(when tags
- \(format \":%s:\"
- \(mapconcat 'identity tags \":\")))))
- \(format (concat \".DS L\\n\"
- \"%s\\n\\n\"
- \"%s\"
- \".DE\")
- full-title contents))"
- :group 'org-export-groff
- :type 'function)
-
-;; Src blocks
-
-(defcustom org-groff-source-highlight nil
- "Use GNU source highlight to embellish source blocks "
- :group 'org-export-groff
- :type 'boolean)
-
-(defcustom org-groff-source-highlight-langs
- '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp")
- (scheme "scheme")
- (c "c") (cc "cpp") (csharp "csharp") (d "d")
- (fortran "fortran") (cobol "cobol") (pascal "pascal")
- (ada "ada") (asm "asm")
- (perl "perl") (cperl "perl")
- (python "python") (ruby "ruby") (tcl "tcl") (lua "lua")
- (java "java") (javascript "javascript")
- (tex "latex")
- (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4")
- (ocaml "caml") (caml "caml")
- (sql "sql") (sqlite "sql")
- (html "html") (css "css") (xml "xml")
- (bat "bat") (bison "bison") (clipper "clipper")
- (ldap "ldap") (opa "opa")
- (php "php") (postscript "postscript") (prolog "prolog")
- (properties "properties") (makefile "makefile")
- (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg"))
- "Alist mapping languages to their listing language counterpart.
-The key is a symbol, the major mode symbol without the \"-mode\".
-The value is the string that should be inserted as the language
-parameter for the listings package. If the mode name and the
-listings name are the same, the language does not need an entry
-in this list - but it does not hurt if it is present."
- :group 'org-export-groff
- :type '(repeat
- (list
- (symbol :tag "Major mode ")
- (string :tag "Listings language"))))
-
-(defcustom org-groff-source-highlight-options nil
- "Association list of options for the groff listings package.
-
-These options are supplied as a comma-separated list to the
-\\lstset command. Each element of the association list should be
-a list containing two strings: the name of the option, and the
-value. For example,
-
- (setq org-groff-source-highlight-options
- '((\"basicstyle\" \"\\small\")
- (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
-
-will typeset the code in a small size font with underlined, bold
-black keywords.
-
-Note that the same options will be applied to blocks of all
-languages."
- :group 'org-export-groff
- :type '(repeat
- (list
- (string :tag "Listings option name ")
- (string :tag "Listings option value"))))
-
-(defvar org-groff-custom-lang-environments nil
- "Alist mapping languages to language-specific Groff environments.
-
-It is used during export of src blocks by the listings and
-groff packages. For example,
-
- \(setq org-groff-custom-lang-environments
- '\(\(python \"pythoncode\"\)\)\)
-
-would have the effect that if org encounters begin_src python
-during groff export it will use pythoncode as the source-highlight
-language.")
-
-;;; Plain text
-
-(defcustom org-groff-special-char
- '(("(c)" . "\\\\(co")
- ("(tm)" . "\\\\(tm")
- ("(rg)" . "\\\\(rg"))
- "CONS list in which the value of the car
- is replace on the value of the CDR. "
- :group 'org-export-groff
- :type '(list
- (cons :tag "Character Substitute"
- (string :tag "Original Character Group")
- (string :tag "Replacement Character"))))
-
-;;; Compilation
-
-(defcustom org-groff-pdf-process
- '("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
- "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
- "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf")
-
- "Commands to process a Groff file to a PDF file.
-This is a list of strings, each of them will be given to the
-shell as a command. %f in the command will be replaced by the
-full file name, %b by the file base name \(i.e. without
-extension) and %o by the base directory of the file."
- :group 'org-export-pdf
- :type '(choice
- (repeat :tag "Shell command sequence"
- (string :tag "Shell command"))
- (const :tag "2 runs of pdfgroff"
- ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
- "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
- (const :tag "3 runs of pdfgroff"
- ("pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
- "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"
- "pic %f | tbl | eqn | groff -mm | ps2pdf - > %b.pdf"))
- (function)))
-
-(defcustom org-groff-logfiles-extensions
- '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
- "The list of file extensions to consider as Groff logfiles."
- :group 'org-export-groff
- :type '(repeat (string :tag "Extension")))
-
-(defcustom org-groff-remove-logfiles t
- "Non-nil means remove the logfiles produced by PDF production.
-These are the .aux, .log, .out, and .toc files."
- :group 'org-export-groff
- :type 'boolean)
-
-(defcustom org-groff-organization "Org User"
- "Name of the organization used to populate the .AF command."
- :group 'org-export-groff
- :type 'string)
-
-(defcustom org-groff-raster-to-ps nil
- "Command used to convert raster to EPS. Nil for no conversion. Make sure that
- `org-groff-inline-image-rules' is adjusted accordingly if not conversion is
being
- done. In this case, remove the entries for jpg and png in the file and
fuzzy lists."
- :group 'org-export-groff
- :type '(choice
- (repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
- (const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b} ;grep -v BeginData
${b} > b_${b};mv b_${b} ${b}" )
- (const :tag "NetPNM" "a=%s;b=%s;pngtopnm ${a} | pnmtops -noturn >
${b}" )
- (const :tag "None" nil)))
-
-(defvar org-groff-registered-references nil)
-(defvar org-groff-special-content nil)
-
-
-
-;;; Internal Functions
-
-(defun org-groff--caption/label-string (element info)
- "Return caption and label Groff string for ELEMENT.
-
-INFO is a plist holding contextual information. If there's no
-caption nor label, return the empty string.
-
-For non-floats, see `org-groff--wrap-label'."
- (let ((main (org-export-get-caption element))
- (short (org-export-get-caption element t))
- (label (org-element-property :name element)))
- (cond ((and (not main) (not label)) "")
- ((not main) (format "\\fI%s\\fP" label))
- ;; Option caption format with short name.
- (short (format "%s\n.br\n - %s\n"
- (org-export-data short info)
- (org-export-data main info)))
- ;; Standard caption format.
- (t (format "\\fR%s\\fP" (org-export-data main info))))))
-
-(defun org-groff--wrap-label (element output)
- "Wrap label associated to ELEMENT around OUTPUT, if appropriate.
-This function shouldn't be used for floats. See
-`org-groff--caption/label-string'."
- (let ((label (org-element-property :name element)))
- (if (or (not output) (not label) (string= output "") (string= label ""))
- output
- (concat (format "%s\n.br\n" label) output))))
-
-(defun org-groff--text-markup (text markup)
- "Format TEXT depending on MARKUP text markup.
-See `org-groff-text-markup-alist' for details."
- (let ((fmt (cdr (assq markup org-groff-text-markup-alist))))
- (cond
- ;; No format string: Return raw text.
- ((not fmt) text)
- ((string= "protectedtexttt" fmt)
- (let ((start 0)
- (trans '(("\\" . "\\")))
- (rtn "")
- char)
- (while (string-match "[\\{}$%&_#~^]" text)
- (setq char (match-string 0 text))
- (if (> (match-beginning 0) 0)
- (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
- (setq text (substring text (1+ (match-beginning 0))))
- (setq char (or (cdr (assoc char trans)) (concat "\\" char))
- rtn (concat rtn char)))
- (setq text (concat rtn text))
- (format "\\fC%s\\fP" text)))
- ;; Else use format string.
- (t (format fmt text)))))
-
-
-(defun org-groff--get-tagged-content (tag info)
- (cdr (assoc tag org-groff-special-content)))
-
-(defun org-groff--mt-head (title contents attr info)
- (concat
-
- ;; 1. Insert Organization
- (let ((firm-option (plist-get attr :firm)))
- (cond
- ((stringp firm-option)
- (format ".AF \"%s\" \n" firm-option))
- (t (format ".AF \"%s\" \n" (or org-groff-organization "")))))
-
- ;; 2. Title
- (let ((title (if (plist-get info :with-title) title ""))
- (subtitle1 (plist-get attr :subtitle1))
- (subtitle2 (plist-get attr :subtitle2)))
-
- (cond
- ((string= "" title)
- (format ".TL \"%s\" \"%s\" \n%s\n"
- (or subtitle1 "")
- (or subtitle2 "") " "))
-
- ((not (or subtitle1 subtitle2))
- (format ".TL\n%s\n"
- (or title "")))
- (t
- (format ".TL \"%s\" \"%s \" \n%s\n"
- (or subtitle1 "")
- (or subtitle2 "") title))))
-
- ;; 3. Author.
- ;; In Groff, .AU *MUST* be placed after .TL
- ;; If From, populate with data from From else
- ;;
- (let ((author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- (and auth (org-export-data auth info)))))
- (email (and (plist-get info :with-email)
- (org-export-data (plist-get info :email) info)))
- (from-data (org-groff--get-tagged-content "FROM" info))
-
- (to-data (org-groff--get-tagged-content "TO" info)))
-
- (cond
- ((and author from-data)
- (let ((au-line
- (mapconcat
- (lambda (from-line)
- (format " \"%s\" " from-line))
- (split-string
- (setq from-data
- (replace-regexp-in-string "\\.P\n" "" from-data)) "\n")
"")))
-
- (concat
- (format ".AU \"%s\" " author) au-line "\n")))
-
- ((and author email (not (string= "" email)))
- (format ".AU \"%s\" \"%s\"\n" author email))
-
- (author (format ".AU \"%s\"\n" author))
-
- (t ".AU \"\" \n")))
-
-
- ;; 4. Author Title, if present
- (let ((at-item (plist-get attr :author-title)))
- (if (and at-item (stringp at-item))
- (format ".AT \"%s\" \n" at-item)
- ""))
-
- ;; 5. Date.
- (when (plist-get info :with-date)
- (let ((date (org-export-data (org-export-get-date info) info)))
- (and (org-string-nw-p date) (format ".ND \"%s\"\n" date))))
-
- ;;
- ;; If Abstract, then Populate Abstract
- ;;
-
- (let ((abstract-data (org-groff--get-tagged-content "ABSTRACT" info))
- (to-data (org-groff--get-tagged-content "TO" info)))
- (cond
- (abstract-data
- (format ".AS\n%s\n.AE\n" abstract-data))
- (to-data
- (format ".AS\n%s\n.AE\n" to-data))))))
-
-(defun org-groff--letter-head (title contents attr info)
- (let ((author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- (and auth (org-export-data auth info)))))
- (email (and (plist-get info :with-email)
- (org-export-data (plist-get info :email) info)))
- (from-data (org-groff--get-tagged-content "FROM" info))
- (at-item (plist-get attr :author-title))
- (to-data (org-groff--get-tagged-content "TO" info)))
-
-
- ;; If FROM then get data from FROM
- (if from-data
- (setq from-data
- (replace-regexp-in-string "\\.P\n" "" from-data))
- (setq from-data ""))
-
- (if to-data
- (setq to-data
- (replace-regexp-in-string "\\.P\n" "" to-data))
- (setq from-data ""))
-
- (concat
- (cond
- (from-data
- (format ".WA \"%s\" \"%s\" \n%s\n.WE\n" author (or at-item "")
from-data))
- ((and author email (not (string= "" email)))
- (format ".WA \"%s\"\n \"%s\"\n.WE\n" author email))
- (author (format ".WA \"%s\"\n.WE\n" author))
- (t ".WA \"\" \n.WE\n"))
-
- ;; If TO then get data from TO
-
- (when to-data
- (format ".IA \n%s\n.IE\n" to-data)))))
-
-
-;;; Template
-
-(defun org-groff-template (contents info)
- "Return complete document string after Groff conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (let* ((title (org-export-data (plist-get info :title) info))
- (attr (read
- (format "(%s)"
- (mapconcat
- #'identity
- (list (plist-get info :groff-class-options))
- " "))))
- (class (plist-get info :groff-class))
- (class-options (plist-get info :groff-class-options))
- (classes (assoc class org-groff-classes))
- (classes-options (car (last classes)))
- (heading-option (plist-get classes-options :heading))
- (type-option (plist-get classes-options :type))
- (last-option (plist-get classes-options :last-section))
- (hyphenate (plist-get attr :hyphenate))
- (justify-right (plist-get attr :justify-right))
-
- (document-class-string
- (progn
- (org-element-normalize-string
- (let* ((header (nth 1 (assoc class org-groff-classes)))
- (document-class-item (if (stringp header) header "")))
- document-class-item)))))
-
-
- (concat
- (if justify-right
- (case justify-right
- ('yes ".SA 1 \n")
- ('no ".SA 0 \n")
- (t ""))
- "")
-
- (if hyphenate
- (case hyphenate
- ('yes ".nr Hy 1 \n")
- ('no ".nr Hy 0 \n")
- (t ""))
- "")
-
- (cond
- ((string= type-option "custom") "")
-
- ((and (stringp document-class-string)
- (string= type-option "cover"))
-
- (concat
- (format ".COVER %s\n" document-class-string)
- (org-groff--mt-head title contents attr info)
- ".COVEND\n"))
-
- ((string= type-option "memo")
- (concat
- (org-groff--mt-head title contents attr info)
- document-class-string))
- ((string= type-option "letter")
- (concat
- (org-groff--letter-head title contents attr info)
- (let ((sa-item (plist-get attr :salutation))
- (cn-item (plist-get attr :confidential))
- (sj-item (plist-get attr :subject))
- (rn-item (plist-get attr :reference))
- (at-item (plist-get attr :attention)))
-
- (concat
-
- (if (stringp sa-item)
- (format ".LO SA \"%s\" \n" sa-item)
- ".LO SA\n")
-
- (when cn-item
- (if (stringp cn-item)
- (format ".LO CN \"%s\"\n" cn-item)
- ".LO CN\n"))
-
- (when (and at-item (stringp at-item))
- (format ".LO AT \"%s\" \n" at-item))
- (when (and title rn-item)
- (format ".LO RN \"%s\"\n" title))
-
- (when (and sj-item (stringp sj-item))
- (format ".LO SJ \"%s\" \n" sj-item))
-
-
- ".LT " document-class-string "\n"))))
-
- (t ""))
-
- contents
-
- (cond
- ((string= last-option "toc")
- ".TC")
- ((string= last-option "sign")
- (let ((fc-item (plist-get attr :closing)))
- (concat (if (stringp fc-item)
- (format ".FC \"%s\" \n" fc-item)
- ".FC\n")
- ".SG\n")))
- (t ""))
-
- (progn
- (mapconcat
- (lambda (item)
- (when (string= (car item) "NS")
- (replace-regexp-in-string
- "\\.P\n" "" (cdr item))))
- (reverse org-groff-special-content) "\n")))))
-
-
-
-;;; Transcode Functions
-
-;;; Babel Call
-;;
-;; Babel Calls are ignored.
-
-
-;;; Bold
-
-(defun org-groff-bold (bold contents info)
- "Transcode BOLD from Org to Groff.
-CONTENTS is the text with bold markup. INFO is a plist holding
-contextual information."
- (org-groff--text-markup contents 'bold))
-
-;;; Center Block
-
-(defun org-groff-center-block (center-block contents info)
- "Transcode a CENTER-BLOCK element from Org to Groff.
-CONTENTS holds the contents of the center block. INFO is a plist
-holding contextual information."
- (org-groff--wrap-label
- center-block
- (format ".DS C \n%s\n.DE" contents)))
-
-;;; Clock
-
-(defun org-groff-clock (clock contents info)
- "Transcode a CLOCK element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (concat
- (format "\\fB%s\\fP " org-clock-string)
- (format org-groff-inactive-timestamp-format
- (concat (org-timestamp-translate (org-element-property :value
clock))
- (let ((time (org-element-property :duration clock)))
- (and time (format " (%s)" time)))))))
-
-;;; Code
-
-(defun org-groff-code (code contents info)
- "Transcode a CODE object from Org to Groff.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (org-groff--text-markup (org-element-property :value code) 'code))
-
-;;; Comments and Comment Blocks are ignored.
-
-;;; Drawer
-
-(defun org-groff-drawer (drawer contents info)
- "Transcode a DRAWER element from Org to Groff.
-CONTENTS holds the contents of the block. INFO is a plist
-holding contextual information."
- (let* ((name (org-element-property :drawer-name drawer))
- (output (if (functionp org-groff-format-drawer-function)
- (funcall org-groff-format-drawer-function
- name contents)
- ;; If there's no user defined function: simply
- ;; display contents of the drawer.
- contents)))
- (org-groff--wrap-label drawer output)))
-
-;;; Dynamic Block
-
-(defun org-groff-dynamic-block (dynamic-block contents info)
- "Transcode a DYNAMIC-BLOCK element from Org to Groff.
-CONTENTS holds the contents of the block. INFO is a plist
-holding contextual information. See `org-export-data'."
- (org-groff--wrap-label dynamic-block contents))
-
-;;; Entity
-
-(defun org-groff-entity (entity contents info)
- "Transcode an ENTITY object from Org to Groff.
-CONTENTS are the definition itself. INFO is a plist holding
-contextual information."
- (org-element-property :utf-8 entity))
-
-;;; Example Block
-
-(defun org-groff-example-block (example-block contents info)
- "Transcode an EXAMPLE-BLOCK element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (org-groff--wrap-label
- example-block
- (format ".DS L\n%s\n.DE"
- (org-export-format-code-default example-block info))))
-
-;;; Export Block
-
-(defun org-groff-export-block (export-block contents info)
- "Transcode a EXPORT-BLOCK element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (when (string= (org-element-property :type export-block) "GROFF")
- (org-remove-indentation (org-element-property :value export-block))))
-
-;;; Export Snippet
-
-(defun org-groff-export-snippet (export-snippet contents info)
- "Transcode a EXPORT-SNIPPET object from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (when (eq (org-export-snippet-backend export-snippet) 'groff)
- (org-element-property :value export-snippet)))
-
-;;; Fixed Width
-
-(defun org-groff-fixed-width (fixed-width contents info)
- "Transcode a FIXED-WIDTH element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (org-groff--wrap-label
- fixed-width
- (format "\\fC\n%s\n\\fP"
- (org-remove-indentation
- (org-element-property :value fixed-width)))))
-
-;;; Footnote Definition
-;;
-;; Footnote Definitions are ignored.
-;;
-;; Footnotes are handled automatically in GROFF. Although manual
-;; references can be added, not really required.
-
-(defun org-groff-footnote-reference (footnote-reference contents info)
- ;; Changing from info to footnote-reference
- (let* ((raw (org-export-get-footnote-definition footnote-reference info))
- (n (org-export-get-footnote-number footnote-reference info))
- (data (org-trim (org-export-data raw info)))
- (ref-id (plist-get (nth 1 footnote-reference) :label)))
- ;; It is a reference
- (if (string-match "fn:rl" ref-id)
- (if (member ref-id org-groff-registered-references)
- (format "\\*[%s]" ref-id)
- (progn
- (push ref-id org-groff-registered-references)
- (format "\\*(Rf\n.RS \"%s\" \n%s\n.RF\n" ref-id data)))
- ;; else it is a footnote
- (format "\\u\\s-2%s\\d\\s+2\n.FS %s\n%s\n.FE\n" n n data))))
-
-;;; Headline
-
-(defun org-groff-headline (headline contents info)
- "Transcode a HEADLINE element from Org to Groff.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- (let* ((class (plist-get info :groff-class))
- (level (org-export-get-relative-level headline info))
- (numberedp (org-export-numbered-headline-p headline info))
- ;; Section formatting will set two placeholders: one for the
- ;; title and the other for the contents.
- (classes (assoc class org-groff-classes))
- (classes-options (car (last classes)))
- (heading-option (plist-get classes-options :heading))
- (section-fmt
- (progn
- (cond
- ((and (symbolp heading-option)
- (fboundp heading-option))
- (funcall heading-option level numberedp))
- ((> level 7) nil)
- (t (if numberedp
- (concat ".H " (number-to-string level) " \"%s\"\n%s")
- ".HU \"%s\"\n%s")))))
- ;; End of section-fmt
- (text (org-export-data (org-element-property :title headline) info))
- (todo
- (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- ;; Create the headline text along with a no-tag version. The
- ;; latter is required to remove tags from table of contents.
- (full-text (if (functionp org-groff-format-headline-function)
- ;; User-defined formatting function.
- (funcall org-groff-format-headline-function
- todo todo-type priority text tags)
- ;; Default formatting.
- (concat
- (when todo
- (format "\\fB%s\\fP " todo))
- (when priority (format " [\\#%c] " priority))
- text
- (when tags
- (format " \\fC%s\\fP " (org-make-tag-string tags))))))
- (full-text-no-tag
- (if (functionp org-groff-format-headline-function)
- ;; User-defined formatting function.
- (funcall org-groff-format-headline-function
- todo todo-type priority text nil)
- ;; Default formatting.
- (concat
- (when todo (format "\\fB%s\\fP " todo))
- (when priority (format " [\\#%c] " priority))
- text)))
- ;; Associate some \label to the headline for internal links.
- ;; (headline-label
- ;; (format "\\label{sec-%s}\n"
- ;; (mapconcat 'number-to-string
- ;; (org-export-get-headline-number headline
info)
- ;; "-")))
- (headline-label "")
- (pre-blanks
- (make-string (org-element-property :pre-blank headline) 10)))
-
- (cond
- ;; Case 1: Special Tag
- ((member (car tags) org-groff-special-tags)
- (cond
- ((string= (car tags) "BODY") contents)
-
- ((string= (car tags) "NS")
- (progn
- (push (cons (car tags)
- (format ".NS \"%s\" 1 \n%s"
- (car (org-element-property :title headline))
- (or contents " ")))
- org-groff-special-content) nil))
-
- (t
- (progn
- (push (cons (car tags) contents) org-groff-special-content)
- nil))))
-
- ;; Case 2: This is a footnote section: ignore it.
- ((org-element-property :footnote-section-p headline) nil)
-
- ;; Case 3: This is a deep sub-tree: export it as a list item.
- ;; Also export as items headlines for which no section
- ;; format has been found.
- ((or (not section-fmt) (org-export-low-level-p headline info))
- ;; Build the real contents of the sub-tree.
- (let ((low-level-body
- (concat
- ;; If the headline is the first sibling, start a list.
- (when (org-export-first-sibling-p headline info)
- (format "%s\n" (if numberedp ".AL 1\n" ".DL \n")))
- ;; Itemize headline
- ".LI\n" full-text "\n" headline-label pre-blanks contents)))
- ;; If headline is not the last sibling simply return
- ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
- ;; blank line.
- (if (not (org-export-last-sibling-p headline info)) low-level-body
- (replace-regexp-in-string
- "[ \t\n]*\\'"
- (concat "\n.LE")
- low-level-body))))
-
- ;; Case 4. Standard headline. Export it as a section.
- (t
- (format section-fmt full-text
- (concat headline-label pre-blanks contents))))))
-
-;;; Horizontal Rule
-;; Not supported
-
-;;; Inline Babel Call
-;;
-;; Inline Babel Calls are ignored.
-
-;;; Inline Src Block
-
-(defun org-groff-inline-src-block (inline-src-block contents info)
- "Transcode an INLINE-SRC-BLOCK element from Org to Groff.
-CONTENTS holds the contents of the item. INFO is a plist holding
-contextual information."
- (let* ((code (org-element-property :value inline-src-block)))
- (cond
- (org-groff-source-highlight
- (let* ((tmpdir temporary-file-directory)
- (in-file (make-temp-name
- (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name
- (expand-file-name "reshilite" tmpdir)))
- (org-lang (org-element-property :language inline-src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-groff-source-highlight-langs)))
-
- (cmd (concat (expand-file-name "source-highlight")
- " -s " lst-lang
- " -f groff_mm_color "
- " -i " in-file
- " -o " out-file)))
- (if lst-lang
- (let ((code-block ""))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- code-block)
- (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
- code))))
-
- ;; Do not use a special package: transcode it verbatim.
- (t
- (concat ".DS I\n" "\\fC" code "\\fP\n.DE\n")))))
-
-;;; Inlinetask
-
-(defun org-groff-inlinetask (inlinetask contents info)
- "Transcode an INLINETASK element from Org to Groff.
-CONTENTS holds the contents of the block. INFO is a plist
-holding contextual information."
- (let ((title (org-export-data (org-element-property :title inlinetask) info))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword
inlinetask)))
- (and todo (org-export-data todo info)))))
- (todo-type (org-element-property :todo-type inlinetask))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags inlinetask info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority inlinetask))))
- ;; If `org-groff-format-inlinetask-function' is provided, call it
- ;; with appropriate arguments.
- (if (functionp org-groff-format-inlinetask-function)
- (funcall org-groff-format-inlinetask-function
- todo todo-type priority title tags contents)
- ;; Otherwise, use a default template.
- (org-groff--wrap-label
- inlinetask
- (let ((full-title
- (concat
- (when todo (format "\\fB%s\\fP " todo))
- (when priority (format " [\\#%c] " priority))
- title
- (when tags (format " \\fC%s\\fP " (org-make-tag-string
tags))))))
- (format (concat "\n.DS I\n"
- "%s\n"
- ".sp"
- "%s\n"
- ".DE")
- full-title contents))))))
-
-;;; Italic
-
-(defun org-groff-italic (italic contents info)
- "Transcode ITALIC from Org to Groff.
-CONTENTS is the text with italic markup. INFO is a plist holding
-contextual information."
- (org-groff--text-markup contents 'italic))
-
-;;; Item
-
-(defun org-groff-item (item contents info)
- "Transcode an ITEM element from Org to Groff.
-CONTENTS holds the contents of the item. INFO is a plist holding
-contextual information."
- (let* ((bullet (org-element-property :bullet item))
- (type (org-element-property
- :type (org-element-property :parent item)))
- (checkbox (case (org-element-property :checkbox item)
- (on "\\o'\\(sq\\(mu'")
- (off "\\(sq")
- (trans "\\o'\\(sq\\(mi'")))
- (tag (let ((tag (org-element-property :tag item)))
- ;; Check-boxes must belong to the tag.
- (and tag (format "%s"
- (concat checkbox
- (org-export-data tag info)))))))
-
- (cond
- ((or checkbox tag)
- (concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
- "\n"
- (org-trim (or contents " "))))
- ((eq type 'ordered)
- (concat ".LI"
- "\n"
- (org-trim (or contents " "))))
- (t
- (let* ((bullet (org-trim bullet))
- (marker (cond ((string= "-" bullet) "\\(em")
- ((string= "*" bullet) "\\(bu")
- (t "\\(dg"))))
- (concat ".LI " marker "\n"
- (org-trim (or contents " "))))))))
-
-;;; Keyword
-
-(defun org-groff-keyword (keyword contents info)
- "Transcode a KEYWORD element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((key (org-element-property :key keyword))
- (value (org-element-property :value keyword)))
- (cond
- ((string= key "GROFF") value)
- (t nil))))
-
-;;; Line Break
-
-(defun org-groff-line-break (line-break contents info)
- "Transcode a LINE-BREAK object from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- ".br\n")
-
-;;; Link
-;; Inline images just place a call to .PSPIC or .PS/.PE
-;; and load the graph.
-
-(defun org-groff-link--inline-image (link info)
- "Return Groff code for an inline image.
-LINK is the link pointing to the inline image. INFO is a plist
-used as a communication channel."
- (let* ((parent (org-export-get-parent-element link))
- (path (let ((raw-path (org-element-property :path link)))
- (if (not (file-name-absolute-p raw-path)) raw-path
- (expand-file-name raw-path))))
- (attr (org-export-read-attribute :attr_groff link))
- (placement
- (let ((pos (plist-get attr :position)))
- (cond ((string= pos 'center) "")
- ((string= pos 'left) "-L")
- ((string= pos 'right) "-R")
- (t ""))))
- (width (or (plist-get attr :width) ""))
- (height (or (plist-get attr :height) ""))
- (caption (and (not (plist-get attr :disable-caption))
- (org-groff--caption/label-string parent info))))
- ;; Now clear ATTR from any special keyword and set a default value
- ;; if nothing is left. Return proper string.
- (concat
- (cond
- ((and org-groff-raster-to-ps
- (or (string-match ".\.png$" path)
- (string-match ".\.jpg$" path)))
- (let ((eps-path (concat path ".eps")))
- (shell-command (format org-groff-raster-to-ps path eps-path))
- (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
- placement eps-path width height)))
- ((string-match ".\.pic$" path)
- (format "\n.PS\ncopy \"%s\"\n.PE" path))
- (t (format "\n.DS L F\n.PSPIC %s \"%s\" %s %s\n.DE "
- placement path width height)))
- (and caption (format "\n.FG \"%s\"" caption)))))
-
-(defun org-groff-link (link desc info)
- "Transcode a LINK object from Org to Groff.
-
-DESC is the description part of the link, or the empty string.
-INFO is a plist holding contextual information. See
-`org-export-data'."
-
- (let* ((type (org-element-property :type link))
- (raw-path (org-element-property :path link))
- ;; Ensure DESC really exists, or set it to nil.
- (desc (and (not (string= desc "")) desc))
- (imagep (org-export-inline-image-p
- link org-groff-inline-image-rules))
- (path (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
- ((string= type "file") (org-export-file-uri raw-path))
- (t raw-path))))
- (cond
- ((org-export-custom-protocol-maybe link desc 'groff info))
- ;; Image file.
- (imagep (org-groff-link--inline-image link info))
- ;; import groff files
- ((and (string= type "file")
- (string-match ".\.groff$" raw-path))
- (concat ".so " raw-path "\n"))
- ;; Radio link: transcode target's contents and use them as link's
- ;; description.
- ((string= type "radio")
- (let ((destination (org-export-resolve-radio-link link info)))
- (if (not destination) desc
- (format "\\fI [%s] \\fP"
- (org-export-get-reference destination info)))))
-
- ;; Links pointing to a headline: find destination and build
- ;; appropriate referencing command.
- ((member type '("custom-id" "fuzzy" "id"))
- (let ((destination (if (string= type "fuzzy")
- (org-export-resolve-fuzzy-link link info)
- (org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- ;; Id link points to an external file.
- (plain-text
- (if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination)
- (format "\\fI file://%s \\fP" destination)))
- ;; Fuzzy link points nowhere.
- ('nil
- (format org-groff-link-with-unknown-path-format
- (or desc
- (org-export-data
- (org-element-property :raw-link link) info))))
- ;; LINK points to a headline. If headlines are numbered and
- ;; the link has no description, display headline's number.
- ;; Otherwise, display description or headline's title.
- (headline
- (let ((label ""))
- (if (and (plist-get info :section-numbers) (not desc))
- (format "\\fI%s\\fP" label)
- (format "\\fI%s\\fP"
- (or desc
- (org-export-data
- (org-element-property :title destination)
info))))))
- ;; Fuzzy link points to a target. Do as above.
- (otherwise
- (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.
- (path (format "\\fI%s\\fP" path))
- ;; No path, only description. Try to do something useful.
- (t (format org-groff-link-with-unknown-path-format desc)))))
-
-;;; Node Property
-
-(defun org-groff-node-property (node-property contents info)
- "Transcode a NODE-PROPERTY element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (format "%s:%s"
- (org-element-property :key node-property)
- (let ((value (org-element-property :value node-property)))
- (if value (concat " " value) ""))))
-
-;;; Paragraph
-
-(defun org-groff-paragraph (paragraph contents info)
- "Transcode a PARAGRAPH element from Org to Groff.
-CONTENTS is the contents of the paragraph, as a string. INFO is
-the plist used as a communication channel."
- (let ((parent (plist-get (nth 1 paragraph) :parent)))
- (when parent
- (let* ((parent-type (car parent))
- (fixed-paragraph "")
- (class (plist-get info :groff-class))
- (class-options (plist-get info :groff-class-options))
- (classes (assoc class org-groff-classes))
- (classes-options (car (last classes)))
- (paragraph-option (plist-get classes-options :paragraph)))
- (cond
- ((and (symbolp paragraph-option)
- (fboundp paragraph-option))
- (funcall paragraph-option parent-type parent contents))
- ((and (eq parent-type 'item)
- (plist-get (nth 1 parent) :bullet))
- (setq fixed-paragraph (concat "" contents)))
- ((eq parent-type 'section)
- (setq fixed-paragraph (concat ".P\n" contents)))
- ((eq parent-type 'footnote-definition)
- (setq fixed-paragraph (concat "" contents)))
- (t (setq fixed-paragraph (concat "" contents))))
- fixed-paragraph))))
-
-;;; Plain List
-
-(defun org-groff-plain-list (plain-list contents info)
- "Transcode a PLAIN-LIST element from Org to Groff.
-CONTENTS is the contents of the list. INFO is a plist holding
-contextual information."
- (let* ((type (org-element-property :type plain-list))
- (attr (mapconcat #'identity
- (org-element-property :attr_groff plain-list)
- " "))
- (groff-type (cond
- ((eq type 'ordered) ".AL")
- ((eq type 'unordered) ".BL")
- ((eq type 'descriptive) ".VL 2.0i"))))
- (org-groff--wrap-label
- plain-list
- (format "%s\n%s\n.LE" groff-type contents))))
-
-;;; Plain Text
-
-(defun org-groff-plain-text (text info)
- "Transcode a TEXT string from Org to Groff.
-TEXT is the string to transcode. INFO is a plist holding
-contextual information."
-(let ((output text))
- ;; Protect various characters.
- (setq output (replace-regexp-in-string
- "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)"
- "$\\" output nil t 1))
- ;; Activate smart quotes. Be sure to provide original TEXT string
- ;; since OUTPUT may have been modified.
- (when (plist-get info :with-smart-quotes)
- (setq output (org-export-activate-smart-quotes output :utf-8 info text)))
- ;; Handle Special Characters
- (if org-groff-special-char
- (dolist (special-char-list org-groff-special-char)
- (setq output
- (replace-regexp-in-string (car special-char-list)
- (cdr special-char-list) output))))
- ;; Handle break preservation if required.
- (when (plist-get info :preserve-breaks)
- (setq output (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" output)))
- ;; Return value.
- output))
-
-;;; Planning
-
-(defun org-groff-planning (planning contents info)
- "Transcode a PLANNING element from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (concat
- (mapconcat
- 'identity
- (delq nil
- (list
- (let ((closed (org-element-property :closed planning)))
- (when closed
- (concat
- (format "\\fR %s \\fP" org-closed-string)
- (format org-groff-inactive-timestamp-format
- (org-timestamp-translate closed)))))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline
- (concat
- (format "\\fB %s \\fP" org-deadline-string)
- (format org-groff-active-timestamp-format
- (org-timestamp-translate deadline)))))
- (let ((scheduled (org-element-property :scheduled planning)))
- (when scheduled
- (concat
- (format "\\fR %s \\fP" org-scheduled-string)
- (format org-groff-active-timestamp-format
- (org-timestamp-translate scheduled)))))))
- "")
- ""))
-
-;;;; Property Drawer
-
-(defun org-groff-property-drawer (property-drawer contents info)
- "Transcode a PROPERTY-DRAWER element from Org to Groff.
-CONTENTS holds the contents of the drawer. INFO is a plist
-holding contextual information."
- (and (org-string-nw-p contents)
- (format "\\fC\n%s\\fP" contents)))
-
-;;; Quote Block
-
-(defun org-groff-quote-block (quote-block contents info)
- "Transcode a QUOTE-BLOCK element from Org to Groff.
-CONTENTS holds the contents of the block. INFO is a plist
-holding contextual information."
- (org-groff--wrap-label
- quote-block
- (format ".DS I\n.I\n%s\n.R\n.DE" contents)))
-
-;;; Radio Target
-
-(defun org-groff-radio-target (radio-target text info)
- "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-get-reference radio-target info) text))
-
-;;; Section
-
-(defun org-groff-section (section contents info)
- "Transcode a SECTION element from Org to Groff.
-CONTENTS holds the contents of the section. INFO is a plist
-holding contextual information."
- contents)
-
-;;; Special Block
-
-(defun org-groff-special-block (special-block contents info)
- "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 (org-element-property :type special-block)))
- (org-groff--wrap-label
- special-block
- (format "%s\n" contents))))
-
-;;; Src Block
-
-(defun org-groff-src-block (src-block contents info)
- "Transcode a SRC-BLOCK element from Org to Groff.
-CONTENTS holds the contents of the item. INFO is a plist holding
-contextual information."
- (let* ((lang (org-element-property :language src-block))
- (label (org-element-property :name src-block))
- (code (org-element-property :value src-block))
- (custom-env (and lang
- (cadr (assq (intern lang)
- org-groff-custom-lang-environments))))
- (num-start (org-export-get-loc src-block info))
- (retain-labels (org-element-property :retain-labels src-block))
- (caption (and (not (org-export-read-attribute
- :attr_groff src-block :disable-caption))
- (org-groff--caption/label-string src-block info))))
-
- (cond
- ;; Case 1. No source fontification.
- ((not org-groff-source-highlight)
- (concat
- (format ".DS I\n\\fC%s\\fP\n.DE\n"
- (org-export-format-code-default src-block info))
- (and caption (format ".EX \"%s\" " caption))))
-
- ;; Case 2. Source fontification.
- (org-groff-source-highlight
- (let* ((tmpdir temporary-file-directory)
- (in-file (make-temp-name
- (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name
- (expand-file-name "reshilite" tmpdir)))
-
- (org-lang (org-element-property :language src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-groff-source-highlight-langs)))
-
- (cmd (concat "source-highlight"
- " -s " lst-lang
- " -f groff_mm_color "
- " -i " in-file
- " -o " out-file)))
-
- (concat
- (if lst-lang
- (let ((code-block ""))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- (format "%s\n" code-block))
- (format ".DS I\n\\fC\\m[black]%s\\m[]\\fP\n.DE\n"
- code))
- (and caption (format ".EX \"%s\" " caption))))))))
-
-
-;;; Statistics Cookie
-
-(defun org-groff-statistics-cookie (statistics-cookie contents info)
- "Transcode a STATISTICS-COOKIE object from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (org-element-property :value statistics-cookie))
-
-
-;;; Strike-Through
-
-(defun org-groff-strike-through (strike-through contents info)
- "Transcode STRIKE-THROUGH from Org to Groff.
-CONTENTS is the text with strike-through markup. INFO is a plist
-holding contextual information."
- (org-groff--text-markup contents 'strike-through))
-
-;;; Subscript
-
-(defun org-groff-subscript (subscript contents info)
- "Transcode a SUBSCRIPT object from Org to Groff.
-CONTENTS is the contents of the object. INFO is a plist holding
-contextual information."
- (format "\\d\\s-2%s\\s+2\\u" contents))
-
-;;; Superscript "^_%s$
-
-(defun org-groff-superscript (superscript contents info)
- "Transcode a SUPERSCRIPT object from Org to Groff.
-CONTENTS is the contents of the object. INFO is a plist holding
-contextual information."
- (format "\\u\\s-2%s\\s+2\\d" contents))
-
-
-;;; Table
-;;
-;; `org-groff-table' is the entry point for table transcoding. It
-;; takes care of tables with a "verbatim" attribute. Otherwise, it
-;; delegates the job to `org-groff-table--org-table' function,
-;; depending of the type of the table.
-;;
-;; `org-groff-table--align-string' is a subroutine used to build
-;; alignment string for Org tables.
-
-(defun org-groff-table (table contents info)
- "Transcode a TABLE element from Org to Groff.
-CONTENTS is the contents of the table. INFO is a plist holding
-contextual information."
- (cond
- ;; Case 1: verbatim table.
- ((or org-groff-tables-verbatim
- (let ((attr (read (format "(%s)"
- (mapconcat
- #'identity
- (org-element-property :attr_groff table) "
")))))
- (and attr (plist-get attr :verbatim))))
-
- (format ".DS L\n\\fC%s\\fP\n.DE"
- ;; Re-create table, without affiliated keywords.
- (org-trim
- (org-element-interpret-data
- `(table nil ,@(org-element-contents table))))))
-
- ;; Case 2: Standard table.
- (t (org-groff-table--org-table table contents info))))
-
-(defun org-groff-table--align-string (divider table info)
- "Return an appropriate Groff alignment string.
-TABLE is the considered table. INFO is a plist used as
-a communication channel."
- (let (alignment)
- ;; Extract column groups and alignment from first (non-rule) row.
- (org-element-map
- (org-element-map table 'table-row
- (lambda (row)
- (and (eq (org-element-property :type row) 'standard) row))
- info 'first-match)
- 'table-cell
- (lambda (cell)
- (let* ((borders (org-export-table-cell-borders cell info))
- (raw-width (org-export-table-cell-width cell info))
- (width-cm (when raw-width (/ raw-width 5)))
- (width (if raw-width (format "w(%dc)"
- (if (< width-cm 1) 1 width-cm))
"")))
- ;; Check left border for the first cell only.
- ;; Alignment is nil on assignment
-
- (when (and (memq 'left borders) (not alignment))
- (push "|" alignment))
- (push
- (case (org-export-table-cell-alignment cell info)
- (left (concat "l" width divider))
- (right (concat "r" width divider))
- (center (concat "c" width divider)))
- alignment)
- (when (memq 'right borders) (push "|" alignment))))
- info)
- (apply 'concat (reverse alignment))))
-
-(defun org-groff-table--org-table (table contents info)
- "Return appropriate Groff code for an Org table.
-
-TABLE is the table type element to transcode. CONTENTS is its
-contents, as a string. INFO is a plist used as a communication
-channel.
-
-This function assumes TABLE has `org' as its `:type' attribute."
- (let* ((attr (org-export-read-attribute :attr_groff table))
- (label (org-element-property :name table))
- (caption (and (not (plist-get attr :disable-caption))
- (org-groff--caption/label-string table info)))
- (divider (if (plist-get attr :divider) "|" " "))
-
- ;; Determine alignment string.
- (alignment (org-groff-table--align-string divider table info))
-
- ;; Extract others display options.
-
- (lines (org-split-string contents "\n"))
-
- (attr-list
- (delq nil
- (list (and (plist-get attr :expand) "expand")
- (let ((placement (plist-get attr :placement)))
- (cond ((string= placement 'center) "center")
- ((string= placement 'left) nil)
- (t (if org-groff-tables-centered "center" ""))))
- (or (plist-get attr :boxtype) "box"))))
-
- (title-line (plist-get attr :title-line))
- (long-cells (plist-get attr :long-cells))
-
- (table-format
- (concat
- (or (car attr-list) "")
- (or
- (let (output-list)
- (when (cdr attr-list)
- (dolist (attr-item (cdr attr-list))
- (setq output-list (concat output-list
- (format ",%s" attr-item)))))
- output-list) "")))
- (first-line
- (when lines (org-split-string (car lines) "\t"))))
- ;; Prepare the final format string for the table.
-
-
- (cond
- ;; Others.
- (lines
- (concat ".TS\n " table-format ";\n"
- (format "%s.\n"
- (let ((final-line ""))
- (when title-line
- (dotimes (i (length first-line))
- (setq final-line (concat final-line "cb" divider))))
-
- (setq final-line (concat final-line "\n"))
-
- (if alignment
- (setq final-line (concat final-line alignment))
- (dotimes (i (length first-line))
- (setq final-line (concat final-line "c" divider))))
- final-line))
-
- (format "%s.TE\n"
- (let ((final-line "")
- (long-line "")
- (lines (org-split-string contents "\n")))
-
- (dolist (line-item lines)
- (setq long-line "")
-
- (if long-cells
- (progn
- (if (string= line-item "_")
- (setq long-line (format "%s\n" line-item))
- ;; else string =
- (let ((cell-item-list (org-split-string
line-item "\t")))
- (dolist (cell-item cell-item-list)
-
- (cond ((eq cell-item (car (last
cell-item-list)))
- (setq long-line (concat long-line
- (format
"T{\n%s\nT}\t\n" cell-item))))
- (t
- (setq long-line (concat long-line
- (format
"T{\n%s\nT}\t" cell-item))))))
- long-line))
- ;; else long cells
- (setq final-line (concat final-line long-line)))
-
- (setq final-line (concat final-line line-item
"\n"))))
- final-line))
-
- (if caption (format ".TB \"%s\"" caption) ""))))))
-
-;;; Table Cell
-
-(defun org-groff-table-cell (table-cell contents info)
- "Transcode a TABLE-CELL element from Org to Groff
-CONTENTS is the cell contents. INFO is a plist used as
-a communication channel."
- (progn
- (concat (if (and contents
- org-groff-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-groff-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents)
- (when (org-export-get-next-element table-cell info) "\t"))))
-
-
-;;; Table Row
-
-(defun org-groff-table-row (table-row contents info)
- "Transcode a TABLE-ROW element from Org to Groff
-CONTENTS is the contents of the row. INFO is a plist used as
-a communication channel."
- ;; Rules are ignored since table separators are deduced from
- ;; borders of the current row.
- (when (eq (org-element-property :type table-row) 'standard)
- (let* ((attr (mapconcat 'identity
- (org-element-property
- :attr_groff (org-export-get-parent table-row))
- " "))
- ;; TABLE-ROW's borders are extracted from its first cell.
- (borders
- (org-export-table-cell-borders
- (car (org-element-contents table-row)) info)))
- (concat
- ;; Mark horizontal lines
- (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
- contents
- (cond
- ;; When BOOKTABS are activated enforce bottom rule even when
- ;; no hline was specifically marked.
- ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
- ((memq 'below borders) "\n_"))))))
-
-;;; Target
-
-(defun org-groff-target (target contents info)
- "Transcode a TARGET object from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (format "\\fI%s\\fP" (org-export-get-reference target info)))
-
-;;; Timestamp
-
-(defun org-groff-timestamp (timestamp contents info)
- "Transcode a TIMESTAMP object from Org to Groff.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (let ((value (org-groff-plain-text
- (org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
- ((active active-range)
- (format org-groff-active-timestamp-format value))
- ((inactive inactive-range)
- (format org-groff-inactive-timestamp-format value))
- (t (format org-groff-diary-timestamp-format value)))))
-
-;;; Underline
-
-(defun org-groff-underline (underline contents info)
- "Transcode UNDERLINE from Org to Groff.
-CONTENTS is the text with underline markup. INFO is a plist
-holding contextual information."
- (org-groff--text-markup contents 'underline))
-
-;;; Verbatim
-
-(defun org-groff-verbatim (verbatim contents info)
- "Transcode a VERBATIM object from Org to Groff.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (org-groff--text-markup (org-element-property :value verbatim) 'verbatim))
-
-;;; Verse Block
-
-(defun org-groff-verse-block (verse-block contents info)
- "Transcode a VERSE-BLOCK element from Org to Groff.
-CONTENTS is verse block contents. INFO is a plist holding
-contextual information."
- (format ".DS C\n.ft HI\n%s\n.ft\n.DE" contents))
-
-
-;;; Interactive functions
-
-(defun org-groff-export-to-groff
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to a Groff 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.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return output file's name."
- (interactive)
- (let ((outfile (org-export-output-file-name ".groff" subtreep))
- (org-groff-registered-references nil)
- (org-groff-special-content nil))
- (org-export-to-file 'groff outfile
- async subtreep visible-only body-only ext-plist)))
-
-(defun org-groff-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to Groff then process through to PDF.
-
-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.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return PDF file's name."
- (interactive)
- (let ((outfile (org-export-output-file-name ".groff" subtreep)))
- (org-export-to-file 'groff outfile
- async subtreep visible-only body-only ext-plist
- (lambda (file) (org-groff-compile file)))))
-
-(defun org-groff-compile (file)
- "Compile a Groff file.
-
-FILE is the name of the file being compiled. Processing is done
-through the command specified in `org-groff-pdf-process'.
-
-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)
- default-directory))
- errors)
- (message (format "Processing Groff file %s ..." file))
- (save-window-excursion
- (cond
- ;; A function is provided: Apply it.
- ((functionp org-groff-pdf-process)
- (funcall org-groff-pdf-process (shell-quote-argument file)))
- ;; A list is provided: Replace %b, %f and %o with appropriate
- ;; values in each command before applying it. Output is
- ;; redirected to "*Org PDF Groff Output*" buffer.
- ((consp org-groff-pdf-process)
- (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
- (mapc
- (lambda (command)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t)
- t t) t t)
- outbuf))
- org-groff-pdf-process)
- ;; Collect standard errors from output buffer.
- (setq errors (org-groff-collect-errors outbuf))))
- (t (error "No valid command to process to PDF")))
- (let ((pdffile (concat out-dir base-name ".pdf")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (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
- ;; process to user, along with any error encountered.
- (when org-groff-remove-logfiles
- (dolist (ext org-groff-logfiles-extensions)
- (let ((file (concat out-dir base-name "." ext)))
- (when (file-exists-p file) (delete-file file)))))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- pdffile))))
-
-(defun org-groff-collect-errors (buffer)
- "Collect some kind of errors from \"groff\" output
-BUFFER is the buffer containing output.
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-max))
- ;; Find final run
- nil)))
-
-
-(provide 'ox-groff)
-;;; ox-groff.el ends here
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
deleted file mode 100644
index 003df31..0000000
--- a/contrib/lisp/ox-koma-letter.el
+++ /dev/null
@@ -1,1010 +0,0 @@
-;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine
-
-;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
-
-;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
-;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
-;; Viktor Rosenfeld <listuser36 AT gmail DOT com>
-;; Rasmus Pank Roulund <emacs AT pank DOT eu>
-;; Keywords: org, wp, tex
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library implements a KOMA Scrlttr2 back-end, derived from the
-;; LaTeX one.
-;;
-;; Depending on the desired output format, three commands are provided
-;; for export: `org-koma-letter-export-as-latex' (temporary buffer),
-;; `org-koma-letter-export-to-latex' ("tex" file) and
-;; `org-koma-letter-export-to-pdf' ("pdf" file).
-;;
-;; On top of buffer keywords supported by `latex' back-end (see
-;; `org-latex-options-alist'), this back-end introduces the following
-;; keywords:
-;; - CLOSING: see `org-koma-letter-closing',
-;; - FROM_ADDRESS: see `org-koma-letter-from-address',
-;; - LCO: see `org-koma-letter-class-option-file',
-;; - OPENING: see `org-koma-letter-opening',
-;; - PHONE_NUMBER: see `org-koma-letter-phone-number',
-;; - URL: see `org-koma-letter-url',
-;; - FROM_LOGO: see `org-koma-letter-from-logo',
-;; - 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, 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'.
-;;
-;; A number of OPTIONS settings can be set to change which contents is
-;; exported.
-;; - backaddress (see `org-koma-letter-use-backaddress')
-;; - foldmarks (see `org-koma-letter-use-foldmarks')
-;; - phone (see `org-koma-letter-use-phone')
-;; - url (see `org-koma-letter-use-url')
-;; - from-logo (see `org-koma-letter-use-from-logo')
-;; - 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
-;; special tags after closing (see
-;; `org-koma-letter-special-tags-after-closing')
-;; - after-letter-order, as above, but after the end of the letter
-;; (see `org-koma-letter-special-tags-after-letter').
-;;
-;; The following variables works differently from the main LaTeX class
-;; - AUTHOR: Default to user-full-name but may be disabled.
-;; (See also `org-koma-letter-author'),
-;; - EMAIL: Same as AUTHOR. (see also `org-koma-letter-email'),
-;;
-;; FROM_LOGO uses LaTeX markup. FROM_LOGO provides the
-;; "includegraphics" command to tell LaTeX where to find the logo.
-;; This command needs to know the logo's directory and file name. The
-;; directory can either be relative or absolute, just as you would
-;; expect. LaTeX can use three file types for the logo: PDF, JPEG, or
-;; PNG. The logo can either include or exclude its extension, which
-;; might surprise you. When you exclude its extension, LaTeX will
-;; search the directory for the "best" quality graphics format. For
-;; example if it finds both logo.pdf and logo.png then it will
-;; identify the PDF as "better", and include "logo.pdf". This can be
-;; useful, for example, when you are mocking up a logo in the PNG
-;; raster format and then switch over to the higher quality PDF vector
-;; format. When you include the file extension then LaTeX will
-;; include it without searching for higher quality file types.
-;; Whatever file type you choose, it will probably require a few
-;; design iterations to get the best looking logo size for your
-;; letter. Finally, the directory and file name are specified
-;; *without* quotes. Here are some examples with commentary, in the
-;; location of your letter, with a logo named "logo", to get you
-;; started:
-;;
-;; Logo in the same directory: \includegraphics{logo}
-;; or a sub-directory: \includegraphics{logos/production/logo}
-;;
-;; Logos specified using absolute paths on Linux or Windows:
-;;
-;; \includegraphics{~/correspondence/logo}
-;; \includegraphics{~/correspondence/logos/production/logo}
-;; \includegraphics{c:/you/correspondence/logo}
-;; \includegraphics{c:/you/correspondence/logos/production/logo}
-;;
-;; Logos in the same directory where the "better" quality PDF will
-;; be chosen over the JPG:
-;;
-;; \includegraphics{logo.pdf}
-;; \includegraphics{logo.png}
-;;
-;; Headlines are in general ignored. However, headlines with special
-;; tags can be used for specified contents like postscript (ps),
-;; carbon copy (cc), enclosures (encl) and code to be inserted after
-;; \end{letter} (after_letter). Specials tags are defined in
-;; `org-koma-letter-special-tags-after-closing' and
-;; `org-koma-letter-special-tags-after-letter'. Currently members of
-;; `org-koma-letter-special-tags-after-closing' used as macros and the
-;; content of the headline is the argument.
-;;
-;; 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
-;; to use the KOMA Scrlttr2 class. By default, a sparse scrlttr2
-;; class is provided: "default-koma-letter". You can also add you own
-;; letter class. For instance:
-;;
-;; (add-to-list 'org-latex-classes
-;; '("my-letter"
-;; "\\documentclass\[%
-;; DIV=14,
-;; fontsize=12pt,
-;; parskip=half,
-;; subject=titled,
-;; backaddress=false,
-;; fromalign=left,
-;; fromemail=true,
-;; fromphone=true\]\{scrlttr2\}
-;; \[DEFAULT-PACKAGES]
-;; \[PACKAGES]
-;; \[EXTRA]"))
-;;
-;; Then, in your Org document, be sure to require the proper class
-;; with:
-;;
-;; #+LATEX_CLASS: my-letter
-;;
-;; Or by setting `org-koma-letter-default-class'.
-;;
-;; You may have to load (LaTeX) Babel as well, e.g., by adding
-;; it to `org-latex-packages-alist',
-;;
-;; (add-to-list 'org-latex-packages-alist '("AUTO" "babel" nil))
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'ox-latex)
-
-;; Install a default letter class.
-(unless (assoc "default-koma-letter" org-latex-classes)
- (add-to-list 'org-latex-classes
- '("default-koma-letter" "\\documentclass[11pt]{scrlttr2}")))
-
-
-;;; User-Configurable Variables
-
-(defgroup org-export-koma-letter nil
- "Options for exporting to KOMA scrlttr2 class in LaTeX export."
- :tag "Org Koma-Letter"
- :group 'org-export)
-
-(defcustom org-koma-letter-class-option-file "NF"
- "Letter Class Option File.
-This option can also be set with the LCO keyword."
- :group 'org-export-koma-letter
- :type 'string)
-
-(defcustom org-koma-letter-author 'user-full-name
- "Sender's name.
-
-This variable defaults to calling the function `user-full-name'
-which just returns the current function `user-full-name'.
-Alternatively a string, nil or a function may be given.
-Functions must return a string.
-
-This option can also be set with the AUTHOR keyword."
- :group 'org-export-koma-letter
- :type '(radio (function-item user-full-name)
- (string)
- (function)
- (const :tag "Do not export author" nil)))
-
-(defcustom org-koma-letter-email 'org-koma-letter-email
- "Sender's email address.
-
-This variable defaults to the value `org-koma-letter-email' which
-returns `user-mail-address'. Alternatively a string, nil or
-a function may be given. Functions must return a string.
-
-This option can also be set with the EMAIL keyword."
- :group 'org-export-koma-letter
- :type '(radio (function-item org-koma-letter-email)
- (string)
- (function)
- (const :tag "Do not export email" nil)))
-
-(defcustom org-koma-letter-from-address ""
- "Sender's address, as a string.
-This option can also be set with one or more FROM_ADDRESS
-keywords."
- :group 'org-export-koma-letter
- :type 'string)
-
-(defcustom org-koma-letter-phone-number ""
- "Sender's phone number, as a string.
-This option can also be set with the PHONE_NUMBER keyword."
- :group 'org-export-koma-letter
- :type 'string)
-
-(defcustom org-koma-letter-url ""
- "Sender's URL, e. g., the URL of her homepage.
-This option can also be set with the URL keyword."
- :group 'org-export-koma-letter
- :type 'string
- :safe #'stringp)
-
-(defcustom org-koma-letter-from-logo ""
- "Commands for inserting the sender's logo, e. g., \\includegraphics{logo}.
-This option can also be set with the FROM_LOGO keyword."
- :group 'org-export-koma-letter
- :type 'string
- :safe #'stringp)
-
-(defcustom org-koma-letter-place ""
- "Place from which the letter is sent, as a string.
-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) 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 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. 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.
-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)
-
-(defcustom org-koma-letter-prefer-special-headings nil
- "Non-nil means prefer headlines over keywords for TO and FROM.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"special-headings:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
-
-(defcustom org-koma-letter-subject-format t
- "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
-the following ones:
-
- `afteropening' Subject after opening
- `beforeopening' Subject before opening
- `centered' Subject centered
- `left' Subject left-justified
- `right' Subject right-justified
- `titled' Add title/description to subject
- `underlined' Set subject underlined
- `untitled' Do not add title/description to subject
-
-Please refer to the KOMA-script manual (Table 4.16. in the
-English manual of 2012-07-22).
-
-This option can also be set with the OPTIONS keyword, e.g.:
-\"subject:(underlined centered)\"."
- :type
- '(choice
- (const :tag "No export" nil)
- (const :tag "Default options" t)
- (set :tag "Configure options"
- (const :tag "Subject after opening" afteropening)
- (const :tag "Subject before opening" beforeopening)
- (const :tag "Subject centered" centered)
- (const :tag "Subject left-justified" left)
- (const :tag "Subject right-justified" right)
- (const :tag "Add title or description to subject" underlined)
- (const :tag "Set subject underlined" titled)
- (const :tag "Do not add title or description to subject" untitled)))
- :group 'org-export-koma-letter)
-
-(defcustom org-koma-letter-use-backaddress nil
- "Non-nil prints return address in line above to address.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"backaddress:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
-
-(defcustom org-koma-letter-use-foldmarks t
- "Configure appearance of folding marks.
-
-When t, activate default folding marks. When nil, do not insert
-folding marks at all. It can also be a list of symbols among the
-following ones:
-
- `B' Activate upper horizontal mark on left paper edge
- `b' Deactivate upper horizontal mark on left paper edge
-
- `H' Activate all horizontal marks on left paper edge
- `h' Deactivate all horizontal marks on left paper edge
-
- `L' Activate left vertical mark on upper paper edge
- `l' Deactivate left vertical mark on upper paper edge
-
- `M' Activate middle horizontal mark on left paper edge
- `m' Deactivate middle horizontal mark on left paper edge
-
- `P' Activate punch or center mark on left paper edge
- `p' Deactivate punch or center mark on left paper edge
-
- `T' Activate lower horizontal mark on left paper edge
- `t' Deactivate lower horizontal mark on left paper edge
-
- `V' Activate all vertical marks on upper paper edge
- `v' Deactivate all vertical marks on upper paper edge
-
-This option can also be set with the OPTIONS keyword, e.g.:
-\"foldmarks:(b l m t)\"."
- :group 'org-export-koma-letter
- :type '(choice
- (const :tag "Activate default folding marks" t)
- (const :tag "Deactivate folding marks" nil)
- (set
- :tag "Configure folding marks"
- (const :tag "Activate upper horizontal mark on left paper edge" B)
- (const :tag "Deactivate upper horizontal mark on left paper edge" b)
- (const :tag "Activate all horizontal marks on left paper edge" H)
- (const :tag "Deactivate all horizontal marks on left paper edge" h)
- (const :tag "Activate left vertical mark on upper paper edge" L)
- (const :tag "Deactivate left vertical mark on upper paper edge" l)
- (const :tag "Activate middle horizontal mark on left paper edge" M)
- (const :tag "Deactivate middle horizontal mark on left paper edge"
m)
- (const :tag "Activate punch or center mark on left paper edge" P)
- (const :tag "Deactivate punch or center mark on left paper edge" p)
- (const :tag "Activate lower horizontal mark on left paper edge" T)
- (const :tag "Deactivate lower horizontal mark on left paper edge" t)
- (const :tag "Activate all vertical marks on upper paper edge" V)
- (const :tag "Deactivate all vertical marks on upper paper edge"
v))))
-
-(defcustom org-koma-letter-use-phone nil
- "Non-nil prints sender's phone number.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"phone:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
-
-(defcustom org-koma-letter-use-url nil
- "Non-nil prints sender's URL.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"url:t\"."
- :group 'org-export-koma-letter
- :type 'boolean
- :safe #'booleanp)
-
-(defcustom org-koma-letter-use-from-logo nil
- "Non-nil prints sender's FROM_LOGO.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"from-logo:t\"."
- :group 'org-export-koma-letter
- :type 'boolean
- :safe #'booleanp)
-
-(defcustom org-koma-letter-use-email nil
- "Non-nil prints sender's email address.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"email:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
-
-(defcustom org-koma-letter-use-place t
- "Non-nil prints the letter's place next to the date.
-This option can also be set with the OPTIONS keyword, e.g.:
-\"place:nil\"."
- :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'."
- :group 'org-export-koma-letter
- :type 'string)
-
-(defcustom org-koma-letter-headline-is-opening-maybe t
- "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 interpreted as subject if subject is missing.
-This option can also be set with the OPTIONS keyword,
-e.g. \"title-subject:t\"."
- :group 'org-export-koma-letter
- :type 'boolean)
-
-(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 '(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 the letter.")
-
-(defvar org-koma-letter-special-contents nil
- "Holds special content temporarily.")
-
-
-;;; Define Back-End
-
-(org-export-define-derived-backend 'koma-letter 'latex
- :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)
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)
- (:url "URL" nil org-koma-letter-url)
- (:from-logo "FROM_LOGO" nil org-koma-letter-from-logo)
- (: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)
- (: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-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-url nil "url" org-koma-letter-use-url)
- (:with-from-logo nil "from-logo" org-koma-letter-use-from-logo)
- (:with-place nil "place" org-koma-letter-use-place)
- (:with-subject nil "subject" org-koma-letter-subject-format)
- (: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-url "URL" nil 'koma-letter:empty)
- (:inbuffer-from-logo "FROM_LOGO" 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-url nil "url" 'koma-letter:empty)
- (:inbuffer-with-from-logo nil "from-logo" '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))
- :menu-entry
- '(?k "Export with KOMA Scrlttr2"
- ((?L "As LaTeX buffer" org-koma-letter-export-as-latex)
- (?l "As LaTeX file" org-koma-letter-export-to-latex)
- (?p "As PDF file" org-koma-letter-export-to-pdf)
- (?o "As PDF file and open"
- (lambda (a s v b)
- (if a (org-koma-letter-export-to-pdf t s v b)
- (org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
-
-
-
-;;; Helper functions
-
-(defun org-koma-letter-email ()
- "Return the current `user-mail-address'."
- user-mail-address)
-
-;; The following is taken from/inspired by ox-grof.el
-;; Thanks, Luis!
-
-(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'."
- (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.
-Determines if VALUE is nil, a string, a function or a symbol and
-return a string or nil."
- (when value
- (cond ((stringp value) value)
- ((functionp value) (funcall value))
- ((symbolp value) (symbol-name value))
- (t value))))
-
-(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 the one tagged with PS."
- (mapconcat
- (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
- "\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))))
-
-
-
-;;; Transcode Functions
-
-;;;; Export Block
-
-(defun org-koma-letter-export-block (export-block contents info)
- "Transcode an EXPORT-BLOCK element into KOMA Scrlttr2 code.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (when (member (org-element-property :type export-block)
- '("KOMA-LETTER" "LATEX"))
- (org-remove-indentation (org-element-property :value export-block))))
-
-;;;; Export Snippet
-
-(defun org-koma-letter-export-snippet (export-snippet contents info)
- "Transcode an EXPORT-SNIPPET object into KOMA Scrlttr2 code.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (when (memq (org-export-snippet-backend export-snippet) '(latex koma-letter))
- (org-element-property :value export-snippet)))
-
-;;;; Keyword
-
-(defun org-koma-letter-keyword (keyword contents info)
- "Transcode a KEYWORD element into KOMA Scrlttr2 code.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (let ((key (org-element-property :key keyword))
- (value (org-element-property :value keyword)))
- ;; Handle specifically KOMA-LETTER keywords. Otherwise, fallback
- ;; to `latex' back-end.
- (if (equal key "KOMA-LETTER") value
- (org-export-with-backend 'latex keyword contents info))))
-
-;; Headline
-
-(defun org-koma-letter-headline (headline contents info)
- "Transcode a HEADLINE element from Org to LaTeX.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information.
-
-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."
- (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))))
- (cl-some (lambda (tag) (and (assoc-string tag special-tags) tag))
- (org-export-get-tags headline info))))
-
-(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 (h)
- (and (funcall pred h info)
- (org-element-property :title h)))
- info t))))
- (org-export-data (or headline-candidate keyword-candidate "") info)))
-
-;;;; Template
-
-(defun org-koma-letter-template (contents info)
- "Return complete document string after KOMA Scrlttr2 conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (concat
- ;; 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.
- (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
- ;; variables, then we insert LCO files, and, eventually, we insert
- ;; settings coming from buffer keywords.
- (org-koma-letter--build-settings 'global info)
- (mapconcat (lambda (file) (format "\\LoadLetterOption{%s}\n" file))
- (split-string (or (plist-get info :lco) ""))
- "")
- (org-koma-letter--build-settings 'buffer info)
- ;; Date.
- (format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
- ;; 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.
- (and (stringp hyperref-template)
- (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.
- (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"
- (org-koma-letter--keyword-or-headline
- :opening
- (lambda (h i)
- (not (org-koma-letter--special-tag h i)))
- info))
- ;; Letter body.
- contents
- ;; Closing.
- (format "\\closing{%s}\n"
- (org-koma-letter--keyword-or-headline
- :closing
- (lambda (h i)
- (let ((special-tag (org-koma-letter--special-tag h i)))
- (and special-tag
- (string= "closing" special-tag))))
- 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-inline
- (plist-get info :special-tags-after-letter) info)
- ;; Document end.
- "\n\\end{document}"))
-
-(defun org-koma-letter--build-settings (scope info)
- "Build settings string according to type.
-SCOPE is either `global' or `buffer'. INFO is a plist used as
-a communication channel."
- (let* ((check-scope
- ;; 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
- (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)))
- (and author
- (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
- (funcall check-scope 'email)
- (format "\\setkomavar{fromemail}{%s}\n" email)))
- (and (funcall check-scope 'with-email)
- (format "\\KOMAoption{fromemail}{%s}\n"
- (if (plist-get info :with-email) "true" "false")))
- ;; Phone number.
- (let ((phone-number (plist-get info :phone-number)))
- (and (org-string-nw-p phone-number)
- (funcall check-scope 'phone-number)
- (format "\\setkomavar{fromphone}{%s}\n" phone-number)))
- (and (funcall check-scope 'with-phone)
- (format "\\KOMAoption{fromphone}{%s}\n"
- (if (plist-get info :with-phone) "true" "false")))
- ;; URL
- (let ((url (plist-get info :url)))
- (and (org-string-nw-p url)
- (funcall check-scope 'url)
- (format "\\setkomavar{fromurl}{%s}\n" url)))
- (and (funcall check-scope 'with-url)
- (format "\\KOMAoption{fromurl}{%s}\n"
- (if (plist-get info :with-url) "true" "false")))
- ;; From Logo
- (let ((from-logo (plist-get info :from-logo)))
- (and (org-string-nw-p from-logo)
- (funcall check-scope 'from-logo)
- (format "\\setkomavar{fromlogo}{%s}\n" from-logo)))
- (and (funcall check-scope 'with-from-logo)
- (format "\\KOMAoption{fromlogo}{%s}\n"
- (if (plist-get info :with-from-logo) "true" "false")))
- ;; Signature.
- (let* ((heading-val
- (and (plist-get info :with-headline-opening)
- (pcase (org-koma-letter--get-tagged-contents 'closing)
- ((and (pred org-string-nw-p) closing) (org-trim closing))
- (_ nil))))
- (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.
- (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)))
- (cond ((consp foldmarks)
- (format "\\KOMAoptions{foldmarks=true,foldmarks=%s}\n"
- (mapconcat #'symbol-name foldmarks "")))
- (foldmarks "\\KOMAoptions{foldmarks=true}\n")
- (t "\\KOMAoptions{foldmarks=false}\n")))))))
-
-
-
-;;; Commands
-
-;;;###autoload
-(defun org-koma-letter-export-as-latex
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer as a KOMA Scrlttr2 letter.
-
-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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"\\begin{letter}\" and \"\\end{letter}\".
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Export is done in a buffer named \"*Org KOMA-LETTER Export*\". It
-will be displayed if `org-export-show-temporary-export-buffer' is
-non-nil."
- (interactive)
- (let (org-koma-letter-special-contents)
- (org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*"
- async subtreep visible-only body-only ext-plist
- (lambda () (LaTeX-mode)))))
-
-;;;###autoload
-(defun org-koma-letter-export-to-latex
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer as a KOMA Scrlttr2 letter (tex).
-
-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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"\\begin{letter}\" and \"\\end{letter}\".
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-When optional argument PUB-DIR is set, use it as the publishing
-directory.
-
-Return output file's name."
- (interactive)
- (let ((outfile (org-export-output-file-name ".tex" subtreep))
- (org-koma-letter-special-contents))
- (org-export-to-file 'koma-letter outfile
- async subtreep visible-only body-only ext-plist)))
-
-;;;###autoload
-(defun org-koma-letter-export-to-pdf
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer as a KOMA Scrlttr2 letter (pdf).
-
-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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"\\begin{letter}\" and \"\\end{letter}\".
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return PDF file's name."
- (interactive)
- (let ((file (org-export-output-file-name ".tex" subtreep))
- (org-koma-letter-special-contents))
- (org-export-to-file 'koma-letter file
- async subtreep visible-only body-only ext-plist
- (lambda (file) (org-latex-compile file)))))
-
-
-(provide 'ox-koma-letter)
-;;; ox-koma-letter.el ends here
diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el
deleted file mode 100644
index f8fcda2..0000000
--- a/contrib/lisp/ox-rss.el
+++ /dev/null
@@ -1,419 +0,0 @@
-;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
-
-;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
-
-;; Author: Bastien Guerry <bzg@gnu.org>
-;; Keywords: org, wp, blog, feed, rss
-
-;; 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 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This library implements an RSS 2.0 back-end for Org exporter, based
-;; on the `html' back-end.
-;;
-;; It requires Emacs 24.1 at least.
-;;
-;; It provides two commands for export, depending on the desired output:
-;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss'
-;; (as a ".xml" file).
-;;
-;; This backend understands three new option keywords:
-;;
-;; #+RSS_EXTENSION: xml
-;; #+RSS_IMAGE_URL: https://myblog.org/mypicture.jpg
-;; #+RSS_FEED_URL: https://myblog.org/feeds/blog.xml
-;;
-;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
-;;
-;; Exporting an Org file to RSS modifies each top-level entry by adding a
-;; 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
-;; 'org-publish-project-alist
-;; '("homepage_rss"
-;; :base-directory "~/myhomepage/"
-;; :base-extension "org"
-;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png";
-;; :html-link-home "http://lumiere.ens.fr/~guerry/";
-;; :html-link-use-abs-url t
-;; :rss-extension "xml"
-;; :publishing-directory "/home/guerry/public_html/"
-;; :publishing-function (org-rss-publish-to-rss)
-;; :section-numbers nil
-;; :exclude ".*" ;; To exclude all files...
-;; :include ("index.org") ;; ... except index.org.
-;; :table-of-contents nil))
-;;
-;; ... then rsync /home/guerry/public_html/ with your server.
-;;
-;; By default, the permalink for a blog entry points to the headline.
-;; You can specify a different one by using the :RSS_PERMALINK:
-;; property within an entry.
-
-;;; Code:
-
-(require 'ox-html)
-(declare-function url-encode-url "url-util" (url))
-
-;;; Variables and options
-
-(defgroup org-export-rss nil
- "Options specific to RSS export back-end."
- :tag "Org RSS"
- :group 'org-export
- :version "24.4"
- :package-version '(Org . "8.0"))
-
-(defcustom org-rss-image-url
"https://orgmode.org/img/org-mode-unicorn-logo.png";
- "The URL of the image for the RSS feed."
- :group 'org-export-rss
- :type 'string)
-
-(defcustom org-rss-extension "xml"
- "File extension for the RSS 2.0 feed."
- :group 'org-export-rss
- :type 'string)
-
-(defcustom org-rss-categories 'from-tags
- "Where to extract items category information from.
-The default is to extract categories from the tags of the
-headlines. When set to another value, extract the category
-from the :CATEGORY: property of the entry."
- :group 'org-export-rss
- :type '(choice
- (const :tag "From tags" from-tags)
- (const :tag "From the category property" from-category)))
-
-(defcustom org-rss-use-entry-url-as-guid t
- "Use the URL for the <guid> metatag?
-When nil, Org will create ids using `org-icalendar-create-uid'."
- :group 'org-export-rss
- :type 'boolean)
-
-;;; Define backend
-
-(org-export-define-derived-backend 'rss 'html
- :menu-entry
- '(?r "Export to RSS"
- ((?R "As RSS buffer"
- (lambda (a s v b) (org-rss-export-as-rss a s v)))
- (?r "As RSS file" (lambda (a s v b) (org-rss-export-to-rss a s v)))
- (?o "As RSS file and open"
- (lambda (a s v b)
- (if a (org-rss-export-to-rss t s v)
- (org-open-file (org-rss-export-to-rss nil s v)))))))
- :options-alist
- '((: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)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
- (timestamp . (lambda (&rest args) ""))
- (plain-text . org-rss-plain-text)
- (section . org-rss-section)
- (template . org-rss-template)))
-
-;;; Export functions
-
-;;;###autoload
-(defun org-rss-export-as-rss (&optional async subtreep visible-only)
- "Export current buffer to an RSS 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 RSS Export*\", which will
-be displayed when `org-export-show-temporary-export-buffer' is
-non-nil."
- (interactive)
- (let ((file (buffer-file-name (buffer-base-buffer))))
- (org-icalendar-create-uid file 'warn-user)
- (org-rss-add-pubdate-property))
- (org-export-to-buffer 'rss "*Org RSS Export*"
- async subtreep visible-only nil nil (lambda () (text-mode))))
-
-;;;###autoload
-(defun org-rss-export-to-rss (&optional async subtreep visible-only)
- "Export current buffer to an RSS 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 ((file (buffer-file-name (buffer-base-buffer))))
- (org-icalendar-create-uid file 'warn-user)
- (org-rss-add-pubdate-property))
- (let ((outfile (org-export-output-file-name
- (concat "." org-rss-extension) subtreep)))
- (org-export-to-file 'rss outfile async subtreep visible-only)))
-
-;;;###autoload
-(defun org-rss-publish-to-rss (plist filename pub-dir)
- "Publish an org file to RSS.
-
-FILENAME is the filename of the Org file to be published. PLIST
-is the property list for the given project. PUB-DIR is the
-publishing directory.
-
-Return output file name."
- (let ((bf (get-file-buffer filename)))
- (if bf
- (with-current-buffer bf
- (org-icalendar-create-uid filename 'warn-user)
- (org-rss-add-pubdate-property)
- (write-file filename))
- (find-file filename)
- (org-icalendar-create-uid filename 'warn-user)
- (org-rss-add-pubdate-property)
- (write-file filename) (kill-buffer)))
- (org-publish-org-to
- 'rss filename (concat "." org-rss-extension) plist pub-dir))
-
-;;; Main transcoding functions
-
-(defun org-rss-headline (headline contents info)
- "Transcode HEADLINE element into RSS format.
-CONTENTS is the headline contents. INFO is a plist used as a
-communication channel."
- (if (> (org-export-get-relative-level headline info) 1)
- (org-export-data-with-backend headline 'html info)
- (unless (org-element-property :footnote-section-p headline)
- (let* ((email (org-export-data (plist-get info :email) info))
- (author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- (and auth (org-export-data auth info)))))
- (htmlext (plist-get info :html-extension))
- (hl-number (org-export-get-headline-number headline info))
- (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-get-reference headline info))
- (category (org-rss-plain-text
- (or (org-element-property :CATEGORY headline) "") info))
- (pubdate0 (org-element-property :PUBDATE headline))
- (pubdate (let ((system-time-locale "C"))
- (if (and pubdate0 (not (string-empty-p pubdate0)))
- (format-time-string
- "%a, %d %b %Y %H:%M:%S %z"
- (org-time-string-to-time pubdate0)))))
- (title (org-rss-plain-text
- (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))) info))
- (publink
- (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
- (concat
- (or hl-home hl-pdir)
- (file-name-nondirectory
- (file-name-sans-extension
- (plist-get info :input-file))) "." htmlext "#" anchor)))
- (guid (if org-rss-use-entry-url-as-guid
- publink
- (org-rss-plain-text
- (or (org-element-property :ID headline)
- (org-element-property :CUSTOM_ID headline)
- publink)
- info))))
- (if (not pubdate) "" ;; Skip entries with no PUBDATE prop
- (format
- (concat
- "<item>\n"
- "<title>%s</title>\n"
- "<link>%s</link>\n"
- "<author>%s (%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 email author guid pubdate contents))))))
-
-(defun org-rss-build-categories (headline info)
- "Build categories for the RSS item."
- (if (eq (plist-get info :rss-categories) 'from-tags)
- (mapconcat
- (lambda (c) (format "<category><![CDATA[%s]]></category>" c))
- (org-element-property :tags headline)
- "\n")
- (let ((c (org-element-property :CATEGORY headline)))
- (format "<category><![CDATA[%s]]></category>" c))))
-
-(defun org-rss-template (contents info)
- "Return complete document string after RSS conversion.
-CONTENTS is the transcoded contents string. INFO is a plist used
-as a communication channel."
- (concat
- (format "<?xml version=\"1.0\" encoding=\"%s\"?>"
- (symbol-name org-html-coding-system))
- "\n<rss version=\"2.0\"
- xmlns:content=\"http://purl.org/rss/1.0/modules/content/\";
- xmlns:wfw=\"http://wellformedweb.org/CommentAPI/\";
- xmlns:dc=\"http://purl.org/dc/elements/1.1/\";
- xmlns:atom=\"http://www.w3.org/2005/Atom\";
- xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\";
- xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\";
- xmlns:georss=\"http://www.georss.org/georss\";
- xmlns:geo=\"http://www.w3.org/2003/01/geo/wgs84_pos#\";
- xmlns:media=\"http://search.yahoo.com/mrss/\";>"
- "<channel>"
- (org-rss-build-channel-info info) "\n"
- contents
- "</channel>\n"
- "</rss>"))
-
-(defun org-rss-build-channel-info (info)
- "Build the RSS channel information."
- (let* ((system-time-locale "C")
- (title (org-export-data (plist-get info :title) info))
- (email (org-export-data (plist-get info :email) info))
- (author (and (plist-get info :with-author)
- (let ((auth (plist-get info :author)))
- (and auth (org-export-data auth info)))))
- (date (format-time-string "%a, %d %b %Y %H:%M:%S %z")) ;; RFC 882
- (description (org-export-data (plist-get info :description) info))
- (lang (plist-get info :language))
- (keywords (plist-get info :keywords))
- (rssext (plist-get info :rss-extension))
- (blogurl (or (plist-get info :html-link-home)
- (plist-get info :publishing-directory)))
- (image (url-encode-url (plist-get info :rss-image-url)))
- (ifile (plist-get info :input-file))
- (publink
- (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\" />
-<link>%s</link>
-<description><![CDATA[%s]]></description>
-<language>%s</language>
-<pubDate>%s</pubDate>
-<lastBuildDate>%s</lastBuildDate>
-<generator>%s</generator>
-<webMaster>%s (%s)</webMaster>
-<image>
-<url>%s</url>
-<title>%s</title>
-<link>%s</link>
-</image>
-"
- title publink blogurl description lang date date
- (concat (format "Emacs %d.%d"
- emacs-major-version
- emacs-minor-version)
- " Org-mode " (org-version))
- email author image title blogurl)))
-
-(defun org-rss-section (section contents info)
- "Transcode SECTION element into RSS format.
-CONTENTS is the section contents. INFO is a plist used as
-a communication channel."
- contents)
-
-(defun org-rss-timestamp (timestamp contents info)
- "Transcode a TIMESTAMP object from Org to RSS.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (org-html-encode-plain-text
- (org-timestamp-translate timestamp)))
-
-(defun org-rss-plain-text (contents info)
- "Convert plain text into RSS encoded text."
- (let (output)
- (setq output (org-html-encode-plain-text contents)
- output (org-export-activate-smart-quotes
- output :html info))))
-
-;;; Filters
-
-(defun org-rss-final-function (contents backend info)
- "Prettify the RSS output."
- (with-temp-buffer
- (xml-mode)
- (insert contents)
- (indent-region (point-min) (point-max))
- (buffer-substring-no-properties (point-min) (point-max))))
-
-;;; Miscellaneous
-
-(defun org-rss-add-pubdate-property ()
- "Set the PUBDATE property for top-level headlines."
- (let (msg)
- (org-map-entries
- (lambda ()
- (let* ((entry (org-element-at-point))
- (level (org-element-property :level entry)))
- (when (= level 1)
- (unless (org-entry-get (point) "PUBDATE")
- (setq msg t)
- (org-set-property
- "PUBDATE" (format-time-string
- (cdr org-time-stamp-formats)))))))
- nil nil 'comment 'archive)
- (when msg
- (message "Property PUBDATE added to top-level entries in %s"
- (buffer-file-name))
- (sit-for 2))))
-
-(provide 'ox-rss)
-
-;;; ox-rss.el ends here
diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el
deleted file mode 100644
index d729e38..0000000
--- a/contrib/lisp/ox-s5.el
+++ /dev/null
@@ -1,433 +0,0 @@
-;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine
-
-;; Copyright (C) 2011-2014 Rick Frankel
-
-;; Author: Rick Frankel <emacs at rickster dot com>
-;; Keywords: outlines, hypermedia, S5, wp
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This library implements an S5 Presentation back-end for the Org
-;; generic exporter.
-
-;; Installation
-;; ------------
-;; Get the s5 scripts from
-;; https://meyerweb.com/eric/tools/s5/
-;; (Note that the default s5 version is set for using the alpha, 1.2a2.
-;; Copy the ui dir to somewhere reachable from your published presentation
-;; The default (`org-s5-ui-url') is set to "ui" (e.g., in the
-;; same directory as the html file).
-
-;; Usage
-;; -----
-;; Follow the general instructions at the above website. To generate
-;; incremental builds, you can set the HTML_CONTAINER_CLASS on an
-;; object to "incremental" to make it build. If you want an outline to
-;; build, set the :INCREMENTAL property on the parent headline.
-
-;; To test it, run:
-;;
-;; M-x org-s5-export-as-html
-;;
-;; 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
- '(?s "Export to S5 HTML Presentation"
- ((?H "To temporary buffer" org-s5-export-as-html)
- (?h "To file" org-s5-export-to-html)
- (?o "To file and open"
- (lambda (a s v b)
- (if a (org-s5-export-to-html t s v b)
- (org-open-file (org-s5-export-to-html nil s v b)))))))
- :options-alist
- '((:html-link-home "HTML_LINK_HOME" nil nil)
- (:html-link-up "HTML_LINK_UP" nil nil)
- (:s5-postamble "S5_POSTAMBLE" nil org-s5-postamble newline)
- (:s5-preamble "S5_PREAMBLE" nil org-s5-preamble newline)
- (:html-head-include-default-style "HTML_INCLUDE_DEFAULT_STYLE" nil nil)
- (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil nil)
- (:s5-version "S5_VERSION" nil org-s5-version)
- (:s5-theme-file "S5_THEME_FILE" nil org-s5-theme-file)
- (:s5-ui-url "S5_UI_URL" nil org-s5-ui-url)
- (:s5-default-view "S5_DEFAULT_VIEW" nil org-s5-default-view)
- (:s5-control-visibility "S5_CONTROL_VISIBILITY" nil
- org-s5-control-visibility))
- :translate-alist
- '((headline . org-s5-headline)
- (plain-list . org-s5-plain-list)
- (inner-template . org-s5-inner-template)
- (template . org-s5-template)))
-
-(defgroup org-export-s5 nil
- "Options for exporting Org mode files to S5 HTML Presentations."
- :tag "Org Export S5"
- :group 'org-export-html)
-
-(defcustom org-s5-version "1.2a2"
- "Version of s5 being used (for version metadata.) Defaults to
-s5 v2 alpha 2.
-Can be overridden with S5_VERSION."
- :group 'org-export-s5
- :type 'string)
-
-(defcustom org-s5-theme-file nil
-"Url to S5 theme (slides.css) file. Can be overridden with the
-S5_THEME_FILE property. If nil, defaults to
-`org-s5-ui-url'/default/slides.css. If it starts with anything but
-\"http\" or \"/\", it is used as-is. Otherwise the link in generated
-relative to `org-s5-ui-url'.
-The links for all other required stylesheets and scripts will be
-generated relative to `org-s5-ui-url'/default."
- :group 'org-export-s5
- :type 'string)
-
-(defcustom org-s5-ui-url "ui"
- "Base url to directory containing S5 \"default\" subdirectory
-and the \"s5-notes.html\" file.
-Can be overridden with the S5_UI_URL property."
- :group 'org-export-s5
- :type 'string)
-
-(defcustom org-s5-default-view 'slideshow
- "Setting for \"defaultView\" meta info."
- :group 'org-export-s5
- :type '(choice (const slideshow) (const outline)))
-
-(defcustom org-s5-control-visibility 'hidden
- "Setting for \"controlVis\" meta info."
- :group 'org-export-s5
- :type '(choice (const hidden) (const visibile)))
-
-(defvar org-s5--divs
- '((preamble "div" "header")
- (content "div" "content")
- (postamble "div" "footer"))
- "Alist of the three section elements for HTML export.
-The car of each entry is one of 'preamble, 'content or 'postamble.
-The cdrs of each entry are the ELEMENT_TYPE and ID for each
-section of the exported document.
-
-If you set `org-html-container-element' to \"li\", \"ol\" will be
-uses as the content ELEMENT_TYPE, generating an XOXO format
-slideshow.
-
-Note that changing the preamble or postamble will break the
-core S5 stylesheets.")
-
-(defcustom org-s5-postamble "<h1>%a - %t</h1>"
- "Preamble inserted into the S5 layout section.
-When set to a string, use this string as the postamble.
-
-When set to a function, apply this function and insert the
-returned string. The function takes the property list of export
-options as its only argument.
-
-Setting the S5_POSTAMBLE option -- or the :s5-postamble in publishing
-projects -- will take precedence over this variable.
-
-Note that the default css styling will break if this is set to nil
-or an empty string."
- :group 'org-export-s5
- :type '(choice (const :tag "No postamble" " ")
- (string :tag "Custom formatting string")
- (function :tag "Function (must return a string)")))
-
-(defcustom org-s5-preamble " "
- "Peamble inserted into the S5 layout section.
-
-When set to a string, use this string as the preamble.
-
-When set to a function, apply this function and insert the
-returned string. The function takes the property list of export
-options as its only argument.
-
-Setting S5_PREAMBLE option -- or the :s5-preamble in publishing
-projects -- will take precedence over this variable.
-
-Note that the default css styling will break if this is set to nil
-or an empty string."
- :group 'org-export-s5
- :type '(choice (const :tag "No preamble" " ")
- (string :tag "Custom formatting string")
- (function :tag "Function (must return a string)")))
-
-(defcustom org-s5-title-slide-template
- "<h1>%t</h1>
-<h2>%s</h2>
-<h2>%a</h2>
-<h3>%e</h3>
-<h4>%d</h4>"
- "Format template to specify title page section.
-See `org-html-postamble-format' for the valid elements which
-can be included.
-
-It will be wrapped in the element defined in the :html-container
-property, and defaults to the value of `org-html-container-element',
-and have the id \"title-slide\"."
- :group 'org-export-s5
- :type 'string)
-
-(defun org-s5--format-toc-headline (headline info)
- "Return an appropriate table of contents entry for HEADLINE.
-Note that (currently) the S5 exporter does not support deep links,
-so the table of contents is not \"active\".
-INFO is a plist used as a communication channel."
- (let* ((headline-number (org-export-get-headline-number headline info))
- (section-number
- (and (not (org-export-low-level-p headline info))
- (org-export-numbered-headline-p headline info)
- (concat (mapconcat 'number-to-string headline-number ".") ".
")))
- (tags (and (eq (plist-get info :with-tags) t)
- (org-export-get-tags headline info))))
- (concat section-number
- (org-export-data
- (org-export-get-alt-title headline info) info)
- (and tags " ") (org-html--tags tags info))))
-
-(defun org-s5-toc (depth info)
- (let* ((headlines (org-export-collect-headlines info depth))
- (toc-entries
- (mapcar (lambda (headline)
- (cons (org-s5--format-toc-headline headline info)
- (org-export-get-relative-level headline info)))
- (org-export-collect-headlines info depth))))
- (when toc-entries
- (concat
- (format "<%s id='table-of-contents' class='slide'>\n"
- (plist-get info :html-container))
- (format "<h1>%s</h1>\n"
- (org-html--translate "Table of Contents" info))
- "<div id=\"text-table-of-contents\">"
- (org-html--toc-text toc-entries)
- "</div>\n"
- (format "</%s>\n" (plist-get info :html-container))))))
-
-(defun org-s5--build-head (info)
- (let* ((dir (plist-get info :s5-ui-url))
- (theme (or (plist-get info :s5-theme-file) "default/slides.css")))
- (mapconcat
- 'identity
- (list
- "<!-- style sheet links -->"
- (mapconcat
- (lambda (list)
- (format
- (concat
- "<link rel='stylesheet' href='%s/default/%s' type='text/css'"
- " media='%s' id='%s' />")
- dir (nth 0 list) (nth 1 list) (nth 2 list)))
- (list
- '("outline.css" "screen" "outlineStyle")
- '("print.css" "print" "slidePrint")
- '("opera.css" "projection" "operaFix")) "\n")
- (format (concat
- "<link rel='stylesheet' href='%s' type='text/css'"
- " media='screen' id='slideProj' />")
- (if (string-match-p "^\\(http\\|/\\)" theme) theme
- (concat dir "/" theme)))
- "<!-- S5 JS -->"
- (concat
- "<script src='" dir
- "/default/slides.js'></script>")) "\n")))
-
-(defun org-s5--build-meta-info (info)
- (concat
- (org-html--build-meta-info info)
- (format "<meta name=\"version\" content=\"S5 %s\" />\n"
- (plist-get info :s5-version))
- (format "<meta name='defaultView' content='%s' />\n"
- (plist-get info :s5-default-view))
- (format "<meta name='controlVis' content='%s' />"
- (plist-get info :s5-control-visibility))))
-
-(defun org-s5-headline (headline contents info)
- (let ((org-html-toplevel-hlevel 1)
- (class (or (org-element-property :HTML_CONTAINER_CLASS headline) ""))
- (level (org-export-get-relative-level headline info)))
- (when (and (= 1 level) (not (string-match-p "\\<slide\\>" class)))
- (org-element-put-property headline :HTML_CONTAINER_CLASS (concat class "
slide")))
- (org-html-headline headline contents info)))
-
-(defun org-s5-plain-list (plain-list contents info)
- "Transcode a PLAIN-LIST element from Org to HTML.
-CONTENTS is the contents of the list. INFO is a plist holding
-contextual information.
-If a containing headline has the property :INCREMENTAL,
-then the \"incremental\" class will be added to the to the list,
-which will make the list into a \"build\"."
- (let* ((type (org-element-property :type plain-list))
- (tag (case type
- (ordered "ol")
- (unordered "ul")
- (descriptive "dl"))))
- (format "%s\n%s%s"
- (format
- "<%s class='org-%s%s'>" tag tag
- (if (org-export-get-node-property :INCREMENTAL plain-list t)
- " incremental" ""))
- contents
- (format "</%s>" tag))))
-
-(defun org-s5-inner-template (contents info)
- "Return body of document string after HTML conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (concat contents "\n"))
-
-(defun org-s5-template (contents info)
- "Return complete document string after HTML conversion.
-CONTENTS is the transcoded contents string. INFO is a plist
-holding export options."
- (let ((info (plist-put
- (plist-put
- (plist-put info :html-preamble (plist-get info :s5-preamble))
- :html-postamble
- (plist-get info :s5-postamble))
- :html-divs
- (if (equal "li" (plist-get info :html-container))
- (cons '(content "ol" "content") org-s5--divs)
- org-s5--divs))))
- (mapconcat
- 'identity
- (list
- (org-html-doctype info)
- (format "<html xmlns=\"http://www.w3.org/1999/xhtml\"; lang=\"%s\"
xml:lang=\"%s\">"
- (plist-get info :language) (plist-get info :language))
- "<head>"
- (org-s5--build-meta-info info)
- (org-s5--build-head info)
- (org-html--build-head info)
- (org-html--build-mathjax-config info)
- "</head>"
- "<body>"
- "<div class=\"layout\">"
- "<div id=\"controls\"><!-- no edit --></div>"
- "<div id=\"currentSlide\"><!-- no edit --></div>"
- (org-html--build-pre/postamble 'preamble info)
- (org-html--build-pre/postamble 'postamble info)
- "</div>"
- (format "<%s id=\"%s\" class=\"presentation\">"
- (nth 1 (assq 'content org-html-divs))
- (nth 2 (assq 'content org-html-divs)))
- ;; title page
- (format "<%s id='title-slide' class='slide'>"
- (plist-get info :html-container))
- (format-spec org-s5-title-slide-template (org-html-format-spec info))
- (format "</%s>" (plist-get info :html-container))
- ;; table of contents.
- (let ((depth (plist-get info :with-toc)))
- (when depth (org-s5-toc depth info)))
- contents
- (format "</%s>" (nth 1 (assq 'content org-html-divs)))
- "</body>"
- "</html>\n") "\n")))
-
-(defun org-s5-export-as-html
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to an HTML 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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"<body>\" and \"</body>\" tags.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Export is done in a buffer named \"*Org S5 Export*\", which
-will be displayed when `org-export-show-temporary-export-buffer'
-is non-nil."
- (interactive)
- (org-export-to-buffer 's5 "*Org S5 Export*"
- async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
-
-(defun org-s5-export-to-html
- (&optional async subtreep visible-only body-only ext-plist)
- "Export current buffer to a S5 HTML 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.
-
-When optional argument BODY-ONLY is non-nil, only write code
-between \"<body>\" and \"</body>\" tags.
-
-EXT-PLIST, when provided, is a property list with external
-parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return output file's name."
- (interactive)
- (let* ((extension (concat "." org-html-extension))
- (file (org-export-output-file-name extension subtreep))
- (org-export-coding-system org-html-coding-system))
- (org-export-to-file 's5 file
- async subtreep visible-only body-only ext-plist)))
-
-(defun org-s5-publish-to-html (plist filename pub-dir)
- "Publish an org file to S5 HTML Presentation.
-
-FILENAME is the filename of the Org file to be published. PLIST
-is the property list for the given project. PUB-DIR is the
-publishing directory.
-
-Return output file name."
- (org-publish-org-to 's5 filename ".html" plist pub-dir))
-
-(provide 'ox-s5)
-
-;;; ox-s5.el ends here
diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el
deleted file mode 100644
index 50014d8..0000000
--- a/contrib/lisp/ox-taskjuggler.el
+++ /dev/null
@@ -1,1033 +0,0 @@
-;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine
-;;
-;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
-;;
-;; Emacs Lisp Archive Entry
-;; Filename: ox-taskjuggler.el
-;; Author: Christian Egli
-;; Nicolas Goaziou <n dot goaziou at gmail dot com>
-;; Maintainer: Christian Egli
-;; Keywords: org, taskjuggler, project planning
-;; Description: Converts an Org mode buffer into a TaskJuggler project plan
-
-;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; This library implements a TaskJuggler exporter for Org mode.
-;; TaskJuggler is a project planing tool that uses a text format to
-;; define projects, tasks and resources, so it is a natural fit for
-;; Org mode. It can produce all sorts of reports for tasks or
-;; resources in either HTML, CSV or PDF. TaskJuggler is implemented
-;; in Ruby and should therefore run on any platform.
-;;
-;; The exporter does not export all the nodes of a document or
-;; strictly follow the order of the nodes in the document.
-;;
-;; Instead the TaskJuggler exporter looks for a tree that defines the
-;; tasks and a optionally tree that defines the resources for this
-;; project. It then creates a TaskJuggler file based on these trees
-;; and the attributes defined in all the nodes.
-;;
-;; * Installation
-;;
-;; Put this file into your load-path and the following line into your
-;; ~/.emacs:
-;;
-;; (add-to-list 'org-export-backends 'taskjuggler)
-;;
-;; or customize `org-export-backends' variable.
-;;
-;; The interactive functions are the following:
-;;
-;; M-x `org-taskjuggler-export'
-;; M-x `org-taskjuggler-export-and-open'
-;;
-;; * Tasks
-;;
-;; Let's illustrate the usage with a small example. Create your tasks
-;; as you usually do with org-mode. Assign efforts to each task using
-;; properties (it's easiest to do this in the column view). You
-;; should end up with something similar to the example by Peter Jones
-;; in:
-;;
-;;
https://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
-;; `org-taskjuggler-project-tag' to). You are now ready to export the
-;; project plan with `org-taskjuggler-export-and-open' which will
-;; export the project plan and open a Gantt chart in TaskJugglerUI.
-;;
-;; * Resources
-;;
-;; Next you can define resources and assign those to work on specific
-;; tasks. You can group your resources hierarchically. Tag the top
-;; node of the resources with "taskjuggler_resource" (or whatever you
-;; customized `org-taskjuggler-resource-tag' to). You can optionally
-;; assign an identifier (named "resource_id") to the resources (using
-;; the standard org properties commands) or you can let the exporter
-;; generate identifiers automatically (the exporter picks the first
-;; word of the headline as the identifier as long as it is unique, see
-;; the documentation of `org-taskjuggler--build-unique-id'). Using that
-;; identifier you can then allocate resources to tasks. This is again
-;; done with the "allocate" property on the tasks. Do this in column
-;; view or when on the task type
-;;
-;; C-c C-x p allocate RET <resource_id> RET
-;;
-;; Once the allocations are done you can again export to TaskJuggler
-;; and check in the Resource Allocation Graph which person is working
-;; on what task at what time.
-;;
-;; * Export of properties
-;;
-;; The exporter also takes TODO state information into consideration,
-;; i.e. if a task is marked as done it will have the corresponding
-;; attribute in TaskJuggler ("complete 100"). Also it will export any
-;; property on a task resource or resource node which is known to
-;; TaskJuggler, such as limits, vacation, shift, booking, efficiency,
-;; journalentry, rate for resources or account, start, note, duration,
-;; end, journalentry, milestone, reference, responsible, scheduling,
-;; etc for tasks.
-;;
-;; * Dependencies
-;;
-;; The exporter will handle dependencies that are defined in the tasks
-;; either with the ORDERED attribute (see TODO dependencies in the Org
-;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
-;; alternatively with a depends attribute. Both the BLOCKER and the
-;; depends attribute can be either "previous-sibling" or a reference
-;; to an identifier (named "task_id") which is defined for another
-;; task in the project. BLOCKER and the depends attribute can define
-;; multiple dependencies separated by either space or comma. You can
-;; also specify optional attributes on the dependency by simply
-;; appending it. The following examples should illustrate this:
-;;
-;; * Training material
-;; :PROPERTIES:
-;; :task_id: training_material
-;; :ORDERED: t
-;; :END:
-;; ** Markup Guidelines
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :END:
-;; ** Workflow Guidelines
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :END:
-;; * Presentation
-;; :PROPERTIES:
-;; :Effort: 2d
-;; :BLOCKER: training_material { gapduration 1d } some_other_task
-;; :END:
-;;
-;;;; * TODO
-;; - Look at org-keyword-properties, org-global-properties and
-;; org-global-properties-fixed
-;; - What about property inheritance and org-property-inherit-p?
-;; - Use TYPE_TODO as an way to assign resources
-;; - Add support for org-export-with-planning
-;;
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'ox)
-
-
-
-;;; User Variables
-
-(defgroup org-export-taskjuggler nil
- "Options specific for TaskJuggler export back-end."
- :tag "Org Export TaskJuggler"
- :group 'org-export)
-
-(defcustom org-taskjuggler-extension ".tjp"
- "Extension of TaskJuggler files."
- :group 'org-export-taskjuggler
- :type 'string)
-
-(defcustom org-taskjuggler-project-tag "taskjuggler_project"
- "Tag marking project's tasks.
-This tag is used to find the tree containing all the tasks for
-the project."
- :group 'org-export-taskjuggler
- :type 'string)
-
-(defcustom org-taskjuggler-resource-tag "taskjuggler_resource"
- "Tag marking project's resources.
-This tag is used to find the tree containing all the resources
-for the project."
- :group 'org-export-taskjuggler
- :type 'string)
-
-(defcustom org-taskjuggler-report-tag "taskjuggler_report"
- "Tag marking project's reports.
-This tag is used to find the tree containing all the reports for
-the project."
- :group 'org-export-taskjuggler
- :type 'string)
-
-(defcustom org-taskjuggler-target-version 3.0
- "Which version of TaskJuggler the exporter is targeting.
-By default a project plan is exported which conforms to version
-3.x of TaskJuggler. For a project plan that is compatible with
-versions of TaskJuggler older than 3.0 set this to 2.4.
-
-If you change this variable be sure to also change
-`org-taskjuggler-default-reports' as the format of reports has
-changed considerably between version 2.x and 3.x of TaskJuggler"
- :group 'org-export-taskjuggler
- :type 'number)
-
-(defcustom org-taskjuggler-default-project-version "1.0"
- "Default version string for the project.
-This value can also be set with the \":VERSION:\" property
-associated to the headline defining the project."
- :group 'org-export-taskjuggler
- :type 'string)
-
-(defcustom org-taskjuggler-default-project-duration 280
- "Default project duration.
-The value will be used if no start and end date have been defined
-in the root node of the task tree, i.e. the tree that has been
-marked with `org-taskjuggler-project-tag'"
- :group 'org-export-taskjuggler
- :type 'integer)
-
-(defcustom org-taskjuggler-default-reports
- '("textreport report \"Plan\" {
- formats html
- header '== %title =='
-
- center -8<-
- [#Plan Plan] | [#Resource_Allocation Resource Allocation]
- ----
- === Plan ===
- <[report id=\"plan\"]>
- ----
- === Resource Allocation ===
- <[report id=\"resourceGraph\"]>
- ->8-
-}
-
-# A traditional Gantt chart with a project overview.
-taskreport plan \"\" {
- headline \"Project Plan\"
- columns bsi, name, start, end, effort, chart
- loadunit shortauto
- hideresource 1
-}
-
-# A graph showing resource allocation. It identifies whether each
-# resource is under- or over-allocated for.
-resourcereport resourceGraph \"\" {
- headline \"Resource Allocation Graph\"
- columns no, name, effort, weekly
- loadunit shortauto
- hidetask ~(isleaf() & isleaf_())
- sorttasks plan.start.up
-}")
- "Default reports for the project.
-These are sensible default reports to give a good out-of-the-box
-result when exporting without defining any reports. \"%title\"
-anywhere in the reports will be replaced with the document title.
-If you want to define your own reports you can change them here
-or simply define the default reports so that they include an
-external report definition as follows:
-
-include reports.tji
-
-These default are made to work with tj3. If you are targeting
-TaskJuggler 2.4 (see `org-taskjuggler-target-version') please
-change these defaults to something like the following:
-
-taskreport \"Gantt Chart\" {
- headline \"Project Gantt Chart\"
- columns hierarchindex, name, start, end, effort, duration, completed, chart
- timeformat \"%Y-%m-%d\"
- hideresource 1
- loadunit shortauto
-}
-
-resourcereport \"Resource Graph\" {
- headline \"Resource Allocation Graph\"
- columns no, name, utilization, freeload, chart
- loadunit shortauto
- sorttasks startup
- hidetask ~isleaf()
-}"
- :group 'org-export-taskjuggler
- :type '(repeat (string :tag "Report")))
-
-(defcustom org-taskjuggler-default-global-header ""
- "Default global header for the project.
-This goes before project declaration, and might be useful for
-early macros."
- :group 'org-export-taskjuggler
- :type '(string :tag "Preamble"))
-
-(defcustom org-taskjuggler-default-global-properties
- "shift s40 \"Part time shift\" {
- workinghours wed, thu, fri off
-}
-"
- "Default global properties for the project.
-
-Here you typically define global properties such as shifts,
-accounts, rates, vacation, macros and flags. Any property that
-is allowed within the TaskJuggler file can be inserted. You
-could for example include another TaskJuggler file.
-
-The global properties are inserted after the project declaration
-but before any resource and task declarations."
- :group 'org-export-taskjuggler
- :type '(string :tag "Preamble"))
-
-(defcustom org-taskjuggler-valid-task-attributes
- '(account start note duration endbuffer endcredit end
- flags journalentry length limits maxend maxstart minend
- minstart period reference responsible scheduling
- 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.
-
-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
- '(limits vacation shift booking efficiency journalentry rate
- workinghours flags)
- "Valid attributes for Taskjuggler resources.
-If one of these appears as a property for a headline, it will be
-exported with the corresponding resource."
- :group 'org-export-taskjuggler)
-
-(defcustom org-taskjuggler-valid-report-attributes
- '(headline columns definitions timeformat hideresource hidetask
- loadunit sorttasks formats period)
- "Valid attributes for Taskjuggler reports.
-If one of these appears as a property for a headline, it will be
-exported with the corresponding report."
- :group 'org-export-taskjuggler)
-
-(defcustom org-taskjuggler-process-command
- "tj3 --silent --no-color --output-dir %o %f"
- "Command to process a Taskjuggler file.
-The command will be given to the shell as a command to process a
-Taskjuggler file. \"%f\" in the command will be replaced by the
-full file name, \"%o\" by the reports directory (see
-`org-taskjuggler-reports-directory').
-
-If you are targeting Taskjuggler 2.4 (see
-`org-taskjuggler-target-version') this setting is ignored."
- :group 'org-export-taskjuggler)
-
-(defcustom org-taskjuggler-reports-directory "reports"
- "Default directory to generate the Taskjuggler reports in.
-The command `org-taskjuggler-process-command' generates the
-reports and associated files such as CSS inside this directory.
-
-If the directory is not an absolute path it is relative to the
-directory of the exported file. The directory is created if it
-doesn't exist.
-
-If you are targeting Taskjuggler 2.4 (see
-`org-taskjuggler-target-version') this setting is ignored."
- :group 'org-export-taskjuggler)
-
-(defcustom org-taskjuggler-keep-project-as-task t
- "Non-nil keeps the project headline as an umbrella task for all tasks.
-Setting this to nil will allow maintaining completely separated
-task buckets, while still sharing the same resources pool."
- :group 'org-export-taskjuggler
- :type 'boolean)
-
-
-
-;;; Hooks
-
-(defvar org-taskjuggler-final-hook nil
- "Hook run after a TaskJuggler files has been saved.
-This hook is run with the name of the file as argument.")
-
-
-
-;;; Back-End Definition
-
-(org-export-define-backend 'taskjuggler
- '((template . org-taskjuggler-project-plan))
- :menu-entry
- '(?J "Export to TaskJuggler"
- ((?j "As TJP file" (lambda (a s v b) (org-taskjuggler-export a s v)))
- (?p "As TJP file and process"
- (lambda (a s v b)
- (if a (org-taskjuggler-export a s v)
- (org-taskjuggler-export-and-process s v))))
- (?o "As TJP file, process and open"
- (lambda (a s v b)
- (if a (org-taskjuggler-export a s v)
- (org-taskjuggler-export-process-and-open s v))))))
- ;; This property will be used to store unique ids in communication
- ;; channel. Ids will be retrieved with `org-taskjuggler-get-id'.
- :options-alist '((:taskjuggler-unique-ids nil nil nil)))
-
-
-
-;;; Unique IDs
-
-(defun org-taskjuggler-assign-task-ids (tasks info)
- "Assign a unique ID to each task in TASKS.
-TASKS is a list of headlines. INFO is a plist used as a
-communication channel. Return value is an alist between
-headlines and their associated ID. IDs are hierarchical, which
-means they only need to be unique among the task siblings."
- (let* (alist
- build-id ; For byte-compiler.
- (build-id
- (lambda (tasks local-ids)
- (org-element-map tasks 'headline
- (lambda (task)
- (let ((id (org-taskjuggler--build-unique-id task local-ids)))
- (push id local-ids)
- (push (cons task id) alist)
- (funcall build-id (org-element-contents task) nil)))
- info nil 'headline))))
- (funcall build-id tasks nil)
- alist))
-
-(defun org-taskjuggler-assign-resource-ids (resources info)
- "Assign a unique ID to each resource within RESOURCES.
-RESOURCES is a list of headlines. INFO is a plist used as a
-communication channel. Return value is an alist between
-headlines and their associated ID."
- (let (ids)
- (org-element-map resources 'headline
- (lambda (resource)
- (let ((id (org-taskjuggler--build-unique-id resource ids)))
- (push id ids)
- (cons resource id)))
- info)))
-
-
-
-;;; Accessors
-
-(defun org-taskjuggler-get-project (info)
- "Return project in parse tree.
-INFO is a plist used as a communication channel. First headline
-in buffer with `org-taskjuggler-project-tag' defines the project.
-If no such task is defined, pick the first headline in buffer.
-If there is no headline at all, return nil."
- (let ((tree (plist-get info :parse-tree)))
- (or (org-element-map tree 'headline
- (lambda (hl)
- (and (member org-taskjuggler-project-tag
- (org-export-get-tags hl info))
- hl))
- info t)
- (org-element-map tree 'headline 'identity info t))))
-
-(defun org-taskjuggler-get-id (item info)
- "Return id for task or resource ITEM.
-ITEM is a headline. INFO is a plist used as a communication
-channel. Return value is a string."
- (cdr (assq item (plist-get info :taskjuggler-unique-ids))))
-
-(defun org-taskjuggler-get-name (item)
- "Return name for task or resource ITEM.
-ITEM is a headline. Return value is a string."
- ;; Quote double quotes in name.
- (replace-regexp-in-string
- "\"" "\\\"" (org-element-property :raw-value item) t t))
-
-(defun org-taskjuggler-get-start (item)
- "Return start date for task or resource ITEM.
-ITEM is a headline. Return value is a string or nil if ITEM
-doesn't have any start date defined."
- (let ((scheduled (org-element-property :scheduled item)))
- (or
- (and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))
- (and (memq 'start org-taskjuggler-valid-task-attributes)
- (org-element-property :START item)))))
-
-(defun org-taskjuggler-get-end (item)
- "Return end date for task or resource ITEM.
-ITEM is a headline. Return value is a string or nil if ITEM
-doesn't have any end date defined."
- (let ((deadline (org-element-property :deadline item)))
- (and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))))
-
-
-
-;;; Internal Functions
-
-(defun org-taskjuggler--indent-string (s)
- "Indent string S by 2 spaces.
-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 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
- (intern (upcase (format ":%s" attribute)))
- item)))
- (and value (format "%s %s\n" attribute value))))
- (remq nil attributes) ""))
-
-(defun org-taskjuggler--build-unique-id (item unique-ids)
- "Return a unique id for a given task or a resource.
-ITEM is an `headline' type element representing the task or
-resource. Its id is derived from its name and made unique
-against UNIQUE-IDS. If the (downcased) first token of the
-headline is not unique try to add more (downcased) tokens of the
-headline or finally add more underscore characters (\"_\")."
- (let ((id (org-string-nw-p (org-element-property :TASK_ID item))))
- ;; If an id is specified, use it, as long as it's unique.
- (if (and id (not (member id unique-ids))) id
- (let* ((parts (split-string (org-element-property :raw-value item)))
- (id (org-taskjuggler--clean-id (downcase (pop parts)))))
- ;; Try to add more parts of the headline to make it unique.
- (while (and (car parts) (member id unique-ids))
- (setq id (concat id "_"
- (org-taskjuggler--clean-id (downcase (pop parts))))))
- ;; If it's still not unique, add "_".
- (while (member id unique-ids)
- (setq id (concat id "_")))
- id))))
-
-(defun org-taskjuggler--clean-id (id)
- "Clean and return ID to make it acceptable for TaskJuggler.
-ID is a string."
- ;; Replace non-ascii by "_".
- (replace-regexp-in-string
- "[^a-zA-Z0-9_]" "_"
- ;; Make sure id doesn't start with a number.
- (replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id)))
-
-
-
-;;; Dependencies
-
-(defun org-taskjuggler-resolve-dependencies (task info)
- "Return a list of all tasks TASK depends on.
-TASK is a headline. INFO is a plist used as a communication
-channel."
- (let ((deps-ids
- ;; Get all dependencies specified in BLOCKER and DEPENDS task
- ;; properties. Clean options from them.
- (let ((deps (concat (org-element-property :BLOCKER task)
- (org-element-property :DEPENDS task))))
- (and deps
- (split-string (replace-regexp-in-string "{.*?}" "" deps)
- "[ ,]* +"))))
- depends)
- (when deps-ids
- ;; Find tasks with :task_id: property matching id in DEPS-IDS.
- ;; Add them to DEPENDS.
- (let* ((project (org-taskjuggler-get-project info))
- (tasks (if org-taskjuggler-keep-project-as-task project
- (org-element-contents project))))
- (setq depends
- (org-element-map tasks 'headline
- (lambda (task)
- (let ((task-id (or (org-element-property :TASK_ID task)
- (org-element-property :ID task))))
- (and task-id (member task-id deps-ids) task)))
- info)))
- ;; Check BLOCKER and DEPENDS properties. If "previous-sibling"
- ;; belongs to DEPS-ID, add it to DEPENDS.
- (when (and (member-ignore-case "previous-sibling" deps-ids)
- (not (org-export-first-sibling-p task info)))
- (let ((prev (org-export-get-previous-element task info)))
- (and (not (memq prev depends)) (push prev depends)))))
- ;; Check ORDERED status of parent.
- (let ((parent (org-export-get-parent task)))
- (when (and parent
- (org-element-property :ORDERED parent)
- (not (org-export-first-sibling-p task info)))
- (push (org-export-get-previous-element task info) depends)))
- ;; Return dependencies.
- depends))
-
-(defun org-taskjuggler-format-dependencies (dependencies task info)
- "Format DEPENDENCIES to match TaskJuggler syntax.
-DEPENDENCIES is list of dependencies for TASK, as returned by
-`org-taskjuggler-resolve-depedencies'. TASK is a headline.
-INFO is a plist used as a communication channel. Return value
-doesn't include leading \"depends\"."
- (let* ((dep-str (concat (org-element-property :BLOCKER task)
- " "
- (org-element-property :DEPENDS task)))
- (get-path
- (lambda (dep)
- ;; Return path to DEP relatively to TASK.
- (let ((parent (org-export-get-parent task))
- (exclamations 1)
- (option
- (let ((id (org-element-property :TASK_ID dep)))
- (and id
- (string-match (concat id " +\\({.*?}\\)") dep-str)
- (match-string-no-properties 1 dep-str))))
- path)
- ;; Compute number of exclamation marks by looking for the
- ;; common ancestor between TASK and DEP.
- (while (not (org-element-map parent 'headline
- (lambda (hl) (eq hl dep))))
- (incf exclamations)
- (setq parent (org-export-get-parent parent)))
- ;; Build path from DEP to PARENT.
- (while (not (eq parent dep))
- (push (org-taskjuggler-get-id dep info) path)
- (setq dep (org-export-get-parent dep)))
- ;; Return full path. Add dependency options, if any.
- (concat (make-string exclamations ?!)
- (mapconcat 'identity path ".")
- (and option (concat " " option)))))))
- ;; Return dependencies string, without the leading "depends".
- (mapconcat (lambda (dep) (funcall get-path dep)) dependencies ", ")))
-
-
-
-;;; Translator Functions
-
-(defun org-taskjuggler-project-plan (contents info)
- "Build TaskJuggler project plan.
-CONTENTS is ignored. INFO is a plist holding export options.
-Return complete project plan as a string in TaskJuggler syntax."
- (let* ((tree (plist-get info :parse-tree))
- (project (or (org-taskjuggler-get-project info)
- (error "No project specified"))))
- (concat
- ;; 1. Insert header.
- (org-element-normalize-string org-taskjuggler-default-global-header)
- ;; 2. Insert project.
- (org-taskjuggler--build-project project info)
- ;; 3. Insert global properties.
- (org-element-normalize-string org-taskjuggler-default-global-properties)
- ;; 4. Insert resources. Provide a default one if none is
- ;; specified.
- (let ((main-resources
- ;; Collect contents from various trees marked with
- ;; `org-taskjuggler-resource-tag'. Only gather top level
- ;; resources.
- (apply 'append
- (org-element-map tree 'headline
- (lambda (hl)
- (and (member org-taskjuggler-resource-tag
- (org-export-get-tags hl info))
- (org-element-map (org-element-contents hl)
'headline
- 'identity info nil 'headline)))
- info nil 'headline))))
- ;; Assign a unique ID to each resource. Store it under
- ;; `:taskjuggler-unique-ids' property in INFO.
- (setq info
- (plist-put info :taskjuggler-unique-ids
- (org-taskjuggler-assign-resource-ids
- main-resources info)))
- (concat
- (if main-resources
- (mapconcat
- (lambda (resource) (org-taskjuggler--build-resource resource
info))
- main-resources "")
- (format "resource %s \"%s\" {\n}\n" (user-login-name)
user-full-name))
- ;; 5. Insert tasks.
- (let ((main-tasks
- ;; If `org-taskjuggler-keep-project-as-task' is
- ;; non-nil, there is only one task. Otherwise, every
- ;; direct children of PROJECT is a top level task.
- (if org-taskjuggler-keep-project-as-task (list project)
- (or (org-element-map (org-element-contents project) 'headline
- 'identity info nil 'headline)
- (error "No task specified")))))
- ;; Assign a unique ID to each task. Add it to
- ;; `:taskjuggler-unique-ids' property in INFO.
- (setq info
- (plist-put info :taskjuggler-unique-ids
- (append
- (org-taskjuggler-assign-task-ids main-tasks info)
- (plist-get info :taskjuggler-unique-ids))))
- ;; If no resource is allocated among tasks, allocate one to
- ;; the first task.
- (unless (org-element-map main-tasks 'headline
- (lambda (task) (org-element-property :ALLOCATE task))
- info t)
- (org-element-put-property
- (car main-tasks) :ALLOCATE
- (or (org-taskjuggler-get-id (car main-resources) info)
- (user-login-name))))
- (mapconcat
- (lambda (task) (org-taskjuggler--build-task task info))
- main-tasks ""))
- ;; 6. Insert reports. If no report is defined, insert default
- ;; reports.
- (let ((main-reports
- ;; Collect contents from various trees marked with
- ;; `org-taskjuggler-report-tag'. Only gather top level
- ;; reports.
- (apply 'append
- (org-element-map tree 'headline
- (lambda (hl)
- (and (member org-taskjuggler-report-tag
- (org-export-get-tags hl info))
- (org-element-map (org-element-contents hl)
- 'headline 'identity info nil 'headline)))
- info nil 'headline))))
- (if main-reports
- (mapconcat
- (lambda (report) (org-taskjuggler--build-report report info))
- main-reports "")
- ;; insert title in default reports
- (let* ((title (org-export-data (plist-get info :title) info))
- (report-title (if (string= title "")
- (org-taskjuggler-get-name project)
- title)))
- (mapconcat
- 'org-element-normalize-string
- (mapcar
- (lambda (report)
- (replace-regexp-in-string "%title" report-title report t t))
- org-taskjuggler-default-reports) "")))))))))
-
-(defun org-taskjuggler--build-project (project info)
- "Return a project declaration.
-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."
- (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.
-
-RESOURCE is a headline. INFO is a plist used as a communication
-channel.
-
-All valid attributes from RESOURCE are inserted. If RESOURCE
-defines a property \"resource_id\" it will be used as the id for
-this resource. Otherwise it will use the ID property. If
-neither is defined a unique id will be associated to it."
- (concat
- ;; Opening resource.
- (format "resource %s \"%s\" {\n"
- (org-taskjuggler--clean-id
- (or (org-element-property :RESOURCE_ID resource)
- (org-element-property :ID resource)
- (org-taskjuggler-get-id resource info)))
- (org-taskjuggler-get-name resource))
- ;; Add attributes.
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- resource org-taskjuggler-valid-resource-attributes))
- ;; Add inner resources.
- (org-taskjuggler--indent-string
- (mapconcat
- 'identity
- (org-element-map (org-element-contents resource) 'headline
- (lambda (hl) (org-taskjuggler--build-resource hl info))
- info nil 'headline)
- ""))
- ;; Closing resource.
- "}\n"))
-
-(defun org-taskjuggler--build-report (report info)
- "Return a report declaration.
-REPORT is a headline. INFO is a plist used as a communication
-channel."
- (concat
- ;; Opening report.
- (format "%s \"%s\" {\n"
- (or (org-element-property :REPORT_KIND report) "taskreport")
- (org-taskjuggler-get-name report))
- ;; Add attributes.
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- report org-taskjuggler-valid-report-attributes))
- ;; Add inner reports.
- (org-taskjuggler--indent-string
- (mapconcat
- 'identity
- (org-element-map (org-element-contents report) 'headline
- (lambda (hl) (org-taskjuggler--build-report hl info))
- info nil 'headline)
- ""))
- ;; Closing report.
- "}\n"))
-
-(defun org-taskjuggler--build-task (task info)
- "Return a task declaration.
-
-TASK is a headline. INFO is a plist used as a communication
-channel.
-
-All valid attributes from TASK are inserted. If TASK defines
-a property \"task_id\" it will be used as the id for this task.
-Otherwise it will use the ID property. If neither is defined
-a unique id will be associated to it."
- (let* ((allocate (org-element-property :ALLOCATE task))
- (complete
- (if (eq (org-element-property :todo-type task) 'done) "100"
- (org-element-property :COMPLETE task)))
- (depends (org-taskjuggler-resolve-dependencies task info))
- (effort (let ((property
- (intern (concat ":" (upcase org-effort-property)))))
- (org-element-property property task)))
- (milestone
- (or (org-element-property :MILESTONE task)
- (not (or (org-element-map (org-element-contents task) 'headline
- 'identity info t) ; Has task any child?
- effort
- (org-element-property :LENGTH task)
- (org-element-property :DURATION task)
- (and (org-taskjuggler-get-start task)
- (org-taskjuggler-get-end task))
- (org-element-property :PERIOD task)))))
- (priority
- (let ((pri (org-element-property :priority task)))
- (and pri
- (max 1 (/ (* 1000 (- org-priority-lowest pri))
- (- org-priority-lowest org-priority-highest)))))))
- (concat
- ;; Opening task.
- (format "task %s \"%s\" {\n"
- (org-taskjuggler-get-id task info)
- (org-taskjuggler-get-name task))
- ;; Add default attributes.
- (and depends
- (format " depends %s\n"
- (org-taskjuggler-format-dependencies depends task info)))
- (and allocate
- (format " purge %s\n allocate %s\n"
- ;; Compatibility for previous TaskJuggler versions.
- (if (>= org-taskjuggler-target-version 3.0) "allocate"
- "allocations")
- allocate))
- (and complete (format " complete %s\n" complete))
- (and effort (format " effort %s\n" effort))
- (and priority (format " priority %s\n" priority))
- (and milestone " milestone\n")
- ;; Add other valid attributes.
- (org-taskjuggler--indent-string
- (org-taskjuggler--build-attributes
- task org-taskjuggler-valid-task-attributes))
- ;; Add inner tasks.
- (org-taskjuggler--indent-string
- (mapconcat 'identity
- (org-element-map (org-element-contents task) 'headline
- (lambda (hl) (org-taskjuggler--build-task hl info))
- info nil 'headline)
- ""))
- ;; Closing task.
- "}\n")))
-
-
-
-;;; Interactive Functions
-
-;;;###autoload
-(defun org-taskjuggler-export (&optional async subtreep visible-only)
- "Export current buffer to a TaskJuggler file.
-
-The exporter looks for a tree with tag that matches
-`org-taskjuggler-project-tag' and takes this as the tasks for
-this project. The first node of this tree defines the project
-properties such as project name and project period.
-
-If there is a tree with tag that matches
-`org-taskjuggler-resource-tag' this tree is taken as resources
-for the project. If no resources are specified, a default
-resource is created and allocated to the project.
-
-Also the TaskJuggler project will be created with default reports
-as defined in `org-taskjuggler-default-reports'.
-
-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 org-taskjuggler-extension subtreep)))
- (org-export-to-file 'taskjuggler outfile
- async subtreep visible-only nil nil
- (lambda (file)
- (run-hook-with-args 'org-taskjuggler-final-hook file) nil))))
-
-;;;###autoload
-(defun org-taskjuggler-export-and-process (&optional subtreep visible-only)
- "Export current buffer to a TaskJuggler file and process it.
-
-The exporter looks for a tree with tag that matches
-`org-taskjuggler-project-tag' and takes this as the tasks for
-this project. The first node of this tree defines the project
-properties such as project name and project period.
-
-If there is a tree with tag that matches
-`org-taskjuggler-resource-tag' this tree is taken as resources
-for the project. If no resources are specified, a default
-resource is created and allocated to the project.
-
-Also the TaskJuggler project will be created with default reports
-as defined in `org-taskjuggler-default-reports'.
-
-If narrowing is active in the current buffer, only export its
-narrowed part.
-
-If a region is active, export that region.
-
-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 a list of reports."
- (interactive)
- (let ((file (org-taskjuggler-export nil subtreep visible-only)))
- (org-taskjuggler-compile file)))
-
-;;;###autoload
-(defun org-taskjuggler-export-process-and-open (&optional subtreep
visible-only)
- "Export current buffer to a TaskJuggler file, process and open it.
-
-Export and process the file using
-`org-taskjuggler-export-and-process' and open the generated
-reports with a browser.
-
-If you are targeting TaskJuggler 2.4 (see
-`org-taskjuggler-target-version') the processing and display of
-the reports is done using the TaskJuggler GUI."
- (interactive)
- (if (< org-taskjuggler-target-version 3.0)
- (let* ((process-name "TaskJugglerUI")
- (command
- (concat process-name " "
- (org-taskjuggler-export nil subtreep visible-only))))
- (start-process-shell-command process-name nil command))
- (dolist (report (org-taskjuggler-export-and-process subtreep visible-only))
- (org-open-file report))))
-
-(defun org-taskjuggler-compile (file)
- "Compile a TaskJuggler file.
-
-FILE is the name of the file being compiled. Processing is done
-through the command given in `org-taskjuggler-process-command'.
-
-Return a list of reports."
- (let* ((full-name (file-truename file))
- (out-dir
- (expand-file-name
- org-taskjuggler-reports-directory (file-name-directory file)))
- errors)
- (message (format "Processing TaskJuggler file %s..." file))
- (save-window-excursion
- (let ((outbuf (get-buffer-create "*Org Taskjuggler Output*")))
- (unless (file-directory-p out-dir)
- (make-directory out-dir t))
- (with-current-buffer outbuf (erase-buffer))
- (shell-command
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir)
- org-taskjuggler-process-command t t) t t) outbuf)
- ;; Collect standard errors from output buffer.
- (setq errors (org-taskjuggler--collect-errors outbuf)))
- (if (not errors)
- (message "Process completed.")
- (error (format "TaskJuggler failed with errors: %s" errors))))
- (file-expand-wildcards (format "%s/*.html" out-dir))))
-
-(defun org-taskjuggler--collect-errors (buffer)
- "Collect some kind of errors from \"tj3\" command output.
-
-BUFFER is the buffer containing output.
-
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t)
- (errors ""))
- (while (re-search-forward "^.+:[0-9]+: \\(.*\\)$" nil t)
- (setq errors (concat errors " " (match-string 1))))
- (and (org-string-nw-p errors) (org-trim errors))))))
-
-
-(provide 'ox-taskjuggler)
-
-;; Local variables:
-;; sentence-end-double-space: t
-;; End:
-
-;;; ox-taskjuggler.el ends here
diff --git a/contrib/scripts/.gitignore b/contrib/scripts/.gitignore
deleted file mode 100644
index 20d5925..0000000
--- a/contrib/scripts/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-plantuml.jar
diff --git a/contrib/scripts/StartOzServer.oz b/contrib/scripts/StartOzServer.oz
deleted file mode 100644
index 79b86a8..0000000
--- a/contrib/scripts/StartOzServer.oz
+++ /dev/null
@@ -1,231 +0,0 @@
-%%% *************************************************************
-%%% Copyright (C) 2009-2013 Torsten Anders (www.torsten-anders.de)
-%%% This program is free software; you can redistribute it and/or
-%%% modify it under the terms of the GNU General Public License
-%%% as published by the Free Software Foundation; either version 2
-%%% of the License, or (at your option) any later version.
-%%% This program is distributed in the hope that it will be useful,
-%%% but WITHOUT ANY WARRANTY; without even the implied warranty of
-%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-%%% GNU General Public License for more details.
-%%% *************************************************************
-
-%%
-%% This code implements the Oz-side of the Org-babel Oz interface. It
-%% creates a socket server (to which org-babel-oz.el then
-%% connects). Any input to this socket must be an Oz expression. The
-%% input is fed to the OPI oz compiler, and the results are send back
-%% via the socket.
-%%
-
-
-declare
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Accessing the OPI compiler
-%%
-
-MyCompiler = Emacs.condSend.compiler
-
-
-/* % testing
-
-%% Feed an expression (result browsed)
-{MyCompiler enqueue(setSwitch(expression true))}
-{Browse
- {MyCompiler enqueue(feedVirtualString("1 + 2" return(result: $)))}}
-{MyCompiler enqueue(setSwitch(expression false))}
-
-%% It is really the OPI: I can use declare!
-{MyCompiler enqueue(setSwitch(expression false))}
-{MyCompiler enqueue(feedVirtualString("declare X=3\n{Browse X*X}"))}
-
-%% Note: expressions starting with keyword declare need keyword in
-{MyCompiler enqueue(setSwitch(expression true))}
-{Browse
- {MyCompiler enqueue(feedVirtualString("declare X=3\nin X*X" return(result:
$)))}}
-{MyCompiler enqueue(setSwitch(expression false))}
-
-%% Alternatively you use a session with multiple feeds: first declare
(statement), and then feed an expression
-{MyCompiler enqueue(setSwitch(expression false))}
-{MyCompiler enqueue(feedVirtualString("declare X=7" return))}
-{MyCompiler enqueue(setSwitch(expression true))}
-{Browse
- {MyCompiler enqueue(feedVirtualString("X*X" return(result: $)))}}
-{MyCompiler enqueue(setSwitch(expression false))}
-
-%% !!?? does not work?
-%% return nil in case of any error (division by 0)
-{MyCompiler enqueue(setSwitch(expression true))}
-{Browse
- {MyCompiler enqueue(feedVirtualString(
- {Accum ["try\n"
-% "skip\n" % do something in any case..
- "1 div 0" % my code
-% "1" % my code
- "\ncatch E then {Error.printException
E}\n"
- "error\n" % always return nil
- "end\n"]
- List.append}
- return(result: $)))}}
-{MyCompiler enqueue(setSwitch(expression false))}
-
-
-%% !! catching some exceptions does not work??
-
-%% exception is not caught
-try {Bla} catch E then {Error.printException E} {Browse nil} end
-
-%% exception is caught
-try {Browse 1 div 0} catch E then {Error.printException E} {Browse nil} end
-{Browse ok}
-
-
-*/
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Socket interface
-%%
-
-
-%%
-%% Create socket
-%%
-
-MyPort = 6001
-
-/** %% Creates a TCP socket server. Expects a Host (e.g., 'localhost') and a
PortNo and returns a server plus its corresponding client. This client is an
instance of Open.socket, and is the interface for reading and writing into the
socket.
-%% MakeServer blocks until the server listens. However, waiting until a
connection has been accepted happens in its own thread (i.e. MakeServer does
only block until the server listens).
-%% NB: A port can be used only once, so assign it carefully. In case this
postnnumber was shortly used before, you may need to wait a bit before reusing
it.
-%% */
-%% !! Alternatively, let it assign automatically and output the port number..
-%%
-%% NOTE: for supporting multiple connections see
http://www.mozart-oz.org/documentation/op/node13.html#section.sockets.accept
-proc {MakeServer Host PortNo ?MyServer ?MyClient}
- proc {Accept MyClient}
- thread H in % P
- %% suspends until a connection has been accepted
- {MyServer accept(host:H
- acceptClass:Open.socket
- accepted:?MyClient)}
-% {Myserver accept(host:H port:P)} % suspends until a connection has
been accepted
- %% !!?? port number of client is usually created randomly..
- {System.showInfo "% connection accepted from host "#H}
- end
- %% !!???
- %% If Accept is called recursively, then server accepts multiple
connections. These share the same compiler instance (e.g. variable bindings are
shared). For multiple independent compiler instances call the OzServer
application multiple times.
- %% However, how shall the output for multiple connections be sorted??
Would using the different client sockets created with the Server accept method
work?
- %% NB: The number of clients accepted concurrently must be limited to
the number set by {MyServer listen}
- % {Accept}
- end
-in
- MyServer = {New Open.socket init}
- %% To avoid problems with portnumbers, the port could be assigned
automatically and then output..
- %%{MyServer bind(port:PortNo)}
- {MyServer bind(host:Host takePort:PortNo)}
- {MyServer listen}
- {System.showInfo "% OzServer started at host "#Host#" and port "#PortNo}
- MyClient = {Accept}
-end
-%%
-MySocket = {MakeServer localhost MyPort _/*MyServer*/}
-
-
-%%
-%% Read socket input
-%%
-
-declare
-%% Copied from OzServer/source/Socket.oz
-local
- proc {Aux Socket Size Stream}
- In = {Socket read(list:$
- size:Size)}
- in
- {Wait In}
- %% !! Is this the right way to stop the processing??
- %%
- %% abort condition when client stream ended (i.e. nothing was sent)
- if In == nil
- then {System.showInfo "socket stream ended"}
- Stream = nil
- else Stream = In | {Aux Socket Size}
- end
- end
-in
- /** %% The socket Server returns a stream of the strings it receives. The
Server always waits until someone writes something into the socket, then the
input is immediately written to a stream and the Server waits again.
- %% */
- proc {ReadToStream Socket Size Xs}
- thread {Aux Socket Size Xs} end
- end
-end
-
-/* % test
-
-MyStream = {ReadToStream MySocket 1024}
-
-*/
-
-/* % test
-
-%% writing
-{MySocket write(vs:"this is a test")}
-
-*/
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Send socket input to compiler and send results back to socket
-%%
-
-%% NOTE: Input code must be expression
-thread
- {ForAll {ReadToStream MySocket 1024}
- proc {$ Code}
- Result
- %% Catch any exception (so the will not cause blocking) and return nil
in that case
- FullCode = {Accum ["try\n"
-% "skip\n" % do something in any case..
- Code
- "\ncatch E then {Error.printException E}\n"
- "error\n" % in case of an error, return
'error'
- "end\n"]
- List.append}
- in
- %% ?? Should I make setting switches etc atomic?
- {MyCompiler enqueue(setSwitch(expression true))}
- {MyCompiler enqueue(feedVirtualString(FullCode return(result:
?Result)))}
- {MyCompiler enqueue(setSwitch(expression false))}
- %%
- {Wait Result}
- {MySocket write(vs: if {VirtualString.is Result}
- then Result
- else {Value.toVirtualString Result 1000 1000}
- end)}
- {Show 'Org-babel result: '#Result}
- end}
-end
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%
-%% Aux defs
-%%
-
-/** %% Binds the accumulation of the binary function Fn on all neighbors in Xs
to Y. E.g., Accum returns the sum in Xs if Fn is Number.'+'.
-%% */
-proc {Accum Xs Fn Y}
- {List.foldL Xs.2 Fn Xs.1 Y}
-end
-
-
-
-
-
-
-
diff --git a/contrib/scripts/dir2org.zsh b/contrib/scripts/dir2org.zsh
deleted file mode 100755
index f91ff17..0000000
--- a/contrib/scripts/dir2org.zsh
+++ /dev/null
@@ -1,56 +0,0 @@
-#!/usr/bin/env zsh
-
-# desc:
-#
-# Output an org compatible structure representing the filesystem from
-# the point passed on the command line (or . by default).
-#
-# options:
-# none
-#
-# usage:
-# dir2org.zsh [DIR]...
-#
-# author:
-# Phil Jackson (phil@shellarchive.co.uk)
-
-set -e
-
-function headline {
- local depth="${1}"
- local text="${2}"
-
- printf "%${depth}s %s" "" | tr ' ' '*'
- echo " ${text}"
-}
-
-function scan_and_populate {
- local depth="${1}"
- local dir="${2}"
-
- headline ${depth} "${dir}"
-
- # if there is no files in dir then just move on
- [[ $(ls "${dir}" | wc -l) -eq 0 ]] && return
-
- (( depth += 1 ))
-
- for f in $(ls -d "${dir}"/*); do
- if [ -d "${f}" ]; then
- scan_and_populate ${depth} "${f}"
- else
- headline ${depth} "[[file://${f}][${${f##*/}%.*}]]"
- fi
- done
-
- (( depth -= 1 ))
-}
-
-function main {
- local scan_dir="${1:-$(pwd)}"
- local depth=0
-
- scan_and_populate ${depth} "${scan_dir}"
-}
-
-main "${@}"
diff --git a/contrib/scripts/ditaa.jar b/contrib/scripts/ditaa.jar
deleted file mode 100644
index 5894de4..0000000
Binary files a/contrib/scripts/ditaa.jar and /dev/null differ
diff --git a/contrib/scripts/docco.css b/contrib/scripts/docco.css
deleted file mode 100644
index 9030b6c..0000000
--- a/contrib/scripts/docco.css
+++ /dev/null
@@ -1,185 +0,0 @@
-/*--------------------- Layout and Typography ----------------------------*/
-body {
- font-family: 'Palatino Linotype', 'Book Antiqua', Palatino, FreeSerif, serif;
- font-size: 15px;
- line-height: 22px;
- color: #252519;
- margin: 0; padding: 0;
-}
-a {
- color: #261a3b;
-}
- a:visited {
- color: #261a3b;
- }
-p {
- margin: 0 0 15px 0;
-}
-h1, h2, h3, h4, h5, h6 {
- margin: 0px 0 15px 0;
-}
- h1 {
- margin-top: 40px;
- }
-#container {
- position: relative;
-}
-#background {
- position: fixed;
- top: 0; left: 525px; right: 0; bottom: 0;
- background: #f5f5ff;
- border-left: 1px solid #e5e5ee;
- z-index: -1;
-}
-#jump_to, #jump_page {
- background: white;
- -webkit-box-shadow: 0 0 25px #777; -moz-box-shadow: 0 0 25px #777;
- -webkit-border-bottom-left-radius: 5px; -moz-border-radius-bottomleft: 5px;
- font: 10px Arial;
- text-transform: uppercase;
- cursor: pointer;
- text-align: right;
-}
-#jump_to, #jump_wrapper {
- position: fixed;
- right: 0; top: 0;
- padding: 5px 10px;
-}
- #jump_wrapper {
- padding: 0;
- display: none;
- }
- #jump_to:hover #jump_wrapper {
- display: block;
- }
- #jump_page {
- padding: 5px 0 3px;
- margin: 0 0 25px 25px;
- }
- #jump_page .source {
- display: block;
- padding: 5px 10px;
- text-decoration: none;
- border-top: 1px solid #eee;
- }
- #jump_page .source:hover {
- background: #f5f5ff;
- }
- #jump_page .source:first-child {
- }
-table td {
- border: 0;
- outline: 0;
-}
- td.docs, th.docs {
- max-width: 450px;
- min-width: 450px;
- min-height: 5px;
- padding: 10px 25px 1px 50px;
- overflow-x: hidden;
- vertical-align: top;
- text-align: left;
- }
- .docs pre {
- margin: 15px 0 15px;
- padding-left: 15px;
- }
- .docs p tt, .docs p code {
- background: #f8f8ff;
- border: 1px solid #dedede;
- font-size: 12px;
- padding: 0 0.2em;
- }
- .pilwrap {
- position: relative;
- }
- .pilcrow {
- font: 12px Arial;
- text-decoration: none;
- color: #454545;
- position: absolute;
- top: 3px; left: -20px;
- padding: 1px 2px;
- opacity: 0;
- -webkit-transition: opacity 0.2s linear;
- }
- td.docs:hover .pilcrow {
- opacity: 1;
- }
- td.code, th.code {
- padding: 14px 15px 16px 25px;
- width: 100%;
- vertical-align: top;
- border-left: 1px solid #e5e5ee;
- }
- pre, tt, code {
- font-size: 12px; line-height: 18px;
- font-family: Menlo, Monaco, Consolas, "Lucida Console", monospace;
- margin: 0; padding: 0;
- }
-
-
-/*---------------------- Syntax Highlighting -----------------------------*/
-td.linenos { background-color: #f0f0f0; padding-right: 10px; }
-span.lineno { background-color: #f0f0f0; padding: 0 5px 0 5px; }
-body .hll { background-color: #ffffcc }
-body .c { color: #408080; font-style: italic } /* Comment */
-body .err { border: 1px solid #FF0000 } /* Error */
-body .k { color: #954121 } /* Keyword */
-body .o { color: #666666 } /* Operator */
-body .cm { color: #408080; font-style: italic } /* Comment.Multiline */
-body .cp { color: #BC7A00 } /* Comment.Preproc */
-body .c1 { color: #408080; font-style: italic } /* Comment.Single */
-body .cs { color: #408080; font-style: italic } /* Comment.Special */
-body .gd { color: #A00000 } /* Generic.Deleted */
-body .ge { font-style: italic } /* Generic.Emph */
-body .gr { color: #FF0000 } /* Generic.Error */
-body .gh { color: #000080; font-weight: bold } /* Generic.Heading */
-body .gi { color: #00A000 } /* Generic.Inserted */
-body .go { color: #808080 } /* Generic.Output */
-body .gp { color: #000080; font-weight: bold } /* Generic.Prompt */
-body .gs { font-weight: bold } /* Generic.Strong */
-body .gu { color: #800080; font-weight: bold } /* Generic.Subheading */
-body .gt { color: #0040D0 } /* Generic.Traceback */
-body .kc { color: #954121 } /* Keyword.Constant */
-body .kd { color: #954121; font-weight: bold } /* Keyword.Declaration */
-body .kn { color: #954121; font-weight: bold } /* Keyword.Namespace */
-body .kp { color: #954121 } /* Keyword.Pseudo */
-body .kr { color: #954121; font-weight: bold } /* Keyword.Reserved */
-body .kt { color: #B00040 } /* Keyword.Type */
-body .m { color: #666666 } /* Literal.Number */
-body .s { color: #219161 } /* Literal.String */
-body .na { color: #7D9029 } /* Name.Attribute */
-body .nb { color: #954121 } /* Name.Builtin */
-body .nc { color: #0000FF; font-weight: bold } /* Name.Class */
-body .no { color: #880000 } /* Name.Constant */
-body .nd { color: #AA22FF } /* Name.Decorator */
-body .ni { color: #999999; font-weight: bold } /* Name.Entity */
-body .ne { color: #D2413A; font-weight: bold } /* Name.Exception */
-body .nf { color: #0000FF } /* Name.Function */
-body .nl { color: #A0A000 } /* Name.Label */
-body .nn { color: #0000FF; font-weight: bold } /* Name.Namespace */
-body .nt { color: #954121; font-weight: bold } /* Name.Tag */
-body .nv { color: #19469D } /* Name.Variable */
-body .ow { color: #AA22FF; font-weight: bold } /* Operator.Word */
-body .w { color: #bbbbbb } /* Text.Whitespace */
-body .mf { color: #666666 } /* Literal.Number.Float */
-body .mh { color: #666666 } /* Literal.Number.Hex */
-body .mi { color: #666666 } /* Literal.Number.Integer */
-body .mo { color: #666666 } /* Literal.Number.Oct */
-body .sb { color: #219161 } /* Literal.String.Backtick */
-body .sc { color: #219161 } /* Literal.String.Char */
-body .sd { color: #219161; font-style: italic } /* Literal.String.Doc */
-body .s2 { color: #219161 } /* Literal.String.Double */
-body .se { color: #BB6622; font-weight: bold } /* Literal.String.Escape */
-body .sh { color: #219161 } /* Literal.String.Heredoc */
-body .si { color: #BB6688; font-weight: bold } /* Literal.String.Interpol */
-body .sx { color: #954121 } /* Literal.String.Other */
-body .sr { color: #BB6688 } /* Literal.String.Regex */
-body .s1 { color: #219161 } /* Literal.String.Single */
-body .ss { color: #19469D } /* Literal.String.Symbol */
-body .bp { color: #954121 } /* Name.Builtin.Pseudo */
-body .vc { color: #19469D } /* Name.Variable.Class */
-body .vg { color: #19469D } /* Name.Variable.Global */
-body .vi { color: #19469D } /* Name.Variable.Instance */
-body .il { color: #666666 } /* Literal.Number.Integer.Long
*/
\ No newline at end of file
diff --git a/contrib/scripts/org-docco.org b/contrib/scripts/org-docco.org
deleted file mode 100644
index ed8714f..0000000
--- a/contrib/scripts/org-docco.org
+++ /dev/null
@@ -1,206 +0,0 @@
-#+Title: Org-Docco
-#+Author: Eric Schulte
-#+Style: <link rel="stylesheet" href="docco.css" type="text/css">
-#+Property: tangle yes
-
-The =docco= tool (see https://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
[[https://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.
-
-The way this works is an Org-mode document with embedded code blocks
-is exported to html using the standard Org-mode export functions.
-This file defines a new function named =org-docco-buffer= which, when
-added to the =org-export-html-final-hook=, will be run automatically
-as part of the Org-mod export process doccoizing your Org-mode
-document.
-
-A pure source code file can be extracted (or "/tangled/") from the
-Org-mode document using the normal =org-babel-tangle= function. See
-[[https://orgmode.org/manual/Working-With-Source-Code.html][Working With
Source Code]] chapter of the Org-mode manual for more
-information on using code blocks in Org-mode files.
-
-*Disclaimer*: this currently only works on /very/ simple Org-mode
-files which have no headings but rather are just a collection of
-alternating text and code blocks. It wouldn't be difficult to
-generalize the following code so that it could be run in particular
-sub-trees but I simply don't have the time to do so myself, and this
-version perfectly satisfies my own limit needs. I make no promises to
-support this code moving forward. /Caveat Emptor/
-
-#+begin_src emacs-lisp :padline no
-;;; org-docco.el --- docco type html generation from Org-mode
-
-;; Copyright (C) 2012 Eric Schulte
-
-;; Author: Eric Schulte
-;; Keywords: org-mode, literate programming, html
-;; Homepage: https://orgmode.org/worg/org-contrib/org-mime.php
-;; Version: 0.01
-
-;; This file is not part of GNU Emacs.
-
-;;; License:
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; <- look over there
-#+end_src
-
-The =cl= package provides all of the state-changing functions used
-below e.g., =push= and =incf=. It looks like a namespace-safe version
-of =cl= may soon be permissible for use in official Emacs packages.
-#+begin_src emacs-lisp
-;;; Code:
-(require 'cl)
-#+end_src
-
-This is a function which returns the buffer positions of matching
-regular expressions. It has two special features...
-1. It only counts matched instances of =beg-re= and =end-re= which are
- properly nested, so for example if =beg-re= and =end-re= are set to
- =(= and =)= respectively and we run this against the following,
- : 1 2 3 4 5 6
- : | | | | | |
- : v v v v v v
- : (foo (bar baz) (qux) quux)
- it will return 1 and 6 rather than 1 and 3.
-2. It uses
[[www.gnu.org/s/emacs/manual/html_node/elisp/Markers.html][markers]] which save
their position in a buffer even as the
- buffer is changed (e.g., by me adding in extra HTML text).
-#+begin_src emacs-lisp
-(defun org-docco-balanced-re (beg-re end-re)
- "Return the beginning and of a balanced regexp."
- (save-excursion
- (save-match-data
- (let ((both-re (concat "\\(" beg-re "\\|" end-re "\\)"))
- (beg-count 0) (end-count 0)
- beg end)
- (when (re-search-forward beg-re nil t)
- (goto-char (match-beginning 0))
- (setq beg (point-marker))
- (incf beg-count)
- (goto-char (match-end 0))
- (while (and (not end) (re-search-forward both-re nil t))
- (goto-char (match-beginning 0))
- (cond ((looking-at beg-re) (incf beg-count))
- ((looking-at end-re) (incf end-count))
- (:otherwise (error "miss-matched")))
- (goto-char (match-end 0))
- (when (= beg-count end-count) (setq end (point-marker))))
- (when end (cons beg end)))))))
-#+end_src
-
-This ugly large function does the actual conversion. It wraps the
-entire main content =div= of the exported Org-mode html into a single
-large table. Each row of the table has documentation on the left side
-and code on the right side. This function has two parts.
-1. We use =(org-docco-balanced-re "<div" "</div>")= to find the
- beginning and end of the main content div. We then break up this
- div at =<pre></pre>= boundaries with multiple calls to
- =(org-docco-balanced-re "<pre class\"src" "</pre>")=.
-2. With all documentation/code boundaries in hand we step through the
- buffer inserting the table html code at boundary locations.
-#+begin_src emacs-lisp
-(defun org-docco-buffer ()
- "Call from within an HTML buffer to doccoize it."
- (interactive)
- (let ((table-start "<table>\n")
- (doc-row-start "<tr><th class=\"docs\">\n") (doc-row-end "</th>\n")
- (code-row-start " <td class=\"code\">\n") (code-row-end
"</td></tr>\n")
- (table-end "</table>" )
- pair transition-points next)
- (save-excursion
- (save-match-data
- (goto-char (point-min))
- (when (re-search-forward "<div id=\"content\">" nil t)
- (goto-char (match-end 0))
- (push (point-marker) transition-points)
- (goto-char (match-beginning 0))
- (setq pair (org-docco-balanced-re "<div" "</div>"))
- (while (setq next (org-docco-balanced-re "<pre class=\"src"
"</pre>"))
- (goto-char (cdr next))
- (push (car next) transition-points)
- (push (cdr next) transition-points))
- (goto-char (cdr pair))
- (push (and (re-search-backward "</div>" nil t) (point-marker))
- transition-points)
- ;; collected transitions, so build the table
- (setq transition-points (nreverse transition-points))
- (goto-char (pop transition-points))
- (insert table-start doc-row-start)
- (while (> (length transition-points) 1)
- (goto-char (pop transition-points))
- (insert doc-row-end code-row-start)
- (goto-char (pop transition-points))
- (insert code-row-end doc-row-start))
- (goto-char (pop transition-points))
- (insert code-row-end table-end)
- (unless (null transition-points)
- (error "leftover points")))))))
-#+end_src
-
-We'll use Emacs
[[https://www.gnu.org/software/emacs/manual/html_node/emacs/Specifying-File-Variables.html][File
Local Variables]] and the
-=org-export-html-final-hook= to control which buffers have
-=org-docco-buffer= run as part of their export process.
-#+begin_src emacs-lisp
- (defvar org-docco-doccoize-me nil
- "File local variable controlling if html export should be doccoized.")
- (make-local-variable 'org-docco-doccoize-me)
-#+end_src
-
-A simple function will conditionally process HTML output based on the
-value of this variable.
-#+begin_src emacs-lisp
- (defun org-docco-buffer-maybe ()
- (when org-docco-doccoize-me (org-docco-buffer)))
-#+end_src
-
-Finally this function is added to the =org-export-html-final-hook=.
-#+begin_src emacs-lisp
- (add-hook 'org-export-html-final-hook #'org-docco-buffer-maybe)
-#+end_src
-
-That's it. To use this simply;
-1. Checkout this file from https://github.com/eschulte/org-docco,
- : git clone git://github.com/eschulte/org-docco.git
- and open it using Emacs.
-2. Tangle =org-docco.el= out of this file by calling
- =org-babel-tangle= or =C-c C-v t=.
-3. Load the resulting Emacs Lisp file.
-4. Execute the following in any Org-mode buffer to add file local
- variable declarations which will enable post-processed with
- =org-docco-buffer=.
- : (add-file-local-variable 'org-export-html-postamble nil)
- : (add-file-local-variable 'org-export-html-style-include-default nil)
- : (add-file-local-variable 'org-docco-doccoize-me t)
- And add the following style declaration to make use of the
- =docco.css= style sheet taken directly from
- https://github.com/jashkenas/docco.
- : #+Style: <link rel="stylesheet" href="docco.css" type="text/css">
-
-#+begin_src emacs-lisp
-(provide 'org-docco)
-;;; org-docco.el ends here
-#+end_src
-
-# Local Variables:
-# org-export-html-postamble: nil
-# org-export-html-style-include-default: nil
-# org-docco-doccoize-me: t
-# End:
diff --git a/contrib/scripts/org2hpda b/contrib/scripts/org2hpda
deleted file mode 100755
index 01dac89..0000000
--- a/contrib/scripts/org2hpda
+++ /dev/null
@@ -1,106 +0,0 @@
-# org2hpda - a small utility to generate hipster pda style printouts from org
mode
-# Copyright (C) 2007-2013 Christian Egli
-#
-# Version: 0.6
-#
-# This program is free software: you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 3 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <https://www.gnu.org/licenses/>.
-#
-# Commentary:
-# ===========
-#
-# set cal-tex-diary to true so that diary entries show up in the calendar
-#
-# Usage:
-# ======
-#
-# run this makefile with
-#
-# make -f org2hpda
-#
-# The makfile will take the entries from your diary file and generate
-# two PDFs containing nicely printed weekly and monthly calendars. One
-# is done in the style of a pocketMod (http://www.pocketmod.com/) and
-# the other is done in the style of the Hipster PDA
-# (https://en.wikipedia.org/wiki/Hipster_PDA).
-#
-# Requirements:
-# =============
-#
-# the pdf* commands are part of the pdfjam package which can be found
-# at http://www.warwick.ac.uk/go/pdfjam
-
-EMACS = emacs -batch -l ~/.emacs
-LATEX = latex
-DIARY = $($(EMACS) -eval "diary-file")
-
-# Number of weeks to be printed. Should be a multiple of 4, because 4
-# of them are merged on one page. Can be set when invoking the script
-# as follows: make NUMBER_OF_WEEKS=8 -f org2hpda
-NUMBER_OF_WEEKS = 4
-
-hipsterFiles = weekCalendar.pdf yearCalendar.pdf monthCalendar3.pdf
monthCalendar2.pdf monthCalendar1.pdf
-pocketModFiles = weekCalendar.pdf yearCalendar-rotated.pdf \
- monthCalendar3-rotated.pdf monthCalendar2-rotated.pdf
monthCalendar1-rotated.pdf
-
-all: pocketMod.pdf hipsterPDA.pdf
-
-%.dvi: %.tex
- # Quick hack to massage the LaTeX produced by cal-tex
- # quote '@', then increase font size of week calendars,
- # increase font of diary entries in moth calendar and
- # finally reduce links to their destination, i.e.
- # change '[[http://foo][bar]]' to 'bar'
- sed -e 's/\\verb|@|/\@/g' \
- -e 's/documentclass\[11pt\]/documentclass[12pt]/g' \
- -e 's/{\\tiny \\raggedright #3}/{\\small \\raggedright #3}/g' \
- -e 's/\[\[[^]]\+\]\[\([^]]\+\)\]\]/\1/g' \
- < $< > /tmp/temp-org-file.$$$$; mv /tmp/temp-org-file.$$$$ $<
- $(LATEX) $^
-
-%.pdf: %.dvi
- dvipdf $^
-
-%-rotated.pdf: %.pdf
- cp $^ $@
- for n in 1 2 3; do \
- pdf90 --quiet --outfile tmp.pdf $@; mv tmp.pdf $@; \
- done
-
-weekCalendar.tex: $(DIARY)
- $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-week-iso
$(NUMBER_OF_WEEKS)) (with-current-buffer cal-tex-buffer (write-file \"$@\")))"
-
-monthCalendar1.tex: $(DIARY)
- $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-month-landscape 1)
(with-current-buffer cal-tex-buffer (write-file \"$@\")))"
-
-monthCalendar2.tex: $(DIARY)
- $(EMACS) -eval "(progn (calendar) (calendar-forward-month 1)
(cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer
(write-file \"$@\")))"
-
-monthCalendar3.tex: $(DIARY)
- $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2)
(cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer
(write-file \"$@\")))"
-
-yearCalendar.tex: $(DIARY)
- $(EMACS) -eval "(progn (calendar) (calendar-forward-month 2)
(cal-tex-cursor-year-landscape 1) (with-current-buffer cal-tex-buffer
(write-file \"$@\")))"
-
-pocketMod.pdf: $(pocketModFiles)
- pdfjoin --quiet --outfile tmp.pdf $^
- pdfnup tmp.pdf --quiet --outfile $@ --nup 4x2 --frame true
-
-hipsterPDA.pdf: $(hipsterFiles)
- pdfnup weekCalendar.pdf --quiet --outfile page1.pdf --batch --nup 2x2
--frame true --no-landscape
- pdfjoin --quiet --outfile tmp.pdf monthCalendar[1-3]-rotated.pdf
yearCalendar-rotated.pdf
- pdfnup tmp.pdf --quiet --outfile page2.pdf --batch --nup 2x2 --frame
true --no-landscape
- pdfjoin --quiet --outfile $@ page1.pdf page2.pdf
-
-clean:
- rm -rf *.aux *.dvi *.tex *.log *.pdf
diff --git a/contrib/scripts/staticmathjax/.gitignore
b/contrib/scripts/staticmathjax/.gitignore
deleted file mode 100644
index b25c15b..0000000
--- a/contrib/scripts/staticmathjax/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-*~
diff --git a/contrib/scripts/staticmathjax/README.org
b/contrib/scripts/staticmathjax/README.org
deleted file mode 100644
index e813eaf..0000000
--- a/contrib/scripts/staticmathjax/README.org
+++ /dev/null
@@ -1,79 +0,0 @@
-Static MathJax v0.1 README
-#+AUTHOR: Jan Böcker <jan.boecker@jboecker.de>
-
-Static MathJax is a XULRunner application which loads a HTML input
-file that uses MathJax into a browser, waits until MathJax is done
-processing, and then writes the formatted result to an output HTML
-file.
-
-I have only tested exports from Emacs Org-mode as input files. (As of
-2010-08-14, MathJax is used by default with HTML exports in the
-current Org development version.)
-
-Optionally, references to the math fonts used will be converted to
-"data:" URIs, thus embedding the font data into the HTML file itself.
-(see [[https://en.wikipedia.org/wiki/Data_URI_scheme]])
-
-The code is licensed under the GNU General Public License version
-2, or, at your option, any later version.
-
-
-* Usage
- To run Static MathJax, an existing XULRunner installation is
- required. From the directory to which you unpacked Static MathJax,
- run:
-
- xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>>
- <input file> <output file>
-
- If you prefer to call "staticmathjax" instead of "xulrunner
- application.ini", link xulrunner-stub into the directory:
- ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax
-
- - input file ::
- name of the input file (the result of a HTML export
- from Org-mode). It is assumed that this file uses the
- UTF-8 character encoding.
-
- - output file ::
- name of the output file.
-
- - --embed-fonts ::
- if specified, the math fonts will be embedded into
- the output file using data: URIs
-
- - --final-mathjax-url <URL> ::
- if --embed-fonts is not specified, this
- must be the URL to a MathJax installation folder (e.g. "MathJax"
- if MathJax is installed in a subdirectory, or
- "https://orgmode.org/mathjax"; to use the version hosted on the Org
- website.
-
- All references to math fonts in the output file will point to
- this directory.
-
-* Caveats
-
- The input file must not use a MathJax installation on the
- web. Otherwise, due to a security feature of Firefox, MathJax will
- fallback to image fonts. If you have unpacked MathJax to a
- subdirectory "MathJax", specify the following in your Org file:
-
- #+MathJax: path:"MathJax"
-
- The math is rendered in Firefox, so MathJax applies its
- Firefox-specific settings. When viewing the output files in other
- browsers, it will look slightly different than the result that
- running MathJax in that browser would produce.
-
- Internet Explorer does not use the correct font, because it only
- supports the EOT font format. For all other browsers (including
- Firefox), MathJax uses the OTF font format.
-
- Embedding fonts into the HTML file wastes some space due to the
- base64 encoding used in data: URIs.
-
- I have found no way to access stdout or set an exit code in an
- XULRunner app, so any code which calls Static MathJax has no idea if
- processing was successful and when an error occurs, graphical
- message boxes are displayed.
diff --git a/contrib/scripts/staticmathjax/application.ini
b/contrib/scripts/staticmathjax/application.ini
deleted file mode 100644
index 522376d..0000000
--- a/contrib/scripts/staticmathjax/application.ini
+++ /dev/null
@@ -1,11 +0,0 @@
-[App]
-Vendor=Jan Boecker
-Name=StaticMathJax
-Version=0.2
-BuildID=2
-Copyright=Copyright (c) 2010, 2013 Jan Boecker
-ID=xulapp@jboecker.de
-
-[Gecko]
-MinVersion=1.8
-
diff --git a/contrib/scripts/staticmathjax/chrome/chrome.manifest
b/contrib/scripts/staticmathjax/chrome/chrome.manifest
deleted file mode 100644
index a05d8c8..0000000
--- a/contrib/scripts/staticmathjax/chrome/chrome.manifest
+++ /dev/null
@@ -1 +0,0 @@
-content staticmathjax file:content/
diff --git a/contrib/scripts/staticmathjax/chrome/content/main.js
b/contrib/scripts/staticmathjax/chrome/content/main.js
deleted file mode 100644
index 2e71f3b..0000000
--- a/contrib/scripts/staticmathjax/chrome/content/main.js
+++ /dev/null
@@ -1,198 +0,0 @@
-var docFrame;
-var logtextbox;
-var destFile;
-var embedFonts = false;
-var finalMathJaxURL = null;
-
-function log(text)
-{
- logtextbox.setAttribute("value", logtextbox.getAttribute("value") +
"\n" + text);
-}
-
-function init()
-{
- try {
- docFrame = document.getElementById("docFrame");
- logtextbox = document.getElementById("logtextbox");
-
- // parse command line arguments
- var cmdLine = window.arguments[0];
- cmdLine =
cmdLine.QueryInterface(Components.interfaces.nsICommandLine);
-
- embedFonts = cmdLine.handleFlag("embed-fonts", false);
- finalMathJaxURL =
cmdLine.handleFlagWithParam("final-mathjax-url", false);
-
- if (!embedFonts && !finalMathJaxURL) {
- alert("You must eiher specify --embed-fonts or
--final-mathjax-url");
- window.close();
- return;
- }
-
- sourceFilePath = cmdLine.getArgument(0);
- destFilePath = cmdLine.getArgument(1);
- if ( !sourceFilePath || !destFilePath ) {
- alert("Not enough parameters, expecting two
arguments:\nInput file, output file");
- window.close();
- return;
- }
-
- sourceFile = cmdLine.resolveFile(sourceFilePath);
- if (! (sourceFile.exists() && sourceFile.isFile()) ) {
- alert("Invalid source file path.");
- window.close();
- return;
- }
- sourceURI = cmdLine.resolveURI(sourceFilePath);
-
- // create a nsIFile object for the output file
- try{
- destFile =
cmdLine.resolveURI(destFilePath).QueryInterface(Components.interfaces.nsIFileURL).file;
- }catch(e){
- alert("Invalid destination file.\n\nException:\n" + e);
- window.close();
- return;
- }
-
- // add iframeLoaded() as an onload event handler, then navigate
to the source file
- docFrame.addEventListener("DOMContentLoaded", iframeLoaded,
true);
- docFrame.setAttribute("src", sourceURI.spec);
-
- } catch (e) {
- alert("Error in init():\n\n" + e);
- window.close();
- return;
- }
-}
-
-function iframeLoaded()
-{
- /*
- // print every MathJax signal to the log
- docFrame.contentWindow.MathJax.Hub.Startup.signal.Interest(
- function (message) {log("Startup: "+message)}
- );
- docFrame.contentWindow.MathJax.Hub.signal.Interest(
- function (message) {log("Hub: "+message)}
- );
- */
-
- // tell MathJax to call serialize() when finished
- docFrame.contentWindow.MathJax.Hub.Register.StartupHook("End",
function() {serialize();});
-}
-
-function fileURLtoDataURI(url)
-{
- var ios = Components.classes["@mozilla.org/network/io-service;1"]
- .getService(Components.interfaces.nsIIOService);
- var url_object = ios.newURI(url, "", null);
- var file =
url_object.QueryInterface(Components.interfaces.nsIFileURL).file;
-
- var data = "";
- var fstream =
Components.classes["@mozilla.org/network/file-input-stream;1"].
- createInstance(Components.interfaces.nsIFileInputStream);
- fstream.init(file, -1, -1, false);
- var bstream = Components.classes["@mozilla.org/binaryinputstream;1"].
- createInstance(Components.interfaces.nsIBinaryInputStream);
- bstream.setInputStream(fstream);
-
- var bytes = bstream.readBytes(bstream.available());
- b64bytes = btoa(bytes);
-
- return "data:;base64," + b64bytes;
-
-}
-
-function serialize()
-{
- var MathJaxURL = docFrame.contentWindow.MathJax.Hub.config.root;
-
- var searchURIList = new Array();
- var replacementURIList = new Array();
-
- log("serialize: preprocessing");
-
- // remove the MathJax status message window
- msgdiv = docFrame.contentDocument.getElementById("MathJax_Message");
- msgdiv.parentNode.removeChild(msgdiv);
-
- /* Loop through all CSS rules to find all @font-face rules.
- At this point, they refer to local absolute paths using file:// URLs.
- Replace them either with appropriate URLs relative to finalMathJaxURL
- or with data URIs. */
-
- for (var i = 0; i<docFrame.contentDocument.styleSheets.length; i++) {
- var stylesheet = docFrame.contentDocument.styleSheets[i];
-
- for (var j=0; j< stylesheet.cssRules.length; j++) {
- var rule = stylesheet.cssRules[j];
- if (rule.cssText.match("font-face")) {
-
- url = rule.style.getPropertyValue("src");
- url = url.match(/url\(\"(.+)\"\)/)[1];
-
- // Since the properties seem read-only here, we
populate
- // searchURIList and replacementURIList to do
text substitution
- // after serialization
- searchURIList.push(url);
- if (embedFonts) {
-
replacementURIList.push(fileURLtoDataURI(url));
- } else {
-
replacementURIList.push(url.replace(MathJaxURL, finalMathJaxURL));
- }
- }
- }
- }
-
-
- // find and remove the MathJax <script> tag
- try{
- var scriptTags =
docFrame.contentDocument.getElementsByTagName("script");
- for (var i=0; i<scriptTags.length; i++) {
- if (scriptTags[i].getAttribute("src") &&
scriptTags[i].getAttribute("src").match(/MathJax.js/i))
-
scriptTags[i].parentNode.removeChild(scriptTags[i]);
- }
- }catch(e){alert(e);}
-
- log("serialize: serializing");
-
- var serializer = new XMLSerializer();
- var xhtml = serializer.serializeToString(docFrame.contentDocument);
-
- log("serialize: postprocessing");
- // make the MathJax URL relative again
- // xhtml = xhtml.replace(findMathJaxURL, "MathJax");
-
- try{
- r1 =
RegExp("<!--/\\*--><!\\[CDATA\\[/\\*><!--\\*/", "g");
- xhtml = xhtml.replace(r1, "");
- r2 = RegExp("/\\*\\]\\]>\\*/-->", "g");
- xhtml = xhtml.replace(r2, "");
- r3 = RegExp("/\\*\\]\\]>\\*///-->", "g");
- xhtml = xhtml.replace(r3, "");
- }catch(e){alert(e);}
- for (var i=0; i<searchURIList.length; i++)
- xhtml = xhtml.replace(searchURIList[i], replacementURIList[i]);
-
- save(xhtml);
- window.close();
-}
-
-function save(xhtml)
-{
- try {
- var foStream =
Components.classes["@mozilla.org/network/file-output-stream;1"].
-
createInstance(Components.interfaces.nsIFileOutputStream);
-
- foStream.init(destFile, 0x02 | 0x08 | 0x20, 0666, 0);
- // write, create, truncate
-
- // write in UTF-8 encoding
- var converter =
Components.classes["@mozilla.org/intl/converter-output-stream;1"].
-
createInstance(Components.interfaces.nsIConverterOutputStream);
- converter.init(foStream, "UTF-8", 0, 0);
- converter.writeString(xhtml);
- converter.close(); // this closes foStream
- } catch (e) {
- alert("Error in save():\n\n" + e);
- }
-}
diff --git a/contrib/scripts/staticmathjax/chrome/content/main.xul
b/contrib/scripts/staticmathjax/chrome/content/main.xul
deleted file mode 100644
index 35a00f2..0000000
--- a/contrib/scripts/staticmathjax/chrome/content/main.xul
+++ /dev/null
@@ -1,11 +0,0 @@
-<?xml version="1.0"?>
-<?xml-stylesheet href="chrome://global/skin/" type="text/css"?>
-
-<window onload="init();" id="main" title="Static MathJax" width="300"
height="300"
-xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul";>
-
-<script language="JavaScript" src="chrome://staticmathjax/content/main.js"/>
-
- <browser flex="1" id="docFrame" src="" style="background-color:white;"/>
- <textbox flex="1" id="logtextbox" multiline="true" style="display:none;"/>
-</window>
diff --git a/contrib/scripts/staticmathjax/defaults/preferences/prefs.js
b/contrib/scripts/staticmathjax/defaults/preferences/prefs.js
deleted file mode 100644
index 0532ce0..0000000
--- a/contrib/scripts/staticmathjax/defaults/preferences/prefs.js
+++ /dev/null
@@ -1 +0,0 @@
-pref("toolkit.defaultChromeURI", "chrome://staticmathjax/content/main.xul");
diff --git a/contrib/scripts/x11idle.c b/contrib/scripts/x11idle.c
deleted file mode 100644
index b8db275..0000000
--- a/contrib/scripts/x11idle.c
+++ /dev/null
@@ -1,33 +0,0 @@
-/* This header file is provided by the libxss-dev package on Debian,
- * by the libXss-devel rpm on openSUSE, and the libXScrnSaver-devel
- * rpm on Fedora.
- */
-#include <X11/extensions/scrnsaver.h>
-
-#include <stdio.h>
-
-/* Based on code from
- * http://coderrr.wordpress.com/2008/04/20/getting-idle-time-in-unix/
- *
- * compile with 'gcc -l Xss x11idle.c -o x11idle' and copy x11idle into your
- * path
- */
-int main() {
- XScreenSaverInfo *info = XScreenSaverAllocInfo();
- //open the display specified by the DISPLAY environment variable
- Display *display = XOpenDisplay(0);
-
- //display could be null if there is no X server running
- if (info == NULL || display == NULL) {
- return -1;
- }
-
- //X11 is running, try to retrieve info
- if (XScreenSaverQueryInfo(display, DefaultRootWindow(display), info) == 0)
{
- return -1;
- }
-
- //info was retrieved successfully, print idle time
- printf("%lu\n", info->idle);
- return 0;
-}
- [elpa] externals/org updated (670f45e -> e80be06), ELPA Syncer, 2021/05/03
- [elpa] externals/org e12ee7d 3/6: README*: Remove references to contrib/, ELPA Syncer, 2021/05/03
- [elpa] externals/org 678cb68 5/6: doc/*: Update references to the old contrib/ directory, ELPA Syncer, 2021/05/03
- [elpa] externals/org e80be06 6/6: etc/ORG-NEWS: Announce that contrib/ lives in a separate repository, ELPA Syncer, 2021/05/03
- [elpa] externals/org 0555665 2/6: Remove the contrib/ directory,
ELPA Syncer <=
- [elpa] externals/org 3520c5b 1/6: CONTRIBUTE: Announce the move of contrib/ to a new repository, ELPA Syncer, 2021/05/03
- [elpa] externals/org 096cacf 4/6: lisp/org-clock.el: Point to the new location of x11idle.c, ELPA Syncer, 2021/05/03