Org-Mode 9.5
-----BEGIN PGP SIGNATURE----- iQEzBAABCgAdFiEEG+FaXQip1ZWVgUdrFDesAvc/kaIFAmFUecUACgkQFDesAvc/ kaK4Wwf+NLd907whqmOcWGwKpYHuS0D8HMadl7Qty721hr9Lq+EWZ0g3es1gjtc9 CVM2yJwvHHZwUqAGeeS2jiGP5RrFDlg7dEtLM9nQCWQ4szCQ72CrI7bV1YkAby3P dMft7t2fcEvGSgQ0y0FYmqjnu2QbbdZd3TWWVmsPHwFvU/zthMOUmfxDBZlOBvuZ hnb7BS/vo5S52sAU8vQhfvEoiGpSGHCNJ9mJ7fI5/DY0rLYerb0ik4beZLvF/WbE f0sLsNWwoL997/3OL31ci6miW0o/p80k+gEsyfE4CETqEYhDKdcqvZGW2YXieHKI gBkYPJ4p0AdAam47/gzFOBoRCUvnBQ== =cRv3 -----END PGP SIGNATURE----- Merge tag 'release_9.5' into emacs-sync
This commit is contained in:
commit
e85bb73eb7
|
@ -6,6 +6,8 @@
|
|||
(tab-width . 8)
|
||||
(fill-column . 70)
|
||||
(sentence-end-double-space . t))
|
||||
(emacs-lisp-mode
|
||||
(indent-tabs-mode))
|
||||
(org-mode
|
||||
(indent-tabs-mode)
|
||||
(org-adapt-indentation)
|
||||
|
|
|
@ -48,6 +48,12 @@ local*.mk
|
|||
mk/x11idle
|
||||
ChangeLog
|
||||
|
||||
# Files generated during `make packages/org` in a clone of `elpa.git`.
|
||||
|
||||
/org-pkg.el
|
||||
/org-autoloads.el
|
||||
/lisp/org-autoloads.el
|
||||
|
||||
# texi2pdf --tidy
|
||||
|
||||
doc/*.t2d
|
||||
|
|
73
CONTRIBUTE
73
CONTRIBUTE
|
@ -3,34 +3,36 @@
|
|||
The text below explains the rules for participating in Org mode
|
||||
development.
|
||||
|
||||
* Org maintenance
|
||||
|
||||
Org maintenance is detailed on Worg: see [[https://orgmode.org/worg/org-maintenance.html][org-maintenance]].
|
||||
|
||||
* Main contribution rules
|
||||
|
||||
1. The master git repository is hosted publicly at [[https://orgmode.org][orgmode.org]].
|
||||
1. The master git repository is hosted publicly on [[https://savannah.gnu.org][savannah.gnu.org]].
|
||||
|
||||
Anyone can get a clone of the current repository state using the
|
||||
command
|
||||
: git clone https://git.savannah.gnu.org/git/emacs/org-mode.git
|
||||
|
||||
: git clone https://code.orgmode.org/bzg/org-mode.git
|
||||
This is sufficient to start hacking and to produce patches that can
|
||||
easily and consistently be applied to the main repository.
|
||||
|
||||
Having a clone is sufficient to start hacking and to produce
|
||||
patches that can easily and consistently be applied to the main
|
||||
repository.
|
||||
|
||||
2. People who are interested in participating to the Org mode
|
||||
development can do so by sending patches to this address:
|
||||
2. People who want to participate to the Org mode development can send
|
||||
patches to this address:
|
||||
|
||||
: emacs-orgmode@gnu.org
|
||||
|
||||
3. An interested developer can also request push access to the central
|
||||
repository by creating an account on code.orgmode.org and by
|
||||
sending her/his user info to the maintainer.
|
||||
3. If you are a regular contributor, you can request push access to
|
||||
the repository by creating an account on [[https://savannah.gnu.org/account/register.php][savannah.gnu.org]] and by
|
||||
[[https://savannah.gnu.org/git/?group=emacs][joining the Emacs group]].
|
||||
|
||||
After you have been added as a user with push privileges, you can
|
||||
clone the repository like this:
|
||||
|
||||
After you have been added as a user with push privileges, clone the
|
||||
repository through ssh using
|
||||
: git clone USERNAME@git.savannah.gnu.org:/srv/git/emacs/org-mode.git
|
||||
|
||||
: git clone git@code.orgmode.org:bzg/org-mode.git
|
||||
Replace =USERNAME= with your Savannah username.
|
||||
|
||||
By requesting push access, you acknowledge that you have read and
|
||||
4. By requesting push access, you acknowledge that you have read and
|
||||
agreed with the following rules:
|
||||
|
||||
- Org mode is part of GNU Emacs. Therefore, we need to be very
|
||||
|
@ -40,14 +42,13 @@ development.
|
|||
applies are:
|
||||
|
||||
- all *.el files in the lisp directory of the repository
|
||||
- org.texi, orgcard.tex in the doc directory
|
||||
- the corresponding ChangeLog files
|
||||
- orgcard.tex and all *.org files in the doc/ directory
|
||||
|
||||
- Before making any significant changes, please explain and discuss
|
||||
them on the mailing list [[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
|
||||
them on the mailing list [[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
|
||||
|
||||
This does obviously not apply to people who are maintaining their
|
||||
own contributions to Org mode. Please, just use the new mechanism
|
||||
own contributions to Org mode. Please just use the new mechanism
|
||||
to make sure all changes end up in the right place.
|
||||
|
||||
We value a nice tone in our discussions: please check and respect
|
||||
|
@ -58,29 +59,13 @@ development.
|
|||
`CONTRIBUTE' file in the main Emacs repository.
|
||||
|
||||
- Among other things, Org mode is widely appreciated because of its
|
||||
simplicity, cleanness and consistency. We should try hard to
|
||||
preserve this and ask everyone to keep this in mind when
|
||||
proposing changes.
|
||||
simplicity, cleanness and consistency. We should try to preserve
|
||||
them and ask everyone to keep this in mind when posting changes.
|
||||
|
||||
* The contrib/ directory
|
||||
See [[https://orgmode.org/worg/org-contribute.html][worg/org-contribute]] for guidance on how to contribute effectively.
|
||||
|
||||
The git repository contains a =contrib/= directory. This directory is
|
||||
the playing field for any developer, also people who have not (yet)
|
||||
signed the papers with the FSF. You are free to add files to this
|
||||
directory, implementing extensions, new link types etc.
|
||||
* The =contrib/= directory
|
||||
|
||||
Also non-Lisp extensions like scripts to process Org files in different
|
||||
ways are welcome in this directory. You should provide documentation
|
||||
with your extensions, at least in the form of commentary in the file,
|
||||
better on worg. Please discuss your extensions on
|
||||
[[mailto:emacs-orgmode@gnu.org][emacs-orgmode@gnu.org]].
|
||||
|
||||
After files have been tested in =contrib/= and found to be generally
|
||||
useful, we may decide to clarify copyright questions and then move the
|
||||
file into the Org mode core. This means they will be moved up to the
|
||||
root directory and will also eventually be added to GNU Emacs git
|
||||
repository. The final decision about this rests with the maintainer.
|
||||
|
||||
* Org maintenance
|
||||
|
||||
Org maintenance is explained on Worg: see [[https://orgmode.org/worg/org-maintenance.html][org-maintenance]].
|
||||
The git repository used to contain a =contrib/= directory. Files in
|
||||
this directory were moved to a new [[https://git.sr.ht/~bzg/org-contrib][org-contrib]] repository before Org
|
||||
9.5. You can install the new =org-contrib= from [[https://elpa.nongnu.org/nongnu/][NonGNU ELPA]].
|
||||
|
|
8
COPYING
8
COPYING
|
@ -1,7 +1,7 @@
|
|||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 3, 29 June 2007
|
||||
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
|
||||
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
|
@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
|
|||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
|
@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
|
|||
You should also get your employer (if you work as a programmer) or school,
|
||||
if any, to sign a "copyright disclaimer" for the program, if necessary.
|
||||
For more information on this, and how to apply and follow the GNU GPL, see
|
||||
<http://www.gnu.org/licenses/>.
|
||||
<https://www.gnu.org/licenses/>.
|
||||
|
||||
The GNU General Public License does not permit incorporating your program
|
||||
into proprietary programs. If your program is a subroutine library, you
|
||||
may consider it more useful to permit linking proprietary applications with
|
||||
the library. If this is what you want to do, use the GNU Lesser General
|
||||
Public License instead of this License. But first, please read
|
||||
<http://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
<https://www.gnu.org/philosophy/why-not-lgpl.html>.
|
||||
|
|
44
README
44
README
|
@ -11,8 +11,9 @@ Check the [[https://orgmode.org][homepage of Org]] and the [[https://orgmode.org
|
|||
|
||||
- COPYING :: The GNU General Public License.
|
||||
|
||||
- Makefile :: The makefile to compile and install Org. For installation
|
||||
instructions, see the manual or [[https://orgmode.org/worg/dev/org-build-system.html][the more detailed procedure on Worg]].
|
||||
- Makefile :: The makefile to compile and install Org. For
|
||||
installation instructions, see [[https://orgmode.org/org.html#Installation][the manual]] or [[https://orgmode.org/worg/dev/org-build-system.html][this more detailed
|
||||
procedure on Worg]].
|
||||
|
||||
- mk/ :: Files needed for building Org.
|
||||
|
||||
|
@ -21,20 +22,45 @@ Check the [[https://orgmode.org][homepage of Org]] and the [[https://orgmode.org
|
|||
- doc/ :: The documentation files. org.texi is the source of the
|
||||
documentation, org.html and org.pdf are formatted versions of it.
|
||||
|
||||
- contrib/ :: A directory with third-party additions for Org. Some
|
||||
really cool stuff is in there.
|
||||
|
||||
- etc/ :: Files needed for the ODT exporter.
|
||||
|
||||
- testing/ :: Testing suite for Org.
|
||||
|
||||
- request-assign-future.txt :: The form that contributors have to sign
|
||||
and get processed with the FSF before contributed changes can be
|
||||
integrated into the Org core. All files in this distribution except
|
||||
the contrib/ directory have copyright assigned to the FSF.
|
||||
integrated into the Org core. All files in this distribution have
|
||||
copyright assigned to the FSF.
|
||||
|
||||
* Join the GNU Project
|
||||
|
||||
Org is part of GNU Emacs and GNU Emacs is part of the GNU Operating
|
||||
System, developed by the GNU Project.
|
||||
|
||||
If you are the author of an awesome program and want to join us in
|
||||
writing Free (libre) Software, please consider making it an official
|
||||
GNU program and become a GNU Maintainer. Instructions on how to do
|
||||
this are here http://www.gnu.org/help/evaluation
|
||||
|
||||
Don't have a program to contribute? Look at all the other ways to
|
||||
help: https://www.gnu.org/help/help.html
|
||||
|
||||
And to learn more about Free (libre) Software in general, please
|
||||
read and share this page: https://gnu.org/philosophy/free-sw.html
|
||||
|
||||
* License
|
||||
|
||||
Org-mode is published under [[https://www.gnu.org/licenses/gpl-3.0.html][the GNU GPLv3 license]] or any later
|
||||
version, the same as GNU Emacs. See the COPYING file in this
|
||||
directory.
|
||||
version, the same as GNU Emacs.
|
||||
|
||||
Org-mode 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 Org mode. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
|
|
@ -10,16 +10,13 @@ This distribution contains an ELPA packaged version of Org.
|
|||
"ELPA" stands for the "Emacs Lisp Package Archive".
|
||||
|
||||
The GNU ELPA is at:
|
||||
http://elpa.gnu.org
|
||||
https://elpa.gnu.org
|
||||
|
||||
It contains the org-*.tar package, containing only the org files
|
||||
that are also part of GNU Emacs.
|
||||
|
||||
There are other ELPA online, offering more packages.
|
||||
|
||||
Some contain the org-plus-contrib-*.tar ELPA package, which bundles
|
||||
the core Org files plus many additional contributed libraries.
|
||||
|
||||
All ELPA packages of Org contain:
|
||||
|
||||
README_ELPA
|
||||
|
|
100
contrib/README
100
contrib/README
|
@ -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.
|
|
@ -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 <http://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)
|
||||
|
||||
(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
|
|
@ -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 <http://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)
|
||||
|
||||
(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
|
|
@ -1,83 +0,0 @@
|
|||
;;; ob-csharp.el --- org-babel functions for csharp evaluation
|
||||
|
||||
;; Copyright (C) 2011-2020 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 <http://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
|
|
@ -1,98 +0,0 @@
|
|||
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
|
||||
|
||||
;; Copyright (C) 2010-2020 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating eukleides script.
|
||||
;;
|
||||
;; Inspired by Ian Yang's org-export-blocks-format-eukleides
|
||||
;; http://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
|
|
@ -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
|
|
@ -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)
|
|
@ -1,145 +0,0 @@
|
|||
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
|
||||
|
||||
;; Copyright (C) 2009-2020 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 <http://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
|
|
@ -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
|
|
@ -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
|
|
@ -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
|
|
@ -1,92 +0,0 @@
|
|||
;;; ob-sclang.el --- SCLang support for Org-mode Babel
|
||||
;;; -*- coding: utf-8 -*-
|
||||
|
||||
;; Copyright (C) 2017-2020 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 <http://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)
|
||||
|
||||
(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
|
|
@ -1,54 +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:
|
||||
;;; http://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:
|
||||
|
||||
;; 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]]" path)))
|
||||
|
||||
(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-add-link-type
|
||||
"molecule"
|
||||
'molecule-jump
|
||||
'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
|
|
@ -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: http://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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Org-Babel support for evaluating spice script.
|
||||
;; Inspired by Ian Yang's org-export-blocks-format-plantuml (http://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
|
|
@ -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: http://stata.com
|
||||
;; ESS: http://ess.r-project.org
|
||||
|
||||
;;; Code:
|
||||
(require 'ob)
|
||||
(require 'cl-lib)
|
||||
|
||||
(declare-function orgtbl-to-csv "org-table" (table params))
|
||||
(declare-function stata "ext:ess-stata" (&optional start-args))
|
||||
(declare-function inferior-ess-send-input "ext:ess-inf" ())
|
||||
(declare-function ess-make-buffer-current "ext:ess-inf" ())
|
||||
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
|
||||
(declare-function org-number-sequence "org-compat" (from &optional to inc))
|
||||
|
||||
(defconst org-babel-header-args:stata
|
||||
'((width . :any)
|
||||
(horizontal . :any)
|
||||
(results . ((file list vector table scalar verbatim)
|
||||
(raw org html latex code pp wrap)
|
||||
(replace silent append prepend)
|
||||
;; NOTE: not sure 'value' makes sense in stata
|
||||
;; we may want to remove it from the list
|
||||
(output value graphics))))
|
||||
"stata-specific header arguments.")
|
||||
|
||||
(add-to-list 'org-babel-tangle-lang-exts '("stata" . "do"))
|
||||
|
||||
;; only ':results output' currently works, so make that the default
|
||||
(defvar org-babel-default-header-args:stata '((:results . "output")))
|
||||
|
||||
(defcustom org-babel-stata-command inferior-STA-program-name
|
||||
"Name of command to use for executing stata code."
|
||||
:group 'org-babel
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.3")
|
||||
:type 'string)
|
||||
|
||||
(defvar ess-local-process-name) ; dynamically scoped
|
||||
(defun org-babel-edit-prep:stata (info)
|
||||
(let ((session (cdr (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
|
|
@ -1,128 +0,0 @@
|
|||
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
|
||||
|
||||
;; Copyright (C) 2009-2020 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 <http://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
|
|
@ -1,84 +0,0 @@
|
|||
;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation
|
||||
|
||||
;; Copyright (C) 2011-2020 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 <http://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
|
|
@ -1,90 +0,0 @@
|
|||
;;; ol-bookmark.el - Links to bookmarks
|
||||
;; Copyright (C) 2008-2020 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
|
|
@ -1,157 +0,0 @@
|
|||
;;; ol-elisp-symbol.el --- Links to Emacs-lisp symbols
|
||||
;;
|
||||
;; Copyright 2007-2020 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry
|
||||
;; 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 <http://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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; `org-git-link.el' defines two new link types. The `git' link
|
||||
;; type is meant to be used in the typical scenario and mimics the
|
||||
;; `file' link syntax as closely as possible. The `gitbare' link
|
||||
;; type exists mostly for debugging reasons, but also allows e.g.
|
||||
;; linking to files in a bare git repository for the experts.
|
||||
|
||||
;; * User friendy form
|
||||
;; [[git:/path/to/file::searchstring]]
|
||||
|
||||
;; This form is the familiar from normal org file links
|
||||
;; including search options. However, its use is
|
||||
;; restricted to files in a working directory and does not
|
||||
;; handle bare repositories on purpose (see the bare form for
|
||||
;; that).
|
||||
|
||||
;; The search string references a commit (a tree-ish in Git
|
||||
;; terminology). The two most useful types of search strings are
|
||||
|
||||
;; - A symbolic ref name, usually a branch or tag name (e.g.
|
||||
;; master or nobelprize).
|
||||
;; - A ref followed by the suffix @ with a date specification
|
||||
;; enclosed in a brace pair (e.g. {yesterday}, {1 month 2
|
||||
;; weeks 3 days 1 hour 1 second ago} or {1979-02-26 18:30:00})
|
||||
;; to specify the value of the ref at a prior point in time
|
||||
;;
|
||||
;; * Bare git form
|
||||
;; [[gitbare:$GIT_DIR::$OBJECT]]
|
||||
;;
|
||||
;; This is the more bare metal version, which gives the user most
|
||||
;; control. It directly translates to the git command
|
||||
;; git --no-pager --git-dir=$GIT_DIR show $OBJECT
|
||||
;; Using this version one can also view files from a bare git
|
||||
;; repository. For detailed information on how to specify an
|
||||
;; object, see the man page of `git-rev-parse' (section
|
||||
;; SPECIFYING REVISIONS). A specific blob (file) can be
|
||||
;; specified by a suffix clolon (:) followed by a path.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(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
|
|
@ -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 <http://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
|
|
@ -1,355 +0,0 @@
|
|||
;;; ol-mew.el --- Links to Mew messages
|
||||
|
||||
;; Copyright (C) 2008-2020 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 <http://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
|
|
@ -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 <http://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
|
|
@ -1,167 +0,0 @@
|
|||
;;; ol-vm.el --- Links to VM messages
|
||||
|
||||
;; Copyright (C) 2004-2020 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 <http://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
|
|
@ -1,304 +0,0 @@
|
|||
;;; ol-wl.el --- Links to Wanderlust messages
|
||||
|
||||
;; Copyright (C) 2004-2020 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 <http://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"
|
||||
"http://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
|
|
@ -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
|
|
@ -1,131 +0,0 @@
|
|||
;;; org-attach-embedded-images.el --- Transmute images to attachments
|
||||
;;
|
||||
;; Copyright 2018-2020 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 <http://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
|
|
@ -1,137 +0,0 @@
|
|||
;;; org-bibtex-extras --- extras for working with org-bibtex entries
|
||||
|
||||
;; Copyright (C) 2008-2020 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 <http://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
|
|
@ -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 <http://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
|
|
@ -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
|
|
@ -1,232 +0,0 @@
|
|||
;;; org-collector --- collect properties into tables
|
||||
|
||||
;; Copyright (C) 2008-2020 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Pass in an alist of columns, each column can be either a single
|
||||
;; property or a function which takes column names as arguments.
|
||||
;;
|
||||
;; For example the following propview block would collect the value of
|
||||
;; the 'amount' property from each header in the current buffer
|
||||
;;
|
||||
;; #+BEGIN: propview :cols (ITEM amount)
|
||||
;; | "ITEM" | "amount" |
|
||||
;; |---------------------+----------|
|
||||
;; | "December Spending" | 0 |
|
||||
;; | "Grocery Store" | 56.77 |
|
||||
;; | "Athletic club" | 75.0 |
|
||||
;; | "Restaurant" | 30.67 |
|
||||
;; | "January Spending" | 0 |
|
||||
;; | "Athletic club" | 75.0 |
|
||||
;; | "Restaurant" | 50.00 |
|
||||
;; |---------------------+----------|
|
||||
;; | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; This slightly more selective propview block will limit those
|
||||
;; headers included to those in the subtree with the id 'december'
|
||||
;; in which the spendtype property is equal to "food"
|
||||
;;
|
||||
;; #+BEGIN: propview :id "december" :conds ((string= spendtype "food")) :cols (ITEM amount)
|
||||
;; | "ITEM" | "amount" |
|
||||
;; |-----------------+----------|
|
||||
;; | "Grocery Store" | 56.77 |
|
||||
;; | "Restaurant" | 30.67 |
|
||||
;; |-----------------+----------|
|
||||
;; | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; Org Collector allows arbitrary processing of the property values
|
||||
;; through elisp in the cols: property. This allows for both simple
|
||||
;; computations as in the following example
|
||||
;;
|
||||
;; #+BEGIN: propview :id "results" :cols (ITEM f d list (apply '+ list) (+ f d))
|
||||
;; | "ITEM" | "f" | "d" | "list" | "(apply (quote +) list)" | "(+ f d)" |
|
||||
;; |--------+-----+-----+-------------------------+--------------------------+-----------|
|
||||
;; | "run1" | 2 | 33 | (quote (9 2 3 4 5 6 7)) | 36 | 35 |
|
||||
;; | "run2" | 2 | 34 | :na | :na | 36 |
|
||||
;; | "run3" | 2 | 35 | :na | :na | 37 |
|
||||
;; | "run4" | 2 | 36 | :na | :na | 38 |
|
||||
;; | | | | | | |
|
||||
;; #+END:
|
||||
;;
|
||||
;; or more complex computations as in the following example taken from
|
||||
;; an org file where each header in "results" subtree contained a
|
||||
;; property "sorted_hits" which was passed through the
|
||||
;; "average-precision" elisp function
|
||||
;;
|
||||
;; #+BEGIN: propview :id "results" :cols (ITEM (average-precision sorted_hits))
|
||||
;; | "ITEM" | "(average-precision sorted_hits)" |
|
||||
;; |-----------+-----------------------------------|
|
||||
;; | run (80) | 0.105092 |
|
||||
;; | run (70) | 0.108142 |
|
||||
;; | run (10) | 0.111348 |
|
||||
;; | run (60) | 0.113593 |
|
||||
;; | run (50) | 0.116446 |
|
||||
;; | run (100) | 0.118863 |
|
||||
;; #+END:
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
(require 'org)
|
||||
(require 'org-table)
|
||||
|
||||
(defvar org-propview-default-value 0
|
||||
"Default value to insert into the propview table when the no
|
||||
value is calculated either through lack of required variables for
|
||||
a column, or through the generation of an error.")
|
||||
|
||||
(defun and-rest (list)
|
||||
(if (listp list)
|
||||
(if (> (length list) 1)
|
||||
(and (car list) (and-rest (cdr list)))
|
||||
(car list))
|
||||
list))
|
||||
|
||||
(put 'org-collector-error
|
||||
'error-conditions
|
||||
'(error column-prop-error org-collector-error))
|
||||
|
||||
(defun org-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
|
File diff suppressed because it is too large
Load Diff
|
@ -1,38 +0,0 @@
|
|||
;;; org-contribdir.el --- Mark the location of the contrib directory
|
||||
;; Copyright (C) 2009-2020 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
|
|
@ -1,431 +0,0 @@
|
|||
;;; org-depend.el --- TODO dependencies for Org-mode
|
||||
;; Copyright (C) 2008-2020 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 <http://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
|
|
@ -1,369 +0,0 @@
|
|||
;;; org-effectiveness.el --- Measuring the personal effectiveness
|
||||
|
||||
;; Copyright (C) 2013-2020 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 <http://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)
|
|
@ -1,201 +0,0 @@
|
|||
;;; org-eldoc.el --- display org header and src block info using eldoc -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (c) 2014-2020 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Łukasz Gruner <lukasz@gruner.lu>
|
||||
;; Maintainer: Łukasz Gruner <lukasz@gruner.lu>
|
||||
;; Version: 6
|
||||
;; Package-Requires: ((org "8"))
|
||||
;; URL: https://bitbucket.org/ukaszg/org-eldoc
|
||||
;; Created: 25/05/2014
|
||||
;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer
|
||||
|
||||
;; This file is not part of Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Changelog:
|
||||
|
||||
;; As of 01/11/14 switching license to GPL3 to allow submission to org-mode.
|
||||
;; 08/11/14 switch code to automatically define eldoc-documentation-function, but don't autostart eldoc-mode.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'ob-core)
|
||||
(require 'eldoc)
|
||||
|
||||
(declare-function org-element-at-point "org-element" ())
|
||||
(declare-function org-element-property "org-element" (property element))
|
||||
(declare-function org-element-type "org-element" (element))
|
||||
|
||||
(defgroup org-eldoc nil "" :group 'org)
|
||||
|
||||
(defcustom org-eldoc-breadcrumb-separator "/"
|
||||
"Breadcrumb separator."
|
||||
:group 'org-eldoc
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-eldoc-test-buffer-name " *Org-eldoc test buffer*"
|
||||
"Name of the buffer used while testing for mode-local variable values."
|
||||
:group 'org-eldoc
|
||||
:type 'string)
|
||||
|
||||
(defun org-eldoc-get-breadcrumb ()
|
||||
"Return breadcrumb if on a headline or nil."
|
||||
(let ((case-fold-search t) cur)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(save-match-data
|
||||
(when (looking-at org-complex-heading-regexp)
|
||||
(setq cur (match-string 4))
|
||||
(org-format-outline-path
|
||||
(append (org-get-outline-path) (list cur))
|
||||
(frame-width) "" org-eldoc-breadcrumb-separator))))))
|
||||
|
||||
(defun org-eldoc-get-src-header ()
|
||||
"Returns lang and list of header properties if on src definition line and nil otherwise."
|
||||
(let ((case-fold-search t) info lang hdr-args)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(save-match-data
|
||||
(when (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_src")
|
||||
(setq info (org-babel-get-src-block-info 'light)
|
||||
lang (propertize (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 ((boundp 'eldoc-documentation-functions) ; Emacs>=28
|
||||
(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") ;; http://github.com/nflath/c-eldoc
|
||||
(string= lang "C")) (when (require 'c-eldoc nil t)
|
||||
(c-eldoc-print-current-symbol-info)))
|
||||
;; https://github.com/zenozeng/css-eldoc
|
||||
((string= lang "css") (when (require 'css-eldoc nil t)
|
||||
(css-eldoc-function)))
|
||||
;; https://github.com/zenozeng/php-eldoc
|
||||
((string= lang "php") (when (require 'php-eldoc nil t)
|
||||
(php-eldoc-function)))
|
||||
((or
|
||||
(string= lang "go")
|
||||
(string= lang "golang")) (when (require 'go-eldoc nil t)
|
||||
(go-eldoc--documentation-function)))
|
||||
(t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang))
|
||||
(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
|
|
@ -1,199 +0,0 @@
|
|||
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
|
||||
|
||||
;; Copyright (C) 2008-2020 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 <http://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
|
|
@ -1,216 +0,0 @@
|
|||
;;; org-eval.el --- Display result of evaluating code in various languages
|
||||
;; Copyright (C) 2008-2020 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 <http://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
|
|
@ -1,361 +0,0 @@
|
|||
;;; org-expiry.el --- expiry mechanism for Org entries
|
||||
;;
|
||||
;; Copyright 2007-2020 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Bastien Guerry
|
||||
;; 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 <http://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
|
|
@ -1,311 +0,0 @@
|
|||
;;; org-interactive-query.el --- Interactive modification of agenda query
|
||||
;;
|
||||
;; Copyright 2007-2020 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 <http://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)
|
|
@ -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)
|
|
@ -1,177 +0,0 @@
|
|||
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
|
||||
|
||||
;; Copyright (C) 2009-2020 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 <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; The file implements the learning algorithm described at
|
||||
;; http://supermemo.com/english/ol/sm5.htm, which is a system for reading
|
||||
;; material according to "spaced repetition". See
|
||||
;; http://en.wikipedia.org/wiki/Spaced_repetition for more details.
|
||||
;;
|
||||
;; To use, turn on state logging and schedule some piece of information you
|
||||
;; want to read. Then in the agenda buffer type
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-learn nil
|
||||
"Options concerning the learning code in Org-mode."
|
||||
:tag "Org Learn"
|
||||
:group 'org-progress)
|
||||
|
||||
(defcustom org-learn-always-reschedule nil
|
||||
"If non-nil, always reschedule items, even if retention was \"perfect\"."
|
||||
:type 'boolean
|
||||
:group 'org-learn)
|
||||
|
||||
(defcustom org-learn-fraction 0.5
|
||||
"Controls the rate at which EF is increased or decreased.
|
||||
Must be a number between 0 and 1 (the greater it is the faster
|
||||
the changes of the OF matrix)."
|
||||
:type 'float
|
||||
:group 'org-learn)
|
||||
|
||||
(defun initial-optimal-factor (n ef)
|
||||
(if (= 1 n)
|
||||
4
|
||||
ef))
|
||||
|
||||
(defun get-optimal-factor (n ef of-matrix)
|
||||
(let ((factors (assoc n of-matrix)))
|
||||
(or (and factors
|
||||
(let ((ef-of (assoc ef (cdr factors))))
|
||||
(and ef-of (cdr ef-of))))
|
||||
(initial-optimal-factor n ef))))
|
||||
|
||||
(defun set-optimal-factor (n ef of-matrix of)
|
||||
(let ((factors (assoc n of-matrix)))
|
||||
(if factors
|
||||
(let ((ef-of (assoc ef (cdr factors))))
|
||||
(if ef-of
|
||||
(setcdr ef-of of)
|
||||
(push (cons ef of) (cdr factors))))
|
||||
(push (cons n (list (cons ef of))) of-matrix)))
|
||||
of-matrix)
|
||||
|
||||
(defun inter-repetition-interval (n ef &optional of-matrix)
|
||||
(let ((of (get-optimal-factor n ef of-matrix)))
|
||||
(if (= 1 n)
|
||||
of
|
||||
(* of (inter-repetition-interval (1- n) ef of-matrix)))))
|
||||
|
||||
(defun modify-e-factor (ef quality)
|
||||
(if (< ef 1.3)
|
||||
1.3
|
||||
(+ ef (- 0.1 (* (- 5 quality) (+ 0.08 (* (- 5 quality) 0.02)))))))
|
||||
|
||||
(defun modify-of (of q fraction)
|
||||
(let ((temp (* of (+ 0.72 (* q 0.07)))))
|
||||
(+ (* (- 1 fraction) of) (* fraction temp))))
|
||||
|
||||
(defun calculate-new-optimal-factor (interval-used quality used-of
|
||||
old-of fraction)
|
||||
"This implements the SM-5 learning algorithm in Lisp.
|
||||
INTERVAL-USED is the last interval used for the item in question.
|
||||
QUALITY is the quality of the repetition response.
|
||||
USED-OF is the optimal factor used in calculation of the last
|
||||
interval used for the item in question.
|
||||
OLD-OF is the previous value of the OF entry corresponding to the
|
||||
relevant repetition number and the E-Factor of the item.
|
||||
FRACTION is a number belonging to the range (0,1) determining the
|
||||
rate of modifications (the greater it is the faster the changes
|
||||
of the OF matrix).
|
||||
|
||||
Returns the newly calculated value of the considered entry of the
|
||||
OF matrix."
|
||||
(let (;; the value proposed for the modifier in case of q=5
|
||||
(mod5 (/ (1+ interval-used) interval-used))
|
||||
;; the value proposed for the modifier in case of q=2
|
||||
(mod2 (/ (1- interval-used) interval-used))
|
||||
;; the number determining how many times the OF value will
|
||||
;; increase or decrease
|
||||
modifier)
|
||||
(if (< mod5 1.05)
|
||||
(setq mod5 1.05))
|
||||
(if (< mod2 0.75)
|
||||
(setq mod5 0.75))
|
||||
(if (> quality 4)
|
||||
(setq modifier (1+ (* (- mod5 1) (- quality 4))))
|
||||
(setq modifier (- 1 (* (/ (- 1 mod2) 2) (- 4 quality)))))
|
||||
(if (< modifier 0.05)
|
||||
(setq modifier 0.05))
|
||||
(setq new-of (* used-of modifier))
|
||||
(if (> quality 4)
|
||||
(if (< new-of old-of)
|
||||
(setq new-of old-of)))
|
||||
(if (< quality 4)
|
||||
(if (> new-of old-of)
|
||||
(setq new-of old-of)))
|
||||
(setq new-of (+ (* new-of fraction) (* old-of (- 1 fraction))))
|
||||
(if (< new-of 1.2)
|
||||
(setq new-of 1.2)
|
||||
new-of)))
|
||||
|
||||
(defvar initial-repetition-state '(-1 1 2.5 nil))
|
||||
|
||||
(defun determine-next-interval (n ef quality of-matrix)
|
||||
(assert (> n 0))
|
||||
(assert (and (>= quality 0) (<= quality 5)))
|
||||
(if (< quality 3)
|
||||
(list (inter-repetition-interval n ef) (1+ n) ef nil)
|
||||
(let ((next-ef (modify-e-factor ef quality)))
|
||||
(setq of-matrix
|
||||
(set-optimal-factor n next-ef of-matrix
|
||||
(modify-of (get-optimal-factor n ef of-matrix)
|
||||
quality org-learn-fraction))
|
||||
ef next-ef)
|
||||
;; For a zero-based quality of 4 or 5, don't repeat
|
||||
(if (and (>= quality 4)
|
||||
(not org-learn-always-reschedule))
|
||||
(list 0 (1+ n) ef of-matrix)
|
||||
(list (inter-repetition-interval n ef of-matrix) (1+ n)
|
||||
ef of-matrix)))))
|
||||
|
||||
(defun org-smart-reschedule (quality)
|
||||
(interactive "nHow well did you remember the information (on a scale of 0-5)? ")
|
||||
(let* ((learn-str (org-entry-get (point) "LEARN_DATA"))
|
||||
(learn-data (or (and learn-str
|
||||
(read learn-str))
|
||||
(copy-list initial-repetition-state)))
|
||||
closed-dates)
|
||||
(setq learn-data
|
||||
(determine-next-interval (nth 1 learn-data)
|
||||
(nth 2 learn-data)
|
||||
quality
|
||||
(nth 3 learn-data)))
|
||||
(org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data))
|
||||
(if (= 0 (nth 0 learn-data))
|
||||
(org-schedule t)
|
||||
(org-schedule nil (time-add (current-time)
|
||||
(days-to-time (nth 0 learn-data)))))))
|
||||
|
||||
(provide 'org-learn)
|
||||
|
||||
;;; org-learn.el ends here
|
|
@ -1,540 +0,0 @@
|
|||
;;; org-license.el --- Add a license to your org files
|
||||
|
||||
;; Copyright (C) 2013-2020 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 <http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by/3.0/pt/deed.pt")
|
||||
(insert (concat "* Licença
|
||||
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n")))
|
||||
(t
|
||||
(setq org-license-cc-url "http://creativecommons.org/licenses/by/4.0/deed")
|
||||
(concat (insert "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n"))))
|
||||
|
||||
(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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-sa/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n"))))
|
||||
|
||||
(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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
|
||||
(insert (concat "* Licenzua
|
||||
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
|
||||
((equal language "fi")
|
||||
(setq org-license-cc-url "http://creativecommons.org/licenses/by-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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-nd/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n"))))
|
||||
|
||||
|
||||
(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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-nc/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n"))))
|
||||
|
||||
(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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-nc-sa/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n"))))
|
||||
|
||||
(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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://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 "http://creativecommons.org/licenses/by-nc-nd/4.0/deed")
|
||||
(insert (concat "* License
|
||||
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International]]\n"))))
|
||||
(if (string= "" org-license-images-directory)
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
|
||||
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n"))))
|
||||
|
||||
(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 "http://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:http://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 "http://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:http://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")
|
||||
)
|
||||
|
||||
|
|
@ -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
|
|
@ -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 <http://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
|
File diff suppressed because it is too large
Load Diff
|
@ -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 <http://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
|
|
@ -1,406 +0,0 @@
|
|||
;;; org-notify.el --- Notifications for Org-mode
|
||||
|
||||
;; Copyright (C) 2012-2020 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 <http://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
|
|
@ -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 <http://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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file contains the code for managing your passwords with
|
||||
;; Org-mode. It is part of org/contrib (see 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
|
|
@ -1,272 +0,0 @@
|
|||
;;; org-registry.el --- a registry for Org links
|
||||
;;
|
||||
;; Copyright 2007-2014 Bastien Guerry
|
||||
;;
|
||||
;; 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 <http://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
|
|
@ -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 <http://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)
|
|
@ -1,529 +0,0 @@
|
|||
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
|
||||
;;
|
||||
;; Copyright (C) 2009-2020 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: http://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 <http://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)
|
|
@ -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 <http://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 (function (lambda (x) (concat pre x post))) lst sep))
|
||||
|
||||
(defun org-sec-get-with ()
|
||||
(if org-sec-with
|
||||
org-sec-with
|
||||
org-sec-me))
|
||||
|
||||
(defun org-sec-with-view (par &optional who)
|
||||
"Select tasks marked as dowith=who, where who
|
||||
defaults to the value of org-sec-with."
|
||||
(org-tags-view '(4) (join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with)))
|
||||
"|" "dowith=\"" "\"")))
|
||||
|
||||
(defun org-sec-where-view (par)
|
||||
"Select tasks marked as doat=org-sec-where."
|
||||
(org-tags-view '(4) (concat "doat={" org-sec-where "}")))
|
||||
|
||||
(defun org-sec-assigned-with-view (par &optional who)
|
||||
"Select tasks assigned to who, by default org-sec-with."
|
||||
(org-tags-view '(4)
|
||||
(concat (join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with)))
|
||||
"|")
|
||||
"/TASK")))
|
||||
|
||||
(defun org-sec-stuck-with-view (par &optional who)
|
||||
"Select stuck projects assigned to who, by default
|
||||
org-sec-with."
|
||||
(let ((org-stuck-projects
|
||||
`(,(concat "+prj+"
|
||||
(join (split-string (if who
|
||||
who
|
||||
(org-sec-get-with))) "|")
|
||||
"/-MAYBE-DONE")
|
||||
("TODO" "TASK") ())))
|
||||
(org-agenda-list-stuck-projects)))
|
||||
|
||||
(defun org-sec-who-view (par)
|
||||
"Builds agenda for a given user. Queried. "
|
||||
(let ((who (read-string "Build todo for user/tag: "
|
||||
"" "" "")))
|
||||
(org-sec-with-view "TODO dowith" who)
|
||||
(org-sec-assigned-with-view "TASK with" who)
|
||||
(org-sec-stuck-with-view "STUCK with" who)))
|
||||
|
||||
(provide 'org-secretary)
|
||||
|
||||
;;; org-secretary.el ends here
|
|
@ -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 <http://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)
|
|
@ -1,288 +0,0 @@
|
|||
;;; org-sudoku.el --- Create and solve SUDOKU games in Org tables
|
||||
|
||||
;; Copyright (C) 2012-2020 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 <http://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
|
|
@ -1,508 +0,0 @@
|
|||
;;; org-toc.el --- Table of contents for Org-mode buffer
|
||||
|
||||
;; Copyright 2007-2020 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 <http://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
|
|
@ -1,211 +0,0 @@
|
|||
;;; org-track.el --- Track the most recent Org-mode version available.
|
||||
;;
|
||||
;; Copyright (C) 2009-2020 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: http://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 <http://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
|
|
@ -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 <http://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
|
|
@ -1,327 +0,0 @@
|
|||
;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
|
||||
|
||||
;; Copyright (C) 2010-2020 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 <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(require 'org)
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-wikinodes nil
|
||||
"Wiki-like CamelCase links words to outline nodes in Org mode."
|
||||
:tag "Org WikiNodes"
|
||||
:group 'org)
|
||||
|
||||
(defconst org-wikinodes-camel-regexp "\\<[A-Z]+[a-z]+[A-Z]+[a-z]+[a-zA-Z]*\\>"
|
||||
"Regular expression matching CamelCase words.")
|
||||
|
||||
(defcustom org-wikinodes-active t
|
||||
"Should CamelCase links be active in the current file?"
|
||||
:group 'org-wikinodes
|
||||
:type 'boolean)
|
||||
(put 'org-wikinodes-active 'safe-local-variable 'booleanp)
|
||||
|
||||
(defcustom org-wikinodes-scope 'file
|
||||
"The scope of searches for wiki targets.
|
||||
Allowed values are:
|
||||
|
||||
file Search for targets in the current file only
|
||||
directory Search for targets in all org files in the current directory"
|
||||
:group 'org-wikinodes
|
||||
:type '(choice
|
||||
(const :tag "Find targets in current file" file)
|
||||
(const :tag "Find targets in current directory" directory)))
|
||||
|
||||
(defcustom org-wikinodes-create-targets 'query
|
||||
"Non-nil means create Wiki target when following a wiki link fails.
|
||||
Allowed values are:
|
||||
|
||||
nil never create node, just throw an error if the target does not exist
|
||||
query ask the user what to do
|
||||
t create the node in the current buffer
|
||||
\"file.org\" create the node in the file \"file.org\", in the same directory
|
||||
|
||||
If you are using wiki links across files, you need to set `org-wikinodes-scope'
|
||||
to `directory'."
|
||||
:group 'org-wikinodes
|
||||
:type '(choice
|
||||
(const :tag "Never automatically create node" nil)
|
||||
(const :tag "In current file" t)
|
||||
(file :tag "In one special file\n")
|
||||
(const :tag "Query the user" query)))
|
||||
|
||||
;;; Link activation
|
||||
|
||||
(defun org-wikinodes-activate-links (limit)
|
||||
"Activate CamelCase words as links to Wiki targets."
|
||||
(when org-wikinodes-active
|
||||
(let (case-fold-search)
|
||||
(if (re-search-forward org-wikinodes-camel-regexp limit t)
|
||||
(if (equal (char-after (point-at-bol)) ?*)
|
||||
(progn
|
||||
;; in heading - deactivate flyspell
|
||||
(org-remove-flyspell-overlays-in (match-beginning 0)
|
||||
(match-end 0))
|
||||
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
|
|
@ -1,118 +0,0 @@
|
|||
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
|
||||
|
||||
;; Copyright (C) 2008-2020 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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Converts an orgtbl to a sequence of SQL insertion commands.
|
||||
;; Table cells are quoted and escaped very conservatively.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defun orgtbl-to-sqlinsert (table params)
|
||||
"Convert the orgtbl-mode TABLE to SQL insert statements.
|
||||
TABLE is a list, each entry either the symbol `hline' for a horizontal
|
||||
separator line, or a list of fields for that line.
|
||||
PARAMS is a property list of parameters that can influence the conversion.
|
||||
|
||||
Names and strings are modified slightly by default. Single-ticks
|
||||
are doubled as per SQL's standard mechanism. Backslashes and
|
||||
dollar signs are deleted. And tildes are changed to spaces.
|
||||
These modifications were 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
|
|
@ -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:
|
||||
;;
|
||||
;; http://www.lri.fr/~filliatr/bibtex2html/
|
||||
;;
|
||||
;; For ascii it uses the pandoc software from:
|
||||
;;
|
||||
;; http://johnmacfarlane.net/pandoc/
|
||||
;;
|
||||
;; 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
|
|
@ -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 <http://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)
|
|
@ -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 <http://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' type='text/javascript'></script>" script))
|
||||
(plist-get pkg-info :scripts) "\n")
|
||||
(org-html--build-mathjax-config info)
|
||||
"<script type='text/javascript'>"
|
||||
" $(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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This file contains some convenience functions for org export, which
|
||||
;; are not part of org's core. Call `ox-extras-activate' passing a
|
||||
;; list of symbols naming extras, which will be installed globally in
|
||||
;; your org session.
|
||||
;;
|
||||
;; For example, you could include the following in your .emacs file:
|
||||
;;
|
||||
;; (require 'ox-extra)
|
||||
;; (ox-extras-activate '(latex-header-blocks ignore-headlines))
|
||||
;;
|
||||
|
||||
;; Currently available extras:
|
||||
|
||||
;; - `latex-header-blocks' -- allow the use of latex blocks, the
|
||||
;; contents of which which will be interpreted as #+latex_header lines
|
||||
;; for export. These blocks should be tagged with #+header: :header
|
||||
;; yes. For example:
|
||||
;; #+header: :header yes
|
||||
;; #+begin_export latex
|
||||
;; ...
|
||||
;; #+end_export
|
||||
|
||||
;; - `ignore-headlines' -- allow a headline (but not its children) to
|
||||
;; be ignored. Any headline tagged with the 'ignore' tag will be
|
||||
;; ignored (i.e. will not be included in the export), but any child
|
||||
;; headlines will not be ignored (unless explicitly tagged to be
|
||||
;; ignored), and will instead have their levels promoted by one.
|
||||
|
||||
;; TODO:
|
||||
;; - add a function to org-mode-hook that looks for a ox-extras local
|
||||
;; variable and activates the specified extras buffer-locally
|
||||
;; - allow specification of desired extras to be activated via
|
||||
;; customize
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ox)
|
||||
(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
|
|
@ -1,527 +0,0 @@
|
|||
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2013-2020 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 <http://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
|
File diff suppressed because it is too large
Load Diff
|
@ -1,419 +0,0 @@
|
|||
;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
|
||||
|
||||
;; Copyright (C) 2013-2015 Bastien Guerry
|
||||
|
||||
;; 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 <http://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: http://myblog.org/mypicture.jpg
|
||||
;; #+RSS_FEED_URL: http://myblog.org/feeds/blog.xml
|
||||
;;
|
||||
;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
|
||||
;;
|
||||
;; 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 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 pubdate0) "" ;; 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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library implements an S5 Presentation back-end for the Org
|
||||
;; generic exporter.
|
||||
|
||||
;; Installation
|
||||
;; ------------
|
||||
;; Get the s5 scripts from
|
||||
;; http://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' type='text/javascript'></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
|
File diff suppressed because it is too large
Load Diff
|
@ -1 +0,0 @@
|
|||
plantuml.jar
|
|
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -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 "${@}"
|
Binary file not shown.
|
@ -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 */
|
|
@ -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 http://jashkenas.github.com/docco/) generates
|
||||
HTML from JavaScript source code providing an attractive side-by-side
|
||||
display of source code and comments. This file (see [[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 [[http://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:
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||
#
|
||||
# Commentary:
|
||||
# ===========
|
||||
#
|
||||
# set cal-tex-diary to true so that diary entries show up in the calendar
|
||||
#
|
||||
# Usage:
|
||||
# ======
|
||||
#
|
||||
# run this makefile with
|
||||
#
|
||||
# make -f org2hpda
|
||||
#
|
||||
# The makfile will take the entries from your diary file and generate
|
||||
# two PDFs containing nicely printed weekly and monthly calendars. One
|
||||
# is done in the style of a pocketMod (http://www.pocketmod.com/) and
|
||||
# the other is done in the style of the Hipster PDA
|
||||
# (http://en.wikipedia.org/wiki/Hipster_PDA).
|
||||
#
|
||||
# Requirements:
|
||||
# =============
|
||||
#
|
||||
# the pdf* commands are part of the pdfjam package which can be found
|
||||
# at http://www.warwick.ac.uk/go/pdfjam
|
||||
|
||||
EMACS = emacs -batch -l ~/.emacs
|
||||
LATEX = latex
|
||||
DIARY = $($(EMACS) -eval "diary-file")
|
||||
|
||||
# Number of weeks to be printed. Should be a multiple of 4, because 4
|
||||
# of them are merged on one page. Can be set when invoking the script
|
||||
# as follows: make NUMBER_OF_WEEKS=8 -f org2hpda
|
||||
NUMBER_OF_WEEKS = 4
|
||||
|
||||
hipsterFiles = weekCalendar.pdf yearCalendar.pdf monthCalendar3.pdf monthCalendar2.pdf monthCalendar1.pdf
|
||||
pocketModFiles = weekCalendar.pdf yearCalendar-rotated.pdf \
|
||||
monthCalendar3-rotated.pdf monthCalendar2-rotated.pdf monthCalendar1-rotated.pdf
|
||||
|
||||
all: pocketMod.pdf hipsterPDA.pdf
|
||||
|
||||
%.dvi: %.tex
|
||||
# Quick hack to massage the LaTeX produced by cal-tex
|
||||
# quote '@', then increase font size of week calendars,
|
||||
# increase font of diary entries in moth calendar and
|
||||
# finally reduce links to their destination, i.e.
|
||||
# change '[[http://foo][bar]]' to 'bar'
|
||||
sed -e 's/\\verb|@|/\@/g' \
|
||||
-e 's/documentclass\[11pt\]/documentclass[12pt]/g' \
|
||||
-e 's/{\\tiny \\raggedright #3}/{\\small \\raggedright #3}/g' \
|
||||
-e 's/\[\[[^]]\+\]\[\([^]]\+\)\]\]/\1/g' \
|
||||
< $< > /tmp/temp-org-file.$$$$; mv /tmp/temp-org-file.$$$$ $<
|
||||
$(LATEX) $^
|
||||
|
||||
%.pdf: %.dvi
|
||||
dvipdf $^
|
||||
|
||||
%-rotated.pdf: %.pdf
|
||||
cp $^ $@
|
||||
for n in 1 2 3; do \
|
||||
pdf90 --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
|
|
@ -1 +0,0 @@
|
|||
*~
|
|
@ -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 [[http://en.wikipedia.org/wiki/Data_URI_scheme]])
|
||||
|
||||
The code is licensed under the GNU General Public License version
|
||||
2, or, at your option, any later version.
|
||||
|
||||
|
||||
* Usage
|
||||
To run Static MathJax, an existing XULRunner installation is
|
||||
required. From the directory to which you unpacked Static MathJax,
|
||||
run:
|
||||
|
||||
xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>>
|
||||
<input file> <output file>
|
||||
|
||||
If you prefer to call "staticmathjax" instead of "xulrunner
|
||||
application.ini", link xulrunner-stub into the directory:
|
||||
ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax
|
||||
|
||||
- input file ::
|
||||
name of the input file (the result of a HTML export
|
||||
from Org-mode). It is assumed that this file uses the
|
||||
UTF-8 character encoding.
|
||||
|
||||
- output file ::
|
||||
name of the output file.
|
||||
|
||||
- --embed-fonts ::
|
||||
if specified, the math fonts will be embedded into
|
||||
the output file using data: URIs
|
||||
|
||||
- --final-mathjax-url <URL> ::
|
||||
if --embed-fonts is not specified, this
|
||||
must be the URL to a MathJax installation folder (e.g. "MathJax"
|
||||
if MathJax is installed in a subdirectory, or
|
||||
"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.
|
|
@ -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
|
||||
|
|
@ -1 +0,0 @@
|
|||
content staticmathjax file:content/
|
|
@ -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);
|
||||
}
|
||||
}
|
|
@ -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>
|
|
@ -1 +0,0 @@
|
|||
pref("toolkit.defaultChromeURI", "chrome://staticmathjax/content/main.xul");
|
|
@ -1,28 +0,0 @@
|
|||
#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
|
||||
*/
|
||||
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;
|
||||
}
|
33
doc/Makefile
33
doc/Makefile
|
@ -9,7 +9,7 @@ all: $(ORG_MAKE_DOC)
|
|||
|
||||
info: org orgguide
|
||||
|
||||
html: org.html
|
||||
html: org.html orgguide.html
|
||||
|
||||
pdf: org.pdf orgguide.pdf
|
||||
|
||||
|
@ -28,9 +28,9 @@ guide:: orgguide.texi org-version.inc
|
|||
endif
|
||||
|
||||
org.texi orgguide.texi: org-manual.org org-guide.org
|
||||
$(BATCH) \
|
||||
--eval '(add-to-list '"'"'load-path "../lisp")' \
|
||||
--eval '(load "../mk/org-fixup.el")' \
|
||||
$(BATCH) \
|
||||
--eval '(add-to-list `load-path "../lisp")' \
|
||||
--eval '(load "../mk/org-fixup.el")' \
|
||||
--eval '(org-make-manuals)'
|
||||
|
||||
org-version.inc: org.texi
|
||||
|
@ -48,16 +48,17 @@ org-version.tex: orgcard.tex
|
|||
|
||||
install: org orgguide
|
||||
if [ ! -d $(DESTDIR)$(infodir) ]; then $(MKDIR) $(DESTDIR)$(infodir); else true; fi ;
|
||||
$(CP) org $(DESTDIR)$(infodir)
|
||||
$(CP) orgguide $(DESTDIR)$(infodir)
|
||||
$(INSTALL_INFO) --infodir=$(DESTDIR)$(infodir) org
|
||||
$(INSTALL_INFO) --infodir=$(DESTDIR)$(infodir) orgguide
|
||||
$(CP) org.info $(DESTDIR)$(infodir)
|
||||
$(CP) orgguide.info $(DESTDIR)$(infodir)
|
||||
$(INSTALL_INFO) --infodir=$(DESTDIR)$(infodir) org.info
|
||||
$(INSTALL_INFO) --infodir=$(DESTDIR)$(infodir) orgguide.info
|
||||
|
||||
clean:
|
||||
$(RM) org orgguide *.pdf *.html *_letter.tex org-version.inc \
|
||||
org-version.tex *.aux *.cp *.cps *.dvi *.fn *.fns *.ky *.kys \
|
||||
*.pg *.pgs *.toc *.tp *.tps *.vr *.vrs *.log *.html *.ps
|
||||
$(RM) *.pdf *.html *.info *_letter.tex org-version.inc org-version.tex \
|
||||
*.aux *.cp *.cps *.dvi *.fn *.fns *.ky *.kys *.pg *.pgs *.toc \
|
||||
*.tp *.tps *.vr *.vrs *.log *.ps
|
||||
cleanall: clean
|
||||
$(RM) org.texi orgguide.texi
|
||||
$(RMR) guide manual
|
||||
|
||||
clean-install:
|
||||
|
@ -68,7 +69,7 @@ clean-install:
|
|||
.SUFFIXES: .texi .tex .txt _letter.tex
|
||||
|
||||
%: %.texi org-version.inc
|
||||
$(MAKEINFO) --no-split $< -o $@
|
||||
$(MAKEINFO) --no-split $< -o $@.info
|
||||
|
||||
# the following two lines work around a bug in some versions of texi2dvi
|
||||
%.pdf: LC_ALL=C
|
||||
|
@ -88,8 +89,8 @@ ifneq ($(SERVERMK),)
|
|||
endif
|
||||
|
||||
%_letter.tex: %.tex
|
||||
$(BATCH) \
|
||||
--eval '(add-to-list '"'"'load-path "../lisp")' \
|
||||
--eval '(load "org-compat.el")' \
|
||||
--eval '(load "../mk/org-fixup.el")' \
|
||||
$(BATCH) \
|
||||
--eval '(add-to-list `load-path "../lisp")' \
|
||||
--eval '(load "org-compat.el")' \
|
||||
--eval '(load "../mk/org-fixup.el")' \
|
||||
--eval '(org-make-letterformat "$(<F)" "$(@F)")'
|
||||
|
|
|
@ -7,7 +7,7 @@ Version 1.3, 3 November 2008
|
|||
|
||||
#+begin_verse
|
||||
Copyright \copy{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
|
||||
http://fsf.org/
|
||||
https://fsf.org/
|
||||
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
@ -404,7 +404,7 @@ of this license document, but changing it is not allowed.
|
|||
the GNU Free Documentation License from time to time. Such new
|
||||
versions will be similar in spirit to the present version, but may
|
||||
differ in detail to address new problems or concerns. See
|
||||
http://www.gnu.org/copyleft/.
|
||||
https://www.gnu.org/copyleft/.
|
||||
|
||||
Each version of the License is given a distinguishing version
|
||||
number. If the Document specifies that a particular numbered
|
||||
|
|
|
@ -1,2 +1,2 @@
|
|||
calc mono http://www.gnu.org/software/emacs/manual/html_mono/calc.html
|
||||
calc node http://www.gnu.org/software/emacs/manual/html_node/calc/
|
||||
calc mono https://www.gnu.org/software/emacs/manual/html_mono/calc.html
|
||||
calc node https://www.gnu.org/software/emacs/manual/html_node/calc/
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
:copying: t
|
||||
:END:
|
||||
|
||||
Copyright \copy 2004--2020 Free Software Foundation, Inc.
|
||||
Copyright \copy 2004--2021 Free Software Foundation, Inc.
|
||||
|
||||
#+begin_quote
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
|
@ -59,7 +59,6 @@ subdirectories to the Emacs load path. To do this, add the following
|
|||
line to your Emacs init file:
|
||||
|
||||
: (add-to-list 'load-path "~/path/to/orgdir/lisp")
|
||||
: (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t)
|
||||
|
||||
#+texinfo: @noindent
|
||||
If you have been using git or a tar ball to get Org, you need to run
|
||||
|
@ -77,9 +76,9 @@ keys for three commands that are useful in any Emacs buffer, not just
|
|||
Org buffers. Please choose suitable keys yourself.
|
||||
|
||||
#+begin_src emacs-lisp
|
||||
(global-set-key (kbd "C-c l") 'org-store-link)
|
||||
(global-set-key (kbd "C-c a") 'org-agenda)
|
||||
(global-set-key (kbd "C-c c") 'org-capture)
|
||||
(global-set-key (kbd "C-c l") #'org-store-link)
|
||||
(global-set-key (kbd "C-c a") #'org-agenda)
|
||||
(global-set-key (kbd "C-c c") #'org-capture)
|
||||
#+end_src
|
||||
|
||||
Files with extension =.org= will be put into Org mode automatically.
|
||||
|
@ -169,8 +168,8 @@ Org uses just two commands, bound to {{{kbd(TAB)}}} and
|
|||
When Emacs first visits an Org file, the global state is set to
|
||||
OVERVIEW, i.e., only the top level headlines are visible. This can be
|
||||
configured through the variable ~org-startup-folded~, or on a per-file
|
||||
basis by adding a =STARTUP= keyword to =overview=, =content=, or
|
||||
=showall=, like this:
|
||||
basis by adding a =STARTUP= keyword to =overview=, =content=,
|
||||
=showall=, =showeverything= or =show<n>levels= (n = 2..5) like this:
|
||||
|
||||
: #+STARTUP: content
|
||||
|
||||
|
@ -2221,7 +2220,7 @@ compatible with XHTML 1.0 strict standard.
|
|||
- {{{kbd(C-c C-e h h)}}} ::
|
||||
|
||||
Export as HTML file with a =.html= extension. For =myfile.org=, Org
|
||||
exports to =myfile.html=, overwriting without warning. {{{kbd{C-c
|
||||
exports to =myfile.html=, overwriting without warning. {{{kbd(C-c
|
||||
C-e h o)}}} exports to HTML and opens it in a web browser.
|
||||
|
||||
The HTML export back-end transforms =<= and =>= to =<= and =>=.
|
||||
|
@ -2334,12 +2333,13 @@ example:
|
|||
(setq org-publish-project-alist
|
||||
'(("org"
|
||||
:base-directory "~/org/"
|
||||
:publishing-function org-html-publish-to-html
|
||||
:publishing-directory "~/public_html"
|
||||
:section-numbers nil
|
||||
:table-of-contents nil
|
||||
:style "<link rel=\"stylesheet\"
|
||||
href=\"../other/mystyle.css\"
|
||||
type=\"text/css\"/>")))
|
||||
:with-toc nil
|
||||
:html-head "<link rel=\"stylesheet\"
|
||||
href=\"../other/mystyle.css\"
|
||||
type=\"text/css\"/>")))
|
||||
#+end_src
|
||||
|
||||
- {{{kbd(C-c C-e P x)}}} ::
|
||||
|
|
899
doc/org.org
899
doc/org.org
File diff suppressed because it is too large
Load Diff
|
@ -17,7 +17,7 @@
|
|||
\pdflayout=(0l)
|
||||
|
||||
% Nothing else needs to be changed below this line.
|
||||
% Copyright (C) 1987, 1993, 1996-1997, 2001-2020 Free Software
|
||||
% Copyright (C) 1987, 1993, 1996--1997, 2001--2021 Free Software
|
||||
% Foundation, Inc.
|
||||
|
||||
% This document is free software: you can redistribute it and/or modify
|
||||
|
|
|
@ -13,7 +13,7 @@
|
|||
% GNU General Public License for more details.
|
||||
|
||||
% You should have received a copy of the GNU General Public License
|
||||
% along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
% This file defines `\pdflayout':
|
||||
% - \pdflayout=(0) is A4 portrait,
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
% General Public License for more details.
|
||||
%
|
||||
% You should have received a copy of the GNU General Public License
|
||||
% along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
% along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
%
|
||||
% As a special exception, when this file is read by TeX when processing
|
||||
% a Texinfo source document, you may use the result without
|
||||
|
@ -29,9 +29,9 @@
|
|||
%
|
||||
% Please try the latest version of texinfo.tex before submitting bug
|
||||
% reports; you can get the latest version from:
|
||||
% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
|
||||
% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
|
||||
% http://www.gnu.org/software/texinfo/ (the Texinfo home page)
|
||||
% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
|
||||
% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
|
||||
% https://www.gnu.org/software/texinfo/ (the Texinfo home page)
|
||||
% The texinfo.tex in any given distribution could well be out
|
||||
% of date, so if that's what you're using, please check.
|
||||
%
|
||||
|
@ -55,7 +55,7 @@
|
|||
% extent. You can get the existing language-specific files from the
|
||||
% full Texinfo distribution.
|
||||
%
|
||||
% The GNU Texinfo home page is http://www.gnu.org/software/texinfo.
|
||||
% The GNU Texinfo home page is https://www.gnu.org/software/texinfo.
|
||||
|
||||
|
||||
\message{Loading texinfo [version \texinfoversion]:}
|
||||
|
@ -3101,7 +3101,7 @@ end
|
|||
% We use the free feym* fonts from the eurosym package by Henrik
|
||||
% Theiling, which support regular, slanted, bold and bold slanted (and
|
||||
% "outlined" (blackboard board, sort of) versions, which we don't need).
|
||||
% It is available from http://www.ctan.org/tex-archive/fonts/eurosym.
|
||||
% It is available from https://www.ctan.org/tex-archive/fonts/eurosym.
|
||||
%
|
||||
% Although only regular is the truly official Euro symbol, we ignore
|
||||
% that. The Euro is designed to be slightly taller than the regular
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
ETCDIRS = styles schema
|
||||
ETCDIRS = styles schema csl
|
||||
-include local.mk # optional local customization
|
||||
|
||||
.NOTPARALLEL: # always run this make serially
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue