;; -*- lexical-binding: t -*- ;;; orgnv.el --- notes database based on grep ;;; ;;; Copyright (C) 2020 Juan Jose Garcia-Ripoll ;; ;; All rights reserved. ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions are met: ;; 1. Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; 2. Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; 3. Neither the names of the copyright holders nor the names of any ;; contributors may be used to endorse or promote products derived from ;; this software without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" ;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN ;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ;; POSSIBILITY OF SUCH DAMAGE. ;; ;;; Version: 0.1 ;;; Author: Juan Jose Garcia-Ripoll ;;; Keywords: org mode, plain text, notes, Deft, Simplenote, Notational Velocity ;; This file is not part of GNU Emacs. (require 'org) (defgroup orgnv nil "Emacs OrgNV mode." :group 'local) (defcustom orgnv-directories (or (expand-file-name org-directory) (expand-file-name "~/.orgnv/")) "List of directories where OrgNV looks for notes." :type 'directory :safe 'stringp :group 'orgnv) (defcustom orgnv-recursive t "If true, recursively search the orgnv-directories and its subfolders looking for notes." :type 'boolean :group 'orgnv) (defcustom orgnv-ignore-case t "If true (the default value), ignore cases when searching notes." :type 'boolean :group 'orgnv) (defcustom orgnv-extensions '("org") "File name extensions to consider when looking for notes." :type '(repeat string) :group 'orgnv) (defcustom orgnv-grep-command (or (executable-find "grep") "grep") "Executable file that implements the GNU grep utility." :type 'file :safe 'stringp :group 'orgnv) (defcustom orgnv-description-limit 1000 "Maximum number of files to display in the browser." :type '(choice (integer :tag "Limit number of files displayed") (const :tag "No limit" nil)) :group 'orgnv) (defconst orgnv-buffer "*orgnv output*" "OrgNV buffer name") (defcustom orgnv-context-size 3 "Maximum number of lines to consider after the title." :type 'integer :safe (lambda (x) (< 0 x 10)) :group 'orgnv) (defcustom orgnv-title-pattern "#\\+TITLE\\:" "Pattern used for searching titles in notes." :type 'string :group 'orgnv) (defcustom orgnv-display-limit 300 "Maximum number of items do display in the browsing buffer" :type 'integer :group 'orgnv) (defcustom orgnv-database-sort-predicate 'orgnv-compare-titles "Either NIL, if we do not sort the database, or a function with two arguments that can be passed to SORT." :type '(or function symbol)) (defcustom orgnv-install-keybindings t "Whether to install OrgNV under C-x g" :type 'boolean :group 'orgnv) (defgroup orgnv-faces nil "Faces used in Orgnv mode" :group 'orgnv :group 'faces) (defface orgnv-title-face '((t :inherit font-lock-function-name-face :bold t)) "Face for OrgNV file titles." :group 'orgnv-faces) (defface orgnv-separator-face '((t :inherit font-lock-comment-delimiter-face)) "Face for OrgNV separator string." :group 'orgnv-faces) (defface orgnv-summary-face '((t :inherit font-lock-comment-face)) "Face for OrgNV file summary strings." :group 'orgnv-faces) (defun orgnv-build-database (&optional pattern context directories) "Scan the notes in the orgnv-directories, creating a temporary buffer with the output of the command. PATTERN, CONTEXT, DIRECTORIES default orgnv-title-pattern, orgnv-context-size and orgnv-directories." (with-temp-buffer (delete-region (point-min) (point-max)) (setq context (or context orgnv-context-size) pattern (or pattern orgnv-title-pattern)) (let ((grep-args `(,@(unless (zerop context) (list "-A" (format "%s" context))) ;;"-s" ; Suspend errors "-E" ; Extended syntax "-Z" ; Null separated names "-m" "1" ; One result ,(if orgnv-ignore-case "--ignore-case" "--no-ignore-case") ,@(mapcar (lambda (extension) (format "--include=*.%s" extension)) orgnv-extensions) ,(if orgnv-recursive "--directories=recurse" "--directories=skip") ,(concat "^" pattern) ,@(mapcar (lambda (d) (expand-file-name "*" d)) (or directories orgnv-directories))))) (message "Invoking %s with %S" orgnv-grep-command grep-args) (apply 'call-process orgnv-grep-command nil t nil grep-args) (orgnv--format pattern)))) (defun orgnv-compare-titles (record1 record2) (string< (cadr record1) (cadr record2))) (defun orgnv--format (pattern &optional sort-predicate) "This function processes the current buffer, scanning for an output from GREP in the form of file-name null-character line-matching-title file-name null-character summary-line-1 ... -- It returns a database in the form of an association list, ((filename-1 . (title-1 . description-1)) ...) This database will be sorted if SORT-PREDICATE is a function that can compare pairs of records." (goto-char (point-min)) (let ((file-pattern (concat "^\\([^\x0\n]+\\)\x0[ ]*\\(" pattern "\\)?[ ]*\\([^\n]*\\)$")) (case-fold-search orgnv-ignore-case) (records '()) lastfile record description) (while (re-search-forward file-pattern nil t) (let ((file (match-string 1)) (string (match-string 3))) (cond ((not (equal file lastfile)) (setq lastfile file description "" record (cons string description) records (cons (cons lastfile record) records))) ((or (null string) (zerop (length string))) ;; Nothing in the description ) ((null description) ;; No more text fits into the description ) (t (setq description (concat description string " ")) (if (>= (length description) orgnv-description-limit) (setf description (substring description 0 orgnv-description-limit) (cdr record) description description nil) (setf (cdr record) description)))))) (if (setq sort-predicate (or sort-predicate orgnv-database-sort-predicate)) (sort records sort-predicate) records))) (defun orgnv--filter-database (pattern database &optional size-limit) "Take an OrgNV database and filter the records that match PATTERN. If SIZE-LIMIT is not nil, return a database with at most SIZE-LIMIT elements." (cond ((length pattern) (let ((i 0) (output nil)) (while (and database (or (null size-limit) (<= i orgnv-display-limit))) (let ((record (pop database))) (when (string-match pattern (cadr record)) (setq i (1+ i)) (push record output)))) (nreverse output))) ((null size-limit) database) (t (seq-subseq database 0 size-limit)))) (defvar orgnv--database nil "Database which is currently being interrogated") (defvar orgnv--filtered-database nil "Subset of elements in the database that are displayed") (defvar orgnv--buffer nil "Buffer where the database is displayed") (defun orgnv--display-matches (buffer filtered-database &optional first) (with-current-buffer buffer (delete-region (point-min) (point-max)) (dolist (l filtered-database) (insert (propertize (cadr l) 'face 'orgnv-title-face) (propertize " -- " 'face 'orgnv-separator-face) (propertize (cddr l) 'face 'orgnv-summary-face) "\n")) (when first (toggle-truncate-lines +1) (hl-line-mode +1)) (goto-char (point-min)) (hl-line-highlight))) (defun orgnv-previous-line () (interactive) (with-current-buffer orgnv--buffer (hl-line-unhighlight) (forward-line -1) (hl-line-highlight))) (defun orgnv-next-line () (interactive) (with-current-buffer orgnv--buffer (hl-line-unhighlight) (forward-line +1) (hl-line-highlight))) (defvar orgnv--selection nil "Record selected by the user or nil") (defvar orgnv--next-action nil "Actions to perform once the ORGNV buffer is closed.") (defun orgnv--cleanup () "Quit the OrgNV and close its window." (pop-to-buffer orgnv--buffer) (quit-window)) (defun orgnv-completing-read (database) "Prompt the user to select a record in the OrgNV. The user will input text in the minibuffer. This text will be used to refine queries on the database, with output displayed in orgnv-buffer. The user can press M-p, M-n, and to change the selected entries. Finally pressing implements the selection." (let ((orgnv--database database) (orgnv--filtered-database database) (orgnv--selection nil)) (with-temp-buffer (let ((orgnv--buffer (current-buffer))) (rename-buffer orgnv-buffer t) (orgnv--update t) (display-buffer orgnv--buffer) (unwind-protect (let ((map (orgnv--make-minibuffer-map))) (read-from-minibuffer "Keywords: " nil map)) ;; We cleanup our buffers both for natural causes (e.g. pressing ;; ) or when aborting (pressing C-g) (orgnv--cleanup)))) orgnv--selection)) (defun orgnv--make-minibuffer-map () (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\t" 'minibuffer-complete) ;; Extend the filter string by default. (setq i ?\s) (while (< i 256) (define-key map (vector i) 'orgnv--insert-and-update) (setq i (1+ i))) ;; M-TAB is already abused for many other purposes, so we should find ;; another binding for it. ;; (define-key map "\e\t" 'minibuffer-force-complete) (define-key map [?\M-p] 'orgnv-previous-line) (define-key map [?\M-n] 'orgnv-next-line) (define-key map [?\C-h] 'orgnv-help) (define-key map (kbd "") 'orgnv-previous-line) (define-key map (kbd "") 'orgnv-next-line) (define-key map (kbd "") 'orgnv--update) (define-key map [?\C-c ?\C-l] 'orgnv-link) (define-key map (kbd "RET") 'orgnv-select) map)) (defun orgnv-select () (interactive) (orgnv--select (lambda (selection) (switch-to-buffer (find-file-noselect (car selection) nil nil nil))))) (defun orgnv-link () (interactive) (orgnv--select (lambda (selection) (org-insert-link nil (car selection) (cadr selection))))) (defun orgnv--select (the-action) (let ((filter (minibuffer-contents))) (with-current-buffer orgnv--buffer (let* ((l (min (line-number-at-pos) (length orgnv--filtered-database))) (selection (elt orgnv--filtered-database (1- l)))) (push (if selection (lambda () (funcall the-action selection)) (lambda () (let ((new-note (orgnv-create-note filter))) (when new-note (funcall the-action new-note))))) orgnv--next-action)))) (exit-minibuffer)) (defvar orgnv-help nil) (defun orgnv-help-text () "OrgNV (Org Navigation) ---------------------- Enter keywords to refine search through the OrgNV database. Use the special keys below to affect the selection of records, move through the database, create notes, etc. key binding --- ------- C-g abort C-h show / hide this help message up / M-p move to previous record down / M-n move to next record select current record if it exits, or create new note C-c C-l link current record other keys continue extending the database query ") (defun orgnv-help () (interactive) (if orgnv-help (orgnv--clear-help) (with-current-buffer orgnv--buffer (setq-local orgnv-help (point)) (delete-region (point-min) (point-max)) (insert (orgnv-help-text))))) (defun orgnv--clear-help () (when orgnv-help (with-current-buffer orgnv--buffer (orgnv--update) (goto-char orgnv-help) (setq-local orgnv-help nil)))) (defun orgnv--insert-and-update () (interactive) (let ((c (vector last-command-event)) f) (cond ((setq f (lookup-key minibuffer-local-map c)) (funcall f 1)) ((setq f (lookup-key global-map c)) (funcall f 1)) (t (self-insert-command 1))) (orgnv--update))) (defun orgnv--update (&optional first-time) (interactive) (setq orgnv--filtered-database (orgnv--filter-database (minibuffer-contents) orgnv--database)) (orgnv--display-matches orgnv--buffer orgnv--filtered-database first-time)) (defun orgnv-create-note (tentative-title) "Create a note, prompting the user for the title." (let ((title (read-from-minibuffer "Note title: " tentative-title))) (when title (let* ((filenames (mapcar (lambda (dir) (orgnv-make-file-name title dir)) orgnv-directories)) (filename (completing-read "Filename: " filenames nil nil (car filenames)))) (when filename (orgnv-create-template filename title) (cons filename (cons title nil)) ))))) (defun orgnv-make-file-name (title dir) (expand-file-name (concat title ".org") dir)) (defun orgnv-create-template (filename title) (let ((buffer (find-file-noselect filename nil nil nil))) (when buffer (with-current-buffer buffer (insert "#+TITLE: " title "\n\n")) buffer))) (defcustom orgnv-relative-links nil "Control how to create org-mode links. - nil means insert full paths - t means paths relative to org-directory" :type 'boolean :group 'orgnv) (defun orgnv-browse () (interactive) (let* ((orgnv--next-action nil) (record (orgnv-completing-read (or orgnv--database (orgnv-build-database))))) (dolist (action orgnv--next-action) (funcall action)) record)) (defun orgnv--relative-path (file) (if orgnv-relative-links (file-relative-name file org-directory) file)) (bind-key (kbd "C-x g") 'orgnv-browse org-mode-map) (provide 'orgnv)