From 771abb84830678455de4625ac7f082d8100f0ea0 Mon Sep 17 00:00:00 2001 From: jao Date: Tue, 2 Feb 2021 05:16:17 +0000 Subject: libs -> lib/ --- lib/org/jao-org-gnus.el | 72 +++++++++++++++++++++++ lib/org/jao-org-links.el | 147 +++++++++++++++++++++++++++++++++++++++++++++++ lib/org/jao-org-notes.el | 79 +++++++++++++++++++++++++ lib/org/jao-org-popup.el | 31 ++++++++++ lib/org/jao-org-utils.el | 43 ++++++++++++++ 5 files changed, 372 insertions(+) create mode 100644 lib/org/jao-org-gnus.el create mode 100644 lib/org/jao-org-links.el create mode 100644 lib/org/jao-org-notes.el create mode 100644 lib/org/jao-org-popup.el create mode 100644 lib/org/jao-org-utils.el (limited to 'lib/org') diff --git a/lib/org/jao-org-gnus.el b/lib/org/jao-org-gnus.el new file mode 100644 index 0000000..cdeec65 --- /dev/null +++ b/lib/org/jao-org-gnus.el @@ -0,0 +1,72 @@ +;; Support for saving Gnus messages by Message-ID +(defun mde-org-gnus-save-by-mid () + (when (memq major-mode '(gnus-summary-mode gnus-article-mode)) + (when (eq major-mode 'gnus-article-mode) + (gnus-article-show-summary)) + (let* ((group gnus-newsgroup-name) + (method (gnus-find-method-for-group group))) + (when (memq (car method) '(nnml nntp)) + (let* ((article (gnus-summary-article-number)) + (header (gnus-summary-article-header article)) + (from (mail-header-from header)) + (message-id + (save-match-data + (let ((mid (mail-header-id header))) + (if (string-match "<\\(.*\\)>" mid) + (match-string 1 mid) + (error "Malformed message ID header %s" mid))))) + (date (mail-header-date header)) + (subject (gnus-summary-subject-string))) + (org-store-link-props :type "mid" :from from :subject subject + :message-id message-id :group group + :link (org-make-link "mid:" message-id)) + (apply 'org-store-link-props + :description (org-email-link-description) + org-store-link-plist) + t))))) + +(defvar mde-mid-resolve-methods '() + "List of methods to try when resolving message ID's. For Gnus, +it is a cons of 'gnus and the select (type and name).") +(setq mde-mid-resolve-methods + '((gnus nnml ""))) + +(defvar mde-org-gnus-open-level 1 + "Level at which Gnus is started when opening a link") +(defun mde-org-gnus-open-message-link (msgid) + "Open a message link with Gnus" + (require 'gnus) + (require 'org-table) + (catch 'method-found + (message "[MID linker] Resolving %s" msgid) + (dolist (method mde-mid-resolve-methods) + (cond + ((and (eq (car method) 'gnus) + (eq (cadr method) 'nnml)) + (funcall (cdr (assq 'gnus org-link-frame-setup)) + mde-org-gnus-open-level) + (when gnus-other-frame-object + (select-frame gnus-other-frame-object)) + (let* ((msg-info (nnml-find-group-number + (concat "<" msgid ">") + (cdr method))) + (group (and msg-info (car msg-info))) + (message (and msg-info (cdr msg-info))) + (qname (and group + (if (gnus-methods-equal-p + (cdr method) + gnus-select-method) + group + (gnus-group-full-name group (cdr method)))))) + (when msg-info + (gnus-summary-read-group qname nil t) + (gnus-summary-goto-article message nil t)) + (throw 'method-found t))) + (t (error "Unknown link type")))))) + +(eval-after-load 'org-gnus + '(progn + (add-to-list 'org-store-link-functions 'mde-org-gnus-save-by-mid) + (org-add-link-type "mid" 'mde-org-gnus-open-message-link))) + +(provide 'jao-org-gnus) diff --git a/lib/org/jao-org-links.el b/lib/org/jao-org-links.el new file mode 100644 index 0000000..7d9cb55 --- /dev/null +++ b/lib/org/jao-org-links.el @@ -0,0 +1,147 @@ +(require 'jao-org-utils) +(require 'pdf-info) + +(defvar jao-org--sink-dir "./") +(defvar jao-org-open-pdf-fun 'jao-org--pdf-tools-open) + +(defun jao-org--pdf-tools-open (path page &optional height) + (org-open-file path 1) + (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-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 (string-to-number (match-string 2 link)))) + (jao-org--pdf-open path page))) + (t (org-open-file link 1)))) + +(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))) + +;;;###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) + (setq jao-org--sink-dir (file-name-as-directory sink-dir))) + +;;;###autoload +(defvar jao-org-doc-notes-dir "notes/books") + +;;;###autoload +(defun jao-org-org-to-pdf-file () + (replace-regexp-in-string (format "/%s/\\(.+\\)\\.org$" jao-org-doc-notes-dir) + "/doc/\\1.org" + buffer-file-name)) + +;;;###autoload +(defun jao-org-pdf-to-org-file (&optional file-name) + (replace-regexp-in-string "/doc/\\(.+\\)\\.pdf$" + (format "/%s/\\1.org" jao-org-doc-notes-dir) + (or file-name buffer-file-name))) + +;;;###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/org/jao-org-notes.el b/lib/org/jao-org-notes.el new file mode 100644 index 0000000..3e9abbb --- /dev/null +++ b/lib/org/jao-org-notes.el @@ -0,0 +1,79 @@ +;;; jao-org-notes.el --- A simple system for org note taking -*- lexical-binding: t; -*- + +;; Copyright (C) 2020, 2021 jao + +;; Author: jao +;; 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 . + +;;; Commentary: + +;; A note per file + +;;; Code: + +(require 'org) + +(defvar jao-org-notes-dir (expand-file-name "notes" org-directory)) + +(defun jao-org-notes--insert-title () + (let ((title (read-string "Title: "))) + (when (not (string-empty-p title)) + (let* ((base (replace-regexp-in-string " +" "-" (downcase title))) + (fname (expand-file-name (concat base ".org") jao-org-notes-dir)) + (exists? (file-exists-p fname))) + (find-file fname) + (when (not exists?) + (insert "#+title: " title "\n") + t))))) + +(defun jao-org-notes--insert-tags () + (let ((ts (completing-read-multiple "Tags: " + (org-global-tags-completion-table)))) + (insert "#+filetags:" ":" (mapconcat 'identity ts ":") ":\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) "* %a ")) + +;;;###autoload +(defun jao-org-notes-open () + (interactive) + (when (jao-org-notes--insert-title) + (jao-org-notes--insert-date) + (jao-org-notes--insert-tags) + (insert "#+link: ")) + (save-buffer) + (buffer-file-name)) + +;;;###autoload +(defun jao-org-notes-setup (mnemonic) + (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))) + +;;;###autoload +(defun jao-org-notes-backlinks () + (interactive) + (consult-ripgrep jao-org-notes-dir (regexp-quote (buffer-name)))) + +(provide 'jao-org-notes) +;;; jao-org-notes.el ends here diff --git a/lib/org/jao-org-popup.el b/lib/org/jao-org-popup.el new file mode 100644 index 0000000..eb5b24d --- /dev/null +++ b/lib/org/jao-org-popup.el @@ -0,0 +1,31 @@ +;;; frame popups +;; http://metajack.im/2008/12/30/gtd-capture-with-emacs-orgmode/ +(defsubst jao-remember--frame-p () + (equal "*Remember*" (frame-parameter nil 'name))) + +(defadvice remember-finalize (after delete-remember-frame activate) + "Advise remember-finalize to close the frame if it is the remember frame" + (when (jao-remember--frame-p) (delete-frame))) + +(defadvice remember-destroy (after delete-remember-frame activate) + "Advise remember-destroy to close the frame if it is the remember frame" + (when (jao-remember--frame-p) (delete-frame))) + +;; make the frame contain a single window. by default org-remember +;; splits the window. +(defun jao-remember--delete-other-windows () + (when (jao-remember--frame-p) (delete-other-windows))) + +(add-hook 'remember-mode-hook 'jao-remember--delete-other-windows) + +(defun make-remember-frame () + "Create a new frame and run org-remember" + (interactive) + (make-frame-on-display (getenv "DISPLAY") + '((name . "*Remember*") + (width . 80) + (height . 10))) + (select-frame-by-name "*Remember*") + (org-remember nil ?x)) + +(provide 'jao-org-popup) \ No newline at end of file diff --git a/lib/org/jao-org-utils.el b/lib/org/jao-org-utils.el new file mode 100644 index 0000000..8d65ed7 --- /dev/null +++ b/lib/org/jao-org-utils.el @@ -0,0 +1,43 @@ +(require 'org) + +;;; links +(defun jao-org-link-at-point (&optional copy) + (when (thing-at-point-looking-at "\\[\\[\\([^]]+\\)\\]\\[[^]]+\\]\\]") + (when copy (kill-ring-save (match-beginning 1) (match-end 1))) + (match-string-no-properties 1))) + +(defun jao-org-copy-link-at-point () + (interactive) + (message "%s" (or (jao-org-link-at-point t) "No link at point"))) + +(defun jao-org-insert-link (url title) + (insert (format "[[%s][%s]]" url title))) + +;;; eldoc +(defun jao-org-eldoc--hook () + (set (make-local-variable 'eldoc-documentation-function) + 'jao-org-link-at-point) + (eldoc-mode)) + +;;;###autoload +(defun jao-org-utils-eldoc-setup () + (add-hook 'org-mode-hook 'jao-org-eldoc--hook)) + +;;; play fair with saveplace +(defun jao-org--show-if-hidden () + (when (outline-invisible-p) + (save-excursion + (outline-previous-visible-heading 1) + (org-show-subtree)))) + +;;; verifying org refile targets +(defun jao-org--refile-target-verify () + (not (looking-at-p ".*\\[\\[.+$"))) + +;;;###autoload +(defun jao-org-utils-setup () + (setq org-refile-target-verify-function 'jao-org--refile-target-verify) + (add-hook 'org-mode-hook 'jao-org--show-if-hidden t)) + + +(provide 'jao-org-utils) -- cgit v1.2.3