daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-02-26 20:16:44 +01:00
parent 59db017445
commit 45d49daef0
291 changed files with 16240 additions and 522600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
lisp/org-contrib/README-elpa
View File

@@ -54,6 +54,8 @@ from [https://elpa.nongnu.org/nongnu/].
If a file has a "Homepage:" keyword, it will be removed from the next
minor or major release.
• `ox-taskjuggler.el'
5 Other files
═════════════
@@ -79,10 +81,6 @@ from [https://elpa.nongnu.org/nongnu/].
Measuring your personal effectiveness
org-eldoc.el
Eldoc documentation for SRC blocks
org-eval.el
The <lisp> tag, adapted from Muse
org-eval-light.el
Evaluate in-buffer code on demand
org-expiry.el
Expiry mechanism for Org entries
org-git-link.el
@@ -109,8 +107,6 @@ from [https://elpa.nongnu.org/nongnu/].
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
@@ -138,8 +134,6 @@ from [https://elpa.nongnu.org/nongnu/].
Groff exporter
ox-s5.el
S5 presentations exporter
ox-taskjuggler.el
TaskJuggler exporter
5.3 Org link
@@ -164,10 +158,6 @@ from [https://elpa.nongnu.org/nongnu/].
ob-abc.el
Org-mode Babel Functions for ABC
ob-asymptote.el
Org-mode Babel Functions for Asymptote
ob-coq.el
Org-mode Babel Functions for Coq
ob-csharp.el
Org-mode Babel Functions for csharp evaluation
ob-ebnf.el

8
lisp/org-contrib/README.org
View File

@@ -38,6 +38,8 @@ copy of the repository like this:
If a file has a "Homepage:" keyword, it will be removed from the next
minor or major release.
- ~ox-taskjuggler.el~
** Other files
*** Org utils
@@ -50,8 +52,6 @@ minor or major release.
- org-depend.el :: TODO dependencies for Org-mode
- org-effectiveness.el :: Measuring your personal effectiveness
- org-eldoc.el :: Eldoc documentation for SRC blocks
- org-eval.el :: The <lisp> tag, adapted from Muse
- org-eval-light.el :: Evaluate in-buffer code on demand
- org-expiry.el :: Expiry mechanism for Org entries
- org-git-link.el :: Provide org links to specific file version
- org-interactive-query.el :: Interactive modification of tags query
@@ -65,7 +65,6 @@ minor or major release.
- 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
@@ -80,7 +79,6 @@ minor or major release.
- ox-freemind.el :: Freemind exporter
- ox-groff.el :: Groff exporter
- ox-s5.el :: S5 presentations exporter
- ox-taskjuggler.el :: TaskJuggler exporter
*** Org link
@@ -94,8 +92,6 @@ minor or major release.
*** Org Babel languages
- ob-abc.el :: Org-mode Babel Functions for ABC
- ob-asymptote.el :: Org-mode Babel Functions for Asymptote
- ob-coq.el :: Org-mode Babel Functions for Coq
- ob-csharp.el :: Org-mode Babel Functions for csharp evaluation
- ob-ebnf.el :: Org-mode Babel Functions for EBNF
- ob-eukleides.el :: Org-mode Babel Functions for eukleides evaluation

138
lisp/org-contrib/ob-asymptote.el
View File

@@ -1,138 +0,0 @@
;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Jarmo Hurri <jarmo.hurri@iki.fi>
;; Keywords: literate programming, reproducible research
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; This file is not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating asymptote source code.
;;
;; This differs from most standard languages in that
;;
;; 1) there is no such thing as a "session" in asymptote
;;
;; 2) we are generally only going to return results of type "file"
;;
;; 3) we are adding the "file" and "cmdline" header arguments, if file
;; is omitted then the -V option is passed to the asy command for
;; interactive viewing
;;; Requirements:
;; - The asymptote program :: http://asymptote.sourceforge.net/
;;
;; - asy-mode :: Major mode for editing asymptote files
;;; Code:
(require 'ob)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
(defvar org-babel-default-header-args:asymptote
'((:results . "file") (:exports . "results"))
"Default arguments when evaluating an Asymptote source block.")
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
(let* ((out-file (cdr (assq :file params)))
(format (or (file-name-extension out-file)
"pdf"))
(cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd
(concat "asy "
(if out-file
(concat
"-globalwrite -f " format
" -o " (org-babel-process-file-name out-file))
"-V")
" " cmdline
" " (org-babel-process-file-name in-file))))
(with-temp-file in-file
(insert (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:asymptote params))))
(message cmd) (shell-command cmd)
nil)) ;; signal that output has already been written to file
(defun org-babel-prep-session:asymptote (_session _params)
"Return an error if the :session header argument is set.
Asymptote does not support sessions."
(error "Asymptote does not support sessions"))
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables."
(mapcar #'org-babel-asymptote-var-to-asymptote
(org-babel--get-vars params)))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
The elisp value PAIR is converted into Asymptote code specifying
a variable of the same value."
(let ((var (car pair))
(val (let ((v (cdr pair)))
(if (symbolp v) (symbol-name v) v))))
(cond
((integerp val)
(format "int %S=%S;" var val))
((floatp val)
(format "real %S=%S;" var val))
((stringp val)
(format "string %S=\"%s\";" var val))
((and (listp val) (not (listp (car val))))
(let* ((type (org-babel-asymptote-define-type val))
(fmt (if (eq 'string type) "\"%s\"" "%s"))
(vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
(format "%s[] %S={%s};" type var vect)))
((listp val)
(let* ((type (org-babel-asymptote-define-type val))
(fmt (if (eq 'string type) "\"%s\"" "%s"))
(array (mapconcat (lambda (row)
(concat "{"
(mapconcat (lambda (e) (format fmt e))
row ", ")
"}"))
val ",")))
(format "%S[][] %S={%s};" type var array))))))
(defun org-babel-asymptote-define-type (data)
"Determine type of DATA.
DATA is a list. Return type as a symbol.
The type is `string' if any element in DATA is a string.
Otherwise, it is either `real', if some elements are floats, or
`int'."
(letrec ((type 'int)
(find-type
(lambda (row)
(dolist (e row type)
(cond ((listp e) (setq type (funcall find-type e)))
((stringp e) (throw 'exit 'string))
((floatp e) (setq type 'real)))))))
(catch 'exit (funcall find-type data)) type))
(provide 'ob-asymptote)
;;; ob-asymptote.el ends here

81
lisp/org-contrib/ob-coq.el
View File

@@ -1,81 +0,0 @@
;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;; Author: Eric Schulte
;; Maintainer: Luc Pellissier <luc.pellissier@crans.org>
;; Keywords: literate programming, reproducible research
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; This file is not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Rudimentary support for evaluating Coq code blocks. Currently only
;; session evaluation is supported. Requires both coq.el and
;; coq-inferior.el, both of which are distributed with Coq.
;;
;; https://coq.inria.fr/
;;; Code:
(require 'ob)
(declare-function run-coq "ext:coq-inferior.el" (cmd))
(declare-function coq-proc "ext:coq-inferior.el" ())
(defvar coq-program-name "coqtop"
"Name of the coq toplevel to run.")
(defvar org-babel-coq-buffer "*coq*"
"Buffer in which to evaluate coq code blocks.")
(defun org-babel-coq-clean-prompt (string)
(if (string-match "^[^[:space:]]+ < " string)
(substring string 0 (match-beginning 0))
string))
(defun org-babel-execute:coq (body params)
(let ((full-body (org-babel-expand-body:generic body params))
(session (org-babel-coq-initiate-session))
(pt (lambda ()
(marker-position
(process-mark (get-buffer-process (current-buffer)))))))
(org-babel-coq-clean-prompt
(org-babel-comint-in-buffer session
(let ((start (funcall pt)))
(with-temp-buffer
(insert full-body)
(comint-send-region (coq-proc) (point-min) (point-max))
(comint-send-string (coq-proc)
(if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
"\n"
".\n")))
(while (equal start (funcall pt)) (sleep-for 0.1))
(buffer-substring start (funcall pt)))))))
(defun org-babel-coq-initiate-session ()
"Initiate a coq session.
If there is not a current inferior-process-buffer in SESSION then
create one. Return the initialized session."
(unless (fboundp 'run-coq)
(error "`run-coq' not defined, load coq-inferior.el"))
(save-window-excursion (run-coq coq-program-name))
(sit-for 0.1)
(get-buffer org-babel-coq-buffer))
(provide 'ob-coq)
;;; ob-coq.el ends here

15
lisp/org-contrib/ob-csharp.el
View File

@@ -1,4 +1,4 @@
;;; ob-csharp.el --- org-babel functions for csharp evaluation
;;; ob-csharp.el --- org-babel functions for csharp evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -55,11 +55,12 @@ parameters may be used, like mcs -warnaserror+"
(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) ""))))
(exe-file (concat (file-name-sans-extension src-file) ".exe")))
;; compile
(with-temp-file src-file (insert full-body))
(org-babel-eval
(concat org-babel-csharp-compiler " " cmpflag " " src-file) "")
;; execute
(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))
@@ -72,7 +73,7 @@ parameters may be used, like mcs -warnaserror+"
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-prep-session:csharp (session 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"))

25
lisp/org-contrib/ob-eukleides.el
View File

@@ -1,4 +1,4 @@
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation
;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
@@ -58,36 +58,33 @@
(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))
(let* ((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)))))
" -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")))
(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)
(defun org-babel-prep-session:eukleides (_session _params)
"Return an error because eukleides does not support sessions."
(error "Eukleides does not support sessions"))

7
lisp/org-contrib/ob-fomus.el
View File

@@ -1,4 +1,4 @@
;;; ob-fomus.el --- Org-babel functions for fomus evaluation
;;; ob-fomus.el --- Org-babel functions for fomus evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2014, 2021 Torsten Anders
@@ -64,8 +64,7 @@
(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)))
(let* ((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")))
@@ -83,7 +82,7 @@ This function is called by `org-babel-execute-src-block'."
" -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)
(defun org-babel-prep-session:fomus (_session _params)
"Return an error because Fomus does not support sessions."
(error "Fomus does not support sessions"))

28
lisp/org-contrib/ob-mathomatic.el
View File

@@ -1,4 +1,4 @@
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation
;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -45,7 +45,8 @@
(defcustom org-babel-mathomatic-command
(if (boundp 'mathomatic-command) mathomatic-command "mathomatic")
"Command used to call mathomatic on the shell."
:group 'org-babel)
:group 'org-babel
:type 'string)
(defun org-babel-mathomatic-expand (body params)
"Expand a block of Mathomatic code according to its header arguments."
@@ -93,17 +94,16 @@ called by `org-babel-execute-src-block'."
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 "")))))
;; " | 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 (org-babel-eval cmd "") "[\r\n]"))) "\n"))))
(if (org-babel-mathomatic-graphical-output-file params)
nil
(if (or (member "scalar" result-params)
@@ -114,7 +114,7 @@ called by `org-babel-execute-src-block'."
(with-temp-file tmp-file (insert result))
(org-babel-import-elisp-from-file tmp-file))))))
(defun org-babel-prep-session:mathomatic (session params)
(defun org-babel-prep-session:mathomatic (_session _params)
(error "Mathomatic does not support sessions"))
(defun org-babel-mathomatic-var-to-mathomatic (pair)

58
lisp/org-contrib/ob-oz.el
View File

@@ -1,4 +1,4 @@
;;; ob-oz.el --- Org-babel functions for Oz evaluation
;;; ob-oz.el --- Org-babel functions for Oz evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2014, 2021 Torsten Anders and Eric Schulte
@@ -92,6 +92,10 @@
;;; major mode for editing Oz programs
(require 'mozart nil t)
(defvar oz-compiler-buffer) ; defined in mozart.el
(declare-function oz-send-string "ext:mozart" (string &optional system))
(declare-function run-oz "ext:mozart" ())
;;
;; Interface to communicate with Oz.
;; (1) For statements without any results: oz-send-string
@@ -135,9 +139,9 @@ StartOzServer.oz is located.")
(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)
(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-results (cons string org-babel-oz-collected-results))
(setq org-babel-oz-collected-result string)
)
@@ -165,7 +169,12 @@ StartOzServer.oz is located.")
;; 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."
"Send a string to the OPI compiler.
Similar to `oz-send-string', but string must be an expression and this
function returns the result of the expression (as string).
The function 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)
@@ -174,26 +183,21 @@ StartOzServer.oz is located.")
;; 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))))
(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)))
(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))
(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)
@@ -234,7 +238,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
;; 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)
(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)
@@ -264,7 +268,7 @@ called by `org-babel-execute-src-block' via multiple-value-bind."
;;
;; 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)
(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")
@@ -284,7 +288,7 @@ specifying a var of the same value."
))
;; TODO:
(defun org-babel-oz-table-or-string (results)
(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"))

51
lisp/org-contrib/ob-stata.el
View File

@@ -1,4 +1,4 @@
;;; ob-stata.el --- org-babel functions for stata code evaluation
;;; ob-stata.el --- org-babel functions for stata code evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2014, 2021 Ista Zahn
;; Author: Ista Zahn istazahn@gmail.com
@@ -66,12 +66,20 @@
;; 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
(defcustom org-babel-stata-command nil
"Name of command to use for executing stata code."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.3")
:type 'string)
;; FIXME: Arrange the default value to be set without byte-compiler
;; complaining. A proper fix would be putting this file into a
;; separate package and adding ESS to package requires. Not possible
;; while it is a part of org-contrib.
(defvar inferior-STA-program)
(eval-after-load 'ess-custom
(unless org-babel-stata-command
(setq org-babel-stata-command inferior-STA-program)))
(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:stata (info)
@@ -85,12 +93,13 @@
(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")))
(if graphics-file
(append (org-babel-variable-assignments:stata params)
(list body))
;; FIXME: same value for both `if' branches.
(append (org-babel-variable-assignments:stata params)
(list body)))
"\n")))
(defun org-babel-execute:stata (body params)
"Execute a block of stata code.
@@ -152,7 +161,7 @@ This function is called by `org-babel-execute-src-block'."
(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)))))))
(number-sequence 0 (1- (length vars)))))))
(defun org-babel-stata-quote-csv-field (s)
"Quote field S for export to stata."
@@ -160,7 +169,7 @@ This function is called by `org-babel-execute-src-block'."
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
(format "%S" s)))
(defun org-babel-stata-assign-elisp (name value colnames-p rownames-p)
(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
@@ -175,9 +184,11 @@ This function is called by `org-babel-execute-src-block'."
(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")))
;; FIXME: unused.
;; (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\""
@@ -233,11 +244,12 @@ current code buffer."
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)
(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
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."
(require 'ess-custom)
(cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "stata-")))
@@ -254,11 +266,12 @@ last statement in BODY, as elisp."
column-names-p)))
(output (org-babel-eval org-babel-stata-command body))))
(defvar ess-eval-visibly-p)
(defun org-babel-stata-evaluate-session
(session body result-type result-params column-names-p row-names-p)
(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
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

18
lisp/org-contrib/ob-tcl.el
View File

@@ -1,4 +1,4 @@
;;; ob-tcl.el --- Org-babel functions for tcl evaluation
;;; ob-tcl.el --- Org-babel functions for tcl evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -31,7 +31,6 @@
;;; 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"))
@@ -48,11 +47,10 @@
"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)))
(session (org-babel-tcl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-tcl-evaluate session full-body result-type)
(org-babel-pick-name
@@ -60,7 +58,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defun org-babel-prep-session:tcl (session 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"))
@@ -85,9 +83,9 @@ specifying a var of the same value."
(defvar org-babel-tcl-buffers '(:default . nil))
(defun org-babel-tcl-initiate-session (&optional session params)
(defun org-babel-tcl-initiate-session (&optional _session _params)
"Return nil because sessions are not supported by tcl."
nil)
nil)
(defvar org-babel-tcl-wrapper-method
"
@@ -108,11 +106,11 @@ close $o
(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
If RESULT-TYPE equals symbol \\='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
(cl-case result-type
(output (org-babel-eval org-babel-tcl-command body))
(value (let ((tmp-file (org-babel-temp-file "tcl-")))
(org-babel-eval

15
lisp/org-contrib/ob-vbnet.el
View File

@@ -1,4 +1,4 @@
;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation
;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -55,12 +55,11 @@ parameters may be used, like vbnc /warnaserror+"
(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)
""))))
(exe-file (concat (file-name-sans-extension src-file) ".exe")))
;; Compile.
(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))
@@ -73,7 +72,7 @@ parameters may be used, like vbnc /warnaserror+"
(org-babel-pick-name
(cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-prep-session:vbnet (session 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"))

6
lisp/org-contrib/ol-bookmark.el
View File

@@ -1,4 +1,4 @@
;;; ol-bookmark.el --- Links to bookmarks
;;; ol-bookmark.el --- Links to bookmarks -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
@@ -59,6 +59,8 @@ Otherwise prompt the user for the right bookmark to use."
(defun org-bookmark-store-link ()
"Store a link to the current line's bookmark in bookmark list."
(require 'dired)
(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
(let (file bookmark bmks)
(cond ((and org-bookmark-in-dired
(eq major-mode 'dired-mode))
@@ -83,7 +85,7 @@ Otherwise prompt the user for the right bookmark to use."
(car bmks)
(completing-read "Bookmark: " bmks nil t nil nil (car bmks))))))
(if bookmark
(org-store-link-props :link (concat "bookmark:" bookmark)
(org-link-store-props :link (concat "bookmark:" bookmark)
:description bookmark))))
(provide 'ol-bookmark)

6
lisp/org-contrib/ol-elisp-symbol.el
View File

@@ -1,4 +1,4 @@
;;; ol-elisp-symbol.el --- Links to Emacs-lisp symbols
;;; ol-elisp-symbol.el --- Links to Emacs-lisp symbols -*- lexical-binding: t; -*-
;;
;; Copyright 2007-2021 Free Software Foundation, Inc.
;;
@@ -99,7 +99,7 @@
(sym-name (intern-soft name))
(stype (cond ((commandp sym-name) "Command")
((functionp sym-name) "Function")
((user-variable-p sym-name) "User variable")
((custom-variable-p sym-name) "User variable")
((string= def "defvar") "Variable")
((string= def "defmacro") "Macro")
((string= def "defun") "Function or command")
@@ -133,7 +133,7 @@
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
"::" def " " name))
(setq description (concat stype ": " name))
(org-store-link-props
(org-link-store-props
:type "elisp-symbol"
:link link
:description description

35
lisp/org-contrib/ol-git-link.el
View File

@@ -1,4 +1,4 @@
;;; ol-git-link.el --- Links to specific file version
;;; ol-git-link.el --- Links to specific file version -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2014, 2021 Reimar Finken
@@ -75,7 +75,12 @@
(defun org-gitbare-open (str _)
(let* ((strlist (org-git-split-string str))
(gitdir (nth 0 strlist))
;; If the provided path ends in /.git, use it. Otherwise,
;; append "/.git".
(gitdir (let ((path (nth 0 strlist)))
(if (string-suffix-p "/.git" path)
(expand-file-name path)
(expand-file-name ".git" path))))
(object (nth 1 strlist)))
(org-git-open-file-internal gitdir object)))
@@ -115,19 +120,22 @@
;; Utility functions (file names etc)
(defun org-git-split-dirpath (dirpath)
"Given a directory name, return '(dirname basname)"
"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."
"Given a file PATH, return the a pair (gitdir relpath)
File does not have to exist.
GITDIR is the path to the first .git subdirectory found updstream.
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
@@ -149,8 +157,9 @@
;; 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
"Split STR by \"::\" and return list of strings.
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))
@@ -192,13 +201,13 @@ than two double colons, str2 and/or str3 may be set the empty string."
(let ((file (abbreviate-file-name (buffer-file-name)))
(line (line-number-at-pos)))
(when (org-git-gitrepos-p file)
(org-store-link-props
(org-link-store-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)))
(insert (org-link-make-string (concat "git:" file "::" searchstring) description)))
;; Calling git
(defun org-git-show (gitdir object buffer)

15
lisp/org-contrib/ol-mew.el
View File

@@ -1,4 +1,4 @@
;;; ol-mew.el --- Links to Mew messages
;;; ol-mew.el --- Links to Mew messages -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -99,11 +99,12 @@ destination folders before capture."
: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.
"Alist assigning folder name and the capture template key.
The key in the alist is regular expression matching the folder name.
For example,
'((\"^%emacs-orgmode$\" . \"o\")
\\='((\"^%emacs-orgmode$\" . \"o\")
(\"\" . \"t\"))
the messages in \"%emacs-orgmode\" folder will be captured with
the capture template associated with \"o\" key, and any other
@@ -169,12 +170,12 @@ with \"t\" key."
(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
(org-link-store-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 desc (org-link-email-description))
(setq link (concat "mew:" folder-name "#" message-id))
(org-add-link-props :link link :description desc)
(org-link-add-props :link link :description desc)
link)))))
(defun org-mew-folder-name ()

8
lisp/org-contrib/ol-vm.el
View File

@@ -1,4 +1,4 @@
;;; ol-vm.el --- Links to VM messages
;;; ol-vm.el --- Links to VM messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -88,11 +88,11 @@
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
(org-link-store-props :type link-type :from from :to to :subject subject
:message-id message-id :date date)
(setq desc (org-email-link-description))
(setq desc (org-link-email-description))
(setq link (concat (concat link-type ":") folder "#" message-id))
(org-add-link-props :link link :description desc)
(org-link-add-props :link link :description desc)
link))))
(defun org-vm-open (path _)

16
lisp/org-contrib/ol-wl.el
View File

@@ -1,4 +1,4 @@
;;; ol-wl.el --- Links to Wanderlust messages
;;; ol-wl.el --- Links to Wanderlust messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
@@ -162,7 +162,7 @@ ENTITY is a message entity."
(beginning-of-line)
(unless (and (wl-folder-buffer-group-p)
(looking-at wl-folder-group-regexp))
(org-store-link-props :type "wl" :description petname
(org-link-store-props :type "wl" :description petname
:link link)
link))))
@@ -216,7 +216,7 @@ ENTITY is a message entity."
(cond
((and (eq folder-type 'shimbun)
org-wl-shimbun-prefer-web-links xref)
(org-store-link-props :type "http" :link xref :description subject
(org-link-store-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))
@@ -227,18 +227,18 @@ ENTITY is a message entity."
"http://mid.gmane.org/%s"
"https://groups.google.com/groups/search?as_umsgid=%s")
(url-encode-url message-id)))
(org-store-link-props :type "http" :link link :description subject
(org-link-store-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
(org-link-store-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 desc (org-link-email-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)
(org-link-add-props :link link :description desc)))
(org-link-add-props :date date)
(or link xref)))))))
(defun org-wl-open-nntp (path)

18
lisp/org-contrib/org-annotate-file.el
View File

@@ -1,4 +1,4 @@
;;; org-annotate-file.el --- Annotate a file with org syntax
;;; org-annotate-file.el --- Annotate a file with org syntax -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2014, 2021 Philip Jackson
@@ -111,7 +111,11 @@ 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)))
(line
(let ((inhibit-field-text-motion t))
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
(annotation-buffer (find-file-noselect storage-file)))
(with-current-buffer annotation-buffer
(org-annotate-file-annotate filename line))
@@ -119,8 +123,8 @@ The annotation will link to ANNOTATED-BUFFER if specified,
(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
(let* ((link (org-link-make-string (concat "file:" filename) filename))
(search-link (org-link-make-string
(concat "file:" filename "::" line)
(org-annotate-file-ellipsify-desc line))))
(unless (eq major-mode 'org-mode)
@@ -128,7 +132,9 @@ The annotation will link to ANNOTATED-BUFFER if specified,
(goto-char (point-min))
(widen)
(when org-annotate-file-always-open
(show-all))
(if (fboundp 'org-fold-show-all)
(org-fold-show-all)
(with-no-warnings (org-show-all))))
(unless (search-forward-regexp
(concat "^* " (regexp-quote link)) nil t)
(org-annotate-file-add-upper-level link))
@@ -148,7 +154,7 @@ The annotation will link to ANNOTATED-BUFFER if specified,
(defun org-annotate-file-add-second-level (link)
"Add and link subheading to LINK."
(goto-char (point-at-eol))
(forward-line 0)
(call-interactively 'org-insert-subheading)
(insert link))

89
lisp/org-contrib/org-bibtex-extras.el
View File

@@ -1,4 +1,4 @@
;;; org-bibtex-extras --- extras for working with org-bibtex entries
;;; org-bibtex-extras --- extras for working with org-bibtex entries -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -63,14 +63,22 @@
(declare-function org-trim "org" (s &optional keep-lead))
(defcustom obe-bibtex-file nil "File holding bibtex entries.")
(defgroup org-bibtex-extras nil
"Extras for working with org-bibtex entries."
:group 'org-bibtex)
(defcustom obe-bibtex-file nil
"File holding bibtex entries."
:type 'file
:group 'org-bibtex-extras)
(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))
")
(setq obe-html-link-base (format \"file:%s\" obe-bibtex-file))"
:type 'string
:group 'org-bibtex-extras)
(defvar obe-citations nil)
(defun obe-citations ()
@@ -96,42 +104,43 @@ For example, to point to your `obe-bibtex-file' use the following.
(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))
(cl-incf counter)))
;; build the nodes of the graph
(add (col :title))
(add (cl-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) ",")))))
;; FIXME: `meta-to-links' is not a known function.
;; (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)
;; (cl-flet ((id (it) (cl-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))
;; (cl-incf counter)))
;; ;; build the nodes of the graph
;; (add (col :title))
;; (add (cl-remove-if (lambda (author) (string-match "others" author))
;; (cl-remove-duplicates (apply #'append (col :authors))
;; :test #'string=)))
;; (dolist (field fields)
;; (add (cl-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

91
lisp/org-contrib/org-checklist.el
View File

@@ -1,4 +1,4 @@
;;; org-checklist.el --- org functions for checklist handling
;;; org-checklist.el --- org functions for checklist handling -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2014, 2021 James TD Smith
@@ -43,7 +43,13 @@
;;
;;; Code:
(require 'org)
(defvar org-state)
;; FIXME: This library requires
;; https://git.savannah.gnu.org/cgit/a2ps.git/tree/contrib/emacs/a2ps-print.el file
;; It is a part of a2ps distribution.
(load "a2ps-print" 'no-error)
(defvar a2ps-switches)
(declare-function a2ps-buffer "a2ps-print" (argp))
(setq org-default-properties (cons "RESET_CHECK_BOXES" (cons "LIST_EXPORT_BASENAME" org-default-properties)))
@@ -88,46 +94,49 @@
"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 (cl-case (org-entry-get (point) "PRINT_EXPORT" nil)
(("" "nil" nil) nil)
(nil (y-or-n-p "Print list? "))
(t t)))
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)))))))))
(when (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 (pcase (org-entry-get (point) "PRINT_EXPORT" nil)
(`(or "" "nil" nil) nil)
(`nil (y-or-n-p "Print list? "))
(_ t)))
exported-lines
(title "Checklist export"))
(save-restriction
(save-excursion
(org-narrow-to-subtree)
(org-update-checkbox-count-maybe)
(if (fboundp 'org-fold-show-subtree)
(org-fold-show-subtree)
(with-no-warnings (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) "[-]")))
(setq exported-lines
(nconc exported-lines (list (thing-at-point 'line)))))
(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)
(when print
(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 nil))))))))
(defun org-checklist ()
(when (member org-state org-done-keywords) ;; org-state dynamically bound in org.el/org-todo

30
lisp/org-contrib/org-choose.el
View File

@@ -1,4 +1,4 @@
;;; org-choose.el --- decision management for org-mode
;;; org-choose.el --- decision management for org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2014, 2021 Tom Breton (Tehom)
@@ -64,12 +64,12 @@
(require 'org)
;(eval-when-compile
; (require 'cl))
(require 'cl)
(require 'cl-lib)
;;; Body
;;; The variables
(defstruct (org-choose-mark-data. (:type list))
(cl-defstruct (org-choose-mark-data. (:type list))
"The format of an entry in org-choose-mark-data.
Indexes are 0-based or `nil'.
"
@@ -117,7 +117,7 @@ Each entry is an `org-choose-mark-data.'" )
(string-match "^," args)
(cons nil arglist-x)
arglist-x)))
(decision-arg (second arglist))
(decision-arg (cl-second arglist))
(type
(cond
((string= decision-arg "0")
@@ -127,7 +127,7 @@ Each entry is an `org-choose-mark-data.'" )
((string= decision-arg "-")
'bot-lower-range)
(t nil)))
(vanilla-arg (first arglist))
(vanilla-arg (cl-first arglist))
(vanilla-mark
(if vanilla-arg
(concat vanilla-text "("vanilla-arg")")
@@ -172,11 +172,11 @@ Each entry is an `org-choose-mark-data.'" )
: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)))))))
(cl-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)
@@ -189,9 +189,9 @@ interpretation."
((vanilla-list nil)
(all-mark-texts nil)
(index 0)
bot-lower-range top-upper-range range-length static-default)
bot-lower-range top-upper-range static-default)
(dolist (i raw)
(destructuring-bind
(cl-destructuring-bind
(vanilla-text vanilla-mark &optional type)
(org-choose-filter-one i)
(cond
@@ -332,7 +332,7 @@ setting was changed."
(if funcdata
;;The funny-looking names are to make variable capture
;;unlikely. (Poor-man's lexical bindings).
(destructuring-bind (func-d473 . args-46k) funcdata
(cl-destructuring-bind (func-d473 . args-46k) funcdata
(let
((map-over-entries
(org-choose-get-fn-map-group))
@@ -357,8 +357,8 @@ setting was changed."
(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)))
(cl-position ix all-keywords
:test #'equal)))
;;; org-choose-get-entry-index
(defun org-choose-get-entry-index (all-keywords)

44
lisp/org-contrib/org-collector.el
View File

@@ -1,4 +1,4 @@
;;; org-collector --- collect properties into tables
;;; org-collector --- collect properties into tables -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -123,7 +123,7 @@ preceding the dblock, then update the contents of the dblock."
(colnames (plist-get params :colnames))
(defaultval (plist-get params :defaultval))
(content-lines (org-split-string (plist-get params :content) "\n"))
id table line pos)
id table line pos idpos stringformat)
(save-excursion
(when (setq id (plist-get params :id))
(cond ((not id) nil)
@@ -177,34 +177,40 @@ variables and values specified in props"
(interactive)
;; collect the properties from every header
(let* ((header-props
(let ((org-trust-scanner-tags t) alst)
(let ((org-trust-scanner-tags t))
(org-map-entries
(quote (cons (cons "ITEM" (org-get-heading t))
(org-propview-get-with-inherited inherit)))
(lambda ()
(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))))
(let ((inhibit-lisp-eval (or (string= (car pair) "ITEM")
(string-match-p org-ts-regexp-inactive (cdr pair))
(string-match-p org-link-bracket-re (cdr pair)))))
(condition-case err
(cons (car pair) (org-babel-read (cdr pair) inhibit-lisp-eval))
(error
(error
(print (format "Error processing lisp on property: %S, error: %S. Remember anything that starts with a (, ', ` or [ is considered an elisp expression" pair err)))))))
props))
header-props))
;; collect all property names
(prop-names
(mapcar 'intern (delete-dups
(apply 'append (mapcar (lambda (header)
(mapcar 'car header))
header-props))))))
header-props)))
;; collect all property names
(mapc '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) ;; ------------------------------------------------
'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))
(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
@@ -216,7 +222,7 @@ variables and values specified in props"
conds))
props))
header-props))
header-props)))))
header-props)))))
(defun org-propview-to-table (results stringformat)
;; (message (format "cols:%S" cols))

2
lisp/org-contrib/org-contrib-pkg.el
View File

@@ -1,2 +1,2 @@
;; Generated package description from org-contrib.el -*- no-byte-compile: t -*-
(define-package "org-contrib" "0.4.2" "Unmaintained add-ons for Org-mode" '((emacs "25.1") (org "9.4.6")) :commit "dce101b4612e6deef814516779ce216e8eace569" :authors '(("Bastien Guerry" . "bzg@gnu.org")) :maintainer '("Bastien Guerry" . "bzg@gnu.org") :keywords '("org") :url "https://git.sr.ht/~bzg/org-contrib")
(define-package "org-contrib" "0.6" "Unmaintained add-ons for Org-mode" '((emacs "25.1") (org "9.4.6")) :commit "0e65be83e4b41c17a5b9096c9055c1601b26a23d" :authors '(("Bastien Guerry" . "bzg@gnu.org")) :maintainer '("Bastien Guerry" . "bzg@gnu.org") :keywords '("org") :url "https://git.sr.ht/~bzg/org-contrib")

4
lisp/org-contrib/org-contrib.el
View File

@@ -1,11 +1,11 @@
;;; org-contrib.el --- Unmaintained add-ons for Org-mode
;;; org-contrib.el --- Unmaintained add-ons for Org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Bastien Guerry
;; Author: Bastien Guerry <bzg@gnu.org>
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; Package-Requires: ((emacs "25.1") (org "9.4.6"))
;; Version: 0.4.2
;; Version: 0.6
;; Keywords: org
;; SPDX-License-Identifier: GPL-3.0-or-later

2
lisp/org-contrib/org-contribdir.el
View File

@@ -1,4 +1,4 @@
;;; org-contribdir.el --- Mark the location of the contrib directory
;;; org-contribdir.el --- Mark the location of the contrib directory -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>

30
lisp/org-contrib/org-depend.el
View File

@@ -1,4 +1,4 @@
;;; org-depend.el --- TODO dependencies for Org-mode
;;; org-depend.el --- TODO dependencies for Org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
@@ -156,7 +156,7 @@
(require 'org)
(eval-when-compile
(require 'cl))
(require 'cl-lib))
(defcustom org-depend-tag-blocked t
"Whether to indicate blocked TODO items by a special tag."
@@ -224,8 +224,8 @@ This does two different kinds of triggers:
;; 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)))
(setq trigger (org-entry-get pos "TRIGGER" t)
triggers (and trigger (split-string trigger)))
;; Go through all the triggers
(while (setq tr (pop triggers))
@@ -256,9 +256,7 @@ This does two different kinds of triggers:
(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)
(let ((done nil)
(items '()))
(outline-next-heading)
(while (not done)
@@ -289,21 +287,21 @@ This does two different kinds of triggers:
(t (nreverse items))))
(setq items (cl-remove-if
(lambda (item)
(or (equal (first item) this-item)
(or (equal (cl-first item) this-item)
(and (not todo-and-done-only)
(member (second item) org-done-keywords))
(member (cl-second item) org-done-keywords))
(and (or todo-only
todo-and-done-only)
(null (second item)))))
(null (cl-second item)))))
items))
(setq items
(sort
items
(lambda (item1 item2)
(let* ((p1 (third item1))
(p2 (third item2))
(e1 (fifth item1))
(e2 (fifth item2))
(let* ((p1 (cl-third item1))
(p2 (cl-third item2))
(e1 (cl-fifth item1))
(e2 (cl-fifth item2))
(p1-lt (< p1 p2))
(p1-gt (> p1 p2))
(e1-lt (and e1 (or (not e2) (< e1 e2))))
@@ -323,7 +321,7 @@ This does two different kinds of triggers:
(effort-down
(or e1-lt (and (equal e1 e2) p1-gt))))))))
(when items
(goto-char (first (first items)))
(goto-char (cl-first (cl-first items)))
(org-entry-add-to-multivalued-property nil "TRIGGER" tr)
(org-todo kwd)))))))
((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
@@ -394,7 +392,7 @@ this ID property, that entry is also checked."
(save-excursion
(goto-char pos)
;; find the older sibling, exit if no more siblings
(unless (org-get-last-sibling)
(unless (org-get-previous-sibling)
(throw 'ignore t))
;; Check if this entry is not yet done and block
(unless (org-entry-is-done-p)

241
lisp/org-contrib/org-effectiveness.el
View File

@@ -1,4 +1,4 @@
;;; org-effectiveness.el --- Measuring the personal effectiveness
;;; org-effectiveness.el --- Measuring the personal effectiveness -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -91,7 +91,8 @@ many TODO pending"
(save-excursion
(goto-char (point-min))
(let ((done (float (count-matches "* DONE.*\n.*")))
(canc (float (count-matches "* CANCEL+ED.*\n.*"))))
(canc (float (count-matches "* CANCEL+ED.*\n.*")))
effectiveness)
(if (and (= done canc) (zerop done))
(setq effectiveness 0)
(setq effectiveness (* 100 (/ done (+ done canc)))))
@@ -100,8 +101,8 @@ many TODO pending"
(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)))
(let ((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)
@@ -116,17 +117,17 @@ many TODO pending"
(interactive "sGive me a date: " date)
(save-excursion
(goto-char (point-min))
(setq count (count-matches (concat "TODO.*\n.*" date)))
(message "TODOS: %d" count)))
(let ((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)))
(let ((count (count-matches (concat "CANCEL+ED.*\n.*" date))))
(message "CANCELEDS: %d" count))))
(defun org-effectiveness-ntasks-in-date(date &optional notmessage)
(defun org-effectiveness-ntasks-in-date(date &optional _)
(interactive "sGive me a date: " date)
(save-excursion
(goto-char (point-min))
@@ -138,7 +139,8 @@ many TODO pending"
(save-excursion
(goto-char (point-min))
(let ((done (float (count-matches (concat "* DONE.*\n.*" date))))
(canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date)))))
(canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date))))
effectiveness)
(if (and (= done canc) (zerop done))
(setq effectiveness 0)
(setq effectiveness (* 100 (/ done (+ done canc)))))
@@ -153,50 +155,51 @@ many TODO pending"
(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))))
(let* (;; (dates (org-effectiveness-check-dates startdate enddate))
;; (syear (cadr (assq 'startyear dates)))
;; (smonth (cadr (assq 'startmonth dates)))
;; (eyear (cadr (assq 'endyear dates)))
;; (emonth (assq 'endmonth dates))
startyear startmonth endyear endmonth strplot)
;; 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")))
;; 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)
(defun org-effectiveness-plot-save(startdate enddate &optional _)
(interactive "sGive me the start date: \nsGive me the end date: " startdate enddate)
(org-effectiveness-plot startdate enddate t))
@@ -230,54 +233,57 @@ many TODO pending"
(setq z (+ z 1)))
(insert "+"))))
(defun org-effectiveness-html-bar(n &optional label)
(defun org-effectiveness-html-bar(n &optional _)
"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))
)))
(insert (format "\n<div class='percentage-%d'>%d</div>" n n))
;; FIXME: What are x,y,z for?
;; (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))))
(let (str startmonth startyear endmonth endyear)
(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 ""))
(let* ((dates (org-effectiveness-check-dates startdate enddate))
;; (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*")
@@ -293,15 +299,15 @@ many TODO pending"
(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 ""))
(let* ((dates (org-effectiveness-check-dates startdate enddate))
;; (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*")
@@ -316,15 +322,15 @@ many TODO pending"
(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 ""))
(let* ((dates (org-effectiveness-check-dates startdate enddate))
;; (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*")
@@ -341,15 +347,15 @@ many TODO pending"
(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 ""))
(let* ((dates (org-effectiveness-check-dates startdate enddate))
;; (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)))
@@ -357,7 +363,8 @@ many TODO pending"
(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)
;; FIXME: Value is unused.
;; (format "%s-%s" year month)
(if (eq month 12)
(progn
(setq year (+ 1 year))

25
lisp/org-contrib/org-eldoc.el
View File

@@ -37,10 +37,7 @@
(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))
(require 'org-element)
(defgroup org-eldoc nil "" :group 'org)
@@ -69,7 +66,8 @@
(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."
"On src line, return lang and list of header properties.
Return nil when not on src line."
(let ((case-fold-search t) info lang hdr-args)
(save-excursion
(beginning-of-line)
@@ -83,14 +81,14 @@
": "
(mapconcat
(lambda (elem)
(when-let* ((val (and (cdr elem)
(format "%s" (cdr elem))))
(_ (not (string-empty-p val))))
(concat
(propertize (symbol-name (car elem)) 'face 'org-list-dt)
" "
(propertize val 'face 'org-verbatim)
" ")))
(when-let ((val (and (cdr elem)
(format "%s" (cdr elem)))))
(unless (string-empty-p val)
(concat
(propertize (symbol-name (car elem)) 'face 'org-list-dt)
" "
(propertize val 'face 'org-verbatim)
" "))))
hdr-args " ")))))))
(defun org-eldoc-get-src-lang ()
@@ -203,7 +201,6 @@
(add-function :before-until (local 'eldoc-documentation-function)
#'org-eldoc-documentation-function)))))
;;;###autoload
(add-hook 'org-mode-hook #'org-eldoc-load)
(provide 'org-eldoc)

199
lisp/org-contrib/org-eval-light.el
View File

@@ -1,199 +0,0 @@
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten.dominik@gmail.com>,
;; Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp, literate programming,
;; reproducible research
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; Version: 0.04
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file 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

216
lisp/org-contrib/org-eval.el
View File

@@ -1,216 +0,0 @@
;;; org-eval.el --- Display result of evaluating code in various languages
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; Version: 0.04
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
;; This 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

26
lisp/org-contrib/org-expiry.el
View File

@@ -1,4 +1,4 @@
;;; org-expiry.el --- expiry mechanism for Org entries
;;; org-expiry.el --- expiry mechanism for Org entries -*- lexical-binding: t; -*-
;;
;; Copyright 2007-2021 Free Software Foundation, Inc.
;;
@@ -75,6 +75,8 @@
;;; Code:
(require 'org)
;;; User variables:
(defgroup org-expiry nil
@@ -157,15 +159,15 @@ functions. `org-expiry-deinsinuate' will deactivate them."
;;; Advices and insinuation:
(defadvice org-schedule (after org-schedule-update-created)
(define-advice org-schedule (:after (&rest _) 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)
(define-advice org-deadline (:after (&rest _) 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)
(define-advice org-time-stamp (:after (&rest _) org-time-stamp-update-created)
"Update the creation-date property when calling `org-time-stamp'."
(org-expiry-insert-created))
@@ -195,9 +197,9 @@ restart `org-mode' if necessary."
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)
(advice-remove 'org-schedule #'org-schedule@org-schedule-update-created)
(advice-remove 'org-time-stamp #'org-time-stamp@org-time-stamp-update-created)
(advice-remove 'org-deadline #'org-deadline@org-deadline-update-created)
(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)
@@ -240,7 +242,7 @@ 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 (called-interactively-p 'interactive) (org-reveal))
(when (org-expiry-expired-p)
(org-back-to-heading)
(looking-at org-complex-heading-regexp)
@@ -251,13 +253,13 @@ Otherwise rely on `org-expiry-confirm-flag' to decide."
(if (or force
(null org-expiry-confirm-flag)
(and (eq org-expiry-confirm-flag 'interactive)
(not (interactive)))
(not (called-interactively-p 'interactive)))
(and org-expiry-confirm-flag
(y-or-n-p (format "Entry expired by %d days. Process? " d))))
(funcall org-expiry-handler-function))
(funcall org-expiry-handler-function))
(delete-overlay ov)))))
(defun org-expiry-process-entries (beg end)
(defun org-expiry-process-entries (_ _)
"Process all expired entries between BEG and END.
The expiry process will run the function defined by
`org-expiry-handler-functions'."
@@ -319,7 +321,7 @@ 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)
d-time d-hour timestr)
(setq d-time (if d (org-time-string-to-time d)
(current-time)))
(setq d-hour (format-time-string "%H:%M" d-time))

37
lisp/org-contrib/org-interactive-query.el
View File

@@ -1,4 +1,4 @@
;;; org-interactive-query.el --- Interactive modification of agenda query
;;; org-interactive-query.el --- Interactive modification of agenda query -*- lexical-binding: t; -*-
;;
;; Copyright 2007-2021 Free Software Foundation, Inc.
;;
@@ -36,6 +36,7 @@
;; ;
(require 'org)
(require 'org-agenda)
(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
@@ -82,7 +83,7 @@ not change the current one."
(set-buffer (get-buffer-create " *Org tags*"))
(delete-other-windows)
(split-window-vertically)
(org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
(switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
(erase-buffer)
(setq-local org-done-keywords done-keywords)
(insert "Query: " current "\n")
@@ -153,7 +154,7 @@ not change the current one."
(setq expert nil)
(delete-other-windows)
(split-window-vertically)
(org-switch-to-buffer-other-window " *Org tags*")
(switch-to-buffer-other-window " *Org tags*")
(and (fboundp 'fit-window-to-buffer)
(fit-window-to-buffer))))
((or (= c ?\C-g)
@@ -193,10 +194,10 @@ not change the current one."
(if (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 1)
(delete-region (point) (point-at-eol))
(delete-region (point) (line-end-position))
(insert "Query: " current)
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
(delete-region (point) (line-end-position))
(org-agenda-query-op-line op)
(goto-char (point-min)))))
(if rtn current nil))))
@@ -225,20 +226,20 @@ not change the current one."
(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
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))))
(cl-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))
@@ -258,11 +259,11 @@ keyword string."
(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)))))
(cl-loop for f in files do
(set-buffer (find-file-noselect f))
(cl-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)

13
lisp/org-contrib/org-invoice.el
View File

@@ -1,4 +1,4 @@
;;; org-invoice.el --- Help manage client invoices in OrgMode
;;; org-invoice.el --- Help manage client invoices in OrgMode -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2014, 2021 pmade inc. (Peter Jones pjones@pmade.com)
;;
@@ -46,10 +46,9 @@
;;
;; 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))
(require 'cl-lib))
(require 'org-duration)
(require 'org)
(defgroup org-invoice nil
"OrgMode Invoice Helper"
@@ -387,7 +386,9 @@ I place mine under a third-level heading like so:
(let ((report (org-invoice-in-report-p)))
(when (and (not report) jump)
(when (re-search-forward "^#\\+BEGIN:[ \t]+invoice" nil t)
(org-show-entry)
(if (fboundp 'org-fold-show-entry)
(org-fold-show-entry)
(with-no-warnings (org-show-entry)))
(beginning-of-line)
(setq report (point))))
(if report (goto-char report)

15
lisp/org-contrib/org-learn.el
View File

@@ -1,4 +1,4 @@
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
@@ -35,7 +35,7 @@
(require 'org)
(eval-when-compile
(require 'cl))
(require 'cl-lib))
(defgroup org-learn nil
"Options concerning the learning code in Org-mode."
@@ -112,7 +112,7 @@ OF matrix."
(mod2 (/ (1- interval-used) interval-used))
;; the number determining how many times the OF value will
;; increase or decrease
modifier)
modifier new-of)
(if (< mod5 1.05)
(setq mod5 1.05))
(if (< mod2 0.75)
@@ -137,8 +137,8 @@ OF matrix."
(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)))
(cl-assert (> n 0))
(cl-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)))
@@ -159,8 +159,7 @@ OF matrix."
(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)
(cl-copy-list initial-repetition-state))))
(setq learn-data
(determine-next-interval (nth 1 learn-data)
(nth 2 learn-data)
@@ -170,7 +169,7 @@ OF matrix."
(if (= 0 (nth 0 learn-data))
(org-schedule t)
(org-schedule nil (time-add (current-time)
(days-to-time (nth 0 learn-data)))))))
(days-to-time (nth 0 learn-data)))))))
(provide 'org-learn)

562
lisp/org-contrib/org-license.el
View File

@@ -1,4 +1,4 @@
;;; org-license.el --- Add a license to your org files
;;; org-license.el --- Add a license to your org files -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -44,356 +44,362 @@
(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
(let (org-license-cc-url)
(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
((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
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Lizenz Creative Commons Namensnennung 3.0 Deutschland]]\n")))
((equal language "eo")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/eo/deed.eo")
(insert (concat "* Licenco
((equal language "eo")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/eo/deed.eo")
(insert (concat "* Licenco
Ĉi tiu verko estas disponebla laŭ la permesilo [[" org-license-cc-url "][Krea Komunaĵo Atribuite 3.0 Neadaptita]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.es")
(insert (concat "* Licencia
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.es")
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución 3.0 España]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.eu")
(insert (concat "* Licenzua
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.eu")
(insert (concat "* Licenzua
Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/fr/deed.fr")
(insert (concat "* Licence
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/fr/deed.fr")
(insert (concat "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は [[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by/4.0/deed")
(concat (insert "* License
This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n"))))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by/4.0/deed")
(insert "* License
This document is under a [[" org-license-cc-url "][Creative Commons Attribution 4.0 International]]\n")))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n")))))
(defun org-license-cc-by-sa (language)
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR")
(concat (insert "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca")
(insert (concat "* Licència
(let (org-license-cc-url)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR")
(insert "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n"))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-CompartirIgual 3.0 Espanya]]\n")))
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/de/deed.de")
(insert (concat "* Lizenz
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.es")
(concat (insert "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución Compartir por Igual 3.0 España]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.eu")
(concat (insert "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.es")
(insert "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución Compartir por Igual 3.0 España]]\n"))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.eu")
(insert "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr")
(concat (insert "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les Mêmes Conditions 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr")
(insert "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les Mêmes Conditions 3.0 France]]\n"))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Condividi allo stesso modo 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は、[[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding Gelijk Delen 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição-CompartilhaIgual 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/4.0/deed")
(insert (concat "* License
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/4.0/deed")
(insert (concat "* License
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n")))))
(defun org-license-cc-by-nd (language)
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | pt ): " language)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR")
(insert (concat "* Licença
(let (org-license-cc-url)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n")))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.ca")
(insert (concat "* Licència
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-SenseObraDerivada 3.0 Espanya]]\n")))
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/de/deed.de")
(insert (concat "* Lizenz
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Keine Bearbeitung 3.0 Deutschland]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.es")
(insert (concat "* Licencia
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.es")
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución-SinDerivadas 3.0]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
(insert (concat "* Licenzua
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.eu")
(insert (concat "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr")
(insert (concat "* Licence
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr")
(insert (concat "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は、[[" org-license-cc-url "][Creative Commons No Derivatives 2.1]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding GeenAfgeleideWerken 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Sem Derivados 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/4.0/deed")
(insert (concat "* License
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/4.0/deed")
(insert (concat "* License
This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n")))))
(defun org-license-cc-by-nc (language)
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR")
(insert (concat "* Licença
(let (org-license-cc-url)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Brasil]]\n")))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.ca")
(insert (concat "* Licència
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/de/deed.de")
(insert (concat "* Lizenz
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Nicht-kommerziell 3.0 Deutschland]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.es")
(insert (concat "* Licencia
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.es")
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.eu")
(insert "* Licenzua
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.eu")
(insert "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-EzKomertziala 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr")
(insert (concat "* Licence
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr")
(insert (concat "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non commerciale 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は、[[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 2.1 ]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel 3.0 Nederland 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/4.0/deed")
(insert (concat "* License
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/4.0/deed")
(insert (concat "* License
This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n")))))
(defun org-license-cc-by-nc-sa (language)
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | jp | nl | pt ): " language)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR")
(insert (concat "* Licença
(let (org-license-cc-url)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial - Compartil ha Igual 3.0 Brasil]]\n")))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca")
(insert (concat "* Licència
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n")))
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de")
(insert (concat "* Lizenz
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es")
(insert (concat "* Licencia
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es")
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu")
(insert "* Licenzua
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu")
(insert "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-EzKomertziala-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen-JaaSamoin 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr")
(insert (concat "* Licence
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr")
(insert (concat "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d’Utilisation Commerciale - Partage dans les Mêmes Conditions 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は、[[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 2.1 ]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GelijkDelen 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição NãoComercial Compartil ha Igual 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/4.0/deed")
(insert (concat "* License
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/4.0/deed")
(insert (concat "* License
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n")))))
(defun org-license-cc-by-nc-nd (language)
(interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | pt ): " language)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
(let (org-license-cc-url)
(cond ((equal language "br")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Brasil]]\n")))
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca")
(insert (concat "* Licència
((equal language "ca")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca")
(insert (concat "* Licència
El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial-SenseObraDerivada 3.0 Espanya]]\n")))
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de")
(insert (concat "* Lizenz
((equal language "de")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de")
(insert (concat "* Lizenz
Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-NichtKommerziell-KeineBearbeitung 3.0 Deutschland]]\n")))
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es")
(insert (concat "* Licencia
((equal language "es")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es")
(insert (concat "* Licencia
Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial-SinObraDerivada 3.0]]\n")))
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.eu")
(insert (concat "* Licenzua
((equal language "eu")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.eu")
(insert (concat "* Licenzua
Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")))
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
((equal language "fi")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi")
(insert (concat "* Lisenssi
Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Ei muutoksia-Epäkaupallinen 1.0 Suomi]] lisenssillä\n")))
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr")
(insert (concat "* Licence
((equal language "fr")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr")
(insert (concat "* Licence
Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n")))
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl")
(insert (concat "* Licenza
((equal language "gl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl")
(insert (concat "* Licenza
Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n")))
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it")
(insert (concat "* Licenza
((equal language "it")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it")
(insert (concat "* Licenza
Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n")))
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en")
(insert (concat "* ライセンス
((equal language "jp")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en")
(insert (concat "* ライセンス
この文書は [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial - No Derivs 2.1]] ライセンスの下である\n")))
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl")
(insert (concat "* Licentie
((equal language "nl")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl")
(insert (concat "* Licentie
Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GeenAfgeleideWerken 3.0 Nederland]]\n")))
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
((equal language "pt")
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt")
(insert (concat "* Licença
Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Portugal]]\n")))
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/4.0/deed")
(insert (concat "* License
(t
(setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-nd/4.0/deed")
(insert (concat "* License
This document is under a [[" org-license-cc-url "][License Creative Commons Attribution-NonCommercial-NoDerivatives 4.0 International]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-cc-url "][file:https://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n")))))
(defun org-license-gfdl (language)
(interactive "MLanguage (es | en): " language)
@@ -418,29 +424,31 @@ Copyright (C) " (format-time-string "%Y") " " user-full-name
(defun org-license-publicdomain-zero (language)
(interactive "MLanguage ( en | es ): " language)
(setq org-license-pd-url "https://creativecommons.org/publicdomain/zero/1.0/")
(setq org-license-pd-file "zero/1.0/80x15.png")
(if (equal language "es")
(insert (concat "* Licencia
(let (org-license-pd-url org-license-pd-file)
(setq org-license-pd-url "https://creativecommons.org/publicdomain/zero/1.0/")
(setq org-license-pd-file "zero/1.0/80x15.png")
(if (equal language "es")
(insert (concat "* Licencia
Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))
(insert (concat "* License
(insert (concat "* License
This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n")))))
(defun org-license-publicdomain-mark (language)
(interactive "MLanguage ( en | es ): " language)
(setq org-license-pd-url "https://creativecommons.org/publicdomain/mark/1.0/")
(setq org-license-pd-file "mark/1.0/80x15.png")
(if (equal language "es")
(insert (concat "* Licencia
(let (org-license-pd-url org-license-pd-file)
(setq org-license-pd-url "https://creativecommons.org/publicdomain/mark/1.0/")
(setq org-license-pd-file "mark/1.0/80x15.png")
(if (equal language "es")
(insert (concat "* Licencia
Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n"))
(insert (concat "* License
(insert (concat "* License
This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/mark/1.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n"))))
(if (string= "" org-license-images-directory)
(insert (concat "\n[[" org-license-pd-url "][file:https://i.creativecommons.org/p/mark/1.0/80x15.png]]\n"))
(insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n")))))
(defun org-license-print-all ()
"Print all combinations of licenses and languages, it's useful to find bugs"

252
lisp/org-contrib/org-mac-iCal.el
View File

@@ -1,4 +1,4 @@
;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2014, 2021 Christopher Suckling
@@ -54,6 +54,9 @@
;;; Code:
(require 'calendar)
(require 'xml)
(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
@@ -66,145 +69,153 @@ today's date"
"Selects checked calendars in iCal.app and imports them into
the the Emacs diary"
(interactive)
(let ( currentBuffer openBuffers caldav-folders
caldav-calendars local-calendars all-calendars
import-calendars usedCalendarsBuffers
usedCalendarsFiles)
;; 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))
;; 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
;; 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 local-calendars nil)
(setq local-calendars (directory-files "~/Library/Calendars" 1 ".*calendar$"))
(setq all-calendars (append caldav-calendars local-calendars))
(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)))
;; 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)))
;; 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)
;; 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)
;; 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)
;; 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))
(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))
(let (omi-leopard-events)
(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
(let ( startEntry endEntry yearEntry monthEntry
year month now entryDate isRepeating)
(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)
(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))
(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-char (point-min))
(insert "BEGIN:VCALENDAR\n\n")
(goto-char (point-min))
(forward-line 1)
(while
(re-search-forward "^BEGIN:VCALENDAR$" nil t)
(replace-match "\n"))
(goto-char (point-min))
(forward-line 1)
(while
(re-search-forward "^END:VCALENDAR$" nil t)
(replace-match "\n"))
(insert "END:VCALENDAR")
(goto-char (point-min))
(delete-blank-lines)
(while
(re-search-forward "^END:VEVENT$" nil t)
(delete-blank-lines))
(goto-char (point-min))
(while
(re-search-forward "^ORG.*" nil t)
(replace-match "\n"))
(goto-char (point-min))
(write-region (point-min) (point-max) string)))
(icalendar-import-file string diary-file))
@@ -242,7 +253,14 @@ calendar from list of calendars for import"
x)))
keys))
(keys (delq 'nil keys)))
(when (equal "1" (car (cddr (lax-plist-get keys '(key nil "Checked")))))
(when (equal "1"
(car
(cddr
(if (= 3 (cdr (func-arity #'plist-get)))
;; FIXME: Emacs >=29.
(plist-get keys '(key nil "Checked") #'equal)
(with-no-warnings
(lax-plist-get keys '(key nil "Checked")))))))
directory)))
(provide 'org-mac-iCal)

68
lisp/org-contrib/org-mairix.el
View File

@@ -1,4 +1,4 @@
;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2014, 2021 Georg C. F. Greve
;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
@@ -39,6 +39,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'org)
(require 'gnus-group)
(require 'gnus-sum)
(require 'gnus-art)
(require 'message)
;;; The custom variables
@@ -123,12 +127,12 @@ it."
:link (org-mairix-construct-link mid))))
(apply 'org-store-link-props
(append org-store-link-plist
(list :description (org-email-link-description))))))
(list :description (org-link-email-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."
the buffer just like `message-send-and-exit' does."
(interactive)
(message-send)
(let* ((message-id (message-fetch-field "Message-Id"))
@@ -146,7 +150,7 @@ 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 ""))
(let* ((args "") retval matches)
(if (equal (substring search 0 2) "t:" )
(progn (setq search (substring search 2 nil))
(setq args (concat args " --threads"))))
@@ -246,7 +250,7 @@ along with general mairix configuration."
:type 'string)
(defcustom org-mairix-gnus-select-display-group-function
'org-mairix-gnus-select-display-group-function-gg
'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
@@ -255,8 +259,8 @@ not yet able to figure out, see
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?"
It seems gnus needs a \"forget/ignore everything you think you
know about that group\" function. Volunteers?"
:group 'org-mairix-gnus
:type 'hook)
@@ -276,7 +280,7 @@ Message ID."
:subject subject
:message-id message-id))))
(defun org-mairix-gnus-display-results (search args)
(defun org-mairix-gnus-display-results (search _)
"Display results of mairix search in Gnus.
Note: This does not work as cleanly as I would like it to. The
@@ -288,31 +292,31 @@ 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))
(let ((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))))
;; 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

424
lisp/org-contrib/org-panel.el
View File

@@ -1,4 +1,4 @@
;;; org-panel.el --- Simple routines for us with bad memory
;;; org-panel.el --- Simple routines for us with bad memory -*- lexical-binding: t; -*-
;;
;; Author: Lennart Borgman (lennart O borgman A gmail O com)
;; Created: Thu Nov 15 15:35:03 2007
@@ -89,106 +89,125 @@ active.)"
;; 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))
'(
orgpan-copy-subtree
orgpan-cut-subtree
orgpan-paste-subtree
undo
;;
;orgpan-occur
;;
org-cycle
org-global-cycle
outline-up-heading
outline-next-visible-heading
outline-previous-visible-heading
outline-forward-same-level
outline-backward-same-level
org-todo
org-show-todo-tree
org-priority-up
org-priority-down
org-move-subtree-up
org-move-subtree-down
org-do-promote
org-do-demote
org-promote-subtree
org-demote-subtree))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Hook functions etc
(defvar orgpan-panel-buffer nil
"The panel buffer.
There can be only one such buffer at any time.")
(defvar orgpan-panel-window nil
"The window showing `orgpan-panel-buffer'.")
(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)
)
"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-org-window nil)
;;(make-variable-buffer-local 'orgpan-org-window)
(defvar orgpan-last-org-buffer nil)
;;(make-variable-buffer-local 'orgpan-last-org-buffer)
(defvar orgpan-org-buffer nil)
;;(make-variable-buffer-local 'orgpan-org-buffer)
(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))))
(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))))
(defvar orgpan-point nil)
;;(make-variable-buffer-local 'orgpan-point)
(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))))
(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.
@@ -356,33 +375,13 @@ active.)"
map))
(defun orgpan-occur ()
"Replacement for `org-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)
(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 viper-emacs-state-mode-list)
(defvar viper-new-major-mode-buffer-list)
@@ -472,56 +471,56 @@ There can be only one such buffer at any time.")
))
(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)))
))
(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."
@@ -547,7 +546,7 @@ There can be only one such buffer at any time.")
)
(defun orgpan-panel ()
"Create a control panel for current `org-mode' buffer.
"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
@@ -570,55 +569,54 @@ 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)))
(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 (_ 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)))
(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
)
"Minor mode used in `org-mode' buffer when showing panel."
:keymap orgpan-mode-map
:lighter " PANEL"
:group 'orgpan
)
(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)))
(provide 'org-panel)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

29
lisp/org-contrib/org-registry.el
View File

@@ -1,4 +1,4 @@
;;; org-registry.el --- a registry for Org links
;;; org-registry.el --- a registry for Org links -*- lexical-binding: t; -*-
;;
;; Copyright 2007-2021 Free Software Foundation, Inc.
;;
@@ -64,7 +64,9 @@
;;; Code:
(eval-when-compile
(require 'cl))
(require 'cl-lib))
(require 'org-agenda)
(require 'ol)
(defgroup org-registry nil
"A registry for Org."
@@ -90,11 +92,12 @@
buffer."
(interactive "P")
(org-registry-initialize)
(let* ((blink (or (org-remember-annotation) ""))
(link (when (string-match org-bracket-link-regexp blink)
(let* ((blink (or (org-store-link nil) ""))
(link (when (string-match org-link-bracket-re 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"))
;; FIXME: unused
;; (desc (or (and (string-match org-link-bracket-re blink)
;; (match-string-no-properties 3 blink)) "No description"))
(files (org-registry-assoc-all link))
file point selection tmphist)
(cond ((and files visit)
@@ -119,7 +122,9 @@ buffer."
(funcall org-registry-find-file file)
(goto-char point)
(unless (org-before-first-heading-p)
(org-show-context)))
(if (fboundp 'org-fold-show-context)
(org-fold-show-context)
(with-no-warnings (org-show-context)))))
((and files (not visit))
;; result(s) to display
(cond ((eq 1 (length files))
@@ -198,21 +203,21 @@ Use with caution. This could slow down things a bit."
(defun org-registry-get-entries (file)
"List Org links in FILE that will be put in the registry."
(let (bufstr result)
(let (result)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward org-angle-link-re nil t)
(while (re-search-forward org-link-angle-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))))
(push (list link desc point file) result)))
(goto-char (point-min))
(while (re-search-forward org-bracket-link-regexp nil t)
(while (re-search-forward org-link-bracket-re 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)))))
(push (list link desc point file) result))))
;; return the list of new entries
result))

6
lisp/org-contrib/org-screen.el
View File

@@ -1,4 +1,4 @@
;;; org-screen.el --- Integreate Org-mode with screen.
;;; org-screen.el --- Integreate Org-mode with screen. -*- lexical-binding: t; -*-
;; Copyright (c) 2008-2014, 2021 Andrew Hyatt
;;
@@ -93,8 +93,8 @@ is copied from ansi-term method."
(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")))))
(pop-to-buffer-same-window screen-buffer-name)
(pop-to-buffer-same-window (org-screen-helper name "-dr")))))
(if org-link-abbrev-alist
(add-to-list 'org-link-abbrev-alist

25
lisp/org-contrib/org-screenshot.el
View File

@@ -1,4 +1,4 @@
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
;;; org-screenshot.el --- Take and manage screenshots in Org-mode files -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
@@ -344,10 +344,10 @@ by most recent first"
(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)))
(setq mtime1 (+ (ash (cl-first mtime1) 16)
(cl-second mtime1)))
(setq mtime2 (+ (ash (cl-first mtime2) 16)
(cl-second mtime2)))
(> mtime1 mtime2)))))))
(let ((n -1) (list org-screenshot-file-list))
(while (and list (not (equal (pop list) lastfile)))
@@ -507,7 +507,7 @@ entered, at which point event will be unread"
(substring (image-file-name-regexp) 0 -2)
"\\)\\]"))
(case-fold-search t)
old file ov img type attrwidth width)
file)
(while (re-search-forward re end t)
(setq file (concat (or (match-string 3) "") (match-string 4)))
(when (and (file-exists-p file)
@@ -518,12 +518,13 @@ entered, at which point event will be unread"
(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"))
(ignore
(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)

13
lisp/org-contrib/org-secretary.el
View File

@@ -1,4 +1,4 @@
;;; org-secretary.el --- Team management with org-mode
;;; org-secretary.el --- Team management with org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2014, 2021 Juan Reyero
;;
;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
@@ -100,6 +100,7 @@
;; location and the time to entries.
(require 'org)
(require 'org-agenda)
(defvar org-sec-me nil
"Tag that defines TASK todo entries associated to me")
@@ -183,7 +184,7 @@
org-sec-with
org-sec-me))
(defun org-sec-with-view (par &optional who)
(defun org-sec-with-view (_ &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
@@ -191,11 +192,11 @@
(org-sec-get-with)))
"|" "dowith=\"" "\"")))
(defun org-sec-where-view (par)
(defun org-sec-where-view (_)
"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)
(defun org-sec-assigned-with-view (_ &optional who)
"Select tasks assigned to who, by default org-sec-with."
(org-tags-view '(4)
(concat (join (split-string (if who
@@ -204,7 +205,7 @@
"|")
"/TASK")))
(defun org-sec-stuck-with-view (par &optional who)
(defun org-sec-stuck-with-view (_ &optional who)
"Select stuck projects assigned to who, by default
org-sec-with."
(let ((org-stuck-projects
@@ -216,7 +217,7 @@
("TODO" "TASK") ())))
(org-agenda-list-stuck-projects)))
(defun org-sec-who-view (par)
(defun org-sec-who-view (_)
"Builds agenda for a given user. Queried. "
(let ((who (read-string "Build todo for user/tag: "
"" "" "")))

188
lisp/org-contrib/org-static-mathjax.el
View File

@@ -1,188 +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 not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; 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)

61
lisp/org-contrib/org-sudoku.el
View File

@@ -1,4 +1,4 @@
;;; org-sudoku.el --- Create and solve SUDOKU games in Org tables
;;; org-sudoku.el --- Create and solve SUDOKU games in Org tables -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Free Software Foundation, Inc.
;;
@@ -56,18 +56,17 @@ a game.")
(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)))
(let (game)
(cl-loop for i from 1 to org-sudoku-size do
(cl-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))
(let ((cnt 0) game1)
(while t
(catch 'abort
(message "Attempt %d to create a game" (setq cnt (1+ cnt)))
@@ -78,10 +77,10 @@ a game.")
(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")))
(cl-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)
@@ -159,9 +158,9 @@ A game structure is returned."
(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))
(let (i j v numbers a)
(cl-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
@@ -209,14 +208,18 @@ 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)
(let (e
;; FIXME unused.
;; 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)
;; FIXME: Unused, potential fault is logic.
;; v (nth 1 e)
allowed (nth 2 e))
(catch 'solved
(if (= (length allowed) 1)
@@ -242,14 +245,15 @@ it is probably stuck."
(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."
"Make a copy of GAME.
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)
(let (i j a)
(setq i (car field) j (cdr field))
(setq a (assoc field game))
(setf (nth 1 a) value)
@@ -268,20 +272,21 @@ it is probably stuck."
(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)))
(cl-loop for ii from 1 to org-sudoku-size do
(or (= ii i) (push (cons ii j) ll)))
(cl-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))))
(let (ff)
(cl-loop for ii from imin to imax do
(cl-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

97
lisp/org-contrib/org-toc.el
View File

@@ -1,4 +1,4 @@
;;; org-toc.el --- Table of contents for Org-mode buffer
;;; org-toc.el --- Table of contents for Org-mode buffer -*- lexical-binding: t; -*-
;; Copyright 2007-2021 Free Software Foundation, Inc.
;;
@@ -33,7 +33,8 @@
(provide 'org-toc)
(eval-when-compile
(require 'cl))
(require 'cl-lib))
(require 'org)
;;; Custom variables:
(defvar org-toc-base-buffer nil)
@@ -84,7 +85,7 @@ headlines in the TOC buffer."
(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."
\\='custom. A value >=1000 will call recenter with no arg."
:group 'org-toc
:type 'integer)
@@ -92,7 +93,7 @@ This variable is only used when `org-toc-recenter-mode' is set to
"A list of excluded properties when displaying info in the
echo-area. The COLUMNS property is always excluded."
:group 'org-toc
:type 'lits)
:type '(list string))
;;; Org TOC mode:
(defvar org-toc-mode-map (make-sparse-keymap)
@@ -186,8 +187,7 @@ specified, then make `org-toc-recenter' use this value."
(format "on, line %d" org-toc-recenter) "off")))
(defun org-toc-cycle-subtree ()
"Locally cycle a headline through two states: 'children and
'folded"
"Cycle a headline through two states: \\='children and \\='folded."
(interactive)
(let ((beg (point))
(end (save-excursion (end-of-line) (point)))
@@ -197,14 +197,16 @@ specified, then make `org-toc-recenter' use this value."
(setq ov (make-overlay beg end)))
;; change the folding status of this headline
(cond ((or (null status) (eq status 'folded))
(org-show-children)
(if (fboundp 'org-fold-show-children)
(org-fold-show-children)
(with-no-warnings (org-show-children)))
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq status 'children)
(show-branches)
(outline-show-branches)
(message "BRANCHES")
(overlay-put ov 'status 'branches))
(t (hide-subtree)
(t (outline-hide-subtree)
(message "FOLDED")
(overlay-put ov 'status 'folded)))))
@@ -223,7 +225,7 @@ specified, then make `org-toc-recenter' use this value."
(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)
(pop-to-buffer-same-window org-toc-base-buffer)
(error "Not in an Org buffer")))
;; create the new window display
(let ((pos (or position
@@ -280,7 +282,7 @@ specified, then make `org-toc-recenter' use this value."
(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 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))
@@ -290,9 +292,15 @@ If CYCLE is non-nil, cycle the targeted subtree in the Org window."
(if cycle (org-cycle)
(progn (org-overview)
(if org-toc-show-subtree-mode
(org-show-subtree)
(org-show-entry))
(org-show-context)))
(if (fboundp 'org-fold-show-subtree)
(org-fold-show-subtree)
(with-no-warnings (org-show-subtree)))
(if (fboundp 'org-fold-show-entry)
(org-fold-show-entry)
(with-no-warnings (org-show-entry))))
(if (fboundp 'org-fold-show-context)
(org-fold-show-context)
(with-no-warnings (org-show-context)))))
(if org-toc-recenter-mode
(if (>= org-toc-recenter 1000) (recenter)
(recenter org-toc-recenter)))
@@ -363,13 +371,13 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
"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)
(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)))
(pop-to-buffer-same-window indirect-buffer)))
(defun org-toc-info ()
"Show properties of current subtree in the echo-area."
@@ -377,7 +385,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(let ((pos (point))
(indirect-buffer (current-buffer))
props prop msg)
(org-pop-to-buffer-same-window org-toc-base-buffer)
(pop-to-buffer-same-window org-toc-base-buffer)
(goto-char pos)
(setq props (org-entry-properties))
(while (setq prop (pop props))
@@ -390,7 +398,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer."
(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)
(pop-to-buffer-same-window indirect-buffer)
(message msg)))
;;; Store and restore TOC configuration:
@@ -441,11 +449,13 @@ current table of contents to it."
(setq ov (make-overlay (match-beginning 0)
(match-end 0))))
(cond ((eq (cdr hlcfg0) 'children)
(org-show-children)
(if (fboundp 'org-fold-show-children)
(org-fold-show-children)
(with-no-warnings (org-show-children)))
(message "CHILDREN")
(overlay-put ov 'status 'children))
((eq (cdr hlcfg0) 'branches)
(show-branches)
(outline-show-branches)
(message "BRANCHES")
(overlay-put ov 'status 'branches))))))
(goto-char pos)
@@ -457,30 +467,25 @@ current table of contents to it."
(defun org-toc-get-headlines-status ()
"Return an alist of headlines and their associated folding
status."
(let (output ovs)
(let (output)
(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
(cl-pushnew
(cons (buffer-substring-no-properties
(match-beginning 0)
(save-excursion
(end-of-line) (point)))
(overlay-get
(car (overlays-at (point))) 'status))))))
(car (overlays-at (point))) 'status))
output))))
;; 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
(defvar org-toc--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)
@@ -488,17 +493,25 @@ status."
\[:\] 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"))))
\[q\] quit the TOC \[g\] restore last TOC configuration"
"Help message used by `org-toc-help'.")
(let ((st-start 0))
(while (string-match "\\[[^]]+\\]" org-toc--help-message st-start)
(add-text-properties (match-beginning 0)
(match-end 0) '(face bold) org-toc--help-message)
(setq st-start (match-end 0))))
;; 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)
(message org-toc--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")))
;;;;##########################################################################

210
lisp/org-contrib/org-track.el
View File

@@ -1,210 +0,0 @@
;;; org-track.el --- Track the most recent Org-mode version available.
;;
;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry <bzg@gnu.org>
;; Eric S Fraga <e.fraga at ucl.ac dot uk>
;; Sebastian Rose <sebastian_rose at gmx dot de>
;; The Worg people https://orgmode.org/worg/
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: https://git.sr.ht/~bzg/org-contrib
;; Version: 6.29a
;;
;; Released under the GNU General Public License version 3
;; see: https://www.gnu.org/licenses/gpl-3.0.html
;;
;; This file is not part of GNU Emacs.
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
;; WARNING: This library is obsolete, you should use the make targets
;; to keep track of Org latest developments.
;;
;; Download the latest development tarball, unpack and optionally compile it
;;
;; Usage:
;;
;; (require 'org-track)
;;
;; ;; ... somewhere in your setup (use customize):
;;
;; (setq org-track-directory "~/test/")
;; (setq org-track-compile-sources nil)
;; (setq org-track-remove-package t)
;;
;; M-x org-track-update RET
(require 'url-parse)
(require 'url-handlers)
(autoload 'url-file-local-copy "url-handlers")
(autoload 'url-generic-parse-url "url-parse")
;;; Variables:
(defgroup org-track nil
"Track the most recent Org-mode version available.
To use org-track, adjust `org-track-directory'.
Org will download the archived latest git version for you,
unpack it into that directory (i.e. a subdirectory
`org-mode/' is added), create the autoloads file
`org-loaddefs.el' for you and, optionally, compile the
sources.
All you'll have to do is call `M-x org-track-update' from
time to time."
:group 'org)
(defcustom org-track-directory (concat user-emacs-directory "org/lisp")
"Directory where your org-mode/ directory lives.
If that directory does not exist, it will be created."
:type 'directory)
(defcustom org-track-compile-sources t
"If `nil', never compile org-sources.
Org will only create the autoloads file `org-loaddefs.el' for
you then. If `t', compile the sources, too.
Note, that emacs preferes compiled elisp files over
non-compiled ones."
:type 'boolean)
(defcustom org-track-org-url "https://orgmode.org/"
"The URL where the package to download can be found.
Please append a slash."
:type 'string)
(defcustom org-track-org-package "org-latest.tar.gz"
"The basename of the package you use.
Defaults to the development version of Org-mode.
This should be a *.tar.gz package, since emacs provides all
you need to unpack it."
:type 'string)
(defcustom org-track-remove-package nil
"Remove org-latest.tar.gz after updates?"
:type 'boolean)
;;; Frontend
(defun org-track-update ()
"Update to current Org-mode version.
Also, generate autoloads and evtl. compile the sources."
(interactive)
(let* ((base (file-truename org-track-directory))
(org-exists (file-exists-p
(file-truename
(concat base "/org-mode/lisp/org.el"))))
(nobase (not (file-directory-p
(file-truename org-track-directory)))))
(if nobase
(when (y-or-n-p
(format "Directory %s does not exist. Create it?" base))
(make-directory base t)
(setq nobase nil)))
(if nobase
(message "Not creating %s - giving up." org-track-directory)
(condition-case err
(progn
(org-track-fetch-package)
(org-track-compile-org))
(error (message "%s" (error-message-string err)))))))
;;; tar related functions
;; `url-retrieve-synchronously' fetches files synchronously. How can we ensure
;; that? If the maintainers of that package decide, that an assynchronous
;; download might be better??? (used by `url-file-local-copy')
;;;###autoload
(defun org-track-fetch-package (&optional directory)
"Fetch Org package depending on `org-track-fetch-package-extension'.
If DIRECTORY is defined, unpack the package there, i.e. add the
subdirectory org-mode/ to DIRECTORY."
(interactive "Dorg-track directory: ")
(let* ((pack (concat
(if (string-match "/$" org-track-org-url)
org-track-org-url
(concat org-track-org-url "/"))
org-track-org-package))
(base (file-truename
(or directory org-track-directory)))
(target (file-truename
(concat base "/" org-track-org-package)))
url download tarbuff)
(message "Fetching to %s - this might take some time..." base)
(setq url (url-generic-parse-url pack))
(setq download (url-file-local-copy url)) ;; errors if fail
(copy-file download target t)
(delete-file download)
;; (tar-mode) leads to dubious errors. We use the auto-mode-alist to
;; ensure tar-mode is used:
(add-to-list 'auto-mode-alist '("org-latest\\.tar\\.gz\\'" . tar-mode))
(setq tarbuff (find-file target))
(with-current-buffer tarbuff ;; with-temp-buffer does not work with tar-mode??
(tar-untar-buffer))
(kill-buffer tarbuff)
(if org-track-remove-package
(delete-file target))))
;;; Compile Org-mode sources
;;;###autoload
(defun org-track-compile-org (&optional directory)
"Compile all *.el files that come with org-mode.
Generate the autoloads file `org-loaddefs.el'.
DIRECTORY is where the directory org-mode/ lives (i.e. the
parent directory of your local repo."
(interactive)
;; file-truename expands the filename and removes double slash, if exists:
(setq directory (file-truename
(concat
(or directory
(file-truename (concat org-track-directory "/org-mode/lisp")))
"/")))
(add-to-list 'load-path directory)
(let ((list-of-org-files (file-expand-wildcards (concat directory "*.el"))))
;; create the org-loaddefs file
(require 'autoload)
(setq esf/org-install-file (concat directory "org-loaddefs.el"))
(find-file esf/org-install-file)
(erase-buffer)
(mapc (lambda (x)
(generate-file-autoloads x))
list-of-org-files)
(insert "\n(provide (quote org-loaddefs))\n")
(save-buffer)
(kill-buffer)
(byte-compile-file esf/org-install-file t)
(mapc (lambda (f)
(if (file-exists-p (concat f "c"))
(delete-file (concat f "c"))))
list-of-org-files)
(if org-track-compile-sources
(mapc (lambda (f) (byte-compile-file f)) list-of-org-files))))
(provide 'org-track)
;;; org-track.el ends here

27
lisp/org-contrib/org-wikinodes.el
View File

@@ -24,7 +24,7 @@
(require 'org)
(eval-when-compile
(require 'cl))
(require 'cl-lib))
(defgroup org-wikinodes nil
"Wiki-like CamelCase links words to outline nodes in Org mode."
@@ -76,7 +76,7 @@ to `directory'."
(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)) ?*)
(if (equal (char-after (line-beginning-position)) ?*)
(progn
;; in heading - deactivate flyspell
(org-remove-flyspell-overlays-in (match-beginning 0)
@@ -114,7 +114,7 @@ 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)
pos file rpl)
(setq pos
(or (org-find-exact-headline-in-buffer target (current-buffer))
(and (eq org-wikinodes-scope 'directory)
@@ -153,7 +153,7 @@ setting of `org-wikinodes-create-targets'."
((stringp create)
;; Make new node in another file
(org-mark-ring-push (point))
(org-pop-to-buffer-same-window (find-file-noselect create))
(pop-to-buffer-same-window (find-file-noselect create))
(goto-char (point-max))
(or (bolp) (newline))
(insert "\n* " target "\n")
@@ -209,7 +209,7 @@ setting of `org-wikinodes-create-targets'."
"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)
target-file-alist file visiting buffer)
(while (setq file (pop files))
(setq visiting (org-find-base-buffer-visiting file))
(setq buffer (or visiting (find-file-noselect file)))
@@ -247,12 +247,15 @@ If there is no such wiki target, return nil."
;;; Exporting Wiki links
;; FIXME: These two variables are never set.
;; Apparently, this part of the library is never working.
(defvar target)
(defvar target-alist)
(defvar last-section-target)
(defvar target-alist)
(defvar org-export-target-aliases)
(defun org-wikinodes-set-wiki-targets-during-export (_)
(let ((line (buffer-substring (point-at-bol) (point-at-eol)))
(let ((line (buffer-substring (line-beginning-position) (line-end-position)))
(case-fold-search nil)
wtarget a)
(when (string-match (format org-complex-heading-regexp-format
@@ -273,13 +276,13 @@ 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)
link)
(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 org-link-bracket-re)
(org-in-regexp org-link-plain-re)
(org-in-regexp "<<[^<>]+>>")))
(setq link (match-string 0))
(delete-region (match-beginning 0) (match-end 0))
@@ -303,11 +306,11 @@ with working links."
(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
(add-hook 'org-export-before-parsing-functions
'org-wikinodes-set-wiki-targets-during-export)
;; Turn Wiki links into links the exporter will treat correctly
(add-hook 'org-export-before-parsing-hook
(add-hook 'org-export-before-parsing-functions
'org-wikinodes-process-links-for-export)
;; Activate CamelCase words as part of Org mode font lock

38
lisp/org-contrib/orgtbl-sqlinsert.el
View File

@@ -1,4 +1,4 @@
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements. -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
@@ -27,6 +27,8 @@
;;; Code:
(require 'org-table)
(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
@@ -62,34 +64,36 @@ The most important parameters of ORGTBL-TO-GENERIC for SQL are:
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 ""))
;; (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)
;; (*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
(sqlname (plist-get params :sqlname))
(params2
(list
:sqlname (plist-get params :sqlname)
:tstart (lambda () (concat (if nowebname
(format "<<%s>>= \n" nowebname)
"")
"BEGIN TRANSACTION;"))
: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 ( "))
:hlfmt (lambda (&rest _) (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)))
(params (org-combine-plists params2 params)))
(orgtbl-to-generic table params)))
(defun orgtbl-sql-quote (str)

109
lisp/org-contrib/ox-bibtex.el
View File

@@ -1,4 +1,4 @@
;;; ox-bibtex.el --- Export bibtex fragments
;;; ox-bibtex.el --- Export bibtex fragments -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2014, 2021 Taru Karttunen
@@ -93,6 +93,9 @@
;; Initialization
(require 'cl-lib)
(require 'org)
(require 'ox)
(require 'org-element)
;;; Internal Functions
@@ -160,6 +163,8 @@ to `org-bibtex-citation-p' predicate."
(defun org-bibtex-goto-citation (&optional citation)
"Visit a citation given its ID."
(interactive)
(declare-function obe-citations "org-bibtex-extras" ())
(require 'org-bibtex-extras)
(let ((citation (or citation (completing-read "Citation: " (obe-citations)))))
(find-file (or org-bibtex-file
(error "`org-bibtex-file' has not been configured")))
@@ -167,12 +172,15 @@ to `org-bibtex-citation-p' predicate."
(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))
(org-link-set-parameters "cite" :follow jump-fn))
;;; Filters
(defvar org-bibtex-html-entries-alist nil) ; Dynamically scoped.
(defvar org-bibtex-html-keywords-alist nil) ; Dynamically scoped.
(defun org-bibtex-process-bib-files (tree backend info)
"Send each bibliography in parse tree to \"bibtex2html\" process.
Return new parse tree."
@@ -344,86 +352,65 @@ the HTML and ASCII backends."
;;; LaTeX Part
(defadvice org-latex-keyword (around bibtex-keyword)
(define-advice org-latex-keyword (:around (fun keyword contents info) 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)
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
(funcall fun keyword contents info)
(let ((file (org-bibtex-get-file keyword))
(style (org-not-nil (org-bibtex-get-style keyword))))
(when file
(concat (and style (format "\\bibliographystyle{%s}\n" style))
(format "\\bibliography{%s}" file))))))
;;; 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)
(define-advice org-html-keyword (:around (fun keyword contents info) 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))))))
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
(funcall fun keyword contents info)
(cdr (assq keyword org-bibtex-html-keywords-alist))))
(defadvice org-html-latex-fragment (around bibtex-citation)
(define-advice org-html-latex-fragment (:around (fun fragment contents info) 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)
(if (not (org-bibtex-citation-p fragment))
(funcall fun fragment contents info)
(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) ",") ","))))
;;; Ascii Part
(defadvice org-ascii-keyword (around bibtex-keyword)
(define-advice org-ascii-keyword (:around (fun keyword contents info) 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))))))
(if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
(funcall fun keyword contents info)
(cdr (assq keyword org-bibtex-html-keywords-alist))))
(defadvice org-ascii-latex-fragment (around bibtex-citation)
(define-advice org-ascii-latex-fragment (:around (fun fragment contents info) 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)
(if (not (org-bibtex-citation-p fragment))
(funcall fun fragment contents info)
(format "[%s]"
(mapconcat
(lambda (key)
(or (cdr (assoc key org-bibtex-html-entries-alist))
key))
(org-split-string
(org-bibtex-get-citation-key fragment) ",") ","))))
(provide 'ox-bibtex)

42
lisp/org-contrib/ox-confluence.el
View File

@@ -1,4 +1,4 @@
;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine
;;; ox-confluence --- Confluence Wiki Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2021 Sébastien Delafond
@@ -65,24 +65,30 @@
'(?f "Export to Confluence"
((?f "As Confluence buffer" org-confluence-export-as-confluence))))
(defgroup org-export-confluence nil
"Options for exporting Org mode files to Confluence."
:tag "Org Export Confluence"
:group 'org-export-ascii)
(defcustom org-confluence-lang-alist
'(("sh" . "bash"))
"Map from org-babel language name to confluence wiki language name"
:group 'org-export-confluence
:type '(alist :key-type string :value-type string))
;; All the functions we use
(defun org-confluence-bold (bold contents info)
(defun org-confluence-bold (_ contents _)
(format "*%s*" contents))
(defun org-confluence-empty (empty contents info)
(defun org-confluence-empty (_ _ _)
"")
(defun org-confluence-example-block (example-block contents info)
(defun org-confluence-example-block (example-block _ 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)
(defun org-confluence-italic (_ contents _)
(format "_%s_" contents))
(defun org-confluence-item (item contents info)
@@ -101,22 +107,22 @@
"* - "))
(org-trim contents))))
(defun org-confluence-fixed-width (fixed-width contents info)
(defun org-confluence-fixed-width (fixed-width _ _)
(org-confluence--block
"none"
"Confluence"
(org-trim (org-element-property :value fixed-width))))
(defun org-confluence-verbatim (verbatim contents info)
(defun org-confluence-verbatim (verbatim _ _)
(let ((content (org-element-property :value verbatim)))
(format "\{\{%s\}\}" (string-replace "{" "\\{" content))))
(defun org-confluence-code (code contents info)
(defun org-confluence-code (code _ _)
(let ((content (org-element-property :value code)))
(format "\{\{%s\}\}" (string-replace "{" "\\{" content))))
(defun org-confluence-headline (headline contents info)
(let* ((low-level-rank (org-export-low-level-p headline 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)
@@ -129,7 +135,7 @@
(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)
(defun org-confluence-link (link desc _)
(if (string= "radio" (org-element-property :type link))
desc
(let ((raw-link (org-element-property :raw-link link)))
@@ -142,33 +148,33 @@
raw-link))
"]"))))
(defun org-confluence-paragraph (paragraph contents info)
(defun org-confluence-paragraph (_ contents _)
"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)
(defun org-confluence-property-drawer (_ contents _)
(and (org-string-nw-p contents)
(format "\{\{%s\}\}" contents)))
(defun org-confluence-quote-block (quote-block contents info)
(defun org-confluence-quote-block (_ contents _)
(format "{quote}\n%s{quote}" contents))
(defun org-confluence-section (section contents info)
(defun org-confluence-section (_ contents _)
contents)
(defun org-confluence-src-block (src-block contents info)
(defun org-confluence-src-block (src-block _ 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)
(defun org-confluence-strike-through (_ contents _)
(format "-%s-" contents))
(defun org-confluence-table (table contents info)
(defun org-confluence-table (_ contents _)
contents)
(defun org-confluence-table-row (table-row contents info)
@@ -196,7 +202,7 @@ CONTENTS and INFO are ignored."
(concat "(" (substring translated 1 -1) ")")
translated)))
(defun org-confluence-underline (underline contents info)
(defun org-confluence-underline (_ contents _)
(format "+%s+" contents))
(defun org-confluence--block (language theme contents)

48
lisp/org-contrib/ox-deck.el
View File

@@ -1,4 +1,4 @@
;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine
;;; ox-deck.el --- deck.js Presentation Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2013, 2014, 2021 Rick Frankel
@@ -45,7 +45,7 @@
;; for missing values.
(require 'ox-html)
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl-lib))
(org-export-define-derived-backend 'deck 'html
:menu-entry
@@ -91,7 +91,7 @@ modernizr; core, extensions and themes directories.)"
:type '(repeat (string :tag "Directory")))
(defun org-deck--cleanup-components (components)
(remove-duplicates
(cl-remove-duplicates
(car (remove 'nil components))
:test (lambda (x y)
(string= (file-name-nondirectory x)
@@ -328,10 +328,10 @@ and have the id \"title-slide\"."
(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"))
(cl-pushnew (concat prefix "jquery.min.js") scripts)
(cl-pushnew (concat prefix "core/deck.core.js") scripts)
(cl-pushnew (concat prefix "modernizr.custom.js") scripts)
(cl-pushnew (concat prefix "core/deck.core.css") sheets)
(mapc
(lambda (extdir)
(let* ((name (file-name-nondirectory extdir))
@@ -341,28 +341,28 @@ and have the id \"title-slide\"."
(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")))
(cl-pushnew (concat path base "js") scripts))
(when (file-exists-p (concat dir base "css"))
(add-to-list 'sheets (concat path base "css")))
(cl-pushnew (concat path base "css") sheets))
(when (file-exists-p (concat dir base "html"))
(add-to-list 'snippets (concat dir base "html"))))))
(cl-pushnew (concat dir base "html") snippets)))))
(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))))
(cl-pushnew
(if (file-name-directory theme) theme
(format "%sthemes/style/%s" prefix theme))
sheets))
(if (not (string-match-p "^[[:space:]]*$" transition))
(add-to-list
'sheets
(cl-pushnew
(if (file-name-directory transition) transition
(format "%sthemes/transition/%s" prefix transition))))
(format "%sthemes/transition/%s" prefix transition))
sheets))
(list :scripts (nreverse scripts) :sheets (nreverse sheets)
:snippets snippets)))
(defun org-deck-inner-template (contents info)
(defun org-deck-inner-template (contents _)
"Return body of document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
CONTENTS is the transcoded contents string."
(concat contents "\n"))
(defun org-deck-headline (headline contents info)
@@ -383,7 +383,9 @@ the \"slide\" class will be added to the to the list element,
(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)
;; FIXME: This did nothing before commented. Should the
;; `replace-regexp-in-string' calls be nested?
;; (replace-regexp-in-string "^<li>" "<li class='slide'>" text)
(replace-regexp-in-string "^<li class='checkbox'>" "<li class='checkbox slide'>" text))
text)))
@@ -480,9 +482,9 @@ INFO is a plist used as a communication channel."
(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)))))
;; (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

24
lisp/org-contrib/ox-extra.el
View File

@@ -1,4 +1,4 @@
;;; ox-extra.el --- Convenience functions for org export
;;; ox-extra.el --- Convenience functions for org export -*- lexical-binding: t; -*-
;; Copyright (C) 2014, 2021 Aaron Ecay
@@ -69,22 +69,16 @@
"yes"))
(list (org-element-property :begin block)
(org-element-property :end block)
(org-element-property :post-affiliated block)))))))
(org-element-property :post-affiliated block)
(org-element-property :value 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"))))))
(let ((contents-lines (split-string (nth 3 pos) "\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)))))

57
lisp/org-contrib/ox-freemind.el
View File

@@ -1,4 +1,4 @@
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine
;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2021 Free Software Foundation, Inc.
@@ -144,7 +144,7 @@ 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))))
(cl-assert (symbolp (car parsed-xml))))
(cond
((null parsed-xml) "")
((stringp parsed-xml) parsed-xml)
@@ -182,7 +182,7 @@ 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)
(cl-case (org-element-type element)
(headline
(org-export-get-relative-level element info))
(section
@@ -194,11 +194,8 @@ mappings of different outline levels."
(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."
(defun org-freemind-style-map--default (_ _)
"Return the default style from `org-freemind-styles'."
(or (assoc-default 'default org-freemind-styles)
"<node></node>"))
@@ -293,7 +290,7 @@ will result in following node:
;;;; Helpers :: Node contents
(defun org-freemind--richcontent (type contents &optional css-style)
(let* ((type (case type
(let* ((type (cl-case type
(note "NOTE")
(node "NODE")
(t "NODE")))
@@ -306,7 +303,7 @@ will result in following node:
(format "<body>\n%s\n</body>" contents))))))
(defun org-freemind--build-node-contents (element contents info)
(let* ((title (case (org-element-type element)
(let* ((title (cl-case (org-element-type element)
(headline
(org-element-property :title element))
(org-data
@@ -330,7 +327,7 @@ will result in following node:
(when itemized-contents-p
contents))))
(concat (let ((title (org-export-data title info)))
(case org-freemind-section-format
(cl-case org-freemind-section-format
(inline
(org-freemind--richcontent
'node (concat (format "\n<h2>%s</h2>" title)
@@ -366,10 +363,9 @@ original parsed data. INFO is a plist holding export options."
(let ((org-data (plist-get info :parse-tree)))
(org-freemind--build-node-contents org-data contents info)))))
(defun org-freemind-inner-template (contents info)
(defun org-freemind-inner-template (contents _)
"Return body of document string after Freemind Mindmap conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
CONTENTS is the transcoded contents string."
contents)
;;;; Tags
@@ -385,10 +381,8 @@ holding export options."
;;;; 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."
(defun org-freemind-entity (entity _ _)
"Transcode an ENTITY object from Org to Freemind Mindmap."
(org-element-property :utf-8 entity))
;;;; Headline
@@ -399,25 +393,9 @@ 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)))
(let* ((level (org-export-get-relative-level headline info))
(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
@@ -437,7 +415,6 @@ holding contextual information."
(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)
@@ -463,7 +440,7 @@ holding contextual information."
;;; Filter Functions
(defun org-freemind-final-function (contents backend info)
(defun org-freemind-final-function (contents _ _)
"Return CONTENTS as pretty XML using `indent-region'."
(if (not org-freemind-pretty-output) contents
(with-temp-buffer
@@ -472,10 +449,8 @@ holding contextual information."
(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."
(defun org-freemind-options-function (info _)
"Install script in export options INFO when appropriate."
;; Freemind/Freeplane doesn't seem to like named html entities in
;; richcontent. For now, turn off smart quote processing so that
;; entities like "&rsquo;" & friends are avoided in the exported

216
lisp/org-contrib/ox-groff.el
View File

@@ -1,4 +1,4 @@
;;; ox-groff.el --- Groff Back-End for Org Export Engine
;;; ox-groff.el --- Groff Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2021 Free Software Foundation, Inc.
@@ -37,7 +37,7 @@
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl-lib))
(require 'ox)
(defvar orgtbl-exp-regexp)
@@ -166,7 +166,7 @@
(string :tag "Header")
(repeat :tag "Options" :inline t
(choice
(list :tag "Heading")
(symbol :tag "Heading")
(function :tag "Hook computing sectioning"))))))
;;; Headline
@@ -198,7 +198,7 @@ order to reproduce the default set-up:
text
\(when tags
\(format \" %s \"
\(mapconcat 'identity tags \":\"))))"
\(mapconcat \\='identity tags \":\"))))"
:group 'org-export-groff
:type 'function)
@@ -336,7 +336,7 @@ in order to mimic default behaviour:
title
\(when tags
\(format \":%s:\"
\(mapconcat 'identity tags \":\")))))
\(mapconcat \\='identity tags \":\")))))
\(format (concat \".DS L\\n\"
\"%s\\n\\n\"
\"%s\"
@@ -392,7 +392,7 @@ a list containing two strings: the name of the option, and the
value. For example,
(setq org-groff-source-highlight-options
'((\"basicstyle\" \"\\small\")
\\='((\"basicstyle\" \"\\small\")
(\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\")))
will typeset the code in a small size font with underlined, bold
@@ -413,7 +413,7 @@ It is used during export of src blocks by the listings and
groff packages. For example,
\(setq org-groff-custom-lang-environments
'\(\(python \"pythoncode\"\)\)\)
\\='\(\(python \"pythoncode\"\)\)\)
would have the effect that if org encounters begin_src python
during groff export it will use pythoncode as the source-highlight
@@ -476,15 +476,17 @@ These are the .aux, .log, .out, and .toc files."
:type 'string)
(defcustom org-groff-raster-to-ps nil
"Command used to convert raster to EPS. Nil for no conversion. Make sure that
`org-groff-inline-image-rules' is adjusted accordingly if not conversion is being
done. In this case, remove the entries for jpg and png in the file and fuzzy lists."
"Command used to convert raster to EPS.
Nil for no conversion.
Make sure that `org-groff-inline-image-rules' is adjusted accordingly
if not conversion is being done. In this case, remove the entries for
jpg and png in the file and fuzzy lists."
:group 'org-export-groff
:type '(choice
(repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
(const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b} ;grep -v BeginData ${b} > b_${b};mv b_${b} ${b}" )
(const :tag "NetPNM" "a=%s;b=%s;pngtopnm ${a} | pnmtops -noturn > ${b}" )
(const :tag "None" nil)))
(repeat :tag "Shell Command Sequence" (string :tag "Shell Command"))
(const :tag "sam2p" "a=%s;b=%s;sam2p ${a} ${b} ;grep -v BeginData ${b} > b_${b};mv b_${b} ${b}" )
(const :tag "NetPNM" "a=%s;b=%s;pngtopnm ${a} | pnmtops -noturn > ${b}" )
(const :tag "None" nil)))
(defvar org-groff-registered-references nil)
(defvar org-groff-special-content nil)
@@ -529,8 +531,7 @@ See `org-groff-text-markup-alist' for details."
;; No format string: Return raw text.
((not fmt) text)
((string= "protectedtexttt" fmt)
(let ((start 0)
(trans '(("\\" . "\\")))
(let ((trans '(("\\" . "\\")))
(rtn "")
char)
(while (string-match "[\\{}$%&_#~^]" text)
@@ -546,10 +547,10 @@ See `org-groff-text-markup-alist' for details."
(t (format fmt text)))))
(defun org-groff--get-tagged-content (tag info)
(defun org-groff--get-tagged-content (tag _)
(cdr (assoc tag org-groff-special-content)))
(defun org-groff--mt-head (title contents attr info)
(defun org-groff--mt-head (title _ attr info)
(concat
;; 1. Insert Organization
@@ -587,9 +588,7 @@ See `org-groff-text-markup-alist' for details."
(and auth (org-export-data auth info)))))
(email (and (plist-get info :with-email)
(org-export-data (plist-get info :email) info)))
(from-data (org-groff--get-tagged-content "FROM" info))
(to-data (org-groff--get-tagged-content "TO" info)))
(from-data (org-groff--get-tagged-content "FROM" info)))
(cond
((and author from-data)
@@ -635,7 +634,7 @@ See `org-groff-text-markup-alist' for details."
(to-data
(format ".AS\n%s\n.AE\n" to-data))))))
(defun org-groff--letter-head (title contents attr info)
(defun org-groff--letter-head (_ _ attr info)
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -686,10 +685,8 @@ holding export options."
(list (plist-get info :groff-class-options))
" "))))
(class (plist-get info :groff-class))
(class-options (plist-get info :groff-class-options))
(classes (assoc class org-groff-classes))
(classes-options (car (last classes)))
(heading-option (plist-get classes-options :heading))
(type-option (plist-get classes-options :type))
(last-option (plist-get classes-options :last-section))
(hyphenate (plist-get attr :hyphenate))
@@ -705,16 +702,16 @@ holding export options."
(concat
(if justify-right
(case justify-right
('yes ".SA 1 \n")
('no ".SA 0 \n")
(cl-case justify-right
(yes ".SA 1 \n")
(no ".SA 0 \n")
(t ""))
"")
(if hyphenate
(case hyphenate
('yes ".nr Hy 1 \n")
('no ".nr Hy 0 \n")
(cl-case hyphenate
(yes ".nr Hy 1 \n")
(no ".nr Hy 0 \n")
(t ""))
"")
@@ -784,7 +781,7 @@ holding export options."
(lambda (item)
(when (string= (car item) "NS")
(replace-regexp-in-string
"\\.P\n" "" (cdr item))))
"\\.P\n" "" (cdr item))))
(reverse org-groff-special-content) "\n")))))
@@ -798,7 +795,7 @@ holding export options."
;;; Bold
(defun org-groff-bold (bold contents info)
(defun org-groff-bold (_ contents _)
"Transcode BOLD from Org to Groff.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -806,7 +803,7 @@ contextual information."
;;; Center Block
(defun org-groff-center-block (center-block contents info)
(defun org-groff-center-block (center-block contents _)
"Transcode a CENTER-BLOCK element from Org to Groff.
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
@@ -816,7 +813,7 @@ holding contextual information."
;;; Clock
(defun org-groff-clock (clock contents info)
(defun org-groff-clock (clock _ _)
"Transcode a CLOCK element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -829,7 +826,7 @@ information."
;;; Code
(defun org-groff-code (code contents info)
(defun org-groff-code (code _ _)
"Transcode a CODE object from Org to Groff.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -839,7 +836,7 @@ channel."
;;; Drawer
(defun org-groff-drawer (drawer contents info)
(defun org-groff-drawer (drawer contents _)
"Transcode a DRAWER element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -854,7 +851,7 @@ holding contextual information."
;;; Dynamic Block
(defun org-groff-dynamic-block (dynamic-block contents info)
(defun org-groff-dynamic-block (dynamic-block contents _)
"Transcode a DYNAMIC-BLOCK element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -862,7 +859,7 @@ holding contextual information. See `org-export-data'."
;;; Entity
(defun org-groff-entity (entity contents info)
(defun org-groff-entity (entity _ _)
"Transcode an ENTITY object from Org to Groff.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -870,7 +867,7 @@ contextual information."
;;; Example Block
(defun org-groff-example-block (example-block contents info)
(defun org-groff-example-block (example-block _ info)
"Transcode an EXAMPLE-BLOCK element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -881,7 +878,7 @@ information."
;;; Export Block
(defun org-groff-export-block (export-block contents info)
(defun org-groff-export-block (export-block _ _)
"Transcode a EXPORT-BLOCK element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "GROFF")
@@ -889,7 +886,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Export Snippet
(defun org-groff-export-snippet (export-snippet contents info)
(defun org-groff-export-snippet (export-snippet _ _)
"Transcode a EXPORT-SNIPPET object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'groff)
@@ -897,7 +894,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Fixed Width
(defun org-groff-fixed-width (fixed-width contents info)
(defun org-groff-fixed-width (fixed-width _ _)
"Transcode a FIXED-WIDTH element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-groff--wrap-label
@@ -913,11 +910,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; Footnotes are handled automatically in GROFF. Although manual
;; references can be added, not really required.
(defun org-groff-footnote-reference (footnote-reference contents info)
(defun org-groff-footnote-reference (footnote-reference _ info)
;; Changing from info to footnote-reference
(let* ((raw (org-export-get-footnote-definition footnote-reference info))
(n (org-export-get-footnote-number footnote-reference info))
(data (org-trim (org-export-data raw info)))
(n (org-export-get-footnote-number footnote-reference info))
(data (org-trim (org-export-data raw info)))
(ref-id (plist-get (nth 1 footnote-reference) :label)))
;; It is a reference
(if (string-match "fn:rl" ref-id)
@@ -978,16 +975,18 @@ holding contextual information."
text
(when tags
(format " \\fC%s\\fP " (org-make-tag-string tags))))))
(full-text-no-tag
(if (functionp org-groff-format-headline-function)
;; User-defined formatting function.
(funcall org-groff-format-headline-function
todo todo-type priority text nil)
;; Default formatting.
(concat
(when todo (format "\\fB%s\\fP " todo))
(when priority (format " [\\#%c] " priority))
text)))
;; FIXME: unused
;; (full-text-no-tag
;; (if (functionp org-groff-format-headline-function)
;; ;; User-defined formatting function.
;; (funcall org-groff-format-headline-function
;; todo todo-type priority text nil)
;; ;; Default formatting.
;; (concat
;; (when todo (format "\\fB%s\\fP " todo))
;; (when priority (format " [\\#%c] " priority))
;; text)))
;; Associate some \label to the headline for internal links.
;; (headline-label
;; (format "\\label{sec-%s}\n"
@@ -1055,7 +1054,7 @@ holding contextual information."
;;; Inline Src Block
(defun org-groff-inline-src-block (inline-src-block contents info)
(defun org-groff-inline-src-block (inline-src-block _ _)
"Transcode an INLINE-SRC-BLOCK element from Org to Groff.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
@@ -1129,7 +1128,7 @@ holding contextual information."
;;; Italic
(defun org-groff-italic (italic contents info)
(defun org-groff-italic (_ contents _)
"Transcode ITALIC from Org to Groff.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -1144,7 +1143,7 @@ contextual information."
(let* ((bullet (org-element-property :bullet item))
(type (org-element-property
:type (org-element-property :parent item)))
(checkbox (case (org-element-property :checkbox item)
(checkbox (cl-case (org-element-property :checkbox item)
(on "\\o'\\(sq\\(mu'")
(off "\\(sq")
(trans "\\o'\\(sq\\(mi'")))
@@ -1154,9 +1153,9 @@ contextual information."
(concat checkbox
(org-export-data tag info)))))))
(cond
((or checkbox tag)
(concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
(cond
((or checkbox tag)
(concat ".LI ""\"" (or tag (concat "\\ " checkbox)) "\""
"\n"
(org-trim (or contents " "))))
((eq type 'ordered)
@@ -1173,7 +1172,7 @@ contextual information."
;;; Keyword
(defun org-groff-keyword (keyword contents info)
(defun org-groff-keyword (keyword _ _)
"Transcode a KEYWORD element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -1184,7 +1183,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Line Break
(defun org-groff-line-break (line-break contents info)
(defun org-groff-line-break (_ _ _)
"Transcode a LINE-BREAK object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
".br\n")
@@ -1269,13 +1268,13 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
(case (org-element-type destination)
(pcase (org-element-type destination)
;; Id link points to an external file.
(plain-text
(`plain-text
(if desc (format "%s \\fBat\\fP \\fIfile://%s\\fP" desc destination)
(format "\\fI file://%s \\fP" destination)))
;; Fuzzy link points nowhere.
('nil
(`nil
(format org-groff-link-with-unknown-path-format
(or desc
(org-export-data
@@ -1283,7 +1282,7 @@ INFO is a plist holding contextual information. See
;; LINK points to a headline. If headlines are numbered and
;; the link has no description, display headline's number.
;; Otherwise, display description or headline's title.
(headline
(`headline
(let ((label ""))
(if (and (plist-get info :section-numbers) (not desc))
(format "\\fI%s\\fP" label)
@@ -1292,7 +1291,7 @@ INFO is a plist holding contextual information. See
(org-export-data
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
(_
(let ((ref (org-export-get-reference destination info)))
(if (not desc) (format "\\fI%s\\fP" ref)
(format "%s \\fBat\\fP \\fI%s\\fP" desc ref)))))))
@@ -1305,7 +1304,7 @@ INFO is a plist holding contextual information. See
;;; Node Property
(defun org-groff-node-property (node-property contents info)
(defun org-groff-node-property (node-property _ _)
"Transcode a NODE-PROPERTY element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1325,7 +1324,6 @@ the plist used as a communication channel."
(let* ((parent-type (car parent))
(fixed-paragraph "")
(class (plist-get info :groff-class))
(class-options (plist-get info :groff-class-options))
(classes (assoc class org-groff-classes))
(classes-options (car (last classes)))
(paragraph-option (plist-get classes-options :paragraph)))
@@ -1345,14 +1343,14 @@ the plist used as a communication channel."
;;; Plain List
(defun org-groff-plain-list (plain-list contents info)
(defun org-groff-plain-list (plain-list contents _)
"Transcode a PLAIN-LIST element from Org to Groff.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(let* ((type (org-element-property :type plain-list))
(attr (mapconcat #'identity
(org-element-property :attr_groff plain-list)
" "))
;; (attr (mapconcat #'identity
;; (org-element-property :attr_groff plain-list)
;; " "))
(groff-type (cond
((eq type 'ordered) ".AL")
((eq type 'unordered) ".BL")
@@ -1391,7 +1389,7 @@ contextual information."
;;; Planning
(defun org-groff-planning (planning contents info)
(defun org-groff-planning (planning _ _)
"Transcode a PLANNING element from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1423,7 +1421,7 @@ information."
;;;; Property Drawer
(defun org-groff-property-drawer (property-drawer contents info)
(defun org-groff-property-drawer (_ contents _)
"Transcode a PROPERTY-DRAWER element from Org to Groff.
CONTENTS holds the contents of the drawer. INFO is a plist
holding contextual information."
@@ -1432,7 +1430,7 @@ holding contextual information."
;;; Quote Block
(defun org-groff-quote-block (quote-block contents info)
(defun org-groff-quote-block (quote-block contents _)
"Transcode a QUOTE-BLOCK element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1450,7 +1448,7 @@ contextual information."
;;; Section
(defun org-groff-section (section contents info)
(defun org-groff-section (_ contents _)
"Transcode a SECTION element from Org to Groff.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -1458,31 +1456,28 @@ holding contextual information."
;;; Special Block
(defun org-groff-special-block (special-block contents info)
(defun org-groff-special-block (special-block contents _)
"Transcode a SPECIAL-BLOCK element from Org to Groff.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((type (org-element-property :type special-block)))
(org-groff--wrap-label
special-block
(format "%s\n" contents))))
(org-groff--wrap-label
special-block
(format "%s\n" contents)))
;;; Src Block
(defun org-groff-src-block (src-block contents info)
(defun org-groff-src-block (src-block _ info)
"Transcode a SRC-BLOCK element from Org to Groff.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((lang (org-element-property :language src-block))
(label (org-element-property :name src-block))
(code (org-element-property :value src-block))
(custom-env (and lang
(cadr (assq (intern lang)
org-groff-custom-lang-environments))))
(num-start (org-export-get-loc src-block info))
(retain-labels (org-element-property :retain-labels src-block))
(let* ((code (org-element-property :value src-block))
;; (custom-env (and lang
;; (cadr (assq (intern lang)
;; org-groff-custom-lang-environments))))
;; (num-start (org-export-get-loc src-block info))
;; (retain-labels (org-element-property :retain-labels src-block))
(caption (and (not (org-export-read-attribute
:attr_groff src-block :disable-caption))
:attr_groff src-block :disable-caption))
(org-groff--caption/label-string src-block info))))
(cond
@@ -1527,7 +1522,7 @@ contextual information."
;;; Statistics Cookie
(defun org-groff-statistics-cookie (statistics-cookie contents info)
(defun org-groff-statistics-cookie (statistics-cookie _ _)
"Transcode a STATISTICS-COOKIE object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
@@ -1535,7 +1530,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Strike-Through
(defun org-groff-strike-through (strike-through contents info)
(defun org-groff-strike-through (_ contents _)
"Transcode STRIKE-THROUGH from Org to Groff.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -1543,7 +1538,7 @@ holding contextual information."
;;; Subscript
(defun org-groff-subscript (subscript contents info)
(defun org-groff-subscript (_ contents _)
"Transcode a SUBSCRIPT object from Org to Groff.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1551,7 +1546,7 @@ contextual information."
;;; Superscript "^_%s$
(defun org-groff-superscript (superscript contents info)
(defun org-groff-superscript (_ contents _)
"Transcode a SUPERSCRIPT object from Org to Groff.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1614,7 +1609,7 @@ a communication channel."
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push
(case (org-export-table-cell-alignment cell info)
(cl-case (org-export-table-cell-alignment cell info)
(left (concat "l" width divider))
(right (concat "r" width divider))
(center (concat "c" width divider)))
@@ -1632,7 +1627,6 @@ channel.
This function assumes TABLE has `org' as its `:type' attribute."
(let* ((attr (org-export-read-attribute :attr_groff table))
(label (org-element-property :name table))
(caption (and (not (plist-get attr :disable-caption))
(org-groff--caption/label-string table info)))
(divider (if (plist-get attr :divider) "|" " "))
@@ -1678,14 +1672,14 @@ This function assumes TABLE has `org' as its `:type' attribute."
(format "%s.\n"
(let ((final-line ""))
(when title-line
(dotimes (i (length first-line))
(dotimes (_ (length first-line))
(setq final-line (concat final-line "cb" divider))))
(setq final-line (concat final-line "\n"))
(if alignment
(setq final-line (concat final-line alignment))
(dotimes (i (length first-line))
(dotimes (_ (length first-line))
(setq final-line (concat final-line "c" divider))))
final-line))
@@ -1748,10 +1742,10 @@ a communication channel."
;; Rules are ignored since table separators are deduced from
;; borders of the current row.
(when (eq (org-element-property :type table-row) 'standard)
(let* ((attr (mapconcat 'identity
(org-element-property
:attr_groff (org-export-get-parent table-row))
" "))
(let* (;; (attr (mapconcat 'identity
;; (org-element-property
;; :attr_groff (org-export-get-parent table-row))
;; " "))
;; TABLE-ROW's borders are extracted from its first cell.
(borders
(org-export-table-cell-borders
@@ -1768,7 +1762,7 @@ a communication channel."
;;; Target
(defun org-groff-target (target contents info)
(defun org-groff-target (target _ info)
"Transcode a TARGET object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1776,13 +1770,13 @@ information."
;;; Timestamp
(defun org-groff-timestamp (timestamp contents info)
(defun org-groff-timestamp (timestamp _ info)
"Transcode a TIMESTAMP object from Org to Groff.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-groff-plain-text
(org-timestamp-translate timestamp) info)))
(case (org-element-property :type timestamp)
(cl-case (org-element-property :type timestamp)
((active active-range)
(format org-groff-active-timestamp-format value))
((inactive inactive-range)
@@ -1791,7 +1785,7 @@ information."
;;; Underline
(defun org-groff-underline (underline contents info)
(defun org-groff-underline (_ contents _)
"Transcode UNDERLINE from Org to Groff.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -1799,7 +1793,7 @@ holding contextual information."
;;; Verbatim
(defun org-groff-verbatim (verbatim contents info)
(defun org-groff-verbatim (verbatim _ _)
"Transcode a VERBATIM object from Org to Groff.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1807,7 +1801,7 @@ channel."
;;; Verse Block
(defun org-groff-verse-block (verse-block contents info)
(defun org-groff-verse-block (_ contents _)
"Transcode a VERSE-BLOCK element from Org to Groff.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."

31
lisp/org-contrib/ox-s5.el
View File

@@ -1,4 +1,4 @@
;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine
;;; ox-s5.el --- S5 Presentation Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2014, 2021 Rick Frankel
@@ -55,7 +55,7 @@
;; for missing values.
(require 'ox-html)
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl-lib))
(org-export-define-derived-backend 's5 'html
:menu-entry
@@ -130,9 +130,9 @@ Can be overridden with the S5_UI_URL property."
(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.
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
@@ -212,8 +212,7 @@ INFO is a plist used as a communication channel."
(and tags "&nbsp;&nbsp;&nbsp;") (org-html--tags tags info))))
(defun org-s5-toc (depth info)
(let* ((headlines (org-export-collect-headlines info depth))
(toc-entries
(let* ((toc-entries
(mapcar (lambda (headline)
(cons (org-s5--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
@@ -275,18 +274,17 @@ INFO is a plist used as a communication channel."
(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)
(defun org-s5-plain-list (plain-list contents _)
"Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information.
CONTENTS is the contents of the list.
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"))))
(tag (cl-case type
(ordered "ol")
(unordered "ul")
(descriptive "dl"))))
(format "%s\n%s%s"
(format
"<%s class='org-%s%s'>" tag tag
@@ -295,10 +293,9 @@ which will make the list into a \"build\"."
contents
(format "</%s>" tag))))
(defun org-s5-inner-template (contents info)
(defun org-s5-inner-template (contents _)
"Return body of document string after HTML conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
CONTENTS is the transcoded contents string."
(concat contents "\n"))
(defun org-s5-template (contents info)

277
lisp/org-contrib/ox-taskjuggler.el
View File

@@ -1,4 +1,4 @@
;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine
;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
;;
@@ -8,6 +8,7 @@
;; Nicolas Goaziou <n dot goaziou at gmail dot com>
;; Maintainer: Christian Egli
;; Keywords: org, taskjuggler, project planning
;; Homepage: https://github.com/h-oll/ox-taskjuggler
;; Description: Converts an Org mode buffer into a TaskJuggler project plan
;; This file is not part of GNU Emacs.
@@ -145,7 +146,7 @@
;;
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile (require 'cl-lib))
(require 'ox)
@@ -177,6 +178,13 @@ for the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-account-tag "taskjuggler_account"
"Tag marking project's accounts.
This tag is used to find the tree containing all the accounts
for the project."
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-report-tag "taskjuggler_report"
"Tag marking project's reports.
This tag is used to find the tree containing all the reports for
@@ -311,36 +319,47 @@ exported with the corresponding task.
Note that multiline properties are not supported, so attributes
like note or journalentry have to be on a single line."
:group 'org-export-taskjuggler)
:group 'org-export-taskjuggler
:type '(repeat symbol))
(defcustom org-taskjuggler-valid-project-attributes
'(timingresolution timezone alertlevels currency currencyformat
dailyworkinghours extend includejournalentry now numberformat
outputdir scenario shorttimeformat timeformat trackingscenario
weekstartsmonday weekstartssunday workinghours
yearlyworkingdays)
'( timingresolution timezone alertlevels currency currencyformat
dailyworkinghours extend includejournalentry now numberformat
outputdir scenario shorttimeformat timeformat trackingscenario
weekstartsmonday weekstartssunday workinghours
yearlyworkingdays)
"Valid attributes for Taskjuggler project.
If one of these appears as a property for a headline that is a
project definition, it will be exported with the corresponding
task. Attribute 'timingresolution' should be the first in the
task. Attribute `timingresolution' should be the first in the
list."
:group 'org-export-taskjuggler)
:group 'org-export-taskjuggler
:type '(repeat symbol))
(defcustom org-taskjuggler-valid-resource-attributes
'(limits vacation shift booking efficiency journalentry rate
workinghours flags)
workinghours flags chargeset)
"Valid attributes for Taskjuggler resources.
If one of these appears as a property for a headline, it will be
exported with the corresponding resource."
:group 'org-export-taskjuggler
:type '(repeat symbol))
(defcustom org-taskjuggler-valid-account-attributes
'(aggregate credits flags)
"Valid attributes for Taskjuggler accounts.
If one of these appears as a property for a headline, it will be
exported with the corresponding account."
:group 'org-export-taskjuggler)
(defcustom org-taskjuggler-valid-report-attributes
'(headline columns definitions timeformat hideresource hidetask
loadunit sorttasks formats period)
'(headline columns definitions timeformat hideaccount hideresource hidetask
loadunit sorttasks formats period start end)
"Valid attributes for Taskjuggler reports.
If one of these appears as a property for a headline, it will be
exported with the corresponding report."
:group 'org-export-taskjuggler)
:group 'org-export-taskjuggler
:type '(repeat symbol))
(defcustom org-taskjuggler-process-command
"tj3 --silent --no-color --output-dir %o %f"
@@ -352,7 +371,8 @@ full file name, \"%o\" by the reports directory (see
If you are targeting Taskjuggler 2.4 (see
`org-taskjuggler-target-version') this setting is ignored."
:group 'org-export-taskjuggler)
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-reports-directory "reports"
"Default directory to generate the Taskjuggler reports in.
@@ -365,7 +385,8 @@ doesn't exist.
If you are targeting Taskjuggler 2.4 (see
`org-taskjuggler-target-version') this setting is ignored."
:group 'org-export-taskjuggler)
:group 'org-export-taskjuggler
:type 'string)
(defcustom org-taskjuggler-keep-project-as-task t
"Non-nil keeps the project headline as an umbrella task for all tasks.
@@ -440,6 +461,19 @@ headlines and their associated ID."
(cons resource id)))
info)))
(defun org-taskjuggler-assign-account-ids (accounts info)
"Assign a unique ID to each account within ACCOUNTS.
ACCOUNTS is a list of headlines. INFO is a plist used as a
communication channel. Return value is an alist between
headlines and their associated ID."
(let (ids)
(org-element-map accounts 'headline
(lambda (account)
(let ((id (org-taskjuggler--build-unique-id account ids)))
(push id ids)
(cons account id)))
info)))
;;; Accessors
@@ -478,7 +512,11 @@ ITEM is a headline. Return value is a string or nil if ITEM
doesn't have any start date defined."
(let ((scheduled (org-element-property :scheduled item)))
(or
(and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))
(and scheduled (funcall (eval-and-compile
(if (fboundp 'org-format-timestamp)
#'org-format-timestamp
(with-no-warnings #'org-timestamp-format)))
scheduled "%Y-%02m-%02d"))
(and (memq 'start org-taskjuggler-valid-task-attributes)
(org-element-property :START item)))))
@@ -487,7 +525,10 @@ doesn't have any start date defined."
ITEM is a headline. Return value is a string or nil if ITEM
doesn't have any end date defined."
(let ((deadline (org-element-property :deadline item)))
(and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))))
(or
(and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))
(and (memq 'end org-taskjuggler-valid-task-attributes)
(org-element-property :END item)))))
@@ -626,9 +667,9 @@ doesn't include leading \"depends\"."
;;; Translator Functions
(defun org-taskjuggler-project-plan (contents info)
(defun org-taskjuggler-project-plan (_ info)
"Build TaskJuggler project plan.
CONTENTS is ignored. INFO is a plist holding export options.
INFO is a plist holding export options.
Return complete project plan as a string in TaskJuggler syntax."
(let* ((tree (plist-get info :parse-tree))
(project (or (org-taskjuggler-get-project info)
@@ -640,89 +681,115 @@ Return complete project plan as a string in TaskJuggler syntax."
(org-taskjuggler--build-project project info)
;; 3. Insert global properties.
(org-element-normalize-string org-taskjuggler-default-global-properties)
;; 4. Insert resources. Provide a default one if none is
;; 3.5. Insert accounts. Provide a default one if none is
;; specified.
(let ((main-resources
(let ((main-accounts
;; Collect contents from various trees marked with
;; `org-taskjuggler-resource-tag'. Only gather top level
;; resources.
;; `org-taskjuggler-account-tag'. Only gather top level
;; accounts.
(apply 'append
(org-element-map tree 'headline
(lambda (hl)
(and (member org-taskjuggler-resource-tag
(and (member org-taskjuggler-account-tag
(org-export-get-tags hl info))
(org-element-map (org-element-contents hl) 'headline
'identity info nil 'headline)))
info nil 'headline))))
;; Assign a unique ID to each resource. Store it under
;; Assign a unique ID to each account. Store it under
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(org-taskjuggler-assign-resource-ids
main-resources info)))
(org-taskjuggler-assign-account-ids
main-accounts info)))
(concat
(if main-resources
(if main-accounts
(mapconcat
(lambda (resource) (org-taskjuggler--build-resource resource info))
main-resources "")
(format "resource %s \"%s\" {\n}\n" (user-login-name) user-full-name))
;; 5. Insert tasks.
(let ((main-tasks
;; If `org-taskjuggler-keep-project-as-task' is
;; non-nil, there is only one task. Otherwise, every
;; direct children of PROJECT is a top level task.
(if org-taskjuggler-keep-project-as-task (list project)
(or (org-element-map (org-element-contents project) 'headline
'identity info nil 'headline)
(error "No task specified")))))
;; Assign a unique ID to each task. Add it to
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(append
(org-taskjuggler-assign-task-ids main-tasks info)
(plist-get info :taskjuggler-unique-ids))))
;; If no resource is allocated among tasks, allocate one to
;; the first task.
(unless (org-element-map main-tasks 'headline
(lambda (task) (org-element-property :ALLOCATE task))
info t)
(org-element-put-property
(car main-tasks) :ALLOCATE
(or (org-taskjuggler-get-id (car main-resources) info)
(user-login-name))))
(mapconcat
(lambda (task) (org-taskjuggler--build-task task info))
main-tasks ""))
;; 6. Insert reports. If no report is defined, insert default
;; reports.
(let ((main-reports
(lambda (account) (org-taskjuggler--build-account account info))
main-accounts "")
(format "account %s \"%s\" {\n}\n" (user-login-name) user-full-name))
;; 4. Insert resources. Provide a default one if none is
;; specified.
(let ((main-resources
;; Collect contents from various trees marked with
;; `org-taskjuggler-report-tag'. Only gather top level
;; reports.
;; `org-taskjuggler-resource-tag'. Only gather top level
;; resources.
(apply 'append
(org-element-map tree 'headline
(lambda (hl)
(and (member org-taskjuggler-report-tag
(and (member org-taskjuggler-resource-tag
(org-export-get-tags hl info))
(org-element-map (org-element-contents hl)
'headline 'identity info nil 'headline)))
(org-element-map (org-element-contents hl) 'headline
'identity info nil 'headline)))
info nil 'headline))))
(if main-reports
(mapconcat
(lambda (report) (org-taskjuggler--build-report report info))
main-reports "")
;; insert title in default reports
(let* ((title (org-export-data (plist-get info :title) info))
(report-title (if (string= title "")
(org-taskjuggler-get-name project)
title)))
(mapconcat
'org-element-normalize-string
(mapcar
(lambda (report)
(replace-regexp-in-string "%title" report-title report t t))
org-taskjuggler-default-reports) "")))))))))
;; Assign a unique ID to each resource. Store it under
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(org-taskjuggler-assign-resource-ids
main-resources info)))
(concat
(if main-resources
(mapconcat
(lambda (resource) (org-taskjuggler--build-resource resource info))
main-resources "")
(format "resource %s \"%s\" {\n}\n" (user-login-name) user-full-name))
;; 5. Insert tasks.
(let ((main-tasks
;; If `org-taskjuggler-keep-project-as-task' is
;; non-nil, there is only one task. Otherwise, every
;; direct children of PROJECT is a top level task.
(if org-taskjuggler-keep-project-as-task (list project)
(or (org-element-map (org-element-contents project) 'headline
'identity info nil 'headline)
(error "No task specified")))))
;; Assign a unique ID to each task. Add it to
;; `:taskjuggler-unique-ids' property in INFO.
(setq info
(plist-put info :taskjuggler-unique-ids
(append
(org-taskjuggler-assign-task-ids main-tasks info)
(plist-get info :taskjuggler-unique-ids))))
;; If no resource is allocated among tasks, allocate one to
;; the first task.
(unless (org-element-map main-tasks 'headline
(lambda (task) (org-element-property :ALLOCATE task))
info t)
(org-element-put-property
(car main-tasks) :ALLOCATE
(or (org-taskjuggler-get-id (car main-resources) info)
(user-login-name))))
(mapconcat
(lambda (task) (org-taskjuggler--build-task task info))
main-tasks ""))
;; 6. Insert reports. If no report is defined, insert default
;; reports.
(let ((main-reports
;; Collect contents from various trees marked with
;; `org-taskjuggler-report-tag'. Only gather top level
;; reports.
(apply 'append
(org-element-map tree 'headline
(lambda (hl)
(and (member org-taskjuggler-report-tag
(org-export-get-tags hl info))
(org-element-map (org-element-contents hl)
'headline 'identity info nil 'headline)))
info nil 'headline))))
(if main-reports
(mapconcat
(lambda (report) (org-taskjuggler--build-report report info))
main-reports "")
;; insert title in default reports
(let* ((title (org-export-data (plist-get info :title) info))
(report-title (if (string= title "")
(org-taskjuggler-get-name project)
title)))
(mapconcat
'org-element-normalize-string
(mapcar
(lambda (report)
(replace-regexp-in-string "%title" report-title report t t))
org-taskjuggler-default-reports) "")))))))))))
(defun org-taskjuggler--build-project (project info)
"Return a project declaration.
@@ -785,20 +852,60 @@ neither is defined a unique id will be associated to it."
;; Closing resource.
"}\n"))
(defun org-taskjuggler--build-account (account info)
"Return a account declaration.
ACCOUNT is a headline. INFO is a plist used as a communication
channel.
All valid attributes from ACCOUNT are inserted. If ACCOUNT
defines a property \"account_id\" it will be used as the id for
this account. Otherwise it will use the ID property. If
neither is defined a unique id will be associated to it."
(concat
;; Opening account.
(format "account %s \"%s\" {\n"
(org-taskjuggler--clean-id
(or (org-element-property :ACCOUNT_ID account)
(org-element-property :ID account)
(org-taskjuggler-get-id account info)))
(org-taskjuggler-get-name account))
;; Add attributes.
(org-taskjuggler--indent-string
(org-taskjuggler--build-attributes
account org-taskjuggler-valid-account-attributes))
;; Add inner accounts.
(org-taskjuggler--indent-string
(mapconcat
'identity
(org-element-map (org-element-contents account) 'headline
(lambda (hl) (org-taskjuggler--build-account hl info))
info nil 'headline)
""))
;; Closing account.
"}\n"))
(defun org-taskjuggler--build-report (report info)
"Return a report declaration.
REPORT is a headline. INFO is a plist used as a communication
channel."
(concat
;; Opening report.
(format "%s \"%s\" {\n"
(format "%s %s \"%s\" {\n"
(or (org-element-property :REPORT_KIND report) "taskreport")
(or (org-element-property :REPORT_ID report)
(org-element-property :ID report)
(org-taskjuggler-get-id report info))
(org-taskjuggler-get-name report))
;; Add attributes.
(org-taskjuggler--indent-string
(org-taskjuggler--build-attributes
report org-taskjuggler-valid-report-attributes))
;; Add inner reports.
;; Add core of report, ie the first paragraph after the headline
;; and before the next sub-headline
(format "%s" (if (eq (org-element-type (car (org-element-contents report))) 'section)
(org-element-interpret-data (car (org-element-contents report)))
""))
(org-taskjuggler--indent-string
(mapconcat
'identity