diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-10-17 09:10:12 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-10-17 09:10:12 -0700 |
| commit | 39e10e4fb302303e8017d3fb7b645ad787460530 (patch) | |
| tree | d7d4f249319be747acb7d1b8d5f8daab6e51ff65 | |
| parent | c09a96329d2846dd35a7cb61b6e5e1fb46259546 (diff) | |
| parent | 6422b265f1150204f024e33d54f2dcfd8323005c (diff) | |
Merge remote-tracking branch 'upstream/master'
59 files changed, 123 insertions, 6108 deletions
@@ -15,8 +15,8 @@ is no guaranty that they are compatible with the Org stable version.** For files a `Maintainer` header and a `Homepage` pointing outside of this repository are in transition: they are maintained and will be removed -from the next release of this repository. As a user, please carefully -track the new URL where the add-on is now maintained. +from the next minor or major release of this repository. As a user, +please carefully track the new URL where the add-on is now maintained. If you want to maintain some of these add-ons, please send me an email at `bzg@gnu.org` once you set up a separate repository for them. @@ -31,25 +31,8 @@ later version. See [COPYING](COPYING). # Files to remove from the next release -These files are maintained in a separate repository, which you can -find after the "Homepage:" keyword in the files themselves: - -- **ob-arduino.el:** Org-mode Babel support for Arduino -- **ob-clojure-literate.el:** Clojure's Org-mode Literate Programming -- **ob-mathematica.el:** org-babel functions for Mathematica evaluation -- **ob-php.el:** Execute PHP within org-mode blocks -- **ob-redis.el:** Execute Redis queries within org-mode blocks -- **ob-sclang.el:** SCLang support for Org-mode Babel -- **ob-smiles.el:** Org-mode Babel support for SMILES -- **ob-spice.el:** org-babel functions for spice evaluation -- **ol-notmuch.el:** Links to notmuch messages -- **org-attach-embedded-images.el:** Transmute images to attachments -- **org-link-edit.el:** Slurp and barf with Org links -- **org-mac-link.el:** Insert org-mode links to items selected in various Mac apps -- **org-notify.el:** Notifications for Org-mode -- **org-passwords.el:** org derived mode for managing passwords -- **org-velocity.el:** something like Notational Velocity for Org -- **ox-rss.el:** RSS 2.0 Back-End for Org Export Engine +If a file has a "Homepage:" keyword, it will be removed from the next +minor or major release. # Other files @@ -58,12 +41,10 @@ find after the "Homepage:" keyword in the files themselves: ## Org utils - **org-annotate-file.el:** Annotate a file with org syntax -- **org-attach-embedded-images.el:** Transmute images to attachments - **org-bibtex-extras.el:** Extras for working with org-bibtex entries - **org-checklist.el:** org functions for checklist handling - **org-choose.el:** Use TODO keywords to mark decision states - **org-collector.el:** Collect properties into tables -- **org-contacts.el:** Contacts management - **org-contribdir.el:** Dummy file to mark the org contrib Lisp directory - **org-depend.el:** TODO dependencies for Org-mode - **org-effectiveness.el:** Measuring your personal effectiveness @@ -76,13 +57,9 @@ find after the "Homepage:" keyword in the files themselves: - **org-invoice.el:** Help manage client invoices in OrgMode - **org-learn.el:** SuperMemo's incremental learning algorithm - **org-license.el:** Insert free licenses to your org documents -- **org-link-edit.el:** Slurp and barf with Org links - **org-mac-iCal.el:** Imports events from iCal.app to the Emacs diary -- **org-mac-link.el:** Grab links and URLs from various Mac applications - **org-mairix.el:** Hook mairix search into Org for different MUAs -- **org-notify.el:** Notifications for Org-mode - **org-panel.el:** Simple routines for us with bad memory -- **org-passwords.el:** Org derived mode for managing passwords - **org-registry.el:** A registry for Org links - **org-screen.el:** Visit screen sessions through Org-mode links - **org-screenshot.el:** Take and manage screenshots in Org-mode files @@ -91,7 +68,6 @@ find after the "Homepage:" keyword in the files themselves: - **org-sudoku.el:** Create and solve SUDOKU puzzles in Org tables - **org-toc.el:** Table of contents for Org-mode buffer - **org-track.el:** Keep up with Org development -- **org-velocity.el:** something like Notational Velocity for Org - **org-wikinodes.el:** CamelCase wiki-like links for Org @@ -103,7 +79,6 @@ find after the "Homepage:" keyword in the files themselves: - **ox-extra.el:** Convenience functions for org export - **ox-freemind.el:** Freemind exporter - **ox-groff.el:** Groff exporter -- **ox-rss.el:** RSS 2.0 exporter - **ox-s5.el:** S5 presentations exporter - **ox-taskjuggler.el:** TaskJuggler exporter @@ -114,7 +89,6 @@ find after the "Homepage:" keyword in the files themselves: - **ol-elisp-symbol.el:** Links to Emacs-lisp symbols - **ol-git-link.el:** Links to specific file version - **ol-mew.el:** Links to Mew messages -- **ol-notmuch.el:** Links to notmuch messages - **ol-vm.el:** Support for links to VM messages - **ol-wl.el:** Support for links to Wanderlust messages @@ -122,9 +96,7 @@ find after the "Homepage:" keyword in the files themselves: ## Org Babel languages - **ob-abc.el:** Org-mode Babel Functions for ABC -- **ob-arduino.el:** Org-mode Babel Functions for Arduino - **ob-asymptote.el:** Org-mode Babel Functions for Asymptote -- **ob-clojure-literate.el:** Clojure's Org-mode Literate Programming - **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 @@ -134,17 +106,11 @@ find after the "Homepage:" keyword in the files themselves: - **ob-io.el:** Org-mode Babel Functions for Io - **ob-J.el:** Org-mode Babel Functions for J - **ob-ledger.el:** Org-mode Babel Functions for Ledger -- **ob-mathematica.el:** Org-mode Babel Functions for Mathematica evaluation - **ob-mathomatic.el:** Org-mode Babel Functions for mathomatic evaluation - **ob-mscgen.el:** Org-mode Babel Functions for Mscgen - **ob-oz.el:** Org-mode Babel Functions for Oz evaluation -- **ob-php.el:** Execute PHP within org-mode blocks - **ob-picolisp.el:** Org-mode Babel Functions for Picolisp -- **ob-redis.el:** Execute Redis queries within org-mode blocks -- **ob-sclang.el:** SCLang support for Org-mode Babel - **ob-shen.el:** Org-mode Babel Functions for Shen -- **ob-smiles.el:** Org-mode Babel support for SMILES -- **ob-spice.el:** Org-mode Babel Functions for spice evaluation - **ob-stan.el:** Babel Functions for Stan - **ob-stata.el:** Org-mode Babel Functions for Stata evaluation - **ob-tcl.el:** Org-mode Babel Functions for tcl evaluation @@ -14,8 +14,8 @@ is no guaranty that they are compatible with the Org stable version.* For files a =Maintainer= header and a =Homepage= pointing outside of this repository are in transition: they are maintained and will be removed -from the next release of this repository. As a user, please carefully -track the new URL where the add-on is now maintained. +from the next minor or major release of this repository. As a user, +please carefully track the new URL where the add-on is now maintained. If you want to maintain some of these add-ons, please send me an email at =bzg@gnu.org= once you set up a separate repository for them. @@ -28,36 +28,17 @@ later version. See [[file:COPYING][COPYING]]. ** Files to remove from the next release -These files are maintained in a separate repository, which you can -find after the "Homepage:" keyword in the files themselves: - -- ob-arduino.el :: Org-mode Babel support for Arduino -- ob-clojure-literate.el :: Clojure's Org-mode Literate Programming -- ob-mathematica.el :: org-babel functions for Mathematica evaluation -- ob-php.el :: Execute PHP within org-mode blocks -- ob-redis.el :: Execute Redis queries within org-mode blocks -- ob-sclang.el :: SCLang support for Org-mode Babel -- ob-smiles.el :: Org-mode Babel support for SMILES -- ob-spice.el :: org-babel functions for spice evaluation -- ol-notmuch.el :: Links to notmuch messages -- org-attach-embedded-images.el :: Transmute images to attachments -- org-link-edit.el :: Slurp and barf with Org links -- org-mac-link.el :: Insert org-mode links to items selected in various Mac apps -- org-notify.el :: Notifications for Org-mode -- org-passwords.el :: org derived mode for managing passwords -- org-velocity.el :: something like Notational Velocity for Org -- ox-rss.el :: RSS 2.0 Back-End for Org Export Engine +If a file has a "Homepage:" keyword, it will be removed from the next +minor or major release. ** Other files *** Org utils - org-annotate-file.el :: Annotate a file with org syntax -- org-attach-embedded-images.el :: Transmute images to attachments - org-bibtex-extras.el :: Extras for working with org-bibtex entries - org-checklist.el :: org functions for checklist handling - org-choose.el :: Use TODO keywords to mark decision states - org-collector.el :: Collect properties into tables -- org-contacts.el :: Contacts management - org-contribdir.el :: Dummy file to mark the org contrib Lisp directory - org-depend.el :: TODO dependencies for Org-mode - org-effectiveness.el :: Measuring your personal effectiveness @@ -70,13 +51,9 @@ find after the "Homepage:" keyword in the files themselves: - org-invoice.el :: Help manage client invoices in OrgMode - org-learn.el :: SuperMemo's incremental learning algorithm - org-license.el :: Insert free licenses to your org documents -- org-link-edit.el :: Slurp and barf with Org links - org-mac-iCal.el :: Imports events from iCal.app to the Emacs diary -- org-mac-link.el :: Grab links and URLs from various Mac applications - org-mairix.el :: Hook mairix search into Org for different MUAs -- org-notify.el :: Notifications for Org-mode - org-panel.el :: Simple routines for us with bad memory -- org-passwords.el :: Org derived mode for managing passwords - org-registry.el :: A registry for Org links - org-screen.el :: Visit screen sessions through Org-mode links - org-screenshot.el :: Take and manage screenshots in Org-mode files @@ -85,7 +62,6 @@ find after the "Homepage:" keyword in the files themselves: - org-sudoku.el :: Create and solve SUDOKU puzzles in Org tables - org-toc.el :: Table of contents for Org-mode buffer - org-track.el :: Keep up with Org development -- org-velocity.el :: something like Notational Velocity for Org - org-wikinodes.el :: CamelCase wiki-like links for Org *** Org exporters @@ -96,7 +72,6 @@ find after the "Homepage:" keyword in the files themselves: - ox-extra.el :: Convenience functions for org export - ox-freemind.el :: Freemind exporter - ox-groff.el :: Groff exporter -- ox-rss.el :: RSS 2.0 exporter - ox-s5.el :: S5 presentations exporter - ox-taskjuggler.el :: TaskJuggler exporter @@ -106,16 +81,13 @@ find after the "Homepage:" keyword in the files themselves: - ol-elisp-symbol.el :: Links to Emacs-lisp symbols - ol-git-link.el :: Links to specific file version - ol-mew.el :: Links to Mew messages -- ol-notmuch.el :: Links to notmuch messages - ol-vm.el :: Support for links to VM messages - ol-wl.el :: Support for links to Wanderlust messages *** Org Babel languages - ob-abc.el :: Org-mode Babel Functions for ABC -- ob-arduino.el :: Org-mode Babel Functions for Arduino - ob-asymptote.el :: Org-mode Babel Functions for Asymptote -- ob-clojure-literate.el :: Clojure's Org-mode Literate Programming - 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 @@ -125,17 +97,11 @@ find after the "Homepage:" keyword in the files themselves: - ob-io.el :: Org-mode Babel Functions for Io - ob-J.el :: Org-mode Babel Functions for J - ob-ledger.el :: Org-mode Babel Functions for Ledger -- ob-mathematica.el :: Org-mode Babel Functions for Mathematica evaluation - ob-mathomatic.el :: Org-mode Babel Functions for mathomatic evaluation - ob-mscgen.el :: Org-mode Babel Functions for Mscgen - ob-oz.el :: Org-mode Babel Functions for Oz evaluation -- ob-php.el :: Execute PHP within org-mode blocks - ob-picolisp.el :: Org-mode Babel Functions for Picolisp -- ob-redis.el :: Execute Redis queries within org-mode blocks -- ob-sclang.el :: SCLang support for Org-mode Babel - ob-shen.el :: Org-mode Babel Functions for Shen -- ob-smiles.el :: Org-mode Babel support for SMILES -- ob-spice.el :: Org-mode Babel Functions for spice evaluation - ob-stan.el :: Babel Functions for Stan - ob-stata.el :: Org-mode Babel Functions for Stata evaluation - ob-tcl.el :: Org-mode Babel Functions for tcl evaluation diff --git a/lisp/ob-J.el b/lisp/ob-J.el index 8dc6ba7..89f76e0 100644 --- a/lisp/ob-J.el +++ b/lisp/ob-J.el @@ -5,7 +5,7 @@ ;; Author: Oleh Krehel ;; Maintainer: Joseph Novakovich <josephnovakovich@gmail.com> ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-arduino.el b/lisp/ob-arduino.el deleted file mode 100644 index 76054e8..0000000 --- a/lisp/ob-arduino.el +++ /dev/null @@ -1,117 +0,0 @@ -;;; ob-arduino.el --- Org-mode Babel support for Arduino -;; -;; Authors: stardiviner <numbchild@gmail.com> -;; Package-Requires: ((emacs "24.4") (org "24.1")) -;; Package-Version: 1.0 -;; Keywords: arduino org babel -;; homepage: https://github.com/stardiviner/arduino-mode/blob/master/ob-arduino.el -;; -;; 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: -;; -;; Like the following src block, press =[C-c C-c]= to upload to Arduino board. -;; -;; #+begin_src arduino -;; // the setup function runs once when you press reset or power the board -;; void setup() { -;; // initialize digital pin LED_BUILTIN as an output. -;; pinMode(LED_BUILTIN, OUTPUT); -;; } -;; -;; // the loop function runs over and over again forever -;; void loop() { -;; digitalWrite(LED_BUILTIN, HIGH); // turn the LED on (HIGH is the voltage level) -;; delay(100); // wait for 0.1 second -;; digitalWrite(LED_BUILTIN, LOW); // turn the LED off by making the voltage LOW -;; delay(100); // wait for 0.1 second -;; } -;; #+end_src -;; -;;; Code: - -(require 'org) -(require 'ob) -(require 'arduino-mode nil t) - -(defgroup ob-arduino nil - "org-mode blocks for Arduino." - :group 'org) - -(defcustom ob-arduino:program "arduino" - "Default Arduino program name." - :group 'ob-arduino - :type 'string) - -(defcustom ob-arduino:port "/dev/ttyACM0" - "Default Arduino port." - :group 'ob-arduino - :type 'string) - -(defcustom ob-arduino:board "arduino:avr:uno" - "Default Arduino board." - :group 'ob-arduino - :type 'string) - - -(defvar org-babel-default-header-args:sclang nil) - -;;;###autoload -(defun org-babel-execute:arduino (body params) - "org-babel arduino hook." - (let* ((port (cdr (assoc :port params))) - (board (cdr (assoc :board params))) - (cmd (mapconcat 'identity (list - ob-arduino:program "--upload" - (if port (concat "--port " port)) - (if board (concat "--board " board)) - ) " ")) - (code (org-babel-expand-body:generic body params)) - (src-file (org-babel-temp-file "ob-arduino-" ".ino"))) - ;; delete all `ob-arduino' temp files, otherwise arduino will compile all - ;; ob-arduino temp files, and report error. - (mapc - (lambda (f) - (unless (file-directory-p f) - (delete-file (expand-file-name f org-babel-temporary-directory)))) - (directory-files - (file-name-directory (org-babel-temp-file "ob-arduino-" ".ino")) - nil ".ino")) - ;; specify file for arduino command. - (with-temp-file src-file - (insert code)) - (org-babel-eval - (concat ob-arduino:program - " " "--upload" - " " (if port (concat "--port " port)) - " " (if board (concat "--board " board)) - " " src-file) - "" ; pass empty string "" as `BODY' to `org-babel--shell-command-on-region' - ;; to fix command `arduino' don't accept string issue. - ) - )) - - -;;;###autoload -(eval-after-load 'org - '(add-to-list 'org-src-lang-modes '("arduino" . arduino))) - - - - -(provide 'ob-arduino) - -;;; ob-arduino.el ends here diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el index 86f7773..6df51d0 100644 --- a/lisp/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Maintainer: Luc Pellissier <luc.pellissier@crans.org> ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-clojure-literate.el b/lisp/ob-clojure-literate.el deleted file mode 100644 index 39e4f39..0000000 --- a/lisp/ob-clojure-literate.el +++ /dev/null @@ -1,306 +0,0 @@ -;;; ob-clojure-literate.el --- Clojure's Org-mode Literate Programming - -;; Authors: stardiviner <numbchild@gmail.com> -;; Package-Requires: ((emacs "24.4") (org "9") (cider "0.16.0") (dash "2.12.0")) -;; Package-Version: 1.1 -;; Keywords: tools -;; homepage: https://github.com/stardiviner/ob-clojure-literate - -;; 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: -;; -;; Auto setup ob-clojure-literate scaffold and jack-in Clojure project. -;; -;; Usage: -;; -;; [M-x ob-clojure-literate-mode] to toggle this minor mode. - -;;; Code: - -(require 'ob-clojure) -(require 'cider nil t) - -(defgroup ob-clojure-literate nil - "Clojure's Org-mode Literate Programming." - :prefix "ob-clojure-literate-" - :group 'ob-babel) - -;;;###autoload -(defcustom ob-clojure-literate-auto-jackin-p nil - "Auto jack in ob-clojure project. -Don't auto jack in by default for not rude." - :type 'boolean - :group 'ob-clojure-literate) - -(defcustom ob-clojure-literate-project-location nil - "The location for `ob-clojure-literate' scaffold project. -If it is nil, then `cider-jack-in' will jack-in outside of Clojure project. -If it is a directory, `ob-clojure-literate' will try to create Clojure project automatically." - :type 'string - :group 'ob-clojure-literate) - -(defvar ob-clojure-literate-session nil) -(defvar ob-clojure-literate-original-ns nil) -(defvar ob-clojure-literate-session-ns nil) -(defvar ob-clojure-literate-cider-connections nil) - -(defcustom ob-clojure-literate-default-session "*cider-repl localhost*" - "The default session name for `ob-clojure-literate'." - :type 'string - :group 'ob-clojure-literate) - -(defun ob-clojure-literate-any-connection-p () - "Return t if have any CIDER connection." - (and - ;; handle the case `cider-jack-in' is not finished creating connection, but `ob-clojure-literate-mode' is enabled. - (not (null (cider-connections))) - (not (null ob-clojure-literate-session)) ; before mode enabled, it is nil. - (not (string-empty-p ob-clojure-literate-session)) ; after disable, it is "". - )) - -(defun ob-clojure-literate-get-session-list () - "Return a list of available started CIDER REPL sessions list." - (mapcar #'buffer-name - ;; for multiple connections case. - ;; get global value instead of buffer local. - (default-value 'cider-connections))) - -;;; Do not allow "ob-clojure" project session name. -(defun ob-clojure-literate-set-session () - "Set session name for buffer local." - ;; if default session is the only one in connections list. - (if (and (= (length (ob-clojure-literate-get-session-list)) 1) - (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list))) - (setq-local ob-clojure-literate-session ob-clojure-literate-default-session) - ;; if have any connections, choose one from them. - (if (ob-clojure-literate-any-connection-p) - (setq-local ob-clojure-literate-session - (completing-read "Choose ob-clojure-literate :session : " - (ob-clojure-literate-get-session-list))) - ;; if none, set to default session name to fix `ob-clojure-literate-mode' - ;; is enabled before `cider-jack-in' generated connections. - (setq-local ob-clojure-literate-session - ob-clojure-literate-default-session)))) - -;;;###autoload -(defun ob-clojure-literate-specify-session () - "Specify ob-clojure header argument :session with value selected from a list of available sessions." - (interactive) - (let ((lang (nth 0 (org-babel-get-src-block-info)))) - (if (and (string= lang "clojure") ; only in clojure src block. - (car (seq-filter ; only when :session is not specified yet. - (lambda (header-argument) - (if (eq (car header-argument) :session) - (not (null (cdr header-argument))))) - (nth 2 (org-babel-get-src-block-info))))) - (org-babel-insert-header-arg - "session" - (format "\"%s\"" - (completing-read - "Choose :session for ob-clojure-literate: " - (ob-clojure-literate-get-session-list)))) - (message "This function only used in `clojure' src block."))) - ) - -;;; Auto start CIDER REPL session in a complete Leiningen project environment for Org-mode Babel to jack-in. -;;;###autoload -(defun ob-clojure-literate-auto-jackin () - "Auto setup ob-clojure-literate scaffold and jack-in Clojure project." - (interactive) - (cond - ;; jack-in outside of Clojure project. - ((null ob-clojure-literate-project-location) - (if (member (get-buffer "*cider-repl localhost*") cider-connections) - (message "CIDER default session already launched.") - (cider-jack-in nil))) - ((not (null ob-clojure-literate-project-location)) - (unless (file-directory-p (expand-file-name ob-clojure-literate-project-location)) - (make-directory ob-clojure-literate-project-location t) - (let ((default-directory ob-clojure-literate-project-location)) - (shell-command "lein new ob-clojure"))) - (unless (or - (and (cider-connected-p) - (if (not (null ob-clojure-literate-session)) - (seq-contains cider-connections (get-buffer ob-clojure-literate-session)))) - cider-connections - (ob-clojure-literate-any-connection-p)) - ;; return back to original file. - (if (not (and (= (length (ob-clojure-literate-get-session-list)) 1) - (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list)))) - (save-window-excursion - (find-file (expand-file-name (concat ob-clojure-literate-project-location "ob-clojure/src/ob_clojure/core.clj"))) - (with-current-buffer "core.clj" - (cider-jack-in)))))))) - -(defun ob-clojure-literate-set-local-cider-connections (toggle?) - "Set buffer local `cider-connections' for `ob-clojure-literate-mode' `TOGGLE?'." - (if toggle? - (progn - (setq ob-clojure-literate-cider-connections cider-connections) - (unless (local-variable-if-set-p 'cider-connections) - (make-local-variable 'cider-connections)) - (setq-local cider-connections ob-clojure-literate-cider-connections)) - ;; store/restore emptied CIDER connections by `ob-clojure-literate-enable'. - (kill-local-variable 'cider-connections) ; kill local variable so that I can get the original global variable value. - ;; Empty all CIDER connections to avoid `cider-current-connection' return any connection. - ;; FIXME: when try to enable, `cider-connections' is local and nil. - ;; (if (and (= (length (ob-clojure-literate-get-session-list)) 1) - ;; (member ob-clojure-literate-default-session (ob-clojure-literate-get-session-list)))) - ;; (unless (local-variable-if-set-p 'cider-connections) - ;; (make-local-variable 'cider-connections)) - ;; (setq-local cider-connections '()) - )) - -(defun ob-clojure-literate-set-ns (body params) - "Fix the issue that `cider-current-ns' try to invoke `clojure-find-ns' to extract ns from buffer." - ;; TODO: Is it possible to find ns in `body'? - (when (ob-clojure-literate-any-connection-p) - (setq ob-clojure-literate-original-ns (cider-current-ns)) - (with-current-buffer ob-clojure-literate-session - (setq ob-clojure-literate-session-ns cider-buffer-ns)) - (setq-local cider-buffer-ns (or (cdr (assq :ns params)) - ob-clojure-literate-session-ns))) - (message (format "ob-clojure-literate: current CIDER ns is [%s]." cider-buffer-ns))) - -(defun ob-clojure-literate-set-local-session (toggle?) - "Set buffer local `org-babel-default-header-args:clojure' for `ob-clojure-literate-mode' `TOGGLE?'." - (if toggle? - (progn - ;; set local default session for ob-clojure. - (setq ob-clojure-literate-session (ob-clojure-literate-set-session)) - (unless (local-variable-if-set-p 'org-babel-default-header-args:clojure) - (make-local-variable 'org-babel-default-header-args:clojure)) - (add-to-list 'org-babel-default-header-args:clojure - `(:session . ,ob-clojure-literate-session)) - ) - ;; remove :session from buffer local default header arguments list. - (unless (local-variable-if-set-p 'org-babel-default-header-args:clojure) - (make-local-variable 'org-babel-default-header-args:clojure)) - (setq org-babel-default-header-args:clojure - (delq t - (mapcar - (lambda (cons) (if (eq (car cons) :session) t cons)) - org-babel-default-header-args:clojure))))) - - -;;; Support header arguments :results graphics :file "image.png" by inject Clojure code. -(defun ob-clojure-literate-inject-code (args) - "Inject Clojure code into `BODY' in `ARGS'. -It is used to change Clojure currently working directory in a FAKE way. -And generate inline graphics image file link result. -Use header argument like this: - -:results graphics :file \"incanter-plot.png\" - -Then you need to assign image variable to this :file value like: -(def incanter-plot (histogram (sample-normal 1000))) - -*NOTE*: Currently only support Incanter's `save' function. -" - (let* ((body (nth 0 args)) - (params (nth 1 args)) - (dir (cdr (assq :dir params))) - (default-directory (and (buffer-file-name) (file-name-directory (buffer-file-name)))) - (directory (and dir (file-name-as-directory (expand-file-name dir)))) - (result-type (cdr (assq :results params))) - (file (cdr (assq :file params))) - (file-name (and file (file-name-base file))) - ;; TODO: future support `:graphics-file' to avoid collision. - (graphics-result (member "graphics" (cdr (assq :result-params params)))) - ;; (graphics-file (cdr (assq :graphics-file params))) - ;; (graphics-name (file-name-base graphics-file)) - (prepend-to-body (lambda (code) - (setq body (concat code "\n" body)))) - (append-to-body (lambda (code) - (setq body (concat body "\n" code "\n")))) - ) - (when directory - (unless (file-directory-p (expand-file-name directory)) - (warn (format "Target directory %s does not exist, please create it." dir)))) - (when file - (funcall append-to-body - (format "(save %s \"%s\")" file-name (concat directory file))) - ) - (list body params) ; return modified argument list - )) - -;;; support :results graphics :dir "data/image" :file "incanter-plot.png" -(defun ob-clojure-literate-support-graphics-result (result) - "Support :results graphics :dir \"data/images\" :file \"incanter-plot.png\" -reset `RESULT' to `nil'." - (let* ((params (nth 2 info)) - (graphics-result (member "graphics" (cdr (assq :result-params params))))) - (if graphics-result - (setq result nil)) - result)) - - -(defvar ob-clojure-literate-mode-map - (let ((map (make-sparse-keymap))) - map) - "Keymap for `ob-clojure-literate-mode'.") - -(define-key org-babel-map (kbd "M-s") 'ob-clojure-literate-specify-session) -(define-key org-babel-map (kbd "M-j") 'ob-clojure-literate-auto-jackin) -;; (define-key org-babel-map (kbd "M-e") 'cider-eval-last-sexp) -;; (define-key org-babel-map (kbd "M-d") 'cider-doc) - -;;;###autoload -(defun ob-clojure-literate-enable () - "Enable Org-mode buffer locally for `ob-clojure-literate'." - (when (and (not (null cider-connections)) ; only enable `ob-clojure-literate-mode' when has CIDER connections. - (equal major-mode 'org-mode)) ; `ob-clojure-literate-mode' only works in `org-mode'. - (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode) - (ob-clojure-literate-set-local-session ob-clojure-literate-mode) - (advice-add 'org-babel-execute:clojure :before #'ob-clojure-literate-set-ns) - (advice-add 'org-babel-expand-body:clojure :filter-args #'ob-clojure-literate-inject-code) - (advice-add 'org-babel-execute:clojure :filter-return #'ob-clojure-literate-support-graphics-result) - (message "ob-clojure-literate minor mode enabled."))) - -;;;###autoload -(defun ob-clojure-literate-disable () - "Disable Org-mode buffer locally for `ob-clojure-literate'." - (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-set-ns) - (advice-remove 'org-babel-expand-body:clojure #'ob-clojure-literate-inject-code) - (advice-remove 'org-babel-execute:clojure #'ob-clojure-literate-support-graphics-result) - (setq-local cider-buffer-ns ob-clojure-literate-original-ns) - (ob-clojure-literate-set-local-cider-connections ob-clojure-literate-mode) - (ob-clojure-literate-set-local-session ob-clojure-literate-mode) - (message "ob-clojure-literate minor mode disabled.")) - -;;;###autoload -(if ob-clojure-literate-auto-jackin-p (ob-clojure-literate-auto-jackin)) - -;;;###autoload -(define-minor-mode ob-clojure-literate-mode - "A minor mode to toggle `ob-clojure-literate'." - :require 'ob-clojure-literate - :init-value nil - :lighter " clj-lp" - :group 'ob-clojure-literate - :keymap ob-clojure-literate-mode-map - :global nil - (if ob-clojure-literate-mode - (ob-clojure-literate-enable) - (ob-clojure-literate-disable)) - ) - - - -(provide 'ob-clojure-literate) - -;;; ob-clojure-literate.el ends here diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el index 16143be..e052595 100644 --- a/lisp/ob-coq.el +++ b/lisp/ob-coq.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte ;; Maintainer: Luc Pellissier <luc.pellissier@crans.org> ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-csharp.el b/lisp/ob-csharp.el index 1a0be15..dc25f97 100644 --- a/lisp/ob-csharp.el +++ b/lisp/ob-csharp.el @@ -4,7 +4,7 @@ ;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el index 2f5f330..1b601ac 100644 --- a/lisp/ob-ebnf.el +++ b/lisp/ob-ebnf.el @@ -4,7 +4,7 @@ ;; Author: Michael Gauland ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-eukleides.el b/lisp/ob-eukleides.el index be3f1fd..eccd474 100644 --- a/lisp/ob-eukleides.el +++ b/lisp/ob-eukleides.el @@ -4,7 +4,7 @@ ;; Author: Luis Anaya ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-fomus.el b/lisp/ob-fomus.el index 5279714..8d834f8 100644 --- a/lisp/ob-fomus.el +++ b/lisp/ob-fomus.el @@ -4,7 +4,7 @@ ;; Author: Torsten Anders ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-hledger.el b/lisp/ob-hledger.el index 79afa62..9c5059f 100644 --- a/lisp/ob-hledger.el +++ b/lisp/ob-hledger.el @@ -4,7 +4,7 @@ ;; Author: Simon Michael ;; Keywords: literate programming, reproducible research, plain text accounting -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-io.el b/lisp/ob-io.el index 3a2fea2..e752003 100644 --- a/lisp/ob-io.el +++ b/lisp/ob-io.el @@ -4,7 +4,7 @@ ;; Author: Andrzej Lichnerowicz ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el index b1812ac..5e3b68b 100644 --- a/lisp/ob-ledger.el +++ b/lisp/ob-ledger.el @@ -5,7 +5,7 @@ ;; Author: Eric S Fraga ;; Maintainer: Eric S Fraga ;; Keywords: literate programming, reproducible research, accounting -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-mathematica.el b/lisp/ob-mathematica.el deleted file mode 100644 index 2b703da..0000000 --- a/lisp/ob-mathematica.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; ob-mathematica.el --- org-babel functions for Mathematica evaluation - -;; Copyright (C) 2014, 2021 Yi Wang - -;; Authors: Yi Wang -;; Keywords: literate programming, reproducible research -;; Homepage: https://github.com/tririver/ob-mathematica/ - -;; 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/>. - -;; Org-Babel support for evaluating Mathematica source code. - -;;; Code: -(require 'ob) -(require 'ob-ref) -(require 'ob-comint) -(require 'ob-eval) - -(declare-function org-trim "org" (s &optional keep-lead)) - -;; Optionally require mma.el for font lock, etc -(require 'mma nil 'noerror) -(add-to-list 'org-src-lang-modes '("mathematica" . "mma")) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("mathematica" . "m")) - -(defvar org-babel-default-header-args:mathematica '()) - -(defvar org-babel-mathematica-command "MathematicaScript -script" - "Name of the command for executing Mathematica code.") - -(defvar org-babel-mathematica-command-alt "math -noprompt" - "Name of the command for executing Mathematica code.") - -(defun org-babel-expand-body:mathematica (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (org-babel--get-vars params))) - (concat - (mapconcat ;; define any variables - (lambda (pair) - (format "%s=%s;" - (car pair) - (org-babel-mathematica-var-to-mathematica (cdr pair)))) - vars "\n") "\nPrint[\n" body "\n]\n"))) - -(defun org-babel-execute:mathematica (body params) - "Execute a block of Mathematica code with org-babel. This function is -called by `org-babel-execute-src-block'" - (let* ((result-params (cdr (assq :result-params params))) - (full-body (org-babel-expand-body:mathematica body params)) - (tmp-script-file (org-babel-temp-file "mathematica-")) - (cmd org-babel-mathematica-command)) - ;; actually execute the source-code block - (with-temp-file tmp-script-file (insert full-body)) - ;; (with-temp-file "/tmp/dbg" (insert full-body)) - ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params) - (and (member "output" result-params) - (not (member "table" result-params)))) - raw - (org-babel-script-escape (org-trim raw)))) - (org-babel-eval (concat cmd " " tmp-script-file) "")))) - -(defun org-babel-prep-session:mathematica (session params) - "This function does nothing so far" - (error "Currently no support for sessions")) - -(defun org-babel-prep-session:mathematica (session body params) - "This function does nothing so far" - (error "Currently no support for sessions")) - -(defun org-babel-mathematica-var-to-mathematica (var) - "Convert an elisp value to a Mathematica variable. -Convert an elisp value, VAR, into a string of Mathematica source code -specifying a variable of the same value." - (if (listp var) - (concat "{" (mapconcat #'org-babel-mathematica-var-to-mathematica var ", ") "}") - (format "%S" var))) - -(provide 'ob-mathematica) diff --git a/lisp/ob-mathomatic.el b/lisp/ob-mathomatic.el index adc7c37..beb5285 100644 --- a/lisp/ob-mathomatic.el +++ b/lisp/ob-mathomatic.el @@ -7,7 +7,7 @@ ;; Luis Anaya (Mathomatic) ;; Keywords: literate programming, reproducible research, mathomatic -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el index 09f20c2..236300c 100644 --- a/lisp/ob-mscgen.el +++ b/lisp/ob-mscgen.el @@ -5,7 +5,7 @@ ;; Author: Juan Pechiar ;; Maintainer: Justin Abrahms ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-oz.el b/lisp/ob-oz.el index 434e0db..4a3175f 100644 --- a/lisp/ob-oz.el +++ b/lisp/ob-oz.el @@ -4,7 +4,7 @@ ;; Author: Torsten Anders and Eric Schulte ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.02 ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-php.el b/lisp/ob-php.el deleted file mode 100644 index 9b0b990..0000000 --- a/lisp/ob-php.el +++ /dev/null @@ -1,73 +0,0 @@ -;;; ob-php.el --- Execute PHP within org-mode blocks -;; Copyright 2016, 2021 stardiviner - -;; Author: stardiviner <numbchild@gmail.com> -;; Maintainer: stardiviner <numbchild@gmail.com> -;; Homepage: https://github.com/stardiviner/ob-php -;; Keywords: org babel php -;; Homepage: https://github.com/stardiviner/ob-php -;; Created: 04th May 2016 -;; Version: 0.0.1 -;; Package-Requires: ((org "8")) - -;; 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: -;; -;; Execute PHP within org-mode blocks. - -;;; Code: -(require 'org) -(require 'ob) - -(defgroup ob-php nil - "org-mode blocks for PHP." - :group 'org) - -(defcustom org-babel-php-command "php" - "The command to execute babel body code." - :group 'ob-php - :type 'string) - -(defcustom org-babel-php-command-options nil - "The php command options to use when execute code." - :group 'ob-php - :type 'string) - -(defcustom ob-php:inf-php-buffer "*php*" - "Default PHP inferior buffer." - :group 'ob-php - :type 'string) - -;;;###autoload -(defun org-babel-execute:php (body params) - "Orgmode Babel PHP evaluate function for `BODY' with `PARAMS'." - (let* ((cmd (concat org-babel-php-command " " org-babel-php-command-options)) - (body (concat "<?php\n" body "\n?>"))) - (org-babel-eval cmd body))) - -;;;###autoload -(eval-after-load 'org - '(add-to-list 'org-src-lang-modes '("php" . php))) - -(defvar org-babel-default-header-args:php '()) - -(add-to-list 'org-babel-default-header-args:php - '(:results . "output")) - -(provide 'ob-php) - -;;; ob-php.el ends here diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index f7faff0..a00eabd 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -5,7 +5,7 @@ ;; Authors: Thorsten Jolitz ;; Eric Schulte ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-redis.el b/lisp/ob-redis.el deleted file mode 100644 index 204f5d4..0000000 --- a/lisp/ob-redis.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; ob-redis.el --- Execute Redis queries within org-mode blocks -;; Copyright 2016-2021 stardiviner - -;; Author: stardiviner <numbchild@gmail.com> -;; Maintainer: stardiviner <numbchild@gmail.com> -;; Keywords: org babel redis -;; Homepage: https://github.com/stardiviner/ob-redis -;; Created: 28th Feb 2016 -;; Version: 0.0.1 -;; Package-Requires: ((org "8")) - -;; 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: -;; -;; Execute Redis queries within org-mode blocks. - -;;; Code: -(require 'org) -(require 'ob) - -(defgroup ob-redis nil - "org-mode blocks for Redis." - :group 'org) - -(defcustom ob-redis:default-db "127.0.0.1:6379" - "Default Redis database." - :group 'ob-redis - :type 'string) - -;;;###autoload -(defun org-babel-execute:redis (body params) - "org-babel redis hook." - (let* ((db (or (cdr (assoc :db params)) - ob-redis:default-db)) - (cmd (mapconcat 'identity (list "redis-cli") " "))) - (org-babel-eval cmd body) - )) - -;;;###autoload -(eval-after-load 'org - '(add-to-list 'org-src-lang-modes '("redis" . redis))) - -(provide 'ob-redis) - -;;; ob-redis.el ends here diff --git a/lisp/ob-sclang.el b/lisp/ob-sclang.el deleted file mode 100644 index 861ef37..0000000 --- a/lisp/ob-sclang.el +++ /dev/null @@ -1,93 +0,0 @@ -;;; ob-sclang.el --- SCLang support for Org-mode Babel -;;; -*- coding: utf-8 -*- - -;; Copyright (C) 2017-2021 Free Software Foundation, Inc. - -;; Authors: stardiviner <numbchild@gmail.com> -;; Homepage: https://github.com/stardiviner/ob-sclang -;; Package-Version: 0.1 -;; Keywords: babel sclang - -;; This file is not part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; `ob-sclang' requires `sclang' from SuperCollider. -;; Usually SuperCollider dependencies for Emacs are at /usr/share/emacs/site-lisp/SuperCollider/ -;; You can install SuperCollider following this article: -;; https://github.com/supercollider/supercollider#building-the-source-code - -;; Usage: - -;; Support to evaluate sclang Org-mode src block with function `sclang-eval-string'. - -;; For example: - -;; #+BEGIN_SRC sclang :results none -;; "Hello World".postln; -;; #+END_SRC -;; -;; *NOTE* Temporary output to org-babel result output is not supported. -;; Because `sclang-eval-string' will send output to Sclang Post Buffer. -;; And command line `sclang' execute will not automatically stop after finished execution. -;; -;; #+BEGIN_SRC sclang :results none -;; // modulate a sine frequency and a noise amplitude with another sine -;; // whose frequency depends on the horizontal mouse pointer position -;; { -;; var x = SinOsc.ar(MouseX.kr(1, 100)); -;; SinOsc.ar(300 * x + 800, 0, 0.1) -;; + -;; PinkNoise.ar(0.1 * x + 0.1) -;; }.play; -;; #+END_SRC - - -;;; Code: -;;; ---------------------------------------------------------------------------- -(require 'org) -(require 'ob) - -(require 'sclang nil t) - -(defgroup ob-sclang nil - "org-mode blocks for SuperCollider SCLang." - :group 'org) - -;;;###autoload -(defun org-babel-execute:sclang (body params) - "Org-mode Babel sclang hook for evaluate `BODY' with `PARAMS'." - (unless (or (equal (buffer-name) sclang-post-buffer) - (sclang-get-process)) - (sclang-start)) - (sclang-eval-string body t)) - -(defvar org-babel-default-header-args:sclang nil) - -(setq org-babel-default-header-args:sclang - '((:session . "*SCLang:Workspace*") - ;; TODO: temporary can't find way to let sclang output to stdout for org-babel. - (:output . "none"))) - -(eval-after-load 'org - '(progn - (add-to-list 'org-src-lang-modes '("sclang" . sclang)))) - -;;; ---------------------------------------------------------------------------- - -(provide 'ob-sclang) - -;;; ob-sclang.el ends here diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index 6eccce1..a46c34e 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -4,7 +4,7 @@ ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, shen -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-smiles.el b/lisp/ob-smiles.el deleted file mode 100644 index 1e61a00..0000000 --- a/lisp/ob-smiles.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; ob-smiles.el --- Org-mode Babel support for SMILES - -;; Author: John Kitchin <jkitchin@andrew.cmu.edu> -;; Maintainer: stardiviner <numbchild@gmail.com> -;; Homepage: https://github.com/stardiviner/ob-smiles -;; Keywords: org babel SMILES -;; Version: 0.0.1 -;; Package-Requires: ((smiles-mode "0.0.1") (org "8")) - -;; 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: - -;;; I copy code from: -;;; https://kitchingroup.cheme.cmu.edu/blog/2016/03/26/A-molecule-link-for-org-mode - -;;; Code: - -(require 'ob) -(require 'org-element) - -;; Org-mode Babel -(defun org-babel-execute:smiles (body params) - "Execute SMILES babel `BODY' with `PARAMS'." - (shell-command-to-string - (format "obabel -:\"%s\" -osvg 2> /dev/null" body))) - -;; Org-mode link -(defun molecule-jump (name) - "Jump to molecule `NAME' definition." - (org-mark-ring-push) - (org-link-open-from-string (format "[[%s]]" name))) - -(defun molecule-export (path desc backend) - "Export molecule to HTML format on `PATH' with `DESC' and `BACKEND'." - (let ((name (save-window-excursion - (molecule-jump path) - (org-element-property :name (org-element-context))))) - (cond - ((eq 'html backend) - (format "<a href=\"#%s\">%s</a>" name name))))) - -(org-link-set-parameters - "molecule" - :follow 'molecule-jump - :export 'molecule-export) - -;; org-mode element -(org-element-map (org-element-parse-buffer) - 'src-block - (lambda (src) - (when (string= "smiles" (org-element-property :language src)) - (org-element-property :name src)))) - - -(provide 'ob-smiles) - -;;; ob-smiles.el ends here diff --git a/lisp/ob-spice.el b/lisp/ob-spice.el index 3b732a5..8a101ea 100644 --- a/lisp/ob-spice.el +++ b/lisp/ob-spice.el @@ -3,7 +3,7 @@ ;; Author: Tiago Oliveira Weber ;; Maintainer: stardiviner <numbchild@gmail.com> -;; Homepage: https://github.com/stardiviner/ob-spice +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.4 ;; Package-Requires: ((spice-mode "0.0.1") (org "8")) diff --git a/lisp/ob-stan.el b/lisp/ob-stan.el deleted file mode 100644 index 398ccec..0000000 --- a/lisp/ob-stan.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*- - -;; Copyright (C) 2015-2021 Free Software Foundation, Inc. - -;; Author: Kyle Meyer -;; Keywords: literate programming, reproducible research -;; Homepage: https://git.kyleam.com/ob-stan - -;; 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 Stan [1] source code. -;; -;; Evaluating a Stan block can produce two different results. -;; -;; 1) Dump the source code contents to a file. -;; -;; This file can then be used as a variable in other blocks, which -;; allows interfaces like RStan to use the model. -;; -;; 2) Compile the contents to a model file. -;; -;; This provides access to the CmdStan interface. To use this, set -;; `org-babel-stan-cmdstan-directory' and provide a :file argument -;; that does not end in ".stan". -;; -;; For more information and usage examples, visit -;; https://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html -;; -;; [1] https://mc-stan.org/ - -;;; Code: -(require 'ob) -(require 'org-compat) - -(defcustom org-babel-stan-cmdstan-directory nil - "CmdStan source directory. -Call \"make\" from this directory to compile the Stan block. -When nil, executing Stan blocks dumps the content to a file." - :group 'org-babel - :type '(choice - (directory :tag "Compilation directory") - (const :tag "Dump to a file" nil))) - -(defvar org-babel-default-header-args:stan - '((:results . "file"))) - -(defun org-babel-execute:stan (body params) - "Generate Stan file from BODY according to PARAMS. -A :file header argument must be given. If -`org-babel-stan-cmdstan-directory' is non-nil and the file name -does not have a \".stan\" extension, save an intermediate -\".stan\" file and compile the block to the named file. -Otherwise, write the Stan code directly to the named file." - (let ((file (expand-file-name - (or (cdr (assq :file params)) - (user-error "Set :file argument to execute Stan blocks"))))) - (if (or (not org-babel-stan-cmdstan-directory) - (string-match-p "\\.stan\\'" file)) - (with-temp-file file (insert body)) - (with-temp-file (concat file ".stan") (insert body)) - (let ((default-directory org-babel-stan-cmdstan-directory)) - (call-process-shell-command (concat "make " file)))) - nil)) ; Signal that output has been written to file. - -(defun org-babel-prep-session:stan (_session _params) - "Return an error because Stan does not support sessions." - (user-error "Stan does not support sessions")) - -(provide 'ob-stan) - -;;; ob-stan.el ends here diff --git a/lisp/ob-tcl.el b/lisp/ob-tcl.el index 6270047..4c57541 100644 --- a/lisp/ob-tcl.el +++ b/lisp/ob-tcl.el @@ -7,7 +7,7 @@ ;; Luis Anaya (tcl) ;; ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-vala.el b/lisp/ob-vala.el index 826d32f..ad9eff4 100644 --- a/lisp/ob-vala.el +++ b/lisp/ob-vala.el @@ -4,7 +4,7 @@ ;; Author: Christian Garbs <mitch@cgarbs.de> ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ob-vbnet.el b/lisp/ob-vbnet.el index 1ea572d..015bf1f 100644 --- a/lisp/ob-vbnet.el +++ b/lisp/ob-vbnet.el @@ -4,7 +4,7 @@ ;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte ;; Keywords: literate programming, reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ol-mew.el b/lisp/ol-mew.el index a8aa5d0..bae2685 100644 --- a/lisp/ol-mew.el +++ b/lisp/ol-mew.el @@ -4,7 +4,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; This file is not part of GNU Emacs. diff --git a/lisp/ol-notmuch.el b/lisp/ol-notmuch.el deleted file mode 100644 index 7d95972..0000000 --- a/lisp/ol-notmuch.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; ol-notmuch.el --- Links to notmuch messages - -;; Copyright (C) 2010-2014, 2021 Matthieu Lemerre - -;; Author: Matthieu Lemerre <racin@free.fr> -;; Maintainer: Jonas Bernoulli <jonas@bernoul.li> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://git.sr.ht/~tarsius/ol-notmuch - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file implements links to notmuch messages and "searches". A -;; search is a query to be performed by notmuch; it is the equivalent -;; to folders in other mail clients. Similarly, mails are referred to -;; by a query, so both a link can refer to several mails. - -;; Links have one the following form -;; notmuch:<search terms> -;; notmuch-search:<search terms>. - -;; The first form open the queries in notmuch-show mode, whereas the -;; second link open it in notmuch-search mode. Note that queries are -;; performed at the time the link is opened, and the result may be -;; different from when the link was stored. - -;;; Code: - -(require 'ol) - -;; customisable notmuch open functions -(defcustom org-notmuch-open-function - 'org-notmuch-follow-link - "Function used to follow notmuch links. - -Should accept a notmuch search string as the sole argument." - :group 'org-notmuch - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -(defcustom org-notmuch-search-open-function - 'org-notmuch-search-follow-link - "Function used to follow notmuch-search links. -Should accept a notmuch search string as the sole argument." - :group 'org-notmuch - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -(make-obsolete-variable 'org-notmuch-search-open-function nil "9.3") - - - -;; Install the link type -(org-link-set-parameters "notmuch" - :follow #'org-notmuch-open - :store #'org-notmuch-store-link) - -(defun org-notmuch-store-link () - "Store a link to a notmuch search or message." - (when (memq major-mode '(notmuch-show-mode notmuch-tree-mode)) - (let* ((message-id (notmuch-show-get-message-id t)) - (subject (notmuch-show-get-subject)) - (to (notmuch-show-get-to)) - (from (notmuch-show-get-from)) - (date (org-trim (notmuch-show-get-date))) - desc link) - (org-link-store-props :type "notmuch" :from from :to to :date date - :subject subject :message-id message-id) - (setq desc (org-link-email-description)) - (setq link (concat "notmuch:id:" message-id)) - (org-link-add-props :link link :description desc) - link))) - -(defun org-notmuch-open (path _) - "Follow a notmuch message link specified by PATH." - (funcall org-notmuch-open-function path)) - -(defun org-notmuch-follow-link (search) - "Follow a notmuch link to SEARCH. - -Can link to more than one message, if so all matching messages are shown." - (require 'notmuch) - (notmuch-show search)) - - - -(org-link-set-parameters "notmuch-search" - :follow #'org-notmuch-search-open - :store #'org-notmuch-search-store-link) - -(defun org-notmuch-search-store-link () - "Store a link to a notmuch search or message." - (when (eq major-mode 'notmuch-search-mode) - (let ((link (concat "notmuch-search:" notmuch-search-query-string)) - (desc (concat "Notmuch search: " notmuch-search-query-string))) - (org-link-store-props :type "notmuch-search" - :link link - :description desc) - link))) - -(defun org-notmuch-search-open (path _) - "Follow a notmuch message link specified by PATH." - (message "%s" path) - (org-notmuch-search-follow-link path)) - -(defun org-notmuch-search-follow-link (search) - "Follow a notmuch link by displaying SEARCH in notmuch-search mode." - (require 'notmuch) - (notmuch-search search)) - - - -(org-link-set-parameters "notmuch-tree" - :follow #'org-notmuch-tree-open - :store #'org-notmuch-tree-store-link) - -(defun org-notmuch-tree-store-link () - "Store a link to a notmuch search or message." - (when (eq major-mode 'notmuch-tree-mode) - (let ((link (concat "notmuch-tree:" (notmuch-tree-get-query))) - (desc (concat "Notmuch tree: " (notmuch-tree-get-query)))) - (org-link-store-props :type "notmuch-tree" - :link link - :description desc) - link))) - -(defun org-notmuch-tree-open (path _) - "Follow a notmuch message link specified by PATH." - (message "%s" path) - (org-notmuch-tree-follow-link path)) - -(defun org-notmuch-tree-follow-link (search) - "Follow a notmuch link by displaying SEARCH in notmuch-tree mode." - (require 'notmuch) - (notmuch-tree search)) - -(provide 'ol-notmuch) - -;;; ol-notmuch.el ends here diff --git a/lisp/ol-vm.el b/lisp/ol-vm.el index 5720188..bfd4a0b 100644 --- a/lisp/ol-vm.el +++ b/lisp/ol-vm.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; ;; Support for IMAP folders added ;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net> diff --git a/lisp/ol-wl.el b/lisp/ol-wl.el index cc122c5..413a042 100644 --- a/lisp/ol-wl.el +++ b/lisp/ol-wl.el @@ -5,7 +5,7 @@ ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; David Maus <dmaus at ictsoc dot de> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; ;; This file is not part of GNU Emacs. ;; diff --git a/lisp/org-attach-embedded-images.el b/lisp/org-attach-embedded-images.el deleted file mode 100644 index 5beb37a..0000000 --- a/lisp/org-attach-embedded-images.el +++ /dev/null @@ -1,132 +0,0 @@ -;;; org-attach-embedded-images.el --- Transmute images to attachments -;; -;; Copyright 2018-2021 Free Software Foundation, Inc. -;; -;; Author: Marco Wahl -;; Homepage: https://gitlab.com/marcowahl/org-attach-embedded-imagse -;; Version: 0.1 -;; Keywords: org, media -;; -;; This file is not part of GNU Emacs. -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; There are occasions when images are displayed in a subtree which -;; are not org attachments. For example if you copy and paste a part -;; of a web page (containing images) from eww to an org subtree. - -;; This module provides command `org-attach-embedded-images-in-subtree' -;; to save such images as attachments and insert org links to them. - -;; Install: - -;; To use this module insert it to `org-modules'. The insert can be -;; performed via {M-x customize-variable RET org-modules RET} followed -;; by insertion of `org-attach-embedded-images' to the external -;; modules section. - -;; Alternatively you can add the line - -;; (require 'org-attach-embedded-images) - -;; to your emacs configuration. - -;; Use - -;; M-x org-attach-embedded-images-in-subtree - -;; in a subtree with embedded images. The images get attached and can -;; later be reviewed. - -;; Note: Possibly - -;; M-x org-toggle-inline-images - -;; is needed to see the images in the Org mode window. - - -;; Code: - -(require 'org) -(require 'org-attach) - - -;; Auxiliary functions - -(defun org-attach-embedded-images--next-property-display-data (position limit) - "Return position of the next property-display location with image data. -Return nil if there is no next display property. -POSITION and LIMIT as in `next-single-property-change'." - (let ((pos (next-single-property-change position 'display nil limit))) - (while (and (< pos limit) - (let ((display-prop - (plist-get (text-properties-at pos) 'display))) - (or (not display-prop) - (not (plist-get (cdr display-prop) :data))))) - (setq pos (next-single-property-change pos 'display nil limit))) - pos)) - -(defun org-attach-embedded-images--attach-with-sha1-name (data) - "Save the image given as DATA as org attachment with its sha1 as name. -Return the filename." - (let* ((extension (symbol-name (image-type-from-data data))) - (basename (concat (sha1 data) "." extension)) - (dir (org-attach-dir t)) - (filename (concat dir "/" basename))) - (unless (file-exists-p filename) - (with-temp-file filename - (setq buffer-file-coding-system 'binary) - (set-buffer-multibyte nil) - (insert data))) - (org-attach-sync) - basename)) - - -;; Command - -;;;###autoload -(defun org-attach-embedded-images-in-subtree () - "Save the displayed images as attachments and insert links to them." - (interactive) - (when (org-before-first-heading-p) - (user-error "Before first heading. Nothing has been attached.")) - (save-excursion - (org-attach-dir t) - (let ((beg (progn (org-back-to-heading) (point))) - (end (progn (org-end-of-subtree) (point))) - names) - ;; pass 1 - (goto-char beg) - (while (< (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) end) - (let ((data (plist-get (cdr (plist-get (text-properties-at (point)) 'display)) :data))) - (assert data) - (push (org-attach-embedded-images--attach-with-sha1-name data) - names))) - ;; pass 2 - (setq names (nreverse names)) - (goto-char beg) - (while names - (goto-char (org-attach-embedded-images--next-property-display-data (point) end)) - (while (get-text-property (point) 'display) - (goto-char (next-property-change (point) nil end))) - (skip-chars-forward "]") - (insert (concat "\n[[attachment:" (pop names) "]]")))))) - - -(provide 'org-attach-embedded-images) - - -;;; org-attach-embedded-images.el ends here diff --git a/lisp/org-bibtex-extras.el b/lisp/org-bibtex-extras.el index 1374c99..f4a0401 100644 --- a/lisp/org-bibtex-extras.el +++ b/lisp/org-bibtex-extras.el @@ -4,7 +4,7 @@ ;; Author: Eric Schulte <eric dot schulte at gmx dot com> ;; Keywords: outlines, hypermedia, bibtex, d3 -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.01 ;; This file is not part of GNU Emacs. @@ -103,12 +103,12 @@ For example, to point to your `obe-bibtex-file' use the following. (col (k) (mapcar (lambda (r) (cdr (assoc k r))) meta)) (add (lst) (dolist (el lst) (push (cons el counter) nodes)) - (incf counter))) + (cl-incf counter))) ;; build the nodes of the graph (add (col :title)) - (add (remove-if (lambda (author) (string-match "others" author)) - (remove-duplicates (apply #'append (col :authors)) - :test #'string=))) + (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 diff --git a/lisp/org-checklist.el b/lisp/org-checklist.el index b813c88..26b78cf 100644 --- a/lisp/org-checklist.el +++ b/lisp/org-checklist.el @@ -93,10 +93,10 @@ of checkbox items" "-" (format-time-string org-checklist-export-time-format) ".org")) - (print (case (org-entry-get (point) "PRINT_EXPORT" nil) + (print (cl-case (org-entry-get (point) "PRINT_EXPORT" nil) (("" "nil" nil) nil) - (t t) - (nil (y-or-n-p "Print list? ")))) + (nil (y-or-n-p "Print list? ")) + (t t))) exported-lines (title "Checklist export")) (save-restriction diff --git a/lisp/org-choose.el b/lisp/org-choose.el index ef5eca4..8491a57 100644 --- a/lisp/org-choose.el +++ b/lisp/org-choose.el @@ -201,7 +201,7 @@ interpretation." (setq top-upper-range index)) ((eq type 'default-mark) (setq static-default index))) - (incf index) + (cl-incf index) (push vanilla-text all-mark-texts) (push vanilla-mark vanilla-list))) diff --git a/lisp/org-collector.el b/lisp/org-collector.el index 876cda9..12c836b 100644 --- a/lisp/org-collector.el +++ b/lisp/org-collector.el @@ -5,7 +5,7 @@ ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp, experimentation, ;; organization, properties -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.01 ;; This file is not part of GNU Emacs. diff --git a/lisp/org-contacts.el b/lisp/org-contacts.el deleted file mode 100644 index 2a4ac10..0000000 --- a/lisp/org-contacts.el +++ /dev/null @@ -1,1243 +0,0 @@ -;;; org-contacts.el --- Contacts management - -;; Copyright (C) 2010-2014, 2021 Julien Danjou <julien@danjou.info> - -;; Author: Julien Danjou <julien@danjou.info> -;; Maintainer: stardiviner <numbchild@gmail.com> -;; Keywords: outlines, hypermedia, calendar -;; -;; This file is not part of GNU Emacs. -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the code for managing your contacts into Org-mode. - -;; To enter new contacts, you can use `org-capture' and a minimal template just like -;; this: - -;; ("c" "Contacts" entry (file "~/Org/contacts.org") -;; "* %(org-contacts-template-name) -;; :PROPERTIES: -;; :EMAIL: %(org-contacts-template-email) -;; :END:"))) -;; -;; You can also use a complex template, for example: -;; -;; ("c" "Contacts" entry (file "~/Org/contacts.org") -;; "* %(org-contacts-template-name) -;; :PROPERTIES: -;; :EMAIL: %(org-contacts-template-email) -;; :PHONE: -;; :ALIAS: -;; :NICKNAME: -;; :IGNORE: -;; :ICON: -;; :NOTE: -;; :ADDRESS: -;; :BIRTHDAY: -;; :END:"))) - -;;;; Usage: - -;;; How to search? -;;; -;;; You can use `org-sparse-tree' [C-c / p] to filter based on a -;;; specific property. Or other matcher on `org-sparse-tree'. - -;;; Code: - -(require 'cl-lib) -(require 'org) -(require 'gnus-util) -(require 'gnus-art) -(require 'mail-utils) -(require 'org-agenda) -(require 'org-capture) -(require 'ol) - -(defgroup org-contacts nil - "Options about contacts management." - :group 'org) - -(defcustom org-contacts-files nil - "List of Org files to use as contacts source. -When set to nil, all your Org files will be used." - :type '(repeat file) - :group 'org-contacts) - -(defcustom org-contacts-email-property "EMAIL" - "Name of the property for contact email address." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-tel-property "PHONE" - "Name of the property for contact phone number." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-address-property "ADDRESS" - "Name of the property for contact address." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-birthday-property "BIRTHDAY" - "Name of the property for contact birthday date." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-note-property "NOTE" - "Name of the property for contact note." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-alias-property "ALIAS" - "Name of the property for contact name alias." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-ignore-property "IGNORE" - "Name of the property, which values will be ignored when -completing or exporting to vcard." - :type 'string - :group 'org-contacts) - - -(defcustom org-contacts-birthday-format "Birthday: %l (%Y)" - "Format of the anniversary agenda entry. -The following replacements are available: - - %h - Heading name - %l - Link to the heading - %y - Number of year - %Y - Number of year (ordinal)" - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-last-read-mail-property "LAST_READ_MAIL" - "Name of the property for contact last read email link storage." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-icon-property "ICON" - "Name of the property for contact icon." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-nickname-property "NICKNAME" - "Name of the property for IRC nickname match." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-icon-size 32 - "Size of the contacts icons." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-icon-use-gravatar (fboundp 'gravatar-retrieve) - "Whether use Gravatar to fetch contact icons." - :type 'boolean - :group 'org-contacts) - -(defcustom org-contacts-completion-ignore-case t - "Ignore case when completing contacts." - :type 'boolean - :group 'org-contacts) - -(defcustom org-contacts-group-prefix "+" - "Group prefix." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-tags-props-prefix "#" - "Tags and properties prefix." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-matcher - (mapconcat #'identity - (mapcar (lambda (x) (concat x "<>\"\"")) - (list org-contacts-email-property - org-contacts-alias-property - org-contacts-tel-property - org-contacts-address-property - org-contacts-birthday-property)) - "|") - "Matching rule for finding heading that are contacts. -This can be a tag name, or a property check." - :type 'string - :group 'org-contacts) - -(defcustom org-contacts-email-link-description-format "%s (%d)" - "Format used to store links to email. -This overrides `org-email-link-description-format' if set." - :group 'org-contacts - :type 'string) - -(defcustom org-contacts-vcard-file "contacts.vcf" - "Default file for vcard export." - :group 'org-contacts - :type 'file) - -(defcustom org-contacts-enable-completion t - "Enable or not the completion in `message-mode' with `org-contacts'." - :group 'org-contacts - :type 'boolean) - -(defcustom org-contacts-complete-functions - '(org-contacts-complete-group org-contacts-complete-tags-props org-contacts-complete-name) - "List of functions used to complete contacts in `message-mode'." - :group 'org-contacts - :type 'hook) - -;; Decalre external functions and variables -(declare-function org-reverse-string "org") -(declare-function diary-ordinal-suffix "ext:diary-lib") -(declare-function wl-summary-message-number "ext:wl-summary") -(declare-function wl-address-header-extract-address "ext:wl-address") -(declare-function wl-address-header-extract-realname "ext:wl-address") -(declare-function erc-buffer-list "ext:erc") -(declare-function erc-get-channel-user-list "ext:erc") -(declare-function google-maps-static-show "ext:google-maps-static") -(declare-function elmo-message-field "ext:elmo-pipe") -(declare-function std11-narrow-to-header "ext:std11") -(declare-function std11-fetch-field "ext:std11") - -(defconst org-contacts-property-values-separators "[,; \f\t\n\r\v]+" - "The default value of separators for `org-contacts-split-property'. - -A regexp matching strings of whitespace, `,' and `;'.") - -(defvar org-contacts-keymap - (let ((map (make-sparse-keymap))) - (define-key map "M" 'org-contacts-view-send-email) - (define-key map "i" 'org-contacts-view-switch-to-irc-buffer) - map) - "The keymap used in `org-contacts' result list.") - -(defvar org-contacts-db nil - "Org Contacts database.") - -(defvar org-contacts-last-update nil - "Last time the Org Contacts database has been updated.") - -(defun org-contacts-files () - "Return list of Org files to use for contact management." - (or org-contacts-files (org-agenda-files t 'ifmode))) - -(defun org-contacts-db-need-update-p () - "Determine whether `org-contacts-db' needs to be refreshed." - (or (null org-contacts-last-update) - (cl-find-if (lambda (file) - (or (time-less-p org-contacts-last-update - (elt (file-attributes file) 5)))) - (org-contacts-files)) - (org-contacts-db-has-dead-markers-p org-contacts-db))) - -(defun org-contacts-db-has-dead-markers-p (org-contacts-db) - "Returns t if at least one dead marker is found in -ORG-CONTACTS-DB. A dead marker in this case is a marker pointing -to dead or no buffer." - ;; Scan contacts list looking for dead markers, and return t at first found. - (catch 'dead-marker-found - (while org-contacts-db - (unless (marker-buffer (nth 1 (car org-contacts-db))) - (throw 'dead-marker-found t)) - (setq org-contacts-db (cdr org-contacts-db))) - nil)) - -(defun org-contacts-db () - "Return the latest Org Contacts Database." - (let* ((org--matcher-tags-todo-only nil) - (contacts-matcher (cdr (org-make-tags-matcher org-contacts-matcher))) - result) - (when (org-contacts-db-need-update-p) - (let ((progress-reporter - (make-progress-reporter "Updating Org Contacts Database..." 0 (length org-contacts-files))) - (i 0)) - (dolist (file (org-contacts-files)) - (if (catch 'nextfile - ;; if file doesn't exist and the user agrees to removing it - ;; from org-agendas-list, 'nextfile is thrown. Catch it here - ;; and skip processing the file. - ;; - ;; TODO: suppose that the user has set an org-contacts-files - ;; list that contains an element that doesn't exist in the - ;; file system: in that case, the org-agenda-files list could - ;; be updated (and saved to the customizations of the user) if - ;; it contained the same file even though the org-agenda-files - ;; list wasn't actually used. I don't think it is normal that - ;; org-contacts updates org-agenda-files in this case, but - ;; short of duplicating org-check-agenda-files and - ;; org-remove-files, I don't know how to avoid it. - ;; - ;; A side effect of the TODO is that the faulty - ;; org-contacts-files list never gets updated and thus the - ;; user is always queried about the missing files when - ;; org-contacts-db-need-update-p returns true. - (org-check-agenda-file file)) - (message "Skipped %s removed from org-agenda-files list." - (abbreviate-file-name file)) - (with-current-buffer (org-get-agenda-file-buffer file) - (unless (eq major-mode 'org-mode) - (error "File %s is not in `org-mode'" file)) - (setf result - (append result - (org-scan-tags 'org-contacts-at-point - contacts-matcher - org--matcher-tags-todo-only))))) - (progress-reporter-update progress-reporter (setq i (1+ i)))) - (setf org-contacts-db result - org-contacts-last-update (current-time)) - (progress-reporter-done progress-reporter))) - org-contacts-db)) - -(defun org-contacts-at-point (&optional pom) - "Return the contacts at point-or-marker POM or current position -if nil." - (setq pom (or pom (point))) - (org-with-point-at pom - (list (org-get-heading t) (set-marker (make-marker) pom) (org-entry-properties pom 'all)))) - -(defun org-contacts-filter (&optional name-match tags-match prop-match) - "Search for a contact matching any of NAME-MATCH, TAGS-MATCH, PROP-MATCH. -If all match values are nil, return all contacts. - -The optional PROP-MATCH argument is a single (PROP . VALUE) cons -cell corresponding to the contact properties. -" - (if (and (null name-match) - (null prop-match) - (null tags-match)) - (org-contacts-db) - (cl-loop for contact in (org-contacts-db) - if (or - (and name-match - (string-match-p name-match - (first contact))) - (and prop-match - (cl-find-if (lambda (prop) - (and (string= (car prop-match) (car prop)) - (string-match-p (cdr prop-match) (cdr prop)))) - (caddr contact))) - (and tags-match - (cl-find-if (lambda (tag) - (string-match-p tags-match tag)) - (org-split-string - (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))) - collect contact))) - -(when (not (fboundp 'completion-table-case-fold)) - ;; That function is new in Emacs 24... - (defun completion-table-case-fold (table &optional dont-fold) - (lambda (string pred action) - (let ((completion-ignore-case (not dont-fold))) - (complete-with-action action table string pred))))) - -(defun org-contacts-try-completion-prefix (to-match collection &optional predicate) - "Custom implementation of `try-completion'. -This version works only with list and alist and it looks at all -prefixes rather than just the beginning of the string." - (cl-loop with regexp = (concat "\\b" (regexp-quote to-match)) - with ret = nil - with ret-start = nil - with ret-end = nil - - for el in collection - for string = (if (listp el) (car el) el) - - for start = (when (or (null predicate) (funcall predicate string)) - (string-match regexp string)) - - if start - do (let ((end (match-end 0)) - (len (length string))) - (if (= end len) - (cl-return t) - (cl-destructuring-bind (string start end) - (if (null ret) - (values string start end) - (org-contacts-common-substring - ret ret-start ret-end - string start end)) - (setf ret string - ret-start start - ret-end end)))) - - finally (cl-return - (replace-regexp-in-string "\\`[ \t\n]*" "" ret)))) - -(defun org-contacts-compare-strings (s1 start1 end1 s2 start2 end2 &optional ignore-case) - "Compare the contents of two strings, using `compare-strings'. - -This function works like `compare-strings' excepted that it -returns a cons. -- The CAR is the number of characters that match at the beginning. -- The CDR is T is the two strings are the same and NIL otherwise." - (let ((ret (compare-strings s1 start1 end1 s2 start2 end2 ignore-case))) - (if (eq ret t) - (cons (or end1 (length s1)) t) - (cons (1- (abs ret)) nil)))) - -(defun org-contacts-common-substring (s1 start1 end1 s2 start2 end2) - "Extract the common substring between S1 and S2. - -This function extracts the common substring between S1 and S2 and -adjust the part that remains common. - -START1 and END1 delimit the part in S1 that we know is common -between the two strings. This applies to START2 and END2 for S2. - -This function returns a list whose contains: -- The common substring found. -- The new value of the start of the known inner substring. -- The new value of the end of the known inner substring." - ;; Given two strings: - ;; s1: "foo bar baz" - ;; s2: "fooo bar baz" - ;; and the inner substring is "bar" - ;; then: start1 = 4, end1 = 6, start2 = 5, end2 = 7 - ;; - ;; To find the common substring we will compare two substrings: - ;; " oof" and " ooof" to find the beginning of the common substring. - ;; " baz" and " baz" to find the end of the common substring. - (let* ((len1 (length s1)) - (start1 (or start1 0)) - (end1 (or end1 len1)) - - (len2 (length s2)) - (start2 (or start2 0)) - (end2 (or end2 len2)) - - (new-start (car (org-contacts-compare-strings - (substring (org-reverse-string s1) (- len1 start1)) nil nil - (substring (org-reverse-string s2) (- len2 start2)) nil nil))) - - (new-end (+ end1 (car (org-contacts-compare-strings - (substring s1 end1) nil nil - (substring s2 end2) nil nil))))) - (list (substring s1 (- start1 new-start) new-end) - new-start - (+ new-start (- end1 start1))))) - -(defun org-contacts-all-completions-prefix (to-match collection &optional predicate) - "Custom version of `all-completions'. -This version works only with list and alist and it looks at all -prefixes rather than just the beginning of the string." - (cl-loop with regexp = (concat "\\b" (regexp-quote to-match)) - for el in collection - for string = (if (listp el) (car el) el) - for match? = (when (and (or (null predicate) (funcall predicate string))) - (string-match regexp string)) - if match? - collect (progn - (let ((end (match-end 0))) - (org-no-properties string) - (when (< end (length string)) - ;; Here we add a text property that will be used - ;; later to highlight the character right after - ;; the common part between each addresses. - ;; See `org-contacts-display-sort-function'. - (put-text-property end (1+ end) 'org-contacts-prefix 't string))) - string))) - -(defun org-contacts-make-collection-prefix (collection) - "Make a collection function from COLLECTION which will match on prefixes." - (lexical-let ((collection collection)) - (lambda (string predicate flag) - (cond ((eq flag nil) - (org-contacts-try-completion-prefix string collection predicate)) - ((eq flag t) - ;; `org-contacts-all-completions-prefix' has already been - ;; used to compute `all-completions'. - collection) - ((eq flag 'lambda) - (org-contacts-test-completion-prefix string collection predicate)) - ((and (listp flag) (eq (car flag) 'boundaries)) - (cl-destructuring-bind (to-ignore &rest suffix) - flag - (org-contacts-boundaries-prefix string collection predicate suffix))) - ((eq flag 'metadata) - (org-contacts-metadata-prefix string collection predicate)) - (t nil ; operation unsupported - ))))) - -(defun org-contacts-display-sort-function (completions) - "Sort function for contacts display." - (mapcar (lambda (string) - (cl-loop with len = (1- (length string)) - for i upfrom 0 to len - if (memq 'org-contacts-prefix - (text-properties-at i string)) - do (set-text-properties - i (1+ i) - (list 'font-lock-face - (if (char-equal (aref string i) - (string-to-char " ")) - ;; Spaces can't be bold. - 'underline - 'bold)) string) - else - do (set-text-properties i (1+ i) nil string) - finally (cl-return string))) - completions)) - -(defun org-contacts-test-completion-prefix (string collection predicate) - (cl-find-if (lambda (el) - (and (or (null predicate) (funcall predicate el)) - (string= string el))) - collection)) - -(defun org-contacts-boundaries-prefix (string collection predicate suffix) - (list* 'boundaries (completion-boundaries string collection predicate suffix))) - -(defun org-contacts-metadata-prefix (string collection predicate) - '(metadata . - ((cycle-sort-function . org-contacts-display-sort-function) - (display-sort-function . org-contacts-display-sort-function)))) - -(defun org-contacts-complete-group (start end string) - "Complete text at START from a group. - -A group FOO is composed of contacts with the tag FOO." - (let* ((completion-ignore-case org-contacts-completion-ignore-case) - (group-completion-p (string-match-p - (concat "^" org-contacts-group-prefix) string))) - (when group-completion-p - (let ((completion-list - (all-completions - string - (mapcar (lambda (group) - (propertize (concat org-contacts-group-prefix group) - 'org-contacts-group group)) - (org-uniquify - (cl-loop for contact in (org-contacts-filter) - nconc (org-split-string - (or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":"))))))) - (list start end - (if (= (length completion-list) 1) - ;; We've found the correct group, returns the address - (lexical-let ((tag (get-text-property 0 'org-contacts-group - (car completion-list)))) - (lambda (string pred &optional to-ignore) - (mapconcat 'identity - (cl-loop for contact in (org-contacts-filter - nil - tag) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - ;; Grab the first email of the contact - for email = (org-contacts-strip-link - (or (car (org-contacts-split-property - (or - (cdr (assoc-string org-contacts-email-property - (cl-caddr contact))) - ""))) "")) - ;; If the user has an email address, append USER <EMAIL>. - if email collect (org-contacts-format-email contact-name email)) - ", "))) - ;; We haven't found the correct group - (completion-table-case-fold completion-list - (not org-contacts-completion-ignore-case)))))))) - -(defun org-contacts-complete-tags-props (start end string) - "Insert emails that match the tags expression. - -For example: FOO-BAR will match entries tagged with FOO but not -with BAR. - -See (org) Matching tags and properties for a complete -description." - (let* ((completion-ignore-case org-contacts-completion-ignore-case) - (completion-p (string-match-p - (concat "^" org-contacts-tags-props-prefix) string))) - (when completion-p - (let ((result - (mapconcat - 'identity - (cl-loop for contact in (org-contacts-db) - for contact-name = (car contact) - for email = (org-contacts-strip-link (or (car (org-contacts-split-property - (or - (cdr (assoc-string org-contacts-email-property - (cl-caddr contact))) - ""))) "")) - for tags = (cdr (assoc "TAGS" (nth 2 contact))) - for tags-list = (if tags - (split-string (substring (cdr (assoc "TAGS" (nth 2 contact))) 1 -1) ":") - '()) - for marker = (nth 1 contact) - if (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (let (todo-only) - (eval (cdr (org-make-tags-matcher (cl-subseq string 1))))))) - collect (org-contacts-format-email contact-name email)) - ","))) - (when (not (string= "" result)) - ;; return (start end function) - (lexical-let* ((to-return result)) - (list start end - (lambda (string pred &optional to-ignore) to-return)))))))) - -(defun org-contacts-remove-ignored-property-values (ignore-list list) - "Remove all ignore-list's elements from list and you can use - regular expressions in the ignore list." - (cl-remove-if (lambda (el) - (cl-find-if (lambda (x) - (string-match-p x el)) - ignore-list)) - list)) - -(defun org-contacts-complete-name (start end string) - "Complete text at START with a user name and email." - (let* ((completion-ignore-case org-contacts-completion-ignore-case) - (completion-list - (cl-loop for contact in (org-contacts-filter) - ;; The contact name is always the car of the assoc-list - ;; returned by `org-contacts-filter'. - for contact-name = (car contact) - - ;; Build the list of the email addresses which has - ;; been expired - for ignore-list = (org-contacts-split-property - (or (cdr (assoc-string org-contacts-ignore-property - (nth 2 contact))) "")) - ;; Build the list of the user email addresses. - for email-list = (org-contacts-remove-ignored-property-values - ignore-list - (org-contacts-split-property - (or (cdr (assoc-string org-contacts-email-property - (nth 2 contact))) ""))) - ;; If the user has email addresses… - if email-list - ;; … append a list of USER <EMAIL>. - nconc (cl-loop for email in email-list - collect (org-contacts-format-email contact-name (org-contacts-strip-link email))))) - (completion-list (org-contacts-all-completions-prefix - string - (org-uniquify completion-list)))) - (when completion-list - (list start end - (org-contacts-make-collection-prefix completion-list))))) - -(defun org-contacts-message-complete-function (&optional start) - "Function used in `completion-at-point-functions' in `message-mode'." - ;; Avoid to complete in `post-command-hook'. - (when completion-in-region-mode - (remove-hook 'post-command-hook #'completion-in-region--postch)) - (let ((mail-abbrev-mode-regexp - "^\\(Resent-To\\|To\\|B?Cc\\|Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\|Disposition-Notification-To\\|Return-Receipt-To\\):")) - (when (mail-abbrev-in-expansion-header-p) - (lexical-let* - ((end (point)) - (start (or start - (save-excursion - (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*") - (goto-char (match-end 0)) - (point)))) - (string (buffer-substring start end))) - (run-hook-with-args-until-success - 'org-contacts-complete-functions start end string))))) - -(defun org-contacts-gnus-get-name-email () - "Get name and email address from Gnus message." - (if (gnus-alive-p) - (gnus-with-article-headers - (mail-extract-address-components - (or (mail-fetch-field "From") ""))))) - -(defun org-contacts-gnus-article-from-get-marker () - "Return a marker for a contact based on From." - (let* ((address (org-contacts-gnus-get-name-email)) - (name (car address)) - (email (cadr address))) - (cl-cadar (or (org-contacts-filter - nil - nil - (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b"))) - (when name - (org-contacts-filter - (concat "^" name "$"))))))) - -(defun org-contacts-gnus-article-from-goto () - "Go to contact in the From address of current Gnus message." - (interactive) - (let ((marker (org-contacts-gnus-article-from-get-marker))) - (when marker - (switch-to-buffer-other-window (marker-buffer marker)) - (goto-char marker) - (when (eq major-mode 'org-mode) (org-show-context 'agenda))))) - -(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el -(defun org-contacts-anniversaries (&optional field format) - "Compute FIELD anniversary for each contact, returning FORMAT. -Default FIELD value is \"BIRTHDAY\". - -Format is a string matching the following format specification: - - %h - Heading name - %l - Link to the heading - %y - Number of year - %Y - Number of year (ordinal)" - (let ((calendar-date-style 'american) - (entry "")) - (unless format (setq format org-contacts-birthday-format)) - (cl-loop for contact in (org-contacts-filter) - for anniv = (let ((anniv (cdr (assoc-string - (or field org-contacts-birthday-property) - (nth 2 contact))))) - (when anniv - (calendar-gregorian-from-absolute - (org-time-string-to-absolute anniv)))) - ;; Use `diary-anniversary' to compute anniversary. - if (and anniv (apply 'diary-anniversary anniv)) - collect (format-spec format - `((?l . ,(org-with-point-at (cadr contact) (org-store-link nil))) - (?h . ,(car contact)) - (?y . ,(- (calendar-extract-year date) - (calendar-extract-year anniv))) - (?Y . ,(let ((years (- (calendar-extract-year date) - (calendar-extract-year anniv)))) - (format "%d%s" years (diary-ordinal-suffix years))))))))) - -(defun org-completing-read-date (prompt collection - &optional predicate require-match initial-input - hist def inherit-input-method) - "Like `completing-read' but reads a date. -Only PROMPT and DEF are really used." - (org-read-date nil nil nil prompt nil def)) - -(add-to-list 'org-property-set-functions-alist - `(,org-contacts-birthday-property . org-completing-read-date)) - -(defun org-contacts-template-name (&optional return-value) - "Try to return the contact name for a template. -If not found return RETURN-VALUE or something that would ask the user." - (or (car (org-contacts-gnus-get-name-email)) - return-value - "%^{Name}")) - -(defun org-contacts-template-email (&optional return-value) - "Try to return the contact email for a template. -If not found return RETURN-VALUE or something that would ask the user." - (or (cadr (org-contacts-gnus-get-name-email)) - return-value - (concat "%^{" org-contacts-email-property "}p"))) - -(defun org-contacts-gnus-store-last-mail () - "Store a link between mails and contacts. - -This function should be called from `gnus-article-prepare-hook'." - (let ((marker (org-contacts-gnus-article-from-get-marker))) - (when marker - (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (let* ((org-email-link-description-format (or org-contacts-email-link-description-format - org-email-link-description-format)) - (link (gnus-with-article-buffer (org-store-link nil)))) - (org-set-property org-contacts-last-read-mail-property link))))))) - -(defun org-contacts-icon-as-string () - "Return the contact icon as a string." - (let ((image (org-contacts-get-icon))) - (concat - (propertize "-" 'display - (append - (if image - image - `'(space :width (,org-contacts-icon-size))) - '(:ascent center))) - " "))) - -;;;###autoload -(defun org-contacts (name) - "Create agenda view for contacts matching NAME." - (interactive (list (read-string "Name: "))) - (let ((org-agenda-files (org-contacts-files)) - (org-agenda-skip-function - (lambda () (org-agenda-skip-if nil `(notregexp ,name)))) - (org-agenda-prefix-format (propertize - "%(org-contacts-icon-as-string)% s%(org-contacts-irc-number-of-unread-messages) " - 'keymap org-contacts-keymap)) - (org-agenda-overriding-header - (or org-agenda-overriding-header - (concat "List of contacts matching `" name "':")))) - (setq org-agenda-skip-regexp name) - (org-tags-view nil org-contacts-matcher) - (with-current-buffer org-agenda-buffer-name - (setq org-agenda-redo-command - (list 'org-contacts name))))) - -(defun org-contacts-completing-read (prompt - &optional predicate - initial-input hist def inherit-input-method) - "Call `completing-read' with contacts name as collection." - (org-completing-read - prompt (org-contacts-filter) predicate t initial-input hist def inherit-input-method)) - -(defun org-contacts-format-name (name) - "Trim any local formatting to get a bare NAME." - ;; Remove radio targets characters - (replace-regexp-in-string org-radio-target-regexp "\\1" name)) - -(defun org-contacts-format-email (name email) - "Format an EMAIL address corresponding to NAME." - (unless email - (error "`email' cannot be nul")) - (if name - (concat (org-contacts-format-name name) " <" email ">") - email)) - -(defun org-contacts-check-mail-address (mail) - "Add MAIL address to contact at point if it does not have it." - (let ((mails (org-entry-get (point) org-contacts-email-property))) - (unless (member mail (split-string mails)) - (when (yes-or-no-p - (format "Do you want to add this address to %s?" (org-get-heading t))) - (org-set-property org-contacts-email-property (concat mails " " mail)))))) - -(defun org-contacts-gnus-check-mail-address () - "Check that contact has the current address recorded. -This function should be called from `gnus-article-prepare-hook'." - (let ((marker (org-contacts-gnus-article-from-get-marker))) - (when marker - (org-with-point-at marker - (org-contacts-check-mail-address (cadr (org-contacts-gnus-get-name-email))))))) - -(defun org-contacts-gnus-insinuate () - "Add some hooks for Gnus user. -This adds `org-contacts-gnus-check-mail-address' and -`org-contacts-gnus-store-last-mail' to -`gnus-article-prepare-hook'. It also adds a binding on `;' in -`gnus-summary-mode-map' to `org-contacts-gnus-article-from-goto'" - (require 'gnus) - (require 'gnus-art) - (define-key gnus-summary-mode-map ";" 'org-contacts-gnus-article-from-goto) - (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address) - (add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail)) - -(defun org-contacts-setup-completion-at-point () - "Add `org-contacts-message-complete-function' as a new function -to complete the thing at point." - (add-to-list 'completion-at-point-functions - 'org-contacts-message-complete-function)) - -(defun org-contacts-unload-hook () - (remove-hook 'message-mode-hook 'org-contacts-setup-completion-at-point)) - -(when (and org-contacts-enable-completion - (boundp 'completion-at-point-functions)) - (add-hook 'message-mode-hook 'org-contacts-setup-completion-at-point)) - -(defun org-contacts-wl-get-from-header-content () - "Retrieve the content of the `From' header of an email. -Works from wl-summary-mode and mime-view-mode - that is while viewing email. -Depends on Wanderlust been loaded." - (with-current-buffer (org-capture-get :original-buffer) - (cond - ((eq major-mode 'wl-summary-mode) (when (and (boundp 'wl-summary-buffer-elmo-folder) - wl-summary-buffer-elmo-folder) - (elmo-message-field - wl-summary-buffer-elmo-folder - (wl-summary-message-number) - 'from))) - ((eq major-mode 'mime-view-mode) (std11-narrow-to-header) - (prog1 - (std11-fetch-field "From") - (widen)))))) - -(defun org-contacts-wl-get-name-email () - "Get name and email address from Wanderlust email. -See `org-contacts-wl-get-from-header-content' for limitations." - (let ((from (org-contacts-wl-get-from-header-content))) - (when from - (list (wl-address-header-extract-realname from) - (wl-address-header-extract-address from))))) - -(defun org-contacts-template-wl-name (&optional return-value) - "Try to return the contact name for a template from wl. -If not found, return RETURN-VALUE or something that would ask the -user." - (or (car (org-contacts-wl-get-name-email)) - return-value - "%^{Name}")) - -(defun org-contacts-template-wl-email (&optional return-value) - "Try to return the contact email for a template from Wanderlust. -If not found return RETURN-VALUE or something that would ask the user." - (or (cadr (org-contacts-wl-get-name-email)) - return-value - (concat "%^{" org-contacts-email-property "}p"))) - -(defun org-contacts-view-send-email (&optional ask) - "Send email to the contact at point. -If ASK is set, ask for the email address even if there's only one -address." - (interactive "P") - (let ((marker (org-get-at-bol 'org-hd-marker))) - (org-with-point-at marker - (let ((emails (org-entry-get (point) org-contacts-email-property))) - (if emails - (let ((email-list (org-contacts-split-property emails))) - (if (and (= (length email-list) 1) (not ask)) - (compose-mail (org-contacts-format-email - (org-get-heading t) emails)) - (let ((email (completing-read "Send mail to which address: " email-list))) - (setq email (org-contacts-strip-link email)) - (org-contacts-check-mail-address email) - (compose-mail (org-contacts-format-email (org-get-heading t) email))))) - (error (format "This contact has no mail address set (no %s property)" - org-contacts-email-property))))))) - -(defun org-contacts-get-icon (&optional pom) - "Get icon for contact at POM." - (setq pom (or pom (point))) - (catch 'icon - ;; Use `org-contacts-icon-property' - (let ((image-data (org-entry-get pom org-contacts-icon-property))) - (when image-data - (throw 'icon - (if (fboundp 'gnus-rescale-image) - (gnus-rescale-image (create-image image-data) - (cons org-contacts-icon-size org-contacts-icon-size)) - (create-image image-data))))) - ;; Next, try Gravatar - (when org-contacts-icon-use-gravatar - (let* ((gravatar-size org-contacts-icon-size) - (email-list (org-entry-get pom org-contacts-email-property)) - (gravatar - (when email-list - (cl-loop for email in (org-contacts-split-property email-list) - for gravatar = (gravatar-retrieve-synchronously (org-contacts-strip-link email)) - if (and gravatar - (not (eq gravatar 'error))) - return gravatar)))) - (when gravatar (throw 'icon gravatar)))))) - -(defun org-contacts-irc-buffer (&optional pom) - "Get the IRC buffer associated with the entry at POM." - (setq pom (or pom (point))) - (let ((nick (org-entry-get pom org-contacts-nickname-property))) - (when nick - (let ((buffer (get-buffer nick))) - (when buffer - (with-current-buffer buffer - (when (eq major-mode 'erc-mode) - buffer))))))) - -(defun org-contacts-irc-number-of-unread-messages (&optional pom) - "Return the number of unread messages for contact at POM." - (when (boundp 'erc-modified-channels-alist) - (let ((number (cadr (assoc (org-contacts-irc-buffer pom) erc-modified-channels-alist)))) - (if number - (format (concat "%3d unread message" (if (> number 1) "s" " ") " ") number) - (make-string 21 ? ))))) - -(defun org-contacts-view-switch-to-irc-buffer () - "Switch to the IRC buffer of the current contact if it has one." - (interactive) - (let ((marker (org-get-at-bol 'org-hd-marker))) - (org-with-point-at marker - (switch-to-buffer-other-window (org-contacts-irc-buffer))))) - -(defun org-contacts-completing-read-nickname (prompt collection - &optional predicate require-match initial-input - hist def inherit-input-method) - "Like `completing-read' but reads a nickname." - (org-completing-read prompt (append collection (erc-nicknames-list)) predicate require-match - initial-input hist def inherit-input-method)) - -(defun erc-nicknames-list () - "Return all nicknames of all ERC buffers." - (cl-loop for buffer in (erc-buffer-list) - nconc (with-current-buffer buffer - (cl-loop for user-entry in (mapcar 'car (erc-get-channel-user-list)) - collect (elt user-entry 1))))) - -(add-to-list 'org-property-set-functions-alist - `(,org-contacts-nickname-property . org-contacts-completing-read-nickname)) - -(defun org-contacts-vcard-escape (str) - "Escape ; , and \n in STR for the VCard format." - ;; Thanks to this library for the regexp: - ;; https://www.emacswiki.org/cgi-bin/wiki/bbdb-vcard-export.el - (when str - (replace-regexp-in-string - "\n" "\\\\n" - (replace-regexp-in-string "\\(;\\|,\\|\\\\\\)" "\\\\\\1" str)))) - -(defun org-contacts-vcard-encode-name (name) - "Try to encode NAME as VCard's N property. -The N property expects - - FamilyName;GivenName;AdditionalNames;Prefix;Postfix. - -Org-contacts does not specify how to encode the name. So we try -to do our best." - (concat (replace-regexp-in-string "\\(\\w+\\) \\(.*\\)" "\\2;\\1" name) ";;;")) - -(defun org-contacts-vcard-format (contact) - "Formats CONTACT in VCard 3.0 format." - (let* ((properties (nth 2 contact)) - (name (org-contacts-vcard-escape (car contact))) - (n (org-contacts-vcard-encode-name name)) - (email (cdr (assoc-string org-contacts-email-property properties))) - (tel (cdr (assoc-string org-contacts-tel-property properties))) - (ignore-list (cdr (assoc-string org-contacts-ignore-property properties))) - (ignore-list (when ignore-list - (org-contacts-split-property ignore-list))) - (note (cdr (assoc-string org-contacts-note-property properties))) - (bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties)))) - (addr (cdr (assoc-string org-contacts-address-property properties))) - (nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties)))) - (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)) - emails-list result phones-list) - (concat head - (when email (progn - (setq emails-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property email))) - (setq result "") - (while emails-list - (setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n")) - (setq emails-list (cdr emails-list))) - result)) - (when addr - (format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr))) - (when tel (progn - (setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel))) - (setq result "") - (while phones-list - (setq result (concat result "TEL:" (org-contacts-strip-link (org-link-unescape (car phones-list))) "\n")) - (setq phones-list (cdr phones-list))) - result)) - (when bday - (let ((cal-bday (calendar-gregorian-from-absolute (org-time-string-to-absolute bday)))) - (format "BDAY:%04d-%02d-%02d\n" - (calendar-extract-year cal-bday) - (calendar-extract-month cal-bday) - (calendar-extract-day cal-bday)))) - (when nick (format "NICKNAME:%s\n" nick)) - (when note (format "NOTE:%s\n" note)) - "END:VCARD\n\n"))) - -(defun org-contacts-export-as-vcard (&optional name file to-buffer) - "Export org contacts to V-Card 3.0. - -By default, all contacts are exported to `org-contacts-vcard-file'. - -When NAME is \\[universal-argument], prompts for a contact name. - -When NAME is \\[universal-argument] \\[universal-argument], -prompts for a contact name and a file name where to export. - -When NAME is \\[universal-argument] \\[universal-argument] -\\[universal-argument], prompts for a contact name and a buffer where to export. - -If the function is not called interactively, all parameters are -passed to `org-contacts-export-as-vcard-internal'." - (interactive "P") - (when (called-interactively-p 'any) - (cl-psetf name - (when name - (read-string "Contact name: " - (nth 0 (org-contacts-at-point)))) - file - (when (equal name '(16)) - (read-file-name "File: " nil org-contacts-vcard-file)) - to-buffer - (when (equal name '(64)) - (read-buffer "Buffer: ")))) - (org-contacts-export-as-vcard-internal name file to-buffer)) - -(defun org-contacts-export-as-vcard-internal (&optional name file to-buffer) - "Export all contacts matching NAME as VCard 3.0. -If TO-BUFFER is nil, the content is written to FILE or -`org-contacts-vcard-file'. If TO-BUFFER is non-nil, the buffer -is created and the VCard is written into that buffer." - (let* ((filename (or file org-contacts-vcard-file)) - (buffer (if to-buffer - (get-buffer-create to-buffer) - (find-file-noselect filename)))) - (message "Exporting...") - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (when (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - (cl-loop for contact in (org-contacts-filter name) - do (insert (org-contacts-vcard-format contact))) - (if to-buffer - (current-buffer) - (progn (save-buffer) (kill-buffer))))) - -(defun org-contacts-show-map (&optional name) - "Show contacts on a map. -Requires google-maps-el." - (interactive) - (unless (fboundp 'google-maps-static-show) - (error "`org-contacts-show-map' requires `google-maps-el'")) - (google-maps-static-show - :markers - (cl-loop - for contact in (org-contacts-filter name) - for addr = (cdr (assoc-string org-contacts-address-property (nth 2 contact))) - if addr - collect (cons (list addr) (list :label (string-to-char (car contact))))))) - -(defun org-contacts-strip-link (link) - "Remove brackets, description, link type and colon from an org -link string and return the pure link target." - (let (startpos colonpos endpos) - (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:")) link)) - (if startpos - (progn - (setq colonpos (string-match ":" link)) - (setq endpos (string-match "\\]" link)) - (if endpos (substring link (1+ colonpos) endpos) link)) - (progn - (setq startpos (string-match "mailto:" link)) - (setq colonpos (string-match ":" link)) - (if startpos (substring link (1+ colonpos)) link))))) - -;; Add the link type supported by org-contacts-strip-link -;; so everything is in order for its use in Org files -(org-link-set-parameters "tel") - -(defun org-contacts-split-property (string &optional separators omit-nulls) - "Custom version of `split-string'. -Split a property STRING into sub-strings bounded by matches -for SEPARATORS but keep Org links intact. - -The beginning and end of STRING, and each match for SEPARATORS, are -splitting points. The substrings matching SEPARATORS are removed, and -the substrings between the splitting points are collected as a list, -which is returned. - -If SEPARATORS is non-nil, it should be a regular expression -matching text which separates, but is not part of, the -substrings. If nil it defaults to `org-contacts-property-values-separators', -normally \"[,; \f\t\n\r\v]+\", and OMIT-NULLS is forced to t. - -If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so -that for the default value of SEPARATORS leading and trailing whitespace -are effectively trimmed). If nil, all zero-length substrings are retained." - (let* ((omit-nulls (if separators omit-nulls t)) - (rexp (or separators org-contacts-property-values-separators)) - (inputlist (split-string string rexp omit-nulls)) - (linkstring "") - (bufferstring "") - (proplist (list ""))) - (while inputlist - (setq bufferstring (pop inputlist)) - (if (string-match "\\[\\[" bufferstring) - (progn - (setq linkstring (concat bufferstring " ")) - (while (not (string-match "\\]\\]" bufferstring)) - (setq bufferstring (pop inputlist)) - (setq linkstring (concat linkstring bufferstring " "))) - (setq proplist (cons (org-trim linkstring) proplist))) - (setq proplist (cons bufferstring proplist)))) - (cdr (reverse proplist)))) - -;;; Add an Org link type `org-contact:' for easy jump to or searching org-contacts headline. -;;; link spec: [[org-contact:query][desc]] -(org-link-set-parameters "org-contact" - :follow 'org-contacts-link-open - :complete 'org-contacts-link-complete - :store 'org-contacts-link-store - :face 'org-contacts-link-face) - -(defun org-contacts-link-store () - "Store the contact in `org-contacts-files' with a link." - (when (and (eq major-mode 'org-mode) - (member (buffer-file-name) (mapcar 'expand-file-name org-contacts-files))) - (if (bound-and-true-p org-id-link-to-org-use-id) - (org-id-store-link) - (let ((headline-str (substring-no-properties (org-get-heading t t t t)))) - (org-store-link-props - :type "org-contact" - :link headline-str - :description headline-str) - (setq desc headline-str) - (setq link (concat "org-contact:" headline-str)) - (org-add-link-props :link link :description desc) - link)))) - -(defun org-contacts--all-contacts () - "Return an alist (name . (file . position)) of all contacts in `org-contacts-files'." - (car (mapcar - (lambda (file) - (unless (buffer-live-p (get-buffer (file-name-nondirectory file))) - (find-file file)) - (with-current-buffer (get-buffer (file-name-nondirectory file)) - (org-map-entries - (lambda () - (let ((name (substring-no-properties (org-get-heading t t t t))) - (file (buffer-file-name)) - (position (point))) - `(:name ,name :file ,file :position ,position)))))) - org-contacts-files))) - -(defun org-contacts-link-open (path) - "Open contacts: link type with jumping or searching." - (let ((query path)) - (cond - ;; /query/ format searching - ((string-match "/.*/" query) - (let* ((f (car org-contacts-files)) - (buf (get-buffer (file-name-nondirectory f)))) - (unless (buffer-live-p buf) (find-file f)) - (with-current-buffer buf - (string-match "/\\(.*\\)/" query) - (occur (match-string 1 query))))) - ;; jump to contact headline directly - (t - (let* ((f (car org-contacts-files)) - (buf (get-buffer (file-name-nondirectory f)))) - (unless (buffer-live-p buf) (find-file f)) - (with-current-buffer buf - (goto-char (marker-position (org-find-exact-headline-in-buffer query)))) - (display-buffer buf '(display-buffer-below-selected))) - ;; FIXME - ;; (let* ((contact-entry (plist-get (org-contacts--all-contacts) query)) - ;; (contact-name (plist-get contact-entry :name)) - ;; (file (plist-get contact-entry :file)) - ;; (position (plist-get contact-entry :position)) - ;; (buf (get-buffer (file-name-nondirectory file)))) - ;; (unless (buffer-live-p buf) (find-file file)) - ;; (with-current-buffer buf (goto-char position))) - )))) - -(defun org-contacts-link-complete (&optional arg) - "Create a org-contacts link using completion." - (let ((name (completing-read "org-contact Name: " - (mapcar - (lambda (plist) (plist-get plist :name)) - (org-contacts--all-contacts))))) - (concat "org-contact:" name))) - -(defun org-contacts-link-face (path) - "Different face color for different org-contacts link query." - (cond - ((string-match "/.*/" path) - '(:background "sky blue" :overline t :slant 'italic)) - (t '(:inherit 'org-link)))) - -(provide 'org-contacts) - -;;; org-contacts.el ends here diff --git a/lisp/org-contrib.el b/lisp/org-contrib.el index 46d5577..fd1398c 100644 --- a/lisp/org-contrib.el +++ b/lisp/org-contrib.el @@ -5,7 +5,7 @@ ;; 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.3 +;; Version: 0.4 ;; Keywords: org ;; SPDX-License-Identifier: GPL-3.0-or-later diff --git a/lisp/org-contribdir.el b/lisp/org-contribdir.el index cd22158..e643e25 100644 --- a/lisp/org-contribdir.el +++ b/lisp/org-contribdir.el @@ -3,7 +3,7 @@ ;; ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.01 ;; ;; This file is not part of GNU Emacs. diff --git a/lisp/org-depend.el b/lisp/org-depend.el index 8306184..1d6e7ec 100644 --- a/lisp/org-depend.el +++ b/lisp/org-depend.el @@ -3,7 +3,7 @@ ;; ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.08 ;; ;; This file is not part of GNU Emacs. @@ -281,13 +281,13 @@ This does two different kinds of triggers: (from-bottom items) ((or from-current no-wrap) (let* ((items (nreverse items)) - (pos (position this-item items :key #'first)) - (items-before (subseq items 0 pos)) - (items-after (subseq items pos))) + (pos (cl-position this-item items :key #'cl-first)) + (items-before (cl-subseq items 0 pos)) + (items-after (cl-subseq items pos))) (if no-wrap items-after (append items-after items-before)))) (t (nreverse items)))) - (setq items (remove-if + (setq items (cl-remove-if (lambda (item) (or (equal (first item) this-item) (and (not todo-and-done-only) diff --git a/lisp/org-effectiveness.el b/lisp/org-effectiveness.el index dad56c7..1b2575a 100644 --- a/lisp/org-effectiveness.el +++ b/lisp/org-effectiveness.el @@ -4,7 +4,7 @@ ;; Author: David Arroyo Menéndez <davidam@es.gnu.org> ;; Keywords: effectiveness, plot -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; ;; This file is not part of GNU Emacs. ;; diff --git a/lisp/org-eldoc.el b/lisp/org-eldoc.el index e662b50..5b4f66d 100644 --- a/lisp/org-eldoc.el +++ b/lisp/org-eldoc.el @@ -6,7 +6,7 @@ ;; Maintainer: Łukasz Gruner <lukasz@gruner.lu> ;; Version: 6 ;; Package-Requires: ((org "8")) -;; Homepage: https://bitbucket.org/ukaszg/org-eldoc +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Created: 25/05/2014 ;; Keywords: eldoc, outline, breadcrumb, org, babel, minibuffer @@ -81,11 +81,13 @@ ": " (mapconcat (lambda (elem) - (when (and (cdr elem) (not (string= "" (cdr 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 (cdr elem) 'face 'org-verbatim) + (propertize val 'face 'org-verbatim) " "))) hdr-args " "))))))) @@ -141,40 +143,46 @@ (org-eldoc-get-breadcrumb) (org-eldoc-get-src-header) (let ((lang (org-eldoc-get-src-lang))) - (cond ((or - (string= lang "emacs-lisp") - (string= lang "elisp")) - (cond ((and (boundp 'eldoc-documentation-functions) ; Emacs>=28 - (fboundp 'elisp-eldoc-var-docstring) - (fboundp 'elisp-eldoc-funcall)) - (let ((eldoc-documentation-functions - '(elisp-eldoc-var-docstring elisp-eldoc-funcall))) - (eldoc-print-current-symbol-info))) - ((fboundp 'elisp-eldoc-documentation-function) - (elisp-eldoc-documentation-function)) - (t ; Emacs<25 - (let (eldoc-documentation-function) - (eldoc-print-current-symbol-info))))) - ((or - (string= lang "c") ;; https://github.com/nflath/c-eldoc - (string= lang "C")) (when (require 'c-eldoc nil t) - (c-eldoc-print-current-symbol-info))) - ;; https://github.com/zenozeng/css-eldoc - ((string= lang "css") (when (require 'css-eldoc nil t) - (css-eldoc-function))) - ;; https://github.com/zenozeng/php-eldoc - ((string= lang "php") (when (require 'php-eldoc nil t) - (php-eldoc-function))) - ((or - (string= lang "go") - (string= lang "golang")) (when (require 'go-eldoc nil t) - (go-eldoc--documentation-function))) - (t (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang)) - (callback (car args))) - (when (functionp doc-fun) - (if (functionp callback) - (funcall doc-fun callback) - (funcall doc-fun))))))))) + (cond + ((string= lang "org") ;Prevent inf-loop for Org src blocks + nil) + ((or + (string= lang "emacs-lisp") + (string= lang "elisp")) + (cond ((and (boundp 'eldoc-documentation-functions) ; Emacs>=28 + (fboundp 'elisp-eldoc-var-docstring) + (fboundp 'elisp-eldoc-funcall)) + (let ((eldoc-documentation-functions + '(elisp-eldoc-var-docstring elisp-eldoc-funcall))) + (eldoc-print-current-symbol-info))) + ((fboundp 'elisp-eldoc-documentation-function) + (elisp-eldoc-documentation-function)) + (t ; Emacs<25 + (let (eldoc-documentation-function) + (eldoc-print-current-symbol-info))))) + ((or + (string= lang "c") ;; https://github.com/nflath/c-eldoc + (string= lang "C")) + (when (require 'c-eldoc nil t) + (c-eldoc-print-current-symbol-info))) + ;; https://github.com/zenozeng/css-eldoc + ((string= lang "css") (when (require 'css-eldoc nil t) + (css-eldoc-function))) + ;; https://github.com/zenozeng/php-eldoc + ((string= lang "php") (when (require 'php-eldoc nil t) + (php-eldoc-function))) + ((or + (string= lang "go") + (string= lang "golang")) + (when (require 'go-eldoc nil t) + (go-eldoc--documentation-function))) + (t + (let ((doc-fun (org-eldoc-get-mode-local-documentation-function lang)) + (callback (car args))) + (when (functionp doc-fun) + (if (functionp callback) + (funcall doc-fun callback) + (funcall doc-fun))))))))) ;;;###autoload (defun org-eldoc-load () diff --git a/lisp/org-eval-light.el b/lisp/org-eval-light.el index 7f13557..f079c35 100644 --- a/lisp/org-eval-light.el +++ b/lisp/org-eval-light.el @@ -6,7 +6,7 @@ ;; Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp, literate programming, ;; reproducible research -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.04 ;; This file is not part of GNU Emacs. diff --git a/lisp/org-eval.el b/lisp/org-eval.el index f11443c..3acb732 100644 --- a/lisp/org-eval.el +++ b/lisp/org-eval.el @@ -3,7 +3,7 @@ ;; ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.04 ;; ;; This file is not part of GNU Emacs. diff --git a/lisp/org-learn.el b/lisp/org-learn.el index 897216d..8de2a6f 100644 --- a/lisp/org-learn.el +++ b/lisp/org-learn.el @@ -4,7 +4,7 @@ ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 6.32trans ;; ;; This file is not part of GNU Emacs. diff --git a/lisp/org-license.el b/lisp/org-license.el index 0c3ed6d..58be6a4 100644 --- a/lisp/org-license.el +++ b/lisp/org-license.el @@ -4,7 +4,7 @@ ;; Author: David Arroyo Menéndez <davidam@es.gnu.org> ;; Keywords: licenses, creative commons -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; ;; This file is not part of GNU Emacs. ;; diff --git a/lisp/org-link-edit.el b/lisp/org-link-edit.el deleted file mode 100644 index 9369dd7..0000000 --- a/lisp/org-link-edit.el +++ /dev/null @@ -1,392 +0,0 @@ -;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*- - -;; Copyright (C) 2015-2021 Kyle Meyer <kyle@kyleam.com> - -;; Author: Kyle Meyer <kyle@kyleam.com> -;; Homepage: https://git.kyleam.com/org-link-edit/about -;; Keywords: convenience -;; Version: 1.2.1 -;; Package-Requires: ((cl-lib "0.5") (org "9.3")) - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Org Link Edit provides Paredit-inspired slurping and barfing -;; commands for Org link descriptions. -;; -;; There are four slurp and barf commands, all which operate when -;; point is on an Org link. -;; -;; - org-link-edit-forward-slurp -;; - org-link-edit-backward-slurp -;; - org-link-edit-forward-barf -;; - org-link-edit-backward-barf -;; -;; Org Link Edit doesn't bind these commands to any keys. Finding -;; good keys for these commands is difficult because, while it's -;; convenient to be able to quickly repeat these commands, they won't -;; be used frequently enough to be worthy of a short, repeat-friendly -;; binding. Using Hydra [1] provides a nice solution to this. After -;; an initial key sequence, any of the commands will be repeatable -;; with a single key. (Plus, you get a nice interface that displays -;; the key for each command.) Below is one example of how you could -;; configure this. -;; -;; (define-key org-mode-map YOUR-KEY -;; (defhydra hydra-org-link-edit () -;; "Org Link Edit" -;; ("j" org-link-edit-forward-slurp "forward slurp") -;; ("k" org-link-edit-forward-barf "forward barf") -;; ("u" org-link-edit-backward-slurp "backward slurp") -;; ("i" org-link-edit-backward-barf "backward barf") -;; ("q" nil "cancel"))) -;; -;; In addition to the slurp and barf commands, the command -;; `org-link-edit-transport-next-link' searches for the next (or -;; previous) link and moves it to point, using the word at point or -;; the selected region as the link's description. -;; -;; [1] https://github.com/abo-abo/hydra - -;;; Code: - -(require 'org) -(require 'org-element) -(require 'cl-lib) - -(defun org-link-edit--on-link-p (&optional element) - (org-element-lineage (or element (org-element-context)) '(link) t)) - -(defun org-link-edit--link-data () - "Return list with information about the link at point. -The list includes -- the position at the start of the link -- the position at the end of the link -- the link text -- the link description (nil when on a plain link)" - (let ((el (org-element-context))) - (unless (org-link-edit--on-link-p el) - (user-error "Point is not on a link")) - (save-excursion - (goto-char (org-element-property :begin el)) - (cond - ;; Use match-{beginning,end} because match-end is consistently - ;; positioned after ]], while the :end property is positioned - ;; at the next word on the line, if one is present. - ((looking-at org-link-bracket-re) - (list (match-beginning 0) - (match-end 0) - (save-match-data - (org-link-unescape (match-string-no-properties 1))) - (or (match-string-no-properties 2) ""))) - ((looking-at org-link-plain-re) - (list (match-beginning 0) - (match-end 0) - (match-string-no-properties 0) - nil)) - (t - (error "What am I looking at?")))))) - -(defun org-link-edit--forward-blob (n &optional no-punctuation) - "Move forward N blobs (backward if N is negative). - -A block of non-whitespace characters is a blob. If -NO-PUNCTUATION is non-nil, trailing punctuation characters are -not considered part of the blob when going in the forward -direction. - -If the edge of the buffer is reached before completing the -movement, return nil. Otherwise, return t." - (let* ((forward-p (> n 0)) - (nblobs (abs n)) - (skip-func (if forward-p 'skip-syntax-forward 'skip-syntax-backward)) - skip-func-retval) - (while (/= nblobs 0) - (funcall skip-func " ") - (setq skip-func-retval (funcall skip-func "^ ")) - (setq nblobs (1- nblobs))) - (when (and forward-p no-punctuation) - (let ((punc-tail-offset (save-excursion (skip-syntax-backward ".")))) - ;; Don't consider trailing punctuation as part of the blob - ;; unless the whole blob consists of punctuation. - (unless (= skip-func-retval (- punc-tail-offset)) - (goto-char (+ (point) punc-tail-offset))))) - (/= skip-func-retval 0))) - -;;;###autoload -(defun org-link-edit-forward-slurp (&optional n) - "Slurp N trailing blobs into link's description. - - The \[\[https://orgmode.org/\]\[Org mode\]\] site - - | - v - - The \[\[https://orgmode.org/\]\[Org mode site\]\] - -A blob is a block of non-whitespace characters. When slurping -forward, trailing punctuation characters are not considered part -of a blob. - -After slurping, return the slurped text and move point to the -beginning of the link. - -If N is negative, slurp leading blobs instead of trailing blobs." - (interactive "p") - (setq n (or n 1)) - (cond - ((= n 0)) - ((< n 0) - (org-link-edit-backward-slurp (- n))) - (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) - (goto-char (save-excursion - (goto-char end) - (or (org-link-edit--forward-blob n 'no-punctuation) - (user-error "Not enough blobs after the link")) - (point))) - (let ((slurped (buffer-substring-no-properties end (point)))) - (setq slurped (replace-regexp-in-string "\n+" " " slurped)) - (when (and (= (length desc) 0) - (string-match "^\\s-+\\(.*\\)" slurped)) - (setq slurped (match-string 1 slurped))) - (setq desc (concat desc slurped) - end (+ end (length slurped))) - (delete-region beg (point)) - (insert (org-link-make-string link desc)) - (goto-char beg) - slurped))))) - -;;;###autoload -(defun org-link-edit-backward-slurp (&optional n) - "Slurp N leading blobs into link's description. - - The \[\[https://orgmode.org/\]\[Org mode\]\] site - - | - v - - \[\[https://orgmode.org/\]\[The Org mode\]\] site - -A blob is a block of non-whitespace characters. - -After slurping, return the slurped text and move point to the -beginning of the link. - -If N is negative, slurp trailing blobs instead of leading blobs." - (interactive "p") - (setq n (or n 1)) - (cond - ((= n 0)) - ((< n 0) - (org-link-edit-forward-slurp (- n))) - (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) - (goto-char (save-excursion - (goto-char beg) - (or (org-link-edit--forward-blob (- n)) - (user-error "Not enough blobs before the link")) - (point))) - (let ((slurped (buffer-substring-no-properties (point) beg))) - (when (and (= (length desc) 0) - (string-match "\\(.*\\)\\s-+$" slurped)) - (setq slurped (match-string 1 slurped))) - (setq slurped (replace-regexp-in-string "\n+" " " slurped)) - (setq desc (concat slurped desc) - beg (- beg (length slurped))) - (delete-region (point) end) - (insert (org-link-make-string link desc)) - (goto-char beg) - slurped))))) - -(defun org-link-edit--split-first-blobs (string n) - "Split STRING into (N first blobs . other) cons cell. -'N first blobs' contains all text from the start of STRING up to -the start of the N+1 blob. 'other' includes the remaining text -of STRING. If the number of blobs in STRING is fewer than N, -'other' is nil." - (when (< n 0) (user-error "N cannot be negative")) - (with-temp-buffer - (insert string) - (goto-char (point-min)) - (with-syntax-table org-mode-syntax-table - (let ((within-bound (org-link-edit--forward-blob n))) - (skip-syntax-forward " ") - (cons (buffer-substring 1 (point)) - (and within-bound - (buffer-substring (point) (point-max)))))))) - -(defun org-link-edit--split-last-blobs (string n) - "Split STRING into (other . N last blobs) cons cell. -'N last blobs' contains all text from the end of STRING back to -the end of the N+1 last blob. 'other' includes the remaining -text of STRING. If the number of blobs in STRING is fewer than -N, 'other' is nil." - (when (< n 0) (user-error "N cannot be negative")) - (with-temp-buffer - (insert string) - (goto-char (point-max)) - (with-syntax-table org-mode-syntax-table - (let ((within-bound (org-link-edit--forward-blob (- n)))) - (skip-syntax-backward " ") - (cons (and within-bound - (buffer-substring 1 (point))) - (buffer-substring (point) (point-max))))))) - -;;;###autoload -(defun org-link-edit-forward-barf (&optional n) - "Barf N trailing blobs from link's description. - - The \[\[https://orgmode.org/\]\[Org mode\]\] site - - | - v - - The \[\[https://orgmode.org/\]\[Org\]\] mode site - -A blob is a block of non-whitespace characters. - -After barfing, return the barfed text and move point to the -beginning of the link. - -If N is negative, barf leading blobs instead of trailing blobs." - (interactive "p") - (setq n (or n 1)) - (cond - ((= n 0)) - ((< n 0) - (org-link-edit-backward-barf (- n))) - (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) - (when (= (length desc) 0) - (user-error "Link has no description")) - (pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs - desc n))) - (unless new-desc (user-error "Not enough blobs in description")) - (goto-char beg) - (delete-region beg end) - (insert (org-link-make-string link new-desc)) - (when (string= new-desc "") - (setq barfed (concat " " barfed))) - (insert barfed) - (goto-char beg) - barfed))))) - -;;;###autoload -(defun org-link-edit-backward-barf (&optional n) - "Barf N leading blobs from link's description. - - The \[\[https://orgmode.org/\]\[Org mode\]\] site - - | - v - - The Org \[\[https://orgmode.org/\]\[mode\]\] site - -A blob is a block of non-whitespace characters. - -After barfing, return the barfed text and move point to the -beginning of the link. - -If N is negative, barf trailing blobs instead of leading blobs." - (interactive "p") - (setq n (or n 1)) - (cond - ((= n 0)) - ((< n 0) - (org-link-edit-forward-barf (- n))) - (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) - (when (= (length desc) 0) - (user-error "Link has no description")) - (pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs - desc n))) - (unless new-desc (user-error "Not enough blobs in description")) - (goto-char beg) - (delete-region beg end) - (insert (org-link-make-string link new-desc)) - (when (string= new-desc "") - (setq barfed (concat barfed " "))) - (goto-char beg) - (insert barfed) - barfed))))) - -(defun org-link-edit--next-link-data (&optional previous) - (save-excursion - (if (funcall (if previous #'re-search-backward #'re-search-forward) - org-link-any-re nil t) - (org-link-edit--link-data) - (user-error "No %s link found" (if previous "previous" "next"))))) - -;;;###autoload -(defun org-link-edit-transport-next-link (&optional previous beg end overwrite) - "Move the next link to point. - -If the region is active, use the selected text as the link's -description. Otherwise, use the word at point. - -With prefix argument PREVIOUS, move the previous link instead of -the next link. - -Non-interactively, use the text between BEG and END as the -description, moving the next (or previous) link relative to BEG -and END. By default, refuse to overwrite an existing -description. If OVERWRITE is `ask', prompt for confirmation -before overwriting; for any other non-nil value, overwrite -without asking." - (interactive `(,current-prefix-arg - ,@(if (use-region-p) - (list (region-beginning) (region-end)) - (list nil nil)) - ask)) - (let ((pt (point)) - (desc-bounds (cond - ((and beg end) - (cons (progn (goto-char beg) - (point-marker)) - (progn (goto-char end) - (point-marker)))) - ((not (looking-at-p "\\s-")) - (progn (skip-syntax-backward "w") - (let ((beg (point-marker))) - (skip-syntax-forward "w") - (cons beg (point-marker)))))))) - (when (or (and desc-bounds - (or (progn (goto-char (car desc-bounds)) - (org-link-edit--on-link-p)) - (progn (goto-char (cdr desc-bounds)) - (org-link-edit--on-link-p)))) - (progn (goto-char pt) - (org-link-edit--on-link-p))) - (user-error "Cannot transport next link with point on a link")) - (goto-char (or (car desc-bounds) pt)) - (cl-multiple-value-bind (link-beg link-end link orig-desc) - (org-link-edit--next-link-data previous) - (unless (or (not desc-bounds) - (= (length orig-desc) 0) - (if (eq overwrite 'ask) - (y-or-n-p "Overwrite existing description?") - overwrite)) - (user-error "Link already has a description")) - (delete-region link-beg link-end) - (insert (org-link-make-string - link - (if desc-bounds - (delete-and-extract-region (car desc-bounds) - (cdr desc-bounds)) - orig-desc)))))) - -(provide 'org-link-edit) -;;; org-link-edit.el ends here diff --git a/lisp/org-mac-link.el b/lisp/org-mac-link.el deleted file mode 100644 index 68be823..0000000 --- a/lisp/org-mac-link.el +++ /dev/null @@ -1,1074 +0,0 @@ -;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac apps -;; -;; Copyright (c) 2010-2021 Free Software Foundation, Inc. -;; -;; Author: Anthony Lander <anthony.lander@gmail.com> -;; John Wiegley <johnw@gnu.org> -;; Christopher Suckling <suckling at gmail dot com> -;; Daniil Frumin <difrumin@gmail.com> -;; Alan Schmitt <alan.schmitt@polytechnique.org> -;; Mike McLean <mike.mclean@pobox.com> -;; Maintainer: Aimé Bertrand <aime.bertrand@macowners.club> -;; Homepage: https://gitlab.com/aimebertrand/org-mac-link -;; -;; 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/>. -;; -;; Version: 1.1 -;; Keywords: org, mac, hyperlink -;; -;; Version: 1.2 -;; Keywords: outlook -;; Author: Mike McLean <mike.mclean@pobox.com> -;; Add support for Microsoft Outlook for Mac as Org mode links -;; -;; Version: 1.3 -;; Author: Alan Schmitt <alan.schmitt@polytechnique.org> -;; Consistently use `org-mac-paste-applescript-links' -;; -;; Version 1.4 -;; Author: Mike McLean <mike.mclean@pobox.com> -;; Make the path to Microsoft Outlook a `defcustom' -;; -;; Version 1.5 -;; Author: Mike McLean <mike.mclean@pobox.com> -;; Add Support for Evernote -;; -;;; Commentary: -;; -;; This code allows you to grab either the current selected items, or -;; the frontmost url in various mac appliations, and insert them as -;; hyperlinks into the current org-mode document at point. -;; -;; This code is heavily based on, and indeed incorporates, -;; org-mac-message.el written by John Wiegley and Christopher -;; Suckling. -;; -;; Detailed comments for each application interface are inlined with -;; the code. Here is a brief overview of how the code interacts with -;; each application: -;; -;; Finder.app - grab links to the selected files in the frontmost window -;; Mail.app - grab links to the selected messages in the message list -;; AddressBook.app - Grab links to the selected addressbook Cards -;; Firefox.app - Grab the url of the frontmost tab in the frontmost window -;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window -;; Safari.app - Grab the url of the frontmost tab in the frontmost window -;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window -;; Brave.app - Grab the url of the frontmost tab in the frontmost window -;; Together.app - Grab links to the selected items in the library list -;; Skim.app - Grab a link to the selected page in the topmost pdf document -;; Microsoft Outlook.app - Grab a link to the selected message in the message list -;; DEVONthink Pro Office.app - Grab a link to the selected DEVONthink item(s); open DEVONthink item by reference -;; Evernote.app - Grab a link to the selected Evernote item(s); open Evernote item by ID -;; -;; -;; Installation: -;; -;; add (require 'org-mac-link) to your .emacs, and optionally bind a -;; key to activate the link grabber menu, like this: -;; -;; (add-hook 'org-mode-hook (lambda () -;; (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link))) -;; -;; Usage: -;; -;; Type C-c g (or whatever key you defined, as above), or type M-x -;; org-mac-grab-link RET to activate the link grabber. This will present -;; you with a menu to choose an application from which to grab a link -;; to insert at point. You may also type C-g to abort. -;; -;; Customizing: -;; -;; You may customize which applications appear in the grab menu by -;; customizing the group `org-mac-link'. Changes take effect -;; immediately. -;; -;; -;;; Code: - -(require 'org) - -(defgroup org-mac-link nil - "Options for grabbing links from Mac applications." - :tag "Org Mac link" - :group 'org-link) - -(defcustom org-mac-grab-Finder-app-p t - "Add menu option [F]inder to grab links from the Finder." - :tag "Grab Finder.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Mail-app-p t - "Add menu option [m]ail to grab links from Mail.app." - :tag "Grab Mail.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Outlook-app-p t - "Add menu option [o]utlook to grab links from Microsoft Outlook.app." - :tag "Grab Microsoft Outlook.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-outlook-path "/Applications/Microsoft Outlook.app" - "The path to the installed copy of Microsoft Outlook.app. Do not escape spaces as the AppleScript call will quote this string." - :tag "Path to Microsoft Outlook" - :group 'org-mac-link - :type 'string) - -(defcustom org-mac-grab-devonthink-app-p t - "Add menu option [d]EVONthink to grab links from DEVONthink Pro Office.app." - :tag "Grab DEVONthink Pro Office.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Addressbook-app-p t - "Add menu option [a]ddressbook to grab links from AddressBook.app." - :tag "Grab AddressBook.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Safari-app-p t - "Add menu option [s]afari to grab links from Safari.app." - :tag "Grab Safari.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Firefox-app-p t - "Add menu option [f]irefox to grab links from Firefox.app." - :tag "Grab Firefox.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Firefox+Vimperator-p nil - "Add menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin." - :tag "Grab Vimperator/Firefox.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Chrome-app-p t - "Add menu option [c]hrome to grab links from Google Chrome.app." - :tag "Grab Google Chrome.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Brave-app-p t - "Add menu option [b]rave to grab links from Brave.app." - :tag "Grab Brave.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Together-app-p nil - "Add menu option [t]ogether to grab links from Together.app." - :tag "Grab Together.app links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Skim-app-p - (< 0 (length (shell-command-to-string - "mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'"))) - "Add menu option [S]kim to grab page links from Skim.app." - :tag "Grab Skim.app page links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-Skim-highlight-selection-p nil - "Highlight the active selection when grabbing a link from Skim.app." - :tag "Highlight selection in Skim.app" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-grab-Acrobat-app-p t - "Add menu option [A]crobat to grab page links from Acrobat.app." - :tag "Grab Acrobat.app page links" - :group 'org-mac-link - :type 'boolean) - -(defgroup org-mac-flagged-mail nil - "Options foring linking to flagged Mail.app messages." - :tag "Org Mail.app" - :group 'org-link) - -(defcustom org-mac-mail-account nil - "The Mail.app account in which to search for flagged messages." - :group 'org-mac-flagged-mail - :type 'string) - -(defcustom org-mac-grab-Evernote-app-p nil - "Add menu option [e]vernote to grab note links from Evernote.app." - :tag "Grab Evernote.app note links" - :group 'org-mac-link - :type 'boolean) - -(defcustom org-mac-evernote-path nil - "The path to the installed copy of Evernote.app. Do not escape spaces as the AppleScript call will quote this string." - :tag "Path to Evernote" - :group 'org-mac-link - :type 'string) - -(defcustom org-mac-grab-qutebrowser-app-p t - "Add menu option [q]utebrowser to grab links from qutebrowser.app." - :tag "Grab qutebrowser.app links" - :group 'org-mac-link - :type 'boolean) - - -;; In mac.c, removed in Emacs 23. -(declare-function do-applescript "org-mac-message" (script)) -(unless (fboundp 'do-applescript) - ;; Need to fake this using shell-command-to-string - (defun do-applescript (script) - (let (start cmd return) - (while (string-match "\n" script) - (setq script (replace-match "\r" t t script))) - (while (string-match "'" script start) - (setq start (+ 2 (match-beginning 0)) - script (replace-match "\\'" t t script))) - (setq cmd (concat "osascript -e '" script "'")) - (setq return (shell-command-to-string cmd)) - (concat "\"" (org-trim return) "\"")))) - -;;;###autoload -(defun org-mac-grab-link () - "Prompt for an application to grab a link from. -When done, go grab the link, and insert it at point." - (interactive) - (let* ((descriptors - `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p) - ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p) - ("d" "EVONthink Pro Office" org-mac-devonthink-item-insert-selected - ,org-mac-grab-devonthink-app-p) - ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p) - ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p) - ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p) - ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p) - ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p) - ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p) - ("b" "rave" org-mac-brave-insert-frontmost-url ,org-mac-grab-Brave-app-p) - ("e" "evernote" org-mac-evernote-note-insert-selected ,org-mac-grab-Evernote-app-p) - ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p) - ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p) - ("A" "crobat" org-mac-acrobat-insert-page ,org-mac-grab-Acrobat-app-p) - ("q" "utebrowser" org-mac-qutebrowser-insert-frontmost-url ,org-mac-grab-qutebrowser-app-p))) - (menu-string (make-string 0 ?x)) - input) - - ;; Create the menu string for the keymap - (mapc (lambda (descriptor) - (when (elt descriptor 3) - (setf menu-string (concat menu-string - "[" (elt descriptor 0) "]" - (elt descriptor 1) " ")))) - descriptors) - (setf (elt menu-string (- (length menu-string) 1)) ?:) - - ;; Prompt the user, and grab the link - (message menu-string) - (setq input (read-char-exclusive)) - (mapc (lambda (descriptor) - (let ((key (elt (elt descriptor 0) 0)) - (active (elt descriptor 3)) - (grab-function (elt descriptor 2))) - (when (and active (eq input key)) - (call-interactively grab-function)))) - descriptors))) - -(defun org-mac-paste-applescript-links (as-link-list) - "Paste in a list of links from an applescript handler. -The links are of the form <link>::split::<name>." - (let* ((noquote-as-link-list - (if (string-prefix-p "\"" as-link-list) - (substring as-link-list 1 -1) - as-link-list)) - (link-list - (mapcar (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) - (setq x (match-string 1 x))) - x) - (split-string noquote-as-link-list "[\r\n]+"))) - split-link URL description orglink orglink-insert rtn orglink-list) - (while link-list - (setq split-link (split-string (pop link-list) "::split::")) - (setq URL (car split-link)) - (setq description (cadr split-link)) - (when (not (string= URL "")) - (setq orglink (org-make-link-string URL description)) - (push orglink orglink-list))) - (setq rtn (mapconcat 'identity orglink-list "\n")) - (kill-new rtn) - rtn)) - - -;; Handle links from Firefox.app -;; -;; This code allows you to grab the current active url from the main -;; Firefox.app window, and insert it as a link into an org-mode -;; document. Unfortunately, firefox does not expose an applescript -;; dictionary, so this is necessarily introduces some limitations. -;; -;; The applescript to grab the url from Firefox.app uses the System -;; Events application to give focus to the firefox application, select -;; the contents of the url bar, and copy it. It then uses the title of -;; the window as the text of the link. There is no way to grab links -;; from other open tabs, and further, if there is more than one window -;; open, it is not clear which one will be used (though emperically it -;; seems that it is always the last active window). - -(defun org-as-mac-firefox-get-frontmost-url () - (let ((result - (do-applescript - (concat - "set oldClipboard to the clipboard\n" - "set frontmostApplication to path to frontmost application\n" - "tell application \"Firefox\"\n" - " activate\n" - " delay 0.15\n" - " tell application \"System Events\"\n" - " keystroke \"l\" using {command down}\n" - " keystroke \"a\" using {command down}\n" - " keystroke \"c\" using {command down}\n" - " end tell\n" - " delay 0.15\n" - " set theUrl to the clipboard\n" - " set the clipboard to oldClipboard\n" - " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" - "end tell\n" - "activate application (frontmostApplication as text)\n" - "set links to {}\n" - "copy theResult to the end of links\n" - "return links as string\n")))) - (car (split-string result "[\r\n]+" t)))) - -;;;###autoload -(defun org-mac-firefox-get-frontmost-url () - (interactive) - (message "Applescript: Getting Firefox url...") - (org-mac-paste-applescript-links (org-as-mac-firefox-get-frontmost-url))) - -;;;###autoload -(defun org-mac-firefox-insert-frontmost-url () - (interactive) - (insert (org-mac-firefox-get-frontmost-url))) - - -;; Handle links from Google Firefox.app running the Vimperator extension -;; Grab the frontmost url from Firefox+Vimperator. Same limitations are -;; Firefox - -(defun org-as-mac-vimperator-get-frontmost-url () - (let ((result - (do-applescript - (concat - "set oldClipboard to the clipboard\n" - "set frontmostApplication to path to frontmost application\n" - "tell application \"Firefox\"\n" - " activate\n" - " delay 0.15\n" - " tell application \"System Events\"\n" - " keystroke \"y\"\n" - " end tell\n" - " delay 0.15\n" - " set theUrl to the clipboard\n" - " set the clipboard to oldClipboard\n" - " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" - "end tell\n" - "activate application (frontmostApplication as text)\n" - "set links to {}\n" - "copy theResult to the end of links\n" - "return links as string\n")))) - (replace-regexp-in-string - "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t))))) - -;;;###autoload -(defun org-mac-vimperator-get-frontmost-url () - (interactive) - (message "Applescript: Getting Vimperator url...") - (org-mac-paste-applescript-links (org-as-mac-vimperator-get-frontmost-url))) - -;;;###autoload -(defun org-mac-vimperator-insert-frontmost-url () - (interactive) - (insert (org-mac-vimperator-get-frontmost-url))) - - -;; Handle links from Google Chrome.app -;; Grab the frontmost url from Google Chrome. Same limitations as -;; Firefox because Chrome doesn't publish an Applescript dictionary - -(defun org-as-mac-chrome-get-frontmost-url () - (let ((result - (do-applescript - (concat - "set frontmostApplication to path to frontmost application\n" - "tell application \"Google Chrome\"\n" - " set theUrl to get URL of active tab of first window\n" - " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" - "end tell\n" - "activate application (frontmostApplication as text)\n" - "set links to {}\n" - "copy theResult to the end of links\n" - "return links as string\n")))) - (replace-regexp-in-string - "^\"\\|\"$" "" (car (split-string result "[\r\n]+" t))))) - -;;;###autoload -(defun org-mac-chrome-get-frontmost-url () - (interactive) - (message "Applescript: Getting Chrome url...") - (org-mac-paste-applescript-links (org-as-mac-chrome-get-frontmost-url))) - -;;;###autoload -(defun org-mac-chrome-insert-frontmost-url () - (interactive) - (insert (org-mac-chrome-get-frontmost-url))) - - -;; Handle links from Brave.app -;; Grab the frontmost url from Brave. Same limitations as -;; Firefox/Chrome because Brave doesn't publish an Applescript -;; dictionary - -(defun org-as-mac-brave-get-frontmost-url () - (let ((result - (do-applescript - (concat - "set frontmostApplication to path to frontmost application\n" - "tell application \"Brave\"\n" - " set theUrl to get URL of active tab of first window\n" - " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n" - "end tell\n" - "activate application (frontmostApplication as text)\n" - "set links to {}\n" - "copy theResult to the end of links\n" - "return links as string\n")))) - (replace-regexp-in-string - "^\"\\|\"$" "" (car (split-string result "[\r\n]+" t))))) - -;;;###autoload -(defun org-mac-brave-get-frontmost-url () - (interactive) - (message "Applescript: Getting Brave url...") - (org-mac-paste-applescript-links (org-as-mac-brave-get-frontmost-url))) - -;;;###autoload -(defun org-mac-brave-insert-frontmost-url () - (interactive) - (insert (org-mac-brave-get-frontmost-url))) - - -;; Handle links from Safari.app -;; Grab the frontmost url from Safari. - -(defun org-as-mac-safari-get-frontmost-url () - (do-applescript - (concat - "tell application \"Safari\"\n" - " set theUrl to URL of document 1\n" - " set theName to the name of the document 1\n" - " return theUrl & \"::split::\" & theName & \"\n\"\n" - "end tell\n"))) - -;;;###autoload -(defun org-mac-safari-get-frontmost-url () - (interactive) - (message "Applescript: Getting Safari url...") - (org-mac-paste-applescript-links - (org-as-mac-safari-get-frontmost-url))) - -;;;###autoload -(defun org-mac-safari-insert-frontmost-url () - (interactive) - (insert (org-mac-safari-get-frontmost-url))) - - -;; Handle links from together.app -(org-link-set-parameters "x-together-item" :follow #'org-mac-together-item-open) - -(defun org-mac-together-item-open (uid _) - "Open UID, which is a reference to an item in Together." - (shell-command (concat "open -a Together \"x-together-item:" uid "\""))) - -(defun as-get-selected-together-items () - (do-applescript - (concat - "tell application \"Together\"\n" - " set theLinkList to {}\n" - " set theSelection to selected items\n" - " repeat with theItem in theSelection\n" - " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n" - " copy theLink to end of theLinkList\n" - " end repeat\n" - " return theLinkList as string\n" - "end tell"))) - -;;;###autoload -(defun org-mac-together-get-selected () - (interactive) - (message "Applescript: Getting Together items...") - (org-mac-paste-applescript-links (as-get-selected-together-items))) - -;;;###autoload -(defun org-mac-together-insert-selected () - (interactive) - (insert (org-mac-together-get-selected))) - - -;; Handle links from Finder.app - -(defun as-get-selected-finder-items () - (do-applescript - (concat - "tell application \"Finder\"\n" - " set theSelection to the selection\n" - " set links to {}\n" - " repeat with theItem in theSelection\n" - " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n" - " copy theLink to the end of links\n" - " end repeat\n" - " return links as string\n" - "end tell\n"))) - -;;;###autoload -(defun org-mac-finder-item-get-selected () - (interactive) - (message "Applescript: Getting Finder items...") - (org-mac-paste-applescript-links (as-get-selected-finder-items))) - -;;;###autoload -(defun org-mac-finder-insert-selected () - (interactive) - (insert (org-mac-finder-item-get-selected))) - - -;; Handle links from AddressBook.app -(org-link-set-parameters "addressbook" :follow #'org-mac-addressbook-item-open) - -(defun org-mac-addressbook-item-open (uid _) - "Open UID, which is a reference to an item in the addressbook." - (shell-command (concat "open \"addressbook:" uid "\""))) - -(defun as-get-selected-addressbook-items () - (do-applescript - (concat - "tell application \"Address Book\"\n" - " set theSelection to the selection\n" - " set links to {}\n" - " repeat with theItem in theSelection\n" - " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n" - " copy theLink to the end of links\n" - " end repeat\n" - " return links as string\n" - "end tell\n"))) - -;;;###autoload -(defun org-mac-addressbook-item-get-selected () - (interactive) - (message "Applescript: Getting Address Book items...") - (org-mac-paste-applescript-links (as-get-selected-addressbook-items))) - -;;;###autoload -(defun org-mac-addressbook-insert-selected () - (interactive) - (insert (org-mac-addressbook-item-get-selected))) - - -;; Handle links from Skim.app -;; -;; Original code & idea by Christopher Suckling (org-mac-protocol) - -(org-link-set-parameters "skim" :follow #'org-mac-skim-open) - -(defun org-mac-skim-open (uri _) - "Visit page of pdf in Skim" - (let* ((page (when (string-match "::\\(.+\\)\\'" uri) - (match-string 1 uri))) - (document (substring uri 0 (match-beginning 0)))) - (do-applescript - (concat - "tell application \"Skim\"\n" - "activate\n" - "set theDoc to \"" document "\"\n" - "set thePage to " page "\n" - "open theDoc\n" - "go document 1 to page thePage of document 1\n" - "end tell")))) - -(defun as-get-skim-page-link () - (do-applescript - (concat - "tell application \"Skim\"\n" - "set theDoc to front document\n" - "set theTitle to (name of theDoc)\n" - "set thePath to (path of theDoc)\n" - "set thePage to (get index for current page of theDoc)\n" - "set theSelection to selection of theDoc\n" - "set theContent to contents of (get text for theSelection)\n" - "if theContent is missing value then\n" - " set theContent to theTitle & \", p. \" & thePage\n" - (when org-mac-Skim-highlight-selection-p - (concat - "else\n" - " tell theDoc\n" - " set theNote to make note with properties {type:highlight note, selection:theSelection}\n" - " set text of theNote to (get text for theSelection)\n" - " end tell\n")) - "end if\n" - "set theLink to \"skim://\" & thePath & \"::\" & thePage & " - "\"::split::\" & theContent\n" - "end tell\n" - "return theLink as string\n"))) - -;;;###autoload -(defun org-mac-skim-get-page () - (interactive) - (message "Applescript: Getting Skim page link...") - (org-mac-paste-applescript-links (as-get-skim-page-link))) - -;;;###autoload -(defun org-mac-skim-insert-page () - (interactive) - (insert (org-mac-skim-get-page))) - -;; Handle links from Adobe Acrobat Pro.app -;; -;; Original code & idea by Christopher Suckling (org-mac-protocol) -;; -;; The URI format is path_to_pdf_file::page_number - -(org-link-set-parameters "acrobat" :follow #'org-mac-acrobat-open) - -(defun org-mac-acrobat-open (uri _) - "Visit page of pdf in Acrobat" - (let* ((page (when (string-match "::\\(.+\\)\\'" uri) - (match-string 1 uri))) - (document (substring uri 0 (match-beginning 0)))) - (do-applescript - (concat - "tell application \"Adobe Acrobat Pro\"\n" - " activate\n" - " set theDoc to \"" document "\"\n" - " set thePage to " page "\n" - " open theDoc\n" - " tell PDF Window 1\n" - " goto page thePage\n" - " end tell\n" - "end tell")))) - -;; The applescript returns link in the format -;; "adobe:path_to_pdf_file::page_number::split::document_title, p.page_label" - -(defun org-mac-as-get-acrobat-page-link () - (do-applescript - (concat - "tell application \"Adobe Acrobat Pro\"\n" - " set theDoc to active doc\n" - " set theWindow to (PDF Window 1 of theDoc)\n" - " set thePath to (file alias of theDoc)\n" - " set theTitle to (name of theWindow)\n" - " set thePage to (page number of theWindow)\n" - " set theLabel to (label text of (page thePage of theWindow))\n" - "end tell\n" - "set theResult to \"acrobat:\" & thePath & \"::\" & thePage & \"::split::\" & theTitle & \", p.\" & theLabel\n" - "return theResult as string\n"))) - -;;;###autoload -(defun org-mac-acrobat-get-page () - (interactive) - (message "Applescript: Getting Acrobat page link...") - (org-mac-paste-applescript-links (org-mac-as-get-acrobat-page-link))) - -;;;###autoload -(defun org-mac-acrobat-insert-page () - (interactive) - (insert (org-mac-acrobat-get-page))) - - -;; Handle links from Microsoft Outlook.app - -(org-link-set-parameters "mac-outlook" :follow #'org-mac-outlook-message-open) - -(defun org-mac-outlook-message-open (msgid _) - "Open a message in Outlook" - (do-applescript - (concat - "tell application \"" org-mac-outlook-path "\"\n" - (format "open message id %s\n" (substring-no-properties msgid)) - "activate\n" - "end tell"))) - -(defun org-as-get-selected-outlook-mail () - "AppleScript to create links to selected messages in Microsoft Outlook.app." - (do-applescript - (concat - "tell application \"" org-mac-outlook-path "\"\n" - "set msgCount to count current messages\n" - "if (msgCount < 1) then\n" - "return\n" - "end if\n" - "set theLinkList to {}\n" - "set theSelection to (get current messages)\n" - "repeat with theMessage in theSelection\n" - "set theID to id of theMessage as string\n" - "set theURL to \"mac-outlook:\" & theID\n" - "set theSubject to subject of theMessage\n" - "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun org-sh-get-flagged-outlook-mail () - "Shell commands to create links to flagged messages in Microsoft Outlook.app." - (mapconcat - (lambda (x) "" - (concat - "mac-outlook:" - (mapconcat - (lambda (y) "" y) - (split-string - (shell-command-to-string - (format "mdls -raw -name com_microsoft_outlook_recordID -name kMDItemDisplayName \"%s\"" x)) - "\000") - "::split::") - "\n")) - (with-temp-buffer - (let ((coding-system-for-read (or file-name-coding-system 'utf-8)) - (coding-system-for-write 'utf-8)) - (shell-command - "mdfind com_microsoft_outlook_flagged==1" - (current-buffer))) - (split-string - (buffer-string) "\n" t)) - "")) - -;;;###autoload -(defun org-mac-outlook-message-get-links (&optional select-or-flag) - "Create links to the messages currently selected or flagged in Microsoft Outlook.app. -This will use AppleScript to get the message-id and the subject of the -messages in Microsoft Outlook.app and make a link out of it. -When SELECT-OR-FLAG is \"s\", get the selected messages (this is also -the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. -The Org-syntax text will be pushed to the kill ring, and also returned." - (interactive "sLink to (s)elected or (f)lagged messages: ") - (setq select-or-flag (or select-or-flag "s")) - (message "Org Mac Outlook: searching mailboxes...") - (org-mac-paste-applescript-links - (if (string= select-or-flag "s") - (org-as-get-selected-outlook-mail) - (if (string= select-or-flag "f") - (org-sh-get-flagged-outlook-mail) - (error "Please select \"s\" or \"f\""))))) - -;;;###autoload -(defun org-mac-outlook-message-insert-selected () - "Insert a link to the messages currently selected in Microsoft Outlook.app. -This will use AppleScript to get the message-id and the subject -of the active mail in Microsoft Outlook.app and make a link out -of it." - (interactive) - (insert (org-mac-outlook-message-get-links "s"))) - -;;;###autoload -(defun org-mac-outlook-message-insert-flagged (org-buffer org-heading) - "Asks for an org buffer and a heading within it, and replace message links. -If heading exists, delete all mac-outlook:// links within -heading's first level. If heading doesn't exist, create it at -point-max. Insert list of mac-outlook:// links to flagged mail -after heading." - (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") - (with-current-buffer org-buffer - (goto-char (point-min)) - (let ((isearch-forward t) - (message-re "\\[\\[\\(mac-outlook:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) - (if (org-goto-local-search-headings org-heading nil t) - (if (not (eobp)) - (progn - (save-excursion - (while (re-search-forward - message-re (save-excursion (outline-next-heading)) t) - (delete-region (match-beginning 0) (match-end 0))) - (insert "\n" (org-mac-outlook-message-get-links "f"))) - (flush-lines "^$" (point) (outline-next-heading))) - (insert "\n" (org-mac-outlook-message-get-links "f"))) - (goto-char (point-max)) - (insert "\n") - (org-insert-heading nil t) - (insert org-heading "\n" (org-mac-outlook-message-get-links "f")))))) - -;; Handle links from Evernote.app - -(org-link-set-parameters "mac-evernote" :follow #'org-mac-evernote-note-open) - -(defun org-mac-evernote-path () - "Get path to evernote. -First consider the value of ORG-MAC-EVERNOTE-PATH, then attempt to find it. -Finding the path can be slow." - (or org-mac-evernote-path - (replace-regexp-in-string (rx (* (any " \t\n")) eos) - "" - (shell-command-to-string - "mdfind kMDItemCFBundleIdentifier == 'com.evernote.Evernote'")))) - -(defun org-mac-evernote-note-open (noteid _) - "Open a note in Evernote" - (do-applescript - (concat - "tell application \"" (org-mac-evernote-path) "\"\n" - " set theNotes to get every note of every notebook where its local id is \"" (substring-no-properties noteid) "\"\n" - " repeat with _note in theNotes\n" - " if length of _note is not 0 then\n" - " set _selectedNote to _note\n" - " end if\n" - " end repeat\n" - " open note window with item 1 of _selectedNote\n" - " activate\n" - "end tell"))) - -(defun org-as-get-selected-evernote-notes () - "AppleScript to create links to selected notes in Evernote.app." - (do-applescript - (concat - "tell application \"" (org-mac-evernote-path) "\"\n" - " set noteCount to count selection\n" - " if (noteCount < 1) then\n" - " return\n" - " end if\n" - " set theLinkList to {}\n" - " set theSelection to selection\n" - " repeat with theNote in theSelection\n" - " set theTitle to title of theNote\n" - " set theID to local id of theNote\n" - " set theURL to \"mac-evernote:\" & theID\n" - " set theLink to theURL & \"::split::\" & theTitle & \"\n\"\n" - " copy theLink to end of theLinkList\n" - " end repeat\n" - " return theLinkList as string\n" - "end tell\n"))) - -;;;###autoload -(defun org-mac-evernote-note-insert-selected () - "Insert a link to the notes currently selected in Evernote.app. -This will use AppleScript to get the note id and the title of the -note(s) in Evernote.app and make a link out of it/them." - (interactive) - (message "Org Mac Evernote: searching notes...") -(insert (org-mac-paste-applescript-links - (org-as-get-selected-evernote-notes)))) - - -;; Handle links from DEVONthink Pro Office.app - -(org-link-set-parameters "x-devonthink-item" :follow #'org-devonthink-item-open) - -(defun org-devonthink-item-open (uid _) - "Open UID, which is a reference to an item in DEVONthink Pro Office." - (shell-command (concat "open \"x-devonthink-item:" uid "\""))) - -(defun org-as-get-selected-devonthink-item () - "AppleScript to create links to selected items in DEVONthink Pro Office.app." - (do-applescript - (concat - "set theLinkList to {}\n" - "tell application \"DEVONthink Pro\"\n" - "set selectedRecords to selection\n" - "set selectionCount to count of selectedRecords\n" - "if (selectionCount < 1) then\n" - "return\n" - "end if\n" - "repeat with theRecord in selectedRecords\n" - "set theID to uuid of theRecord\n" - "set theURL to \"x-devonthink-item:\" & theID\n" - "set theSubject to name of theRecord\n" - "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "end tell\n" - "return theLinkList as string" - ))) - -(defun org-mac-devonthink-get-links () - "Create links to the item(s) currently selected in DEVONthink Pro Office. -This will use AppleScript to get the `uuid' and the `name' of the -selected items in DEVONthink Pro Office.app and make links out of -it/them. This function will push the Org-syntax text to the kill -ring, and also return it." - (message "Org Mac DEVONthink: looking for selected items...") - (org-mac-paste-applescript-links (org-as-get-selected-devonthink-item))) - -;;;###autoload -(defun org-mac-devonthink-item-insert-selected () - "Insert a link to the item(s) currently selected in DEVONthink Pro Office. -This will use AppleScript to get the `uuid'(s) and the name(s) of the -selected items in DEVONthink Pro Office and make link(s) out of it/them." - (interactive) - (insert (org-mac-devonthink-get-links))) - - -;; Handle links from Mail.app - -(org-link-set-parameters "message" :follow #'org-mac-message-open) - -(defun org-mac-message-open (message-id _) - "Visit the message with MESSAGE-ID. -This will use the command `open' with the message URL." - (start-process (concat "open message:" message-id) nil - "open" (concat "message://%3C" (substring message-id 2) "%3E"))) - -(defun org-as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app." - (do-applescript - (concat - "tell application \"Mail\"\n" - "set theLinkList to {}\n" - "set theSelection to selection\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject\n" - "if (theLinkList is not equal to {}) then\n" - "set theLink to \"\n\" & theLink\n" - "end if\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun org-as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app." - (unless org-mac-mail-account - (error "You must set org-mac-mail-account")) - (do-applescript - (concat - ;; Get links - "tell application \"Mail\"\n" - "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" - "set theLinkList to {}\n" - "repeat with aMailbox in theMailboxes\n" - "set theSelection to (every message in aMailbox whose flagged status = true)\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -;;;###autoload -(defun org-mac-message-get-links (&optional select-or-flag) - "Create links to the messages currently selected or flagged in Mail.app. -This will use AppleScript to get the message-id and the subject of the -messages in Mail.app and make a link out of it. -When SELECT-OR-FLAG is \"s\", get the selected messages (this is also -the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. -The Org-syntax text will be pushed to the kill ring, and also returned." - (interactive "sLink to (s)elected or (f)lagged messages: ") - (setq select-or-flag (or select-or-flag "s")) - (message "AppleScript: searching mailboxes...") - (org-mac-paste-applescript-links - (cond - ((string= select-or-flag "s") (org-as-get-selected-mail)) - ((string= select-or-flag "f") (org-as-get-flagged-mail)) - (t (error "Please select \"s\" or \"f\""))))) - -;;;###autoload -(defun org-mac-message-insert-selected () - "Insert a link to the messages currently selected in Mail.app. -This will use AppleScript to get the message-id and the subject of the -active mail in Mail.app and make a link out of it." - (interactive) - (insert (org-mac-message-get-links "s"))) - -;; The following line is for backward compatibility -(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected) - -;;;###autoload -(defun org-mac-message-insert-flagged (org-buffer org-heading) - "Asks for an org buffer and a heading within it, and replace message links. -If heading exists, delete all message:// links within heading's first -level. If heading doesn't exist, create it at point-max. Insert -list of message:// links to flagged mail after heading." - (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") - (with-current-buffer org-buffer - (goto-char (point-min)) - (let ((isearch-forward t) - (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) - (if (org-goto-local-search-headings org-heading nil t) - (if (not (eobp)) - (progn - (save-excursion - (while (re-search-forward - message-re (save-excursion (outline-next-heading)) t) - (delete-region (match-beginning 0) (match-end 0))) - (insert "\n" (org-mac-message-get-links "f"))) - (flush-lines "^$" (point) (outline-next-heading))) - (insert "\n" (org-mac-message-get-links "f"))) - (goto-char (point-max)) - (insert "\n") - (org-insert-heading nil t) - (insert org-heading "\n" (org-mac-message-get-links "f")))))) - - -;; Handle links from qutebrowser.app - -(defun org-as-mac-qutebrowser-get-frontmost-url () - (let ((result - (do-applescript - (concat - "set oldClipboard to the clipboard\n" - "set frontmostApplication to path to frontmost application\n" - "tell application \"qutebrowser\"\n" - " activate\n" - " delay 0.15\n" - " tell application \"System Events\"\n" - " keystroke \"y\"\n" - " keystroke \"y\"\n" - " end tell\n" - " delay 0.15\n" - " set theUrl to the clipboard\n" - " set the clipboard to oldClipboard\n" - " delay 0.15\n" - " tell application \"System Events\"\n" - " keystroke \"y\"\n" - " keystroke \"T\"\n" - " end tell\n" - " delay 0.15\n" - " set theTitle to the clipboard\n" - " set the clipboard to oldClipboard\n" - " set theResult to (get theUrl) & \"::split::\" & (get theTitle)\n" - "end tell\n" - "activate application (frontmostApplication as text)\n" - "set links to {}\n" - "copy theResult to the end of links\n" - "return links as string\n")))) - (car (split-string result "[\r\n]+" t)))) - -;;;###autoload -(defun org-mac-qutebrowser-get-frontmost-url () - (interactive) - (message "Applescript: Getting qutebrowser url...") - (org-mac-paste-applescript-links (org-as-mac-qutebrowser-get-frontmost-url))) - -;;;###autoload -(defun org-mac-qutebrowser-insert-frontmost-url () - (interactive) - (insert (org-mac-qutebrowser-get-frontmost-url))) - - -(provide 'org-mac-link) - -;;; org-mac-link.el ends here diff --git a/lisp/org-notify.el b/lisp/org-notify.el deleted file mode 100644 index cee4ea4..0000000 --- a/lisp/org-notify.el +++ /dev/null @@ -1,407 +0,0 @@ -;;; org-notify.el --- Notifications for Org-mode - -;; Copyright (C) 2012-2021 Free Software Foundation, Inc. - -;; Author: Peter Münster <pmrb@free.fr> -;; Homepage: https://github.com/p-m/org-notify -;; Keywords: notification, todo-list, alarm, reminder, pop-up - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Get notifications, when there is something to do. -;; Sometimes, you need a reminder a few days before a deadline, e.g. to buy a -;; present for a birthday, and then another notification one hour before to -;; have enough time to choose the right clothes. -;; For other events, e.g. rolling the dustbin to the roadside once per week, -;; you probably need another kind of notification strategy. -;; This package tries to satisfy the various needs. - -;; In order to activate this package, you must add the following code -;; into your .emacs: -;; -;; (require 'org-notify) -;; (org-notify-start) - -;; Example setup: -;; -;; (org-notify-add 'appt -;; '(:time "-1s" :period "20s" :duration 10 -;; :actions (-message -ding)) -;; '(:time "15m" :period "2m" :duration 100 -;; :actions -notify) -;; '(:time "2h" :period "5m" :actions -message) -;; '(:time "3d" :actions -email)) -;; -;; This means for todo-items with `notify' property set to `appt': 3 days -;; before deadline, send a reminder-email, 2 hours before deadline, start to -;; send messages every 5 minutes, then 15 minutes before deadline, start to -;; pop up notification windows every 2 minutes. The timeout of the window is -;; set to 100 seconds. Finally, when deadline is overdue, send messages and -;; make noise." - -;; Take also a look at the function `org-notify-add'. - -;;; Code: - -(eval-when-compile (require 'cl-lib)) -(require 'org-element) - -(declare-function appt-delete-window "appt" ()) -(declare-function notifications-notify "notifications" (&rest prms)) -(declare-function article-lapsed-string "gnus-art" (t &optional ms)) - -(defgroup org-notify nil - "Options for Org-mode notifications." - :tag "Org Notify" - :group 'org) - -(defcustom org-notify-audible t - "Non-nil means beep to indicate notification." - :type 'boolean - :group 'org-notify) - -(defcustom org-notify-max-notifications-per-run 3 - "Maximum number of notifications per run of `org-notify-process'." - :type 'integer - :group 'org-notify) - -(defconst org-notify-actions - '("show" "show" "done" "done" "hour" "one hour later" "day" "one day later" - "week" "one week later") - "Possible actions for call-back functions.") - -(defconst org-notify-window-buffer-name "*org-notify-%s*" - "Buffer-name for the `org-notify-action-window' function.") - -(defvar org-notify-map nil - "Mapping between names and parameter lists.") - -(defvar org-notify-timer nil - "Timer of the notification daemon.") - -(defvar org-notify-parse-file nil - "Index of current file, that `org-element-parse-buffer' is parsing.") - -(defvar org-notify-on-action-map nil - "Mapping between on-action identifiers and parameter lists.") - -(defun org-notify-string->seconds (str) - "Convert time string STR to number of seconds." - (when str - (let* ((conv `(("s" . 1) ("m" . 60) ("h" . ,(* 60 60)) - ("d" . ,(* 24 60 60)) ("w" . ,(* 7 24 60 60)) - ("M" . ,(* 30 24 60 60)))) - (letters (concat - (mapcar (lambda (x) (string-to-char (car x))) conv))) - (case-fold-search nil)) - (string-match (concat "\\(-?\\)\\([0-9]+\\)\\([" letters "]\\)") str) - (* (string-to-number (match-string 2 str)) - (cdr (assoc (match-string 3 str) conv)) - (if (= (length (match-string 1 str)) 1) -1 1))))) - -(defun org-notify-convert-deadline (orig) - "Convert original deadline from `org-element-parse-buffer' to -simple timestamp string." - (if orig - (replace-regexp-in-string "^<\\|>$" "" - (plist-get (plist-get orig 'timestamp) - :raw-value)))) - -(defun org-notify-make-todo (heading &rest ignored) - "Create one todo item." - (cl-macrolet ((get (k) `(plist-get list ,k)) - (pr (k v) `(setq result (plist-put result ,k ,v)))) - (let* ((list (nth 1 heading)) (notify (or (get :NOTIFY) "default")) - (deadline (org-notify-convert-deadline (get :deadline))) - (heading (get :raw-value)) - result) - (when (and (eq (get :todo-type) 'todo) heading deadline) - (pr :heading heading) (pr :notify (intern notify)) - (pr :begin (get :begin)) - (pr :file (nth org-notify-parse-file (org-agenda-files 'unrestricted))) - (pr :timestamp deadline) (pr :uid (md5 (concat heading deadline))) - (pr :deadline (- (org-time-string-to-seconds deadline) - (float-time)))) - result))) - -(defun org-notify-todo-list () - "Create the todo-list for one org-agenda file." - (let* ((files (org-agenda-files 'unrestricted)) - (max (1- (length files)))) - (when files - (setq org-notify-parse-file - (if (or (not org-notify-parse-file) (>= org-notify-parse-file max)) - 0 - (1+ org-notify-parse-file))) - (save-excursion - (with-current-buffer (find-file-noselect - (nth org-notify-parse-file files)) - (org-element-map (org-element-parse-buffer 'headline) - 'headline 'org-notify-make-todo)))))) - -(defun org-notify-maybe-too-late (diff period heading) - "Print warning message, when notified significantly later than defined by -PERIOD." - (if (> (/ diff period) 1.5) - (message "Warning: notification for \"%s\" behind schedule!" heading)) - t) - -(cl-defun org-notify-process () - "Process the todo-list, and possibly notify user about upcoming or -forgotten tasks." - (let ((notification-cnt 0)) - (cl-macrolet ((prm (k) `(plist-get prms ,k)) (td (k) `(plist-get todo ,k))) - (dolist (todo (org-notify-todo-list)) - (let* ((deadline (td :deadline)) (heading (td :heading)) - (uid (td :uid)) (last-run-sym - (intern (concat ":last-run-" uid)))) - (cl-dolist (prms (plist-get org-notify-map (td :notify))) - (when (< deadline (org-notify-string->seconds (prm :time))) - (let ((period (org-notify-string->seconds (prm :period))) - (last-run (prm last-run-sym)) (now (float-time)) - (actions (prm :actions)) diff plist) - (when (or (not last-run) - (and period (< period (setq diff (- now last-run))) - (org-notify-maybe-too-late diff period heading))) - (setq prms (plist-put prms last-run-sym now) - plist (append todo prms)) - (if (if (plist-member prms :audible) - (prm :audible) - org-notify-audible) - (ding)) - (unless (listp actions) - (setq actions (list actions))) - (cl-incf notification-cnt) - (dolist (action actions) - (funcall (if (fboundp action) action - (intern (concat "org-notify-action" - (symbol-name action)))) - plist)) - (when (>= notification-cnt org-notify-max-notifications-per-run) - (cl-return-from org-notify-process))) - (cl-return))))))))) - -(defun org-notify-add (name &rest params) - "Add a new notification type. -The NAME can be used in Org-mode property `notify'. If NAME is -`default', the notification type applies for todo items without -the `notify' property. This file predefines such a default -notification type. - -Each element of PARAMS is a list with parameters for a given time -distance to the deadline. This distance must increase from one -element to the next. - -List of possible parameters: - - :time Time distance to deadline, when this type of notification shall - start. It's a string: an integral value (positive or negative) - followed by a unit (s, m, h, d, w, M). - :actions A function or a list of functions to be called to notify the - user. Instead of a function name, you can also supply a suffix - of one of the various predefined `org-notify-action-xxx' - functions. - :period Optional: can be used to repeat the actions periodically. - Same format as :time. - :duration Some actions use this parameter to specify the duration of the - notification. It's an integral number in seconds. - :audible Overwrite the value of `org-notify-audible' for this action. - -For the actions, you can use your own functions or some of the predefined -ones, whose names are prefixed with `org-notify-action-'." - (setq org-notify-map (plist-put org-notify-map name params))) - -(defun org-notify-start (&optional secs) - "Start the notification daemon. -If SECS is positive, it's the period in seconds for processing -the notifications of one org-agenda file, and if negative, -notifications will be checked only when emacs is idle for -SECS -seconds. The default value for SECS is 20." - (interactive) - (if org-notify-timer - (org-notify-stop)) - (setq secs (or secs 20) - org-notify-timer (if (< secs 0) - (run-with-idle-timer (* -1 secs) t - 'org-notify-process) - (run-with-timer secs secs 'org-notify-process)))) - -(defun org-notify-stop () - "Stop the notification daemon." - (when org-notify-timer - (cancel-timer org-notify-timer) - (setq org-notify-timer nil))) - -(defun org-notify-on-action (plist key) - "User wants to see action." - (let ((file (plist-get plist :file)) - (begin (plist-get plist :begin))) - (if (string-equal key "show") - (progn - (switch-to-buffer (find-file-noselect file)) - (org-with-wide-buffer - (goto-char begin) - (outline-show-entry)) - (goto-char begin) - (search-forward "DEADLINE: <") - (search-forward ":") - (if (display-graphic-p) - (x-focus-frame nil))) - (save-excursion - (with-current-buffer (find-file-noselect file) - (org-with-wide-buffer - (goto-char begin) - (search-forward "DEADLINE: <") - (cond - ((string-equal key "done") (org-todo)) - ((string-equal key "hour") (org-timestamp-change 60 'minute)) - ((string-equal key "day") (org-timestamp-up-day)) - ((string-equal key "week") (org-timestamp-change 7 'day))))))))) - -(defun org-notify-on-action-notify (id key) - "User wants to see action after mouse-click in notify window." - (org-notify-on-action (plist-get org-notify-on-action-map id) key) - (org-notify-on-close id nil)) - -(defun org-notify-on-action-button (button) - "User wants to see action after button activation." - (cl-macrolet ((get (k) `(button-get button ,k))) - (org-notify-on-action (get 'plist) (get 'key)) - (org-notify-delete-window (get 'buffer)) - (cancel-timer (get 'timer)))) - -(defun org-notify-delete-window (buffer) - "Delete the notification window." - (require 'appt) - (let ((appt-buffer-name buffer) - (appt-audible nil)) - (appt-delete-window))) - -(defun org-notify-on-close (id reason) - "Notification window has been closed." - (setq org-notify-on-action-map (plist-put org-notify-on-action-map id nil))) - -(defun org-notify-action-message (plist) - "Print a message." - (message "TODO: \"%s\" at %s!" (plist-get plist :heading) - (plist-get plist :timestamp))) - -(defun org-notify-action-ding (plist) - "Make noise." - (let ((timer (run-with-timer 0 1 'ding))) - (run-with-timer (or (plist-get plist :duration) 3) nil - 'cancel-timer timer))) - -(defun org-notify-body-text (plist) - "Make human readable string for remaining time to deadline." - (require 'gnus-art) - (format "%s\n(%s)" - (replace-regexp-in-string - " in the future" "" - (article-lapsed-string - (time-add (current-time) - (seconds-to-time (plist-get plist :deadline))) 2)) - (plist-get plist :timestamp))) - -(defun org-notify-action-email (plist) - "Send email to user." - (compose-mail user-mail-address (concat "TODO: " (plist-get plist :heading))) - (insert (org-notify-body-text plist)) - (funcall send-mail-function) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (x) t))) - (kill-buffer))) - -(defun org-notify-select-highest-window () - "Select the highest window on the frame, that is not is not an -org-notify window. Mostly copied from `appt-select-lowest-window'." - (let ((highest-window (selected-window)) - (bottom-edge (nth 3 (window-edges))) - next-bottom-edge) - (walk-windows (lambda (w) - (when (and - (not (string-match "^\\*org-notify-.*\\*$" - (buffer-name - (window-buffer w)))) - (> bottom-edge (setq next-bottom-edge - (nth 3 (window-edges w))))) - (setq bottom-edge next-bottom-edge - highest-window w))) 'nomini) - (select-window highest-window))) - -(defun org-notify-action-window (plist) - "Pop up a window, mostly copied from `appt-disp-window'." - (save-excursion - (cl-macrolet ((get (k) `(plist-get plist ,k))) - (let ((this-window (selected-window)) - (buf (get-buffer-create - (format org-notify-window-buffer-name (get :uid))))) - (when (minibufferp) - (other-window 1) - (and (minibufferp) (display-multi-frame-p) (other-frame 1))) - (if (cdr (assq 'unsplittable (frame-parameters))) - (progn (set-buffer buf) (display-buffer buf)) - (unless (or (special-display-p (buffer-name buf)) - (same-window-p (buffer-name buf))) - (org-notify-select-highest-window) - (when (>= (window-height) (* 2 window-min-height)) - (select-window (split-window nil nil 'above)))) - (switch-to-buffer buf)) - (setq buffer-read-only nil buffer-undo-list t) - (erase-buffer) - (insert (format "TODO: %s, %s.\n" (get :heading) - (org-notify-body-text plist))) - (let ((timer (run-with-timer (or (get :duration) 10) nil - 'org-notify-delete-window buf))) - (dotimes (i (/ (length org-notify-actions) 2)) - (let ((key (nth (* i 2) org-notify-actions)) - (text (nth (1+ (* i 2)) org-notify-actions))) - (insert-button text 'action 'org-notify-on-action-button - 'key key 'buffer buf 'plist plist 'timer timer) - (insert " ")))) - (shrink-window-if-larger-than-buffer (get-buffer-window buf t)) - (set-buffer-modified-p nil) (setq buffer-read-only t) - (raise-frame (selected-frame)) (select-window this-window))))) - -(defun org-notify-action-notify (plist) - "Pop up a notification window." - (require 'notifications) - (let* ((duration (plist-get plist :duration)) - (id (notifications-notify - :title (plist-get plist :heading) - :body (org-notify-body-text plist) - :timeout (if duration (* duration 1000)) - :urgency (plist-get plist :urgency) - :actions org-notify-actions - :on-action 'org-notify-on-action-notify))) - (setq org-notify-on-action-map - (plist-put org-notify-on-action-map id plist)))) - -(defun org-notify-action-notify/window (plist) - "For a graphics display, pop up a notification window, for a text -terminal an emacs window." - (if (display-graphic-p) - (org-notify-action-notify plist) - (org-notify-action-window plist))) - -;;; Provide a minimal default setup. -(org-notify-add 'default '(:time "1h" :actions -notify/window - :period "2m" :duration 60)) - -(provide 'org-notify) - -;;; org-notify.el ends here diff --git a/lisp/org-passwords.el b/lisp/org-passwords.el deleted file mode 100644 index a038b99..0000000 --- a/lisp/org-passwords.el +++ /dev/null @@ -1,385 +0,0 @@ -;;; org-passwords.el --- org derived mode for managing passwords - -;; Author: Jorge A. Alfaro-Murillo <jorge.alfaro-murillo@yale.edu> -;; Created: December 26, 2012 -;; Homepage: https://github.com/alfaromurillo/org-passwords.el -;; Keywords: passwords, password - -;; This file is not part of GNU Emacs. -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the code for managing your passwords with -;; Org-mode. It is part of org/contrib (see https://orgmode.org/). If -;; you want to contribute with development, or have a problem, do it -;; here: https://bitbucket.org/alfaromurillo/org-passwords.el - -;; A basic setup needs to indicate a passwords file, and a dictionary -;; for the random words: - -;; (require 'org-passwords) -;; (setq org-passwords-file "~/documents/passwords.gpg") -;; (setq org-passwords-random-words-dictionary "/etc/dictionaries-common/words") - -;; Basic usage: - -;; `M-x org-passwords' opens the passwords file in -;; `org-passwords-mode'. - -;; `M-x org-passwords-generate-password' generates a random string -;; of numbers, lowercase letters and uppercase letters. - -;; `C-u M-x org-passwords-generate-password' generates a random -;; string of numbers, lowercase letters, uppercase letters and -;; symbols. - -;; `M-x org-passwords-random-words' concatenates random words from -;; the dictionary defined by `org-passwords-random-words-dictionary' -;; into a string, each word separated by the string defined in -;; `org-passwords-random-words-separator'. - -;; `C-u M-x org-passwords-random-words' does the same as above, and -;; also makes substitutions according to -;; `org-passwords-random-words-substitutions'. - -;; It is also useful to set up keybindings for the functions -;; `org-passwords-copy-username', `org-passwords-copy-password' and -;; `org-passwords-open-url' in the `org-passwords-mode', to easily -;; make the passwords and usernames available to the facility for -;; pasting text of the window system (clipboard on X and MS-Windows, -;; pasteboard on Nextstep/Mac OS, etc.), without inserting them in the -;; kill-ring. You can set for example: - -;; (eval-after-load "org-passwords" -;; '(progn -;; (define-key org-passwords-mode-map -;; (kbd "C-c u") -;; 'org-passwords-copy-username) -;; (define-key org-passwords-mode-map -;; (kbd "C-c p") -;; 'org-passwords-copy-password) -;; (kbd "C-c o") -;; 'org-passwords-open-url))) - -;; Finally, to enter new passwords, you can use `org-capture' and a -;; minimal template like: - -;; ("p" "password" entry (file "~/documents/passwords.gpg") -;; "* %^{Title}\n %^{URL}p %^{USERNAME}p %^{PASSWORD}p") - -;; When asked for the password you can then call either -;; `org-passwords-generate-password' or `org-passwords-random-words'. -;; Be sure to enable recursive minibuffers to call those functions -;; from the minibuffer: - -;; (setq enable-recursive-minibuffers t) - -;;; Code: - -(require 'org) - -;;;###autoload -(define-derived-mode org-passwords-mode org-mode - "org-passwords-mode" - "Mode for storing passwords" - nil) - -(defgroup org-passwords nil - "Options for password management." - :group 'org) - -(defcustom org-passwords-password-property "PASSWORD" - "Name of the property for password entry." - :type 'string - :group 'org-passwords) - -(defcustom org-passwords-username-property "USERNAME" - "Name of the property for user name entry." - :type 'string - :group 'org-passwords) - -(defcustom org-passwords-url-property "URL" - "Name of the property for URL entry." - :type 'string - :group 'org-passwords) - -(defcustom org-passwords-file nil - "Default file name for the file that contains the passwords." - :type 'file - :group 'org-passwords) - -(defcustom org-passwords-time-opened "1 min" - "Time that the password file will remain open. It has to be a -string, a number followed by units." - :type 'str - :group 'org-passwords) - -(defcustom org-passwords-default-password-size "20" - "Default number of characters to use in -org-passwords-generate-password. It has to be a string." - :type 'str - :group 'org-passwords) - -(defcustom org-passwords-random-words-dictionary nil - "Default file name for the file that contains a dictionary of -words for `org-passwords-random-words'. Each non-empty line in -the file is considered a word." - :type 'file - :group 'org-passwords) - -(defcustom org-passwords-default-random-words-number "5" - "Default number of words to use in org-passwords-random-words. -It has to be a string." - :type 'str - :group 'org-passwords) - -(defvar org-passwords-random-words-separator "-" - "A string to separate words in `org-passwords-random-words'.") - -(defvar org-passwords-random-words-substitutions - '(("a" . "@") - ("e" . "3") - ("o" . "0")) -"A list of substitutions to be made with -`org-passwords-random-words' if it is called with -`universal-argument'. Each element is pair of -strings (SUBSTITUTE-THIS . BY-THIS).") - -(defun org-passwords-copy-password () - "Makes the password available to other programs. Puts the -password of the entry at the location of the cursor in the -facility for pasting text of the window system (clipboard on X -and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without -putting it in the kill ring." - (interactive) - (funcall interprogram-cut-function - (org-entry-get (point) - org-passwords-password-property))) - -(defun org-passwords-copy-username () - "Makes the password available to other programs. Puts the -username of the entry at the location of the cursor in the -facility for pasting text of the window system (clipboard on X -and MS-Windows, pasteboard on Nextstep/Mac OS, etc.), without -putting it in the kill ring." - (interactive) - (funcall interprogram-cut-function - (org-entry-get (point) - org-passwords-username-property - t))) - -(defun org-passwords-open-url () - "Browse the URL associated with the entry at the location of -the cursor." - (interactive) - (browse-url (org-entry-get (point) - org-passwords-url-property - t))) - -;;;###autoload -(defun org-passwords (&optional arg) - "Open the password file. Open the password file defined by the -variable `org-password-file' in read-only mode and kill that -buffer later according to the value of the variable -`org-passwords-time-opened'. It also adds the `org-password-file' -to the auto-mode-alist so that it is opened with its mode being -`org-passwords-mode'. - -With prefix arg ARG, the command does not set up a timer to kill the buffer. - -With a double prefix arg \\[universal-argument] \\[universal-argument], open the file for editing. -" - (interactive "P") - (if org-passwords-file - (progn - (add-to-list 'auto-mode-alist - (cons - (regexp-quote - (expand-file-name org-passwords-file)) - 'org-passwords-mode)) - (if (equal arg '(4)) - (find-file-read-only org-passwords-file) - (if (equal arg '(16)) - (find-file org-passwords-file) - (progn - (find-file-read-only org-passwords-file) - (org-passwords-set-up-kill-password-buffer))))) - (minibuffer-message "No default password file defined. Set the variable `org-password-file'."))) - -(defun org-passwords-set-up-kill-password-buffer () - (run-at-time org-passwords-time-opened - nil - '(lambda () - (if (get-file-buffer org-passwords-file) - (kill-buffer - (get-file-buffer org-passwords-file)))))) - -;;; Password generator - -;; Set random number seed from current time and pid. Otherwise -;; `random' gives the same results every time emacs restarts. -(random t) - -(defun org-passwords-generate-password (arg) - "Ask a number of characters and insert a password of that size. -Password has a random string of numbers, lowercase letters, and -uppercase letters. Argument ARG include symbols." - (interactive "P") - (let ((number-of-chars - (read-from-minibuffer - (concat "Number of characters (default " - org-passwords-default-password-size - "): ") - nil - nil - t - nil - org-passwords-default-password-size))) - (if arg - (insert (org-passwords-generate-password-with-symbols "" number-of-chars)) - (insert (org-passwords-generate-password-without-symbols "" number-of-chars))))) - -(defun org-passwords-generate-password-with-symbols (previous-string nums-of-chars) - "Return a string consisting of PREVIOUS-STRING and -NUMS-OF-CHARS random characters." - (if (eq nums-of-chars 0) previous-string - (org-passwords-generate-password-with-symbols - (concat previous-string - (char-to-string - ;; symbols, letters, numbers are from 33 to 126 - (+ (random (- 127 33)) 33))) - (1- nums-of-chars)))) - -(defun org-passwords-generate-password-without-symbols (previous-string nums-of-chars) - "Return string consisting of PREVIOUS-STRING and NUMS-OF-CHARS -random numbers, lowercase letters, and numbers." - (if (eq nums-of-chars 0) - previous-string - ; There are 10 numbers, 26 lowercase letters and 26 uppercase - ; letters. 10 + 26 + 26 = 62. The number characters go from 48 - ; to 57, the uppercase letters from 65 to 90, and the lowercase - ; from 97 to 122. The following makes each equally likely. - (let ((temp-value (random 62))) - (cond ((< temp-value 10) - ; If temp-value<10, then add a number - (org-passwords-generate-password-without-symbols - (concat previous-string - (char-to-string (+ 48 temp-value))) - (1- nums-of-chars))) - ((and (> temp-value 9) (< temp-value 36)) - ; If 9<temp-value<36, then add an uppercase letter - (org-passwords-generate-password-without-symbols - (concat previous-string - (char-to-string (+ 65 (- temp-value 10)))) - (1- nums-of-chars))) - ((> temp-value 35) - ; If temp-value>35, then add a lowecase letter - (org-passwords-generate-password-without-symbols - (concat previous-string - (char-to-string (+ 97 (- temp-value 36)))) - (1- nums-of-chars))))))) - -;;; Random words - -(defun org-passwords-random-words (arg) - "Ask for a number of words and inserts a sequence of that many -random words from the list in the file -`org-passwords-random-words-dictionary' separated by -`org-passwords-random-words-separator'. ARG make substitutions in -the words as defined by -`org-passwords-random-words-substitutions'." - (interactive "P") - (if org-passwords-random-words-dictionary - (let ((number-of-words - (read-from-minibuffer - (concat "Number of words (default " - org-passwords-default-random-words-number - "): ") - nil - nil - t - nil - org-passwords-default-random-words-number)) - (list-of-words - (with-temp-buffer - (insert-file-contents - org-passwords-random-words-dictionary) - (split-string (buffer-string) "\n" t)))) - (insert - (org-passwords-substitute - (org-passwords-random-words-attach-number-of-words - (nth (random (length list-of-words)) - list-of-words) - (1- number-of-words) - list-of-words - org-passwords-random-words-separator) - (if arg - org-passwords-random-words-substitutions - nil)))) - (minibuffer-message - "No default dictionary file defined. Set the variable `org-passwords-random-words-dictionary'."))) - -(defun org-passwords-random-words-attach-number-of-words - (previous-string number-of-words list-of-words separator) - "Returns a string consisting of PREVIOUS-STRING followed by a -succession of NUMBER-OF-WORDS random words from the list LIST-OF-WORDS -separated SEPARATOR." - (if (eq number-of-words 0) - previous-string - (org-passwords-random-words-attach-number-of-words - (concat previous-string - separator - (nth (random (length list-of-words)) list-of-words)) - (1- number-of-words) - list-of-words - separator))) - -(defun org-passwords-substitute (string-to-change list-of-substitutions) - "Substitutes each appearance in STRING-TO-CHANGE of the `car' of -each element of LIST-OF-SUBSTITUTIONS by the `cdr' of that -element. For example: - (org-passwords-substitute \"ab\" \'((\"a\" . \"b\") (\"b\" . \"c\"))) - => \"bc\" -Substitutions are made in order of the list, so for example: - (org-passwords-substitute \"ab\" \'((\"ab\" . \"c\") (\"b\" . \"d\"))) - => \"c\"" - (if list-of-substitutions - (concat (org-passwords-concat-this-with-string - (cdar list-of-substitutions) - (mapcar (lambda (x) - (org-passwords-substitute - x - (cdr list-of-substitutions))) - (split-string string-to-change - (caar list-of-substitutions))))) - string-to-change)) - -(defun org-passwords-concat-this-with-string (this list-of-strings) - "Put the string THIS in between every string in LIST-OF-STRINGS. For example: - (org-passwords-concat-this-with-string \"Here\" \'(\"First\" \"Second\" \"Third\")) - => \"FirstHereSencondHereThird\"" - (if (cdr list-of-strings) - (concat (car list-of-strings) - this - (org-passwords-concat-this-with-string - this - (cdr list-of-strings))) - (car list-of-strings))) - -(provide 'org-passwords) - -;;; org-passwords.el ends here diff --git a/lisp/org-screenshot.el b/lisp/org-screenshot.el index 1e8e1e9..8560704 100644 --- a/lisp/org-screenshot.el +++ b/lisp/org-screenshot.el @@ -4,7 +4,7 @@ ;; ;; Author: Max Mikhanosha <max@openchat.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 8.0 ;; ;; Released under the GNU General Public License version 3 @@ -182,7 +182,7 @@ times. Returns just the file, without directory part" (case-fold-search nil)) (while (and (< tries org-screenshot-max-tries) (not name)) - (incf tries) + (cl-incf tries) (let ((tmp org-screenshot-file-name-format) (seq-re "%[-0-9.]*d") (rand-re "%X+")) @@ -282,7 +282,7 @@ screenshot is done, any more `C-u' after that increases delay by ((integerp delay) delay) ((and (consp delay) (integerp (car delay)) - (plusp (car delay))) + (cl-plusp (car delay))) (let ((num 1) (limit (car delay)) (cnt 0)) @@ -307,11 +307,11 @@ screenshot is done, any more `C-u' after that increases delay by (apply 'start-process (append (list "scrot" "*scrot*" "scrot" "-s" path) - (when (plusp delay) + (when (cl-plusp delay) (list "-d" (format "%d" delay))))) (error "Unable to start scrot process"))) (when org-screenshot-process - (if (plusp delay) + (if (cl-plusp delay) (message "Click on a window, or select a rectangle (delay is %d sec)..." delay) (message "Click on a window, or select a rectangle...")) @@ -351,7 +351,7 @@ by most recent first" (> mtime1 mtime2))))))) (let ((n -1) (list org-screenshot-file-list)) (while (and list (not (equal (pop list) lastfile))) - (incf n)) + (cl-incf n)) (setq org-screenshot-rotation-index n))) (defun org-screenshot-do-rotate (dir from-continue-rotating) @@ -396,7 +396,7 @@ other direction" ;; advance one more time (when (equal oldfile newfile) (setq org-screenshot-rotation-index - (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1)) + (mod (+ org-screenshot-rotation-index (if (cl-plusp dir) 1 -1)) (length org-screenshot-file-list)) newfile (nth org-screenshot-rotation-index org-screenshot-file-list))) diff --git a/lisp/org-sudoku.el b/lisp/org-sudoku.el index 5fe5dde..3fe1ec7 100644 --- a/lisp/org-sudoku.el +++ b/lisp/org-sudoku.el @@ -4,7 +4,7 @@ ;; ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp, games -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 0.01 ;; ;; This file is not part of GNU Emacs. diff --git a/lisp/org-velocity.el b/lisp/org-velocity.el deleted file mode 100644 index 5e6f4b4..0000000 --- a/lisp/org-velocity.el +++ /dev/null @@ -1,823 +0,0 @@ -;;; org-velocity.el --- something like Notational Velocity for Org. -*- lexical-binding: t -*- - -;; Copyright (C) 2010-2014, 2021 Paul M. Rodriguez - -;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com> -;; Maintainer: Paul M. Rodriguez <paulmrodriguez@gmail.com> -;; Homepage: https://github.com/ruricolist/org-velocity -;; Created: 2010-05-05 -;; Version: 4.1 - -;; This file is not part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Org-Velocity.el is an interface for Org inspired by the minimalist -;; notetaking program Notational Velocity. The idea is to let you -;; amass and access brief notes on many subjects with minimal fuss. -;; Each note is an entry in an ordinary Org file. - -;; Org-Velocity can be used in two ways: when called outside Org, to -;; store and access notes in a designated bucket file; or, when called -;; inside Org, as a method for navigating any Org file. (Setting the -;; option `org-velocity-always-use-bucket' disables navigation inside -;; Org files by default, although you can still force this behavior by -;; calling `org-velocity-read' with an argument.) - -;; Org-Velocity prompts for search terms in the minibuffer. A list of -;; headings of entries whose text matches your search is updated as -;; you type; you can end the search and visit an entry at any time by -;; clicking on its heading. - -;; RET displays the results. If there are no matches, Org-Velocity -;; offers to create a new entry with your search string as its -;; heading. If there are matches, it displays a list of results where -;; the heading of each matching entry is hinted with a number or -;; letter; clicking a result, or typing the matching hint, opens the -;; entry for editing in an indirect buffer. 0 forces a new entry; RET -;; reopens the search for editing. - -;; You can customize every step in this process, including the search -;; method, completion for search terms, and templates for creating new -;; entries; M-x customize-group RET org-velocity RET to see all the -;; options. - -;; Thanks to Richard Riley, Carsten Dominik, Bastien Guerry, and Jeff -;; Horn for their suggestions. - -;;; Usage: -;; (require 'org-velocity) -;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory)) -;; (global-set-key (kbd "C-c v") 'org-velocity) - -;;; Code: -(require 'org) -(require 'button) -(require 'electric) -(require 'dabbrev) -(require 'cl-lib) - -(defgroup org-velocity nil - "Notational Velocity-style interface for Org." - :tag "Org-Velocity" - :group 'outlines - :group 'hypermedia - :group 'org) - -(defcustom org-velocity-bucket "" - "Where is the bucket file?" - :group 'org-velocity - :type 'file) - -(defcustom org-velocity-show-previews t - "Show previews of the text of each heading?" - :group 'velocity - :type 'boolean - :safe 'booleanp) - -(defcustom org-velocity-exit-on-match nil - "When searching incrementally, exit on a single match?" - :group 'org-velocity - :type 'boolean - :safe 'booleanp) - -(defcustom org-velocity-force-new nil - "Should exiting the minibuffer with C-j force a new entry?" - :group 'org-velocity - :type 'boolean - :safe 'booleanp) - -(defcustom org-velocity-use-search-ring t - "Push search to `search-ring' when visiting an entry? - -This means that C-s C-s will take you directly to the first -instance of the search string." - :group 'org-velocity - :type 'boolean - :safe 'booleanp) - -(defcustom org-velocity-always-use-bucket nil - "Use bucket file even when called from an Org buffer?" - :group 'org-velocity - :type 'boolean - :safe 'booleanp) - -(defcustom org-velocity-use-completion nil - "Use completion? - -Notwithstanding the value of this option, calling -`dabbrev-expand' always completes against the text of the bucket -file." - :group 'org-velocity - :type '(choice - (const :tag "Do not use completion" nil) - (const :tag "Use completion" t)) - :safe 'booleanp) - -(defcustom org-velocity-search-method 'phrase - "Match on whole phrase, any word, or all words?" - :group 'org-velocity - :type '(choice - (const :tag "Match whole phrase" phrase) - (const :tag "Match any word" any) - (const :tag "Match all words" all) - (const :tag "Match a regular expression" regexp)) - :safe (lambda (v) (memq v '(phrase any all regexp)))) - -(defcustom org-velocity-capture-templates - '(("v" - "Velocity entry" - entry - (file "") - "* %:search\n\n%i%?")) - "Use these template with `org-capture'. -Meanwhile `org-default-notes-file' is bound to `org-velocity-bucket-file'. -The keyword :search inserts the current search. -See the documentation for `org-capture-templates'." - :group 'org-velocity - :type (or (get 'org-capture-templates 'custom-type) 'list)) - -(defcustom org-velocity-heading-level 1 - "Only match headings at this level or higher. -0 means to match headings at any level." - :group 'org-velocity - :type 'integer - :safe (lambda (x) - (and (integerp x) - (>= x 0)))) - -(defvar crm-separator) ;Ensure dynamic binding. - -(defsubst org-velocity-grab-preview () - "Grab preview of a subtree. -The length of the preview is determined by `window-width'. - -Replace all contiguous whitespace with single spaces." - (let* ((start (progn - (forward-line 1) - (if (looking-at org-property-start-re) - (re-search-forward org-property-end-re) - (1- (point))))) - (string+props (buffer-substring - start - (min - (+ start (window-width)) - (point-max))))) - ;; We want to preserve the text properties so that, for example, - ;; we don't end up with the raw text of links in the preview. - (with-temp-buffer - (insert string+props) - (goto-char (point-min)) - (save-match-data - (while (re-search-forward split-string-default-separators - (point-max) - t) - (replace-match " "))) - (buffer-string)))) - -(cl-defstruct org-velocity-heading buffer position name level preview) - -(defsubst org-velocity-nearest-heading (position) - "Return last heading at POSITION. -If there is no last heading, return nil." - (save-excursion - (goto-char position) - (re-search-backward (org-velocity-heading-regexp)) - (let ((components (org-heading-components))) - (make-org-velocity-heading - :buffer (current-buffer) - :position (point) - :name (nth 4 components) - :level (nth 0 components) - :preview (if org-velocity-show-previews - (org-velocity-grab-preview)))))) - -(defconst org-velocity-index - (eval-when-compile - (nconc (number-sequence 49 57) ;numbers - (number-sequence 97 122) ;lowercase letters - (number-sequence 65 90))) ;uppercase letters - "List of chars for indexing results.") - -(defconst org-velocity-match-buffer-name "*Velocity matches*") - -(cl-defun org-velocity-heading-regexp (&optional (level org-velocity-heading-level)) - "Regexp to match headings at LEVEL or deeper." - (if (zerop level) - "^\\*+ " - (format "^\\*\\{1,%d\\} " level))) - -(defvar org-velocity-search nil - "Variable to bind to current search.") - -(defun org-velocity-buffer-file-name (&optional buffer) - "Return the name of the file BUFFER saves to. -Same as function `buffer-file-name' unless BUFFER is an indirect -buffer or a minibuffer. In the former case, return the file name -of the base buffer; in the latter, return the file name of -`minibuffer-selected-window' (or its base buffer)." - (let ((buffer (if (minibufferp buffer) - (window-buffer (minibuffer-selected-window)) - buffer))) - (buffer-file-name - (or (buffer-base-buffer buffer) - buffer)))) - -(defun org-velocity-minibuffer-contents () - "Return the contents of the minibuffer when it is active." - (when (active-minibuffer-window) - (with-current-buffer (window-buffer (active-minibuffer-window)) - (minibuffer-contents)))) - -(defun org-velocity-nix-minibuffer () - "Return the contents of the minibuffer and clear it." - (when (active-minibuffer-window) - (with-current-buffer (window-buffer (active-minibuffer-window)) - (prog1 (minibuffer-contents) - (delete-minibuffer-contents))))) - -(defun org-velocity-bucket-file () - "Return the proper file for Org-Velocity to search. -If `org-velocity-always-use-bucket' is t, use bucket file; -complain if missing. Otherwise, if an Org file is current, then -use it." - (let ((org-velocity-bucket - (when org-velocity-bucket (expand-file-name org-velocity-bucket))) - (buffer - (let ((buffer-file (org-velocity-buffer-file-name))) - (when buffer-file - ;; Use the target in capture buffers. - (org-find-base-buffer-visiting buffer-file))))) - (if org-velocity-always-use-bucket - (or org-velocity-bucket (error "Bucket required but not defined")) - (if (and (eq (buffer-local-value 'major-mode (or buffer (current-buffer))) - 'org-mode) - (org-velocity-buffer-file-name)) - (org-velocity-buffer-file-name) - (or org-velocity-bucket - (error "No bucket and not an Org file")))))) - -(defvar org-velocity-bucket-buffer nil) -(defvar org-velocity-navigating nil) - -(defsubst org-velocity-bucket-buffer () - (or org-velocity-bucket-buffer - (find-file-noselect (org-velocity-bucket-file)))) - -(defsubst org-velocity-match-buffer () - "Return the proper buffer for Org-Velocity to display in." - (get-buffer-create org-velocity-match-buffer-name)) - -(defsubst org-velocity-match-window () - (get-buffer-window (org-velocity-match-buffer))) - -(defun org-velocity-beginning-of-headings () - "Goto the start of the first heading." - (goto-char (point-min)) - ;; If we are before the first heading we could still be at the - ;; first heading. - (or (looking-at (org-velocity-heading-regexp)) - (re-search-forward (org-velocity-heading-regexp)))) - -(defun org-velocity-make-indirect-buffer (heading) - "Make or switch to an indirect buffer visiting HEADING." - (let* ((bucket (org-velocity-heading-buffer heading)) - (name (org-velocity-heading-name heading)) - (existing (get-buffer name))) - (if (and existing (buffer-base-buffer existing) - (equal (buffer-base-buffer existing) bucket)) - existing - (make-indirect-buffer - bucket - (generate-new-buffer-name (org-velocity-heading-name heading)) - t)))) - -(defun org-velocity-capture () - "Record a note with `org-capture'." - (let ((org-capture-templates - org-velocity-capture-templates)) - (org-capture nil - ;; This is no longer automatically selected. - (when (null (cdr org-capture-templates)) - (caar org-capture-templates))) - (when org-capture-mode - (rename-buffer org-velocity-search t)))) - -(defvar org-velocity-saved-winconf nil) -(make-variable-buffer-local 'org-velocity-saved-winconf) - -(defun org-velocity-edit-entry (heading) - (if org-velocity-navigating - (org-velocity-edit-entry/inline heading) - (org-velocity-edit-entry/indirect heading))) - -(cl-defun org-velocity-goto-entry (heading &key narrow) - (goto-char (org-velocity-heading-position heading)) - (save-excursion - (when narrow - (org-narrow-to-subtree)) - (outline-show-all))) - -(defun org-velocity-edit-entry/inline (heading) - "Edit entry at HEADING in the original buffer." - (let ((buffer (org-velocity-heading-buffer heading))) - (pop-to-buffer buffer) - (with-current-buffer buffer - (org-velocity-goto-entry heading)))) - -(defun org-velocity-format-header-line (control-string &rest args) - (set (make-local-variable 'header-line-format) - (apply #'format control-string args))) - -(defun org-velocity-edit-entry/indirect (heading) - "Edit entry at HEADING in an indirect buffer." - (let ((winconf (current-window-configuration)) - (dd default-directory) - (buffer (org-velocity-make-indirect-buffer heading)) - (inhibit-point-motion-hooks t) - (inhibit-field-text-motion t)) - (with-current-buffer buffer - (setq default-directory dd) ;Inherit default directory. - (setq org-velocity-saved-winconf winconf) - (org-velocity-goto-entry heading :narrow t) - (goto-char (point-max)) - (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t)) - (pop-to-buffer buffer) - (org-velocity-format-header-line - "%s Use C-c C-c to finish." - (abbreviate-file-name - (buffer-file-name - (org-velocity-heading-buffer heading)))))) - -(defun org-velocity-dismiss () - "Save current entry and close indirect buffer." - (let ((winconf org-velocity-saved-winconf)) - (prog1 t ;Tell hook we're done. - (save-buffer) - (kill-buffer) - (when (window-configuration-p winconf) - (set-window-configuration winconf))))) - -(defun org-velocity-visit-button (button) - (run-hooks 'mouse-leave-buffer-hook) - (when org-velocity-use-search-ring - (add-to-history 'search-ring - (button-get button 'search) - search-ring-max)) - (let ((match (button-get button 'match))) - (throw 'org-velocity-done match))) - -(define-button-type 'org-velocity-button - 'action #'org-velocity-visit-button - 'follow-link 'mouse-face) - -(defsubst org-velocity-buttonize (heading) - "Insert HEADING as a text button with no hints." - (insert-text-button - (propertize (org-velocity-heading-name heading) 'face 'link) - :type 'org-velocity-button - 'match heading - 'search org-velocity-search)) - -(defsubst org-velocity-insert-preview (heading) - (when org-velocity-show-previews - (insert-char ?\ 1) - (insert - (propertize - (org-velocity-heading-preview heading) - 'face 'shadow)))) - -(defvar org-velocity-recursive-headings nil) -(defvar org-velocity-recursive-search nil) - -(cl-defun org-velocity-search-with (fun style search - &key (headings org-velocity-recursive-headings)) - (if headings - (save-restriction - (dolist (heading headings) - (widen) - (let ((start (org-velocity-heading-position heading))) - (goto-char start) - (let ((end (save-excursion - (org-end-of-subtree) - (point)))) - (narrow-to-region start end) - (org-velocity-search-with fun style search - :headings nil))))) - (cl-ecase style - ((phrase any regexp) - (cl-block nil - (while (re-search-forward search nil t) - (let ((match (org-velocity-nearest-heading (point)))) - (funcall fun match)) - ;; Skip to the next heading. - (unless (re-search-forward (org-velocity-heading-regexp) nil t) - (cl-return))))) - ((all) - (let ((keywords - (cl-loop for word in (split-string search) - collect (concat "\\<" (regexp-quote word) "\\>")))) - (org-map-entries - (lambda () - ;; Only search the subtree once. - (setq org-map-continue-from - (save-excursion - (org-end-of-subtree) - (point))) - (when (cl-loop for word in keywords - always (save-excursion - (re-search-forward word org-map-continue-from t))) - (let ((match (org-velocity-nearest-heading (match-end 0)))) - (funcall fun match)))))))))) - -(defun org-velocity-all-results (style search) - (with-current-buffer (org-velocity-bucket-buffer) - (save-excursion - (goto-char (point-min)) - (let (matches) - (org-velocity-search-with (lambda (match) - (push match matches)) - style - search) - (nreverse matches))))) - -(defsubst org-velocity-present-match (hint match) - (with-current-buffer (org-velocity-match-buffer) - (when hint (insert "#" hint " ")) - (org-velocity-buttonize match) - (org-velocity-insert-preview match) - (newline))) - -(defun org-velocity-present-search (style search hide-hints) - (let ((hints org-velocity-index) matches) - (cl-block nil - (org-velocity-search-with (lambda (match) - (unless hints - (cl-return)) - (let ((hint (if hide-hints - nil - (car hints)))) - (org-velocity-present-match hint match)) - (pop hints) - (push match matches)) - style - search)) - (nreverse matches))) - -(defun org-velocity-restrict-search () - (interactive) - (let ((search (org-velocity-nix-minibuffer))) - (when (equal search "") - (error "No search to restrict to")) - (push search org-velocity-recursive-search) - (setq org-velocity-recursive-headings - (org-velocity-all-results - org-velocity-search-method - search)) - ;; TODO We could extend the current search instead of starting - ;; over. - (org-velocity-update-match-header) - (minibuffer-message "Restricting search to %s" search))) - -(cl-defun org-velocity-update-match-header (&key (match-buffer (org-velocity-match-buffer)) - (bucket-buffer (org-velocity-bucket-buffer)) - (search-method org-velocity-search-method)) - (let ((navigating? org-velocity-navigating) - (recursive? org-velocity-recursive-search)) - (with-current-buffer match-buffer - (org-velocity-format-header-line - "%s search in %s%s (%s mode)" - (capitalize (symbol-name search-method)) - (abbreviate-file-name (buffer-file-name bucket-buffer)) - (if (not recursive?) - "" - (let ((sep " > ")) - (concat sep (string-join (reverse recursive?) sep)))) - (if navigating? "nav" "notes"))))) - -(cl-defun org-velocity-present (search &key hide-hints) - "Buttonize matches for SEARCH in `org-velocity-match-buffer'. -If HIDE-HINTS is non-nil, display entries without indices. SEARCH -binds `org-velocity-search'. - -Return matches." - (let ((match-buffer (org-velocity-match-buffer)) - (bucket-buffer (org-velocity-bucket-buffer)) - (search-method org-velocity-search-method)) - (if (and (stringp search) (not (string= "" search))) - ;; Fold case when the search string is all lowercase. - (let ((case-fold-search (equal search (downcase search))) - (truncate-partial-width-windows t)) - (with-current-buffer match-buffer - (erase-buffer) - ;; Permanent locals. - (setq cursor-type nil - truncate-lines t) - (org-velocity-update-match-header - :match-buffer match-buffer - :bucket-buffer bucket-buffer - :search-method search-method)) - (prog1 - (with-current-buffer bucket-buffer - (widen) - (let* ((inhibit-point-motion-hooks t) - (inhibit-field-text-motion t) - (anchored? (string-match-p "^\\s-" search)) - (search - (cl-ecase search-method - (all search) - (phrase - (if anchored? - (regexp-quote search) - ;; Anchor the search to the start of a word. - (concat "\\<" (regexp-quote search)))) - (any - (concat "\\<" (regexp-opt (split-string search)))) - (regexp search)))) - (save-excursion - (org-velocity-beginning-of-headings) - (condition-case lossage - (org-velocity-present-search search-method search hide-hints) - (invalid-regexp - (minibuffer-message "%s" lossage)))))) - (with-current-buffer match-buffer - (goto-char (point-min))))) - (with-current-buffer match-buffer - (erase-buffer))))) - -(defun org-velocity-store-link () - "Function for `org-store-link-functions'." - (if org-velocity-search - (org-store-link-props - :search org-velocity-search))) - -(add-hook 'org-store-link-functions 'org-velocity-store-link) - -(cl-defun org-velocity-create (search &key ask) - "Create new heading named SEARCH. -If ASK is non-nil, ask first." - (when (or (null ask) (y-or-n-p "No match found, create? ")) - (let ((org-velocity-search search) - (org-default-notes-file (org-velocity-bucket-file)) - ;; save a stored link - org-store-link-plist) - (org-velocity-capture)) - search)) - -(defun org-velocity-engine (search) - "Display a list of headings where SEARCH occurs." - (let ((org-velocity-search search)) - (unless (or - (not (stringp search)) - (string= "" search)) ;exit on empty string - (cl-case - (if (and org-velocity-force-new (eq last-command-event ?\C-j)) - :force - (let* ((org-velocity-index (org-velocity-adjust-index)) - (matches (org-velocity-present search))) - (cond ((null matches) :new) - ((null (cdr matches)) :follow) - (t :prompt)))) - (:prompt (progn - (pop-to-buffer (org-velocity-match-buffer)) - (let ((hint (org-velocity-electric-read-hint))) - (when hint (cl-case hint - (:edit (org-velocity-read nil search)) - (:force (org-velocity-create search)) - (otherwise (org-velocity-activate-button hint))))))) - (:new (unless (org-velocity-create search :ask t) - (org-velocity-read nil search))) - (:force (org-velocity-create search)) - (:follow (if (y-or-n-p "One match, follow? ") - (progn - (set-buffer (org-velocity-match-buffer)) - (goto-char (point-min)) - (button-activate (next-button (point)))) - (org-velocity-read nil search))))))) - -(defun org-velocity-activate-button (char) - "Go to button on line number associated with CHAR in `org-velocity-index'." - (goto-char (point-min)) - (forward-line (cl-position char org-velocity-index)) - (goto-char - (button-start - (next-button (point)))) - (message "%s" (button-label (button-at (point)))) - (button-activate (button-at (point)))) - -(defun org-velocity-electric-undefined () - "Complain about an undefined key." - (interactive) - (message "%s" - (substitute-command-keys - "\\[org-velocity-electric-new] for new entry, -\\[org-velocity-electric-edit] to edit search, -\\[scroll-up] to scroll up, -\\[scroll-down] to scroll down, -\\[keyboard-quit] to quit.")) - (sit-for 4)) - -(defun org-velocity-electric-follow (ev) - "Follow a hint indexed by keyboard event EV." - (interactive (list last-command-event)) - (if (not (> (cl-position ev org-velocity-index) - (1- (count-lines (point-min) (point-max))))) - (throw 'org-velocity-select ev) - (call-interactively 'org-velocity-electric-undefined))) - -(defun org-velocity-electric-edit () - "Edit the search string." - (interactive) - (throw 'org-velocity-select :edit)) - -(defun org-velocity-electric-new () - "Force a new entry." - (interactive) - (throw 'org-velocity-select :force)) - -(defvar org-velocity-electric-map - (let ((map (make-sparse-keymap))) - (define-key map [t] 'org-velocity-electric-undefined) - (dolist (c org-velocity-index) - (define-key map (char-to-string c) - 'org-velocity-electric-follow)) - (define-key map "0" 'org-velocity-electric-new) - (define-key map "\C-v" 'scroll-up) - (define-key map "\M-v" 'scroll-down) - (define-key map (kbd "RET") 'org-velocity-electric-edit) - (define-key map [mouse-1] nil) - (define-key map [mouse-2] nil) - (define-key map [escape] 'keyboard-quit) - (define-key map "\C-h" 'help-command) - map)) - -(defun org-velocity-electric-read-hint () - "Read index of button electrically." - (with-current-buffer (org-velocity-match-buffer) - (when (featurep 'evil) - ;; NB Idempotent. - (evil-make-overriding-map org-velocity-electric-map)) - (use-local-map org-velocity-electric-map) - (catch 'org-velocity-select - (Electric-command-loop 'org-velocity-select "Follow: ")))) - -(defvar org-velocity-incremental-keymap - (let ((map (make-sparse-keymap))) - (define-key map "\C-v" 'scroll-up) - (define-key map "\M-v" 'scroll-down) - map)) - -(defun org-velocity-displaying-completions-p () - "Is there a *Completions* buffer showing?" - (get-window-with-predicate - (lambda (w) - (eq (buffer-local-value 'major-mode (window-buffer w)) - 'completion-list-mode)))) - -(defun org-velocity-update () - "Display results of search without hinting." - (unless (org-velocity-displaying-completions-p) - (let* ((search (org-velocity-minibuffer-contents)) - (matches (org-velocity-present search :hide-hints t))) - (cond ((null matches) - (select-window (active-minibuffer-window)) - (unless (or (null search) (= (length search) 0)) - (minibuffer-message "No match; RET to create"))) - ((and (null (cdr matches)) - org-velocity-exit-on-match) - (throw 'click search)) - (t - (with-current-buffer (org-velocity-match-buffer) - (use-local-map org-velocity-incremental-keymap))))))) - -(defvar dabbrev--last-abbreviation) - -(defun org-velocity-dabbrev-completion-list (abbrev) - "Return all dabbrev completions for ABBREV." - ;; This is based on `dabbrev-completion'. - (dabbrev--reset-global-variables) - (setq dabbrev--last-abbreviation abbrev) - (dabbrev--find-all-expansions abbrev case-fold-search)) - -(defvar org-velocity-local-completion-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-completion-map) - (define-key map " " 'self-insert-command) - (define-key map "?" 'self-insert-command) - (define-key map [remap minibuffer-complete] 'minibuffer-complete-word) - (define-key map [(control ?@)] 'org-velocity-restrict-search) - (define-key map [(control ?\s)] 'org-velocity-restrict-search) - map) - "Keymap for completion with `completing-read'.") - -(defun org-velocity-read-with-completion (prompt) - "Completing read with PROMPT." - (let ((minibuffer-local-completion-map - org-velocity-local-completion-map) - (completion-no-auto-exit t) - (crm-separator " ")) - (completing-read prompt - (completion-table-dynamic - 'org-velocity-dabbrev-completion-list)))) - -(cl-defun org-velocity-adjust-index - (&optional (match-window (org-velocity-match-window))) - "Truncate or extend `org-velocity-index' to the lines in -MATCH-WINDOW." - (with-selected-window match-window - (let ((lines (window-height)) - (hints (length org-velocity-index))) - (cond ((= lines hints) - org-velocity-index) - ;; Truncate the index to the size of - ;; the buffer to be displayed. - ((< lines hints) - (cl-subseq org-velocity-index 0 lines)) - ;; If the window is so tall we run out of indices, at - ;; least make the additional results clickable. - ((> lines hints) - (append org-velocity-index - (make-list (- lines hints) nil))))))) - -(defun org-velocity-incremental-read (prompt) - "Read string with PROMPT and display results incrementally. -Stop searching once there are more matches than can be -displayed." - (let ((res - (unwind-protect - (let* ((match-window (display-buffer (org-velocity-match-buffer))) - (org-velocity-index (org-velocity-adjust-index match-window))) - (catch 'click - (add-hook 'post-command-hook 'org-velocity-update) - (cond ((eq org-velocity-search-method 'regexp) - (read-regexp prompt)) - (org-velocity-use-completion - (org-velocity-read-with-completion prompt)) - (t (read-string prompt))))) - (remove-hook 'post-command-hook 'org-velocity-update)))) - (if (bufferp res) (org-pop-to-buffer-same-window res) res))) - -(defun org-velocity (arg &optional search) - "Read a search string SEARCH for Org-Velocity interface. -This means that a buffer will display all headings where SEARCH -occurs, where one can be selected by a mouse click or by typing -its index. If SEARCH does not occur, then a new heading may be -created named SEARCH. - -If `org-velocity-bucket' is defined and -`org-velocity-always-use-bucket' is non-nil, then the bucket file -will be used; otherwise, this will work when called in any Org -file. - -Calling with ARG reverses which file – the current file or the -bucket file – to use. If the bucket file would have been used, -then the current file is used instead, and vice versa." - (interactive "P") - (let ((org-velocity-always-use-bucket - (if org-velocity-always-use-bucket - (not arg) - arg))) - ;; complain if inappropriate - (cl-assert (org-velocity-bucket-file)) - (let* ((starting-buffer (current-buffer)) - (org-velocity-bucket-buffer - (find-file-noselect (org-velocity-bucket-file))) - (org-velocity-navigating - (eq starting-buffer org-velocity-bucket-buffer)) - (org-velocity-recursive-headings '()) - (org-velocity-recursive-search '()) - (org-velocity-heading-level - (if org-velocity-navigating - 0 - org-velocity-heading-level)) - (dabbrev-search-these-buffers-only - (list org-velocity-bucket-buffer))) - (unwind-protect - (let ((match - (catch 'org-velocity-done - (org-velocity-engine - (or search - (org-velocity-incremental-read "Velocity search: "))) - nil))) - (when (org-velocity-heading-p match) - (org-velocity-edit-entry match))) - (kill-buffer (org-velocity-match-buffer)))))) - -(defalias 'org-velocity-read 'org-velocity) - -(provide 'org-velocity) - -;;; org-velocity.el ends here diff --git a/lisp/org-wikinodes.el b/lisp/org-wikinodes.el index b8a5e27..410695e 100644 --- a/lisp/org-wikinodes.el +++ b/lisp/org-wikinodes.el @@ -4,7 +4,7 @@ ;; Author: Carsten Dominik <carsten.dominik@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: https://orgmode.org +;; Homepage: https://git.sr.ht/~bzg/org-contrib ;; Version: 7.01trans ;; ;; This file is not part of GNU Emacs. diff --git a/lisp/ox-groff.el b/lisp/ox-groff.el index 5c18085..1eb3da7 100644 --- a/lisp/ox-groff.el +++ b/lisp/ox-groff.el @@ -647,16 +647,16 @@ See `org-groff-text-markup-alist' for details." ;; If FROM then get data from FROM - (if from-data + (if from-data (setq from-data (replace-regexp-in-string "\\.P\n" "" from-data)) (setq from-data "")) - - (if to-data + + (if to-data (setq to-data (replace-regexp-in-string "\\.P\n" "" to-data)) (setq from-data "")) - + (concat (cond (from-data @@ -1879,6 +1879,12 @@ Return PDF file's name." async subtreep visible-only body-only ext-plist (lambda (file) (org-groff-compile file))))) +;; Port to Emacs 26 and earlier. +(defun org-groff--time-sec (time) + (if (fboundp 'time-convert) + (time-convert time 'integer) + (cl-subseq (or time (current-time)) 0 2))) + (defun org-groff-compile (file) "Compile a Groff file. @@ -1888,8 +1894,8 @@ through the command specified in `org-groff-pdf-process'. Return PDF file name or an error if it couldn't be produced." (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) (full-name (file-truename file)) - (out-dir (file-name-directory file)) - (time (current-time)) + (out-dir (file-name-directory full-name)) + (time (org-groff--time-sec nil)) ;; Properly set working directory for compilation. (default-directory (if (file-name-absolute-p file) (file-name-directory full-name) @@ -1928,8 +1934,9 @@ Return PDF file name or an error if it couldn't be produced." ;; Only compare times up to whole seconds as some ;; filesystems (e.g. HFS+) do not retain any finer ;; granularity. - (time-less-p (cl-subseq (nth 5 (file-attributes pdffile)) 0 2) - (cl-subseq time 0 2))) + (time-less-p (org-groff--time-sec + (nth 5 (file-attributes pdffile))) + time)) (error (concat (format "PDF file %s wasn't produced" pdffile) (when errors (concat ": " errors)))) ;; Else remove log files, when specified, and signal end of diff --git a/lisp/ox-rss.el b/lisp/ox-rss.el deleted file mode 100644 index c98cac8..0000000 --- a/lisp/ox-rss.el +++ /dev/null @@ -1,421 +0,0 @@ -;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine - -;; Copyright (C) 2013-2021 Free Software Foundation, Inc. - -;; Author: Bastien Guerry <bzg@gnu.org> -;; Maintainer: Bastien Guerry <bzg@gnu.org> -;; Keywords: org, wp, blog, feed, rss -;; Homepage: https://gitlab.com/nsavage/ox-rss - -;; This file is not part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements an RSS 2.0 back-end for Org exporter, based -;; on the `html' back-end. -;; -;; It requires Emacs 24.1 at least. -;; -;; It provides two commands for export, depending on the desired output: -;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss' -;; (as a ".xml" file). -;; -;; This backend understands three new option keywords: -;; -;; #+RSS_EXTENSION: xml -;; #+RSS_IMAGE_URL: https://myblog.org/mypicture.jpg -;; #+RSS_FEED_URL: https://myblog.org/feeds/blog.xml -;; -;; It uses #+HTML_LINK_HOME: to set the base url of the feed. -;; -;; Exporting an Org file to RSS modifies each top-level entry by adding a -;; PUBDATE property. If `org-rss-use-entry-url-as-guid', it will also add -;; an ID property, later used as the guid for the feed's item. -;; -;; The top-level headline is used as the title of each RSS item unless -;; an RSS_TITLE property is set on the headline. -;; -;; You typically want to use it within a publishing project like this: -;; -;; (add-to-list -;; 'org-publish-project-alist -;; '("homepage_rss" -;; :base-directory "~/myhomepage/" -;; :base-extension "org" -;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png" -;; :html-link-home "http://lumiere.ens.fr/~guerry/" -;; :html-link-use-abs-url t -;; :rss-extension "xml" -;; :publishing-directory "/home/guerry/public_html/" -;; :publishing-function (org-rss-publish-to-rss) -;; :section-numbers nil -;; :exclude ".*" ;; To exclude all files... -;; :include ("index.org") ;; ... except index.org. -;; :table-of-contents nil)) -;; -;; ... then rsync /home/guerry/public_html/ with your server. -;; -;; By default, the permalink for a blog entry points to the headline. -;; You can specify a different one by using the :RSS_PERMALINK: -;; property within an entry. - -;;; Code: - -(require 'ox-html) -(declare-function url-encode-url "url-util" (url)) - -;;; Variables and options - -(defgroup org-export-rss nil - "Options specific to RSS export back-end." - :tag "Org RSS" - :group 'org-export - :version "24.4" - :package-version '(Org . "8.0")) - -(defcustom org-rss-image-url "https://orgmode.org/img/org-mode-unicorn-logo.png" - "The URL of the image for the RSS feed." - :group 'org-export-rss - :type 'string) - -(defcustom org-rss-extension "xml" - "File extension for the RSS 2.0 feed." - :group 'org-export-rss - :type 'string) - -(defcustom org-rss-categories 'from-tags - "Where to extract items category information from. -The default is to extract categories from the tags of the -headlines. When set to another value, extract the category -from the :CATEGORY: property of the entry." - :group 'org-export-rss - :type '(choice - (const :tag "From tags" from-tags) - (const :tag "From the category property" from-category))) - -(defcustom org-rss-use-entry-url-as-guid t - "Use the URL for the <guid> metatag? -When nil, Org will create ids using `org-icalendar-create-uid'." - :group 'org-export-rss - :type 'boolean) - -;;; Define backend - -(org-export-define-derived-backend 'rss 'html - :menu-entry - '(?r "Export to RSS" - ((?R "As RSS buffer" - (lambda (a s v b) (org-rss-export-as-rss a s v))) - (?r "As RSS file" (lambda (a s v b) (org-rss-export-to-rss a s v))) - (?o "As RSS file and open" - (lambda (a s v b) - (if a (org-rss-export-to-rss t s v) - (org-open-file (org-rss-export-to-rss nil s v))))))) - :options-alist - '((:description "DESCRIPTION" nil nil newline) - (:keywords "KEYWORDS" nil nil space) - (:with-toc nil nil nil) ;; Never include HTML's toc - (:rss-extension "RSS_EXTENSION" nil org-rss-extension) - (:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url) - (:rss-feed-url "RSS_FEED_URL" nil nil t) - (:rss-categories nil nil org-rss-categories)) - :filters-alist '((:filter-final-output . org-rss-final-function)) - :translate-alist '((headline . org-rss-headline) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (timestamp . (lambda (&rest args) "")) - (plain-text . org-rss-plain-text) - (section . org-rss-section) - (template . org-rss-template))) - -;;; Export functions - -;;;###autoload -(defun org-rss-export-as-rss (&optional async subtreep visible-only) - "Export current buffer to an RSS buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Export is done in a buffer named \"*Org RSS Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil." - (interactive) - (let ((file (buffer-file-name (buffer-base-buffer)))) - (org-icalendar-create-uid file 'warn-user) - (org-rss-add-pubdate-property)) - (org-export-to-buffer 'rss "*Org RSS Export*" - async subtreep visible-only nil nil (lambda () (text-mode)))) - -;;;###autoload -(defun org-rss-export-to-rss (&optional async subtreep visible-only) - "Export current buffer to an RSS file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return output file's name." - (interactive) - (let ((file (buffer-file-name (buffer-base-buffer)))) - (org-icalendar-create-uid file 'warn-user) - (org-rss-add-pubdate-property)) - (let ((outfile (org-export-output-file-name - (concat "." org-rss-extension) subtreep))) - (org-export-to-file 'rss outfile async subtreep visible-only))) - -;;;###autoload -(defun org-rss-publish-to-rss (plist filename pub-dir) - "Publish an org file to RSS. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (let ((bf (get-file-buffer filename))) - (if bf - (with-current-buffer bf - (org-icalendar-create-uid filename 'warn-user) - (org-rss-add-pubdate-property) - (write-file filename)) - (find-file filename) - (org-icalendar-create-uid filename 'warn-user) - (org-rss-add-pubdate-property) - (write-file filename) (kill-buffer))) - (org-publish-org-to - 'rss filename (concat "." org-rss-extension) plist pub-dir)) - -;;; Main transcoding functions - -(defun org-rss-headline (headline contents info) - "Transcode HEADLINE element into RSS format. -CONTENTS is the headline contents. INFO is a plist used as a -communication channel." - (if (> (org-export-get-relative-level headline info) 1) - (org-export-data-with-backend headline 'html info) - (unless (org-element-property :footnote-section-p headline) - (let* ((email (org-export-data (plist-get info :email) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (htmlext (plist-get info :html-extension)) - (hl-number (org-export-get-headline-number headline info)) - (hl-home (file-name-as-directory (plist-get info :html-link-home))) - (hl-pdir (plist-get info :publishing-directory)) - (hl-perm (org-element-property :RSS_PERMALINK headline)) - (anchor (org-export-get-reference headline info)) - (category (org-rss-plain-text - (or (org-element-property :CATEGORY headline) "") info)) - (pubdate0 (org-element-property :PUBDATE headline)) - (pubdate (let ((system-time-locale "C")) - (if (and pubdate0 (not (string-empty-p pubdate0))) - (format-time-string - "%a, %d %b %Y %H:%M:%S %z" - (org-time-string-to-time pubdate0))))) - (title (org-rss-plain-text - (or (org-element-property :RSS_TITLE headline) - (replace-regexp-in-string - org-bracket-link-regexp - (lambda (m) (or (match-string 3 m) - (match-string 1 m))) - (org-element-property :raw-value headline))) info)) - (publink - (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm)) - (concat - (or hl-home hl-pdir) - (file-name-nondirectory - (file-name-sans-extension - (plist-get info :input-file))) "." htmlext "#" anchor))) - (guid (if org-rss-use-entry-url-as-guid - publink - (org-rss-plain-text - (or (org-element-property :ID headline) - (org-element-property :CUSTOM_ID headline) - publink) - info)))) - (if (not pubdate) "" ;; Skip entries with no PUBDATE prop - (format - (concat - "<item>\n" - "<title>%s</title>\n" - "<link>%s</link>\n" - "<author>%s (%s)</author>\n" - "<guid isPermaLink=\"false\">%s</guid>\n" - "<pubDate>%s</pubDate>\n" - (org-rss-build-categories headline info) "\n" - "<description><![CDATA[%s]]></description>\n" - "</item>\n") - title publink email author guid pubdate contents)))))) - -(defun org-rss-build-categories (headline info) - "Build categories for the RSS item." - (if (eq (plist-get info :rss-categories) 'from-tags) - (mapconcat - (lambda (c) (format "<category><![CDATA[%s]]></category>" c)) - (org-element-property :tags headline) - "\n") - (let ((c (org-element-property :CATEGORY headline))) - (format "<category><![CDATA[%s]]></category>" c)))) - -(defun org-rss-template (contents info) - "Return complete document string after RSS conversion. -CONTENTS is the transcoded contents string. INFO is a plist used -as a communication channel." - (concat - (format "<?xml version=\"1.0\" encoding=\"%s\"?>" - (symbol-name org-html-coding-system)) - "\n<rss version=\"2.0\" - xmlns:content=\"http://purl.org/rss/1.0/modules/content/\" - xmlns:wfw=\"http://wellformedweb.org/CommentAPI/\" - xmlns:dc=\"http://purl.org/dc/elements/1.1/\" - xmlns:atom=\"http://www.w3.org/2005/Atom\" - xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\" - xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\" - xmlns:georss=\"http://www.georss.org/georss\" - xmlns:geo=\"http://www.w3.org/2003/01/geo/wgs84_pos#\" - xmlns:media=\"http://search.yahoo.com/mrss/\">" - "<channel>" - (org-rss-build-channel-info info) "\n" - contents - "</channel>\n" - "</rss>")) - -(defun org-rss-build-channel-info (info) - "Build the RSS channel information." - (let* ((system-time-locale "C") - (title (org-export-data (plist-get info :title) info)) - (email (org-export-data (plist-get info :email) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (date (format-time-string "%a, %d %b %Y %H:%M:%S %z")) ;; RFC 882 - (description (org-export-data (plist-get info :description) info)) - (lang (plist-get info :language)) - (keywords (plist-get info :keywords)) - (rssext (plist-get info :rss-extension)) - (blogurl (or (plist-get info :html-link-home) - (plist-get info :publishing-directory))) - (image (url-encode-url (plist-get info :rss-image-url))) - (ifile (plist-get info :input-file)) - (publink - (or (plist-get info :rss-feed-url) - (concat (file-name-as-directory blogurl) - (file-name-nondirectory - (file-name-sans-extension ifile)) - "." rssext)))) - (format - "\n<title>%s</title> -<atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" /> -<link>%s</link> -<description><![CDATA[%s]]></description> -<language>%s</language> -<pubDate>%s</pubDate> -<lastBuildDate>%s</lastBuildDate> -<generator>%s</generator> -<webMaster>%s (%s)</webMaster> -<image> -<url>%s</url> -<title>%s</title> -<link>%s</link> -</image> -" - title publink blogurl description lang date date - (concat (format "Emacs %d.%d" - emacs-major-version - emacs-minor-version) - " Org-mode " (org-version)) - email author image title blogurl))) - -(defun org-rss-section (section contents info) - "Transcode SECTION element into RSS format. -CONTENTS is the section contents. INFO is a plist used as -a communication channel." - contents) - -(defun org-rss-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to RSS. -CONTENTS is nil. INFO is a plist holding contextual -information." - (org-html-encode-plain-text - (org-timestamp-translate timestamp))) - -(defun org-rss-plain-text (contents info) - "Convert plain text into RSS encoded text." - (let (output) - (setq output (org-html-encode-plain-text contents) - output (org-export-activate-smart-quotes - output :html info)))) - -;;; Filters - -(defun org-rss-final-function (contents backend info) - "Prettify the RSS output." - (with-temp-buffer - (xml-mode) - (insert contents) - (indent-region (point-min) (point-max)) - (buffer-substring-no-properties (point-min) (point-max)))) - -;;; Miscellaneous - -(defun org-rss-add-pubdate-property () - "Set the PUBDATE property for top-level headlines." - (let (msg) - (org-map-entries - (lambda () - (let* ((entry (org-element-at-point)) - (level (org-element-property :level entry))) - (when (= level 1) - (unless (org-entry-get (point) "PUBDATE") - (setq msg t) - (org-set-property - "PUBDATE" (format-time-string - (cdr org-time-stamp-formats))))))) - nil nil 'comment 'archive) - (when msg - (message "Property PUBDATE added to top-level entries in %s" - (buffer-file-name)) - (sit-for 2)))) - -(provide 'ox-rss) - -;;; ox-rss.el ends here diff --git a/lisp/ox-taskjuggler.el b/lisp/ox-taskjuggler.el index 50014d8..47978a6 100644 --- a/lisp/ox-taskjuggler.el +++ b/lisp/ox-taskjuggler.el @@ -608,8 +608,8 @@ doesn't include leading \"depends\"." ;; Compute number of exclamation marks by looking for the ;; common ancestor between TASK and DEP. (while (not (org-element-map parent 'headline - (lambda (hl) (eq hl dep)))) - (incf exclamations) + (lambda (hl) (eq hl dep)))) + (cl-incf exclamations) (setq parent (org-export-get-parent parent))) ;; Build path from DEP to PARENT. (while (not (eq parent dep)) |