summaryrefslogtreecommitdiffhomepage
path: root/lib/doc
diff options
context:
space:
mode:
Diffstat (limited to 'lib/doc')
-rw-r--r--lib/doc/jao-counsel-recoll.el60
-rw-r--r--lib/doc/jao-org-links.el169
-rw-r--r--lib/doc/jao-org-notes.el166
3 files changed, 335 insertions, 60 deletions
diff --git a/lib/doc/jao-counsel-recoll.el b/lib/doc/jao-counsel-recoll.el
deleted file mode 100644
index adae881..0000000
--- a/lib/doc/jao-counsel-recoll.el
+++ /dev/null
@@ -1,60 +0,0 @@
-;;; jao-counsel-recoll.el --- counsel and recoll -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2020 jao
-
-;; Author: jao <mail@jao.io>
-;; Keywords: docs
-
-;; 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:
-
-;; Helpers for using recoll with counsel
-
-;;; Code:
-
-(require 'jao-recoll)
-(require 'counsel)
-(require 'ivy)
-
-(defvar jao-counsel-recoll--history nil)
-(defun jao-counsel-recoll--function (str)
- (let ((xs (counsel-recoll-function str)))
- (cl-remove-if-not (lambda (x) (string-prefix-p "file://" x)) xs)))
-
-;;;###autoload
-(defun jao-counsel-recoll (&optional initial-input)
- (interactive)
- (counsel-require-program "recoll")
- (ivy-read "recoll: " 'jao-counsel-recoll--function
- :initial-input initial-input
- :dynamic-collection t
- :history 'jao-counsel-recoll--history
- :action (lambda (x)
- (when (string-match "file://\\(.*\\)\\'" x)
- (let ((file-name (match-string 1 x)))
- (if (string-match "pdf$" x)
- (jao-open-doc file-name)
- (find-file file-name)))))
- :unwind #'counsel-delete-process
- :caller 'jao-counsel-recoll))
-
-(defun jao-counsel-recoll--recoll (_s) (jao-recoll ivy-text))
-
-(ivy-set-actions 'jao-counsel-recoll
- '(("x" jao-counsel-recoll--recoll "List in buffer")))
-
-
-(provide 'jao-counsel-recoll)
-;;; jao-counsel-recoll.el ends here
diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el
new file mode 100644
index 0000000..ee6af7c
--- /dev/null
+++ b/lib/doc/jao-org-links.el
@@ -0,0 +1,169 @@
+;; -*- lexical-binding: t; -*-
+
+(require 'jao-maildir)
+(require 'pdf-info)
+
+(defvar jao-org--sink-dir "./")
+(defvar jao-org-open-pdf-fun 'jao-org--pdf-tools-open)
+
+(defun jao-org--pdf-go (page height)
+ (when page (pdf-view-goto-page page))
+ (when height
+ (image-set-window-vscroll
+ (round (/ (* height (cdr (pdf-view-image-size))) (frame-char-height))))))
+
+(defun jao-org--pdf-tools-open (path page &optional height)
+ (org-open-file path 1)
+ (jao-org--pdf-go path page))
+
+(defun jao-org--pdf-open (path page &optional height)
+ (funcall (or jao-org-open-pdf-fun 'jao-org--pdf-tools-open) path page height))
+
+(defun jao-org--pdf-p (file) (string-match-p ".*\\.pdf$" file))
+
+(defun jao-org-links--open-pdf (link)
+ "Open LINK in pdf-view-mode."
+ (require 'pdf-tools)
+ (cond ((string-match "\\(.*\\)::\\([0-9]*\\)\\+\\+\\([[0-9]\\.*[0-9]*\\)" link)
+ (let* ((path (match-string 1 link))
+ (page (string-to-number (match-string 2 link)))
+ (height (string-to-number (match-string 3 link))))
+ (jao-org--pdf-open path page height)))
+ ((string-match "\\(.*\\)::\\([0-9]+\\)$" link)
+ (let* ((path (match-string 1 link))
+ (page (max 1 (string-to-number (match-string 2 link)))))
+ (jao-org--pdf-open path page)))
+ (t (jao-org--pdf-open link nil))))
+
+(defun jao-org-links--follow-doc (link)
+ (let* ((full-link (concat org-directory "/doc/" link))
+ (dest-path (car (split-string full-link "::"))))
+ (when (not (file-exists-p dest-path))
+ (let* ((sink-file (expand-file-name link jao-org--sink-dir))
+ (real-file (if (file-exists-p sink-file) sink-file
+ (read-file-name "Import file: "
+ jao-org--sink-dir link link))))
+ (shell-command (format "mv %s %s" real-file dest-path))))
+ (if (jao-org--pdf-p dest-path)
+ (jao-org-links--open-pdf full-link)
+ (browse-url (format "file://%s" (expand-file-name dest-path))))))
+
+(defun jao-org-links--complete-doc (&optional arg)
+ (let ((default-directory jao-org--sink-dir))
+ (let ((f (replace-regexp-in-string "^file:" "doc:"
+ (org-file-complete-link arg))))
+ (if (jao-org--pdf-p f)
+ (concat f "::" (read-from-minibuffer "Page: " "1"))
+ f))))
+
+(defsubst jao-org--title->file (title)
+ (concat (mapconcat 'downcase (split-string title nil t) "-") ".pdf"))
+
+(defun jao-org--pdf-title (&optional fname)
+ (let ((base (file-name-base (or fname (pdf-view-buffer-file-name)))))
+ (capitalize (replace-regexp-in-string "-" " " base))))
+
+(defvar-local jao--pdf-outline nil)
+
+(defun jao-org--pdf-section-title (&optional page)
+ (when (not jao--pdf-outline)
+ (setq-local jao--pdf-outline (pdf-info-outline)))
+ (let ((page (or page (pdf-view-current-page)))
+ (outline jao--pdf-outline)
+ (cur-page 0)
+ (cur-title (jao-org--pdf-title)))
+ (while (and (car outline) (< cur-page page))
+ (setq cur-page (cdr (assoc 'page (car outline))))
+ (when (<= cur-page page)
+ (setq cur-title (cdr (assoc 'title (car outline)))))
+ (setq outline (cdr outline)))
+ (replace-regexp-in-string "[[:blank:]]+" " " cur-title)))
+
+(defun jao-org-links-open-mail (fname)
+ (let ((group (jao-maildir-file-to-group fname))
+ (id (with-temp-buffer
+ (insert-file fname)
+ (goto-char (point-min))
+ (message-mode)
+ (not-modified)
+ (message-fetch-field "Message-ID"))))
+ (when (and group id) (org-gnus-follow-link group id))))
+
+;;;###autoload
+(defvar jao-org-links-pdf-store-fun nil)
+
+(defun jao-org-links--store-pdf-link ()
+ (or (when (fboundp jao-org-links-pdf-store-fun)
+ (funcall jao-org-links-pdf-store-fun))
+ (when (derived-mode-p 'pdf-view-mode)
+ (jao-org-links-store-pdf-link buffer-file-name
+ (pdf-view-current-page)
+ (jao-org--pdf-section-title)))))
+
+;;;###autoload
+(defun jao-org-links-store-pdf-link (path page title)
+ (org-store-link-props
+ :type "doc"
+ :link (format "doc:%s::%d" (file-name-nondirectory path) page)
+ :description (format "%s (p. %d)" title page)))
+
+;;;###autoload
+(defun jao-org-insert-doc (title)
+ (interactive "sDocument title: ")
+ (insert (format "[[doc:%s][%s]]" (jao-org--title->file title) title)))
+
+;;;###autoload
+(defun jao-org-links-setup (sink-dir)
+ (interactive)
+ (org-link-set-parameters "doc"
+ :follow #'jao-org-links--follow-doc
+ :complete #'jao-org-links--complete-doc
+ :store #'jao-org-links--store-pdf-link)
+ (org-link-set-parameters "message" :follow #'jao-org-links-open-mail)
+ (setq jao-org--sink-dir (file-name-as-directory sink-dir)))
+
+(defvar jao-doc-notes-dir)
+
+;;;###autoload
+(defun jao-org-org-to-pdf-file ()
+ (expand-file-name (concat "doc/" (file-name-base buffer-file-name) ".pdf")
+ jao-org-notes-dir))
+
+;;;###autoload
+(defun jao-org-pdf-to-org-file (&optional file-name)
+ (let* ((file-name (or file-name buffer-file-name))
+ (bn (file-name-base file-name))
+ (rx (format "%s\\.org$" (regexp-quote bn))))
+ (save-some-buffers nil
+ (lambda ()
+ (string-prefix-p jao-org-notes-dir buffer-file-name)))
+ (or (car (directory-files-recursively jao-org-notes-dir rx))
+ (let* ((dirs (seq-difference (directory-files jao-org-notes-dir)
+ '("." ".." "attic")))
+ (dir (completing-read "Notes subdir: " dirs nil t)))
+ (expand-file-name (concat dir "/" bn ".org") jao-org-notes-dir)))))
+
+;;;###autoload
+(defun jao-org-insert-doc-skeleton (&optional title)
+ (insert "#+title: " (or title (jao-org--pdf-title (buffer-file-name)))
+ "\n#+author:\n#+startup: latexpreview\n\n"))
+
+;;;###autoload
+(defun jao-org-pdf-goto-org (arg)
+ (interactive "P")
+ (when (jao-org--pdf-p buffer-file-name)
+ (let* ((file (jao-org-pdf-to-org-file))
+ (new (not (file-exists-p file)))
+ (title (jao-org--pdf-title)))
+ (when (or arg new) (org-store-link nil t))
+ (find-file-other-window file)
+ (when new
+ (jao-org-insert-doc-skeleton title)
+ (org-insert-link)))))
+
+;;;###autoload
+(defun jao-org-pdf-goto-org* ()
+ (interactive)
+ (jao-org-pdf-goto-org t))
+
+(provide 'jao-org-links)
diff --git a/lib/doc/jao-org-notes.el b/lib/doc/jao-org-notes.el
new file mode 100644
index 0000000..a1b9dbe
--- /dev/null
+++ b/lib/doc/jao-org-notes.el
@@ -0,0 +1,166 @@
+;;; jao-org-notes.el --- A simple system for org note taking -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020, 2021 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: tools
+
+;; 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:
+
+;; An org note per file, with consultable title and tags and a
+;; backlinks approximation.
+
+;;; Code:
+
+(require 'org)
+(require 'consult)
+
+(defvar jao-org-notes-dir (expand-file-name "notes" org-directory))
+
+(defvar jao-org-notes--rg
+ (concat "rg --null --line-buffered --color=ansi --max-columns=250"
+ " --no-heading --line-number --smart-case"
+ " . -e \"^(#.(title|filetags): .*)ARG\" OPTS"))
+
+(defvar jao-org-notes--trx ":[0-9]+:#\\+\\(file\\)?\\(title\\|tags\\):")
+
+(defun jao-org-notes--clean-match (m)
+ (cons (replace-regexp-in-string jao-org-notes--trx " (\\2)" (car m)) (cdr m)))
+
+(defun jao-org-notes--matches (lines)
+ (let ((ms (consult--grep-matches lines)))
+ (mapcar #'jao-org-notes--clean-match ms)))
+
+(defun jao-org-notes--lookup (_ cands cand)
+ (or (cadr (assoc cand cands)) cand))
+
+(defvar jao-org-notes--grep-history nil)
+
+(defun jao-org--grep (prompt &optional cat no-req)
+ (let ((default-directory (expand-file-name (or cat "") jao-org-notes-dir)))
+ (consult--read
+ (consult--async-command jao-org-notes--rg
+ (consult--async-transform jao-org-notes--matches))
+ :prompt prompt
+ :lookup #'jao-org-notes--lookup
+ :initial consult-async-default-split
+ :add-history (concat consult-async-default-split (thing-at-point 'symbol))
+ :require-match (not no-req)
+ :category 'jao-org-notes-lookup
+ :history '(:input jao-org-notes--grep-history)
+ :sort nil)))
+
+(defun jao-org-notes--cat ()
+ (let* ((cats (seq-difference (directory-files jao-org-notes-dir)
+ '("." ".." "attic")))
+ (cat (completing-read "Top level category: " cats)))
+ (cond ((file-exists-p (expand-file-name cat jao-org-notes-dir)) cat)
+ ((yes-or-no-p "New category, create?") cat)
+ (t (jao-roam--cat)))))
+
+(defun jao-org-notes--insert-title ()
+ (let* ((cat (jao-org-notes--cat))
+ (title (file-name-base (jao-org--grep "Title: " cat t)))
+ (title (replace-regexp-in-string "^#" "" title)))
+ (when (not (string-empty-p title))
+ (let* ((base (replace-regexp-in-string " +" "-" (downcase title)))
+ (fname (expand-file-name (concat cat "/" base ".org")
+ jao-org-notes-dir))
+ (exists? (file-exists-p fname)))
+ (find-file fname)
+ (when (not exists?)
+ (insert "#+title: " title "\n")
+ t)))))
+
+(defvar jao-org-notes--tags nil)
+
+(defun jao-org-notes--update-tags ()
+ (setq jao-org-notes--tags
+ (org-global-tags-completion-table
+ (directory-files-recursively jao-org-notes-dir ".*\\.org"))))
+
+(defun jao-org-notes--read-tags ()
+ (unless jao-org-notes--tags (jao-org-notes--update-tags))
+ (completing-read-multiple "Tags: " jao-org-notes--tags))
+
+(defun jao-org-notes--insert-tags ()
+ (insert "#+filetags: " (mapconcat #'identity (jao-org-notes--read-tags) " ") "\n"))
+
+(defun jao-org-notes--insert-date ()
+ (insert "#+date: ")
+ (org-insert-time-stamp (current-time))
+ (insert "\n"))
+
+(defun jao-org-notes--template (k)
+ `(,k "Note" plain (file jao-org-notes-open-or-create) "\n- %a "
+ :immediate-finish t :jump-to-captured t))
+
+;;;###autoload
+(defun jao-org-notes-open ()
+ "Search for a note file, matching tags and titles with completion."
+ (interactive)
+ (when-let (f (jao-org--grep "Search notes: "))
+ (find-file f)))
+
+;;;###autoload
+(defun jao-org-notes-open-or-create ()
+ "Open or create a new note file, matching tags and titles with completion."
+ (interactive)
+ (when (jao-org-notes--insert-title)
+ (jao-org-notes--insert-date)
+ (jao-org-notes--insert-tags)
+ (jao-org-notes--update-tags)
+ (insert "#+link: "))
+ (save-buffer)
+ (buffer-file-name))
+
+;;;###autoload
+(defun jao-org-notes-backlinks ()
+ "Show a list of note files linking to the current one."
+ (interactive)
+ (consult-ripgrep jao-org-notes-dir
+ (concat "\\[\\[file:(.*/)?" (regexp-quote (buffer-name)))))
+
+;;;###autoload
+(defun jao-org-notes-insert-tags ()
+ "Insert a list of tags at point, with completing read."
+ (interactive)
+ (insert (mapconcat 'identity (jao-org-notes--read-tags) " ")))
+
+;;;###autoload
+(defun jao-org-notes-insert-link ()
+ "Select a note file (with completion) and insert a link to it."
+ (interactive)
+ (when-let (f (jao-org--grep "Notes file: "))
+ (let ((rel-path (file-relative-name f default-directory))
+ (title (with-current-buffer (find-file-noselect f)
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward "^#\\+title: \\(.+\\)" nil t)
+ (match-string 1))))))
+ (insert (format "[[file:%s][%s]]" rel-path title)))))
+
+;;;###autoload
+(defun jao-org-notes-setup (mnemonic)
+ "Set up the notes system, providing a mnemonic character for its org template."
+ (setq org-capture-templates
+ (add-to-list 'org-capture-templates (jao-org-notes--template mnemonic)))
+ (add-to-list 'org-agenda-files jao-org-notes-dir)
+ (when (fboundp 'org-capture-upgrade-templates)
+ (org-capture-upgrade-templates org-capture-templates)))
+
+(provide 'jao-org-notes)
+;;; jao-org-notes.el ends here