summaryrefslogtreecommitdiffhomepage
path: root/attic/elisp/jao-recoll.el
blob: b23106fdbb426605f2aaab39a38131ef0fd30e71 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
;;; jao-recoll.el -- Displaying recoll queries -*- lexical-binding: t; -*-

;; Copyright (c) 2017, 2020, 2021, 2022 Jose Antonio Ortega Ruiz

;; 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 of the License, 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Start date: Wed Nov 01, 2017 18:14


;;; Comentary:

;; A simple interactive command to perform recoll queries and display
;; its results using org markup.

;;; Code:

(require 'org)

(define-derived-mode recoll-mode org-mode "Recoll"
  "Simple mode for showing recoll query results"
  (read-only-mode 1))

(defvar jao-recoll--file-regexp
  "\\(\\w+/.+\\)\t+\\[\\([^]]+\\)\\]\t+\\[\\([^\t]+\\)\\].+")

(defvar jao-recoll-flags "-A -p 5 -n 100")

(defvar jao-recoll-single-buffer t)
(defvar-local jao-recoll--last-query nil)
(defvar-local jao-recoll--last-full-query nil)

(defun jao-recoll-show-query ()
  (interactive)
  (message (concat jao-recoll--last-query "\n"
                   jao-recoll--last-full-query)))

(defun jao-recoll-requery ()
  (interactive)
  (jao-recoll jao-recoll--last-query))

(defun jao-recoll--buffer (q)
  (get-buffer-create (if jao-recoll-single-buffer
                         "*Recoll*"
                       (format "*Recoll: '%s'*" q))))

(defun jao-recoll--format-snippets (lnk)
  (when (looking-at-p "SNIPPETS")
    (let ((kill-whole-line t))
      (kill-line)
      (while (and (not (eobp)) (not (looking-at-p "/SNIPPETS")))
        (cond ((looking-at "^\\([1-9][0-9]*\\) : ")
               (replace-match (format "  - [[%s::\\1][\\1]] : " lnk)))
              ((looking-at "^0 : \\(.[^\n]+\\)")
               (let ((desc (match-string 1)))
                 (replace-match "  - ")
                 (insert (org-make-link-string lnk desc))))
              (t (insert "  - ")))
        (forward-line 1))
      (unless (eobp) (kill-line)))))

(defun jao-recoll--org-link (uri desc mime)
  (cond ((string= mime "application/pdf")
         (concat "doc:" (file-name-nondirectory uri)))
        ((string= mime "message/rfc822") (concat "message:" (substring uri 7)))
        ((string= mime "text/x-orgmode-sub") (concat uri "::*" desc))
        (t uri)))

;;;###autoload
(defun jao-recoll (&optional prefix-query)
  "Performs a query using recoll and shows the results using org markup."
  (interactive)
  (let* ((query (read-string "Recoll query: " prefix-query))
         (cmd (format "recoll %s -t %s"
                      jao-recoll-flags (shell-quote-argument query)))
         (inhibit-read-only t))
    (with-current-buffer (jao-recoll--buffer query)
      (recoll-mode)
      (delete-region (point-min) (point-max))
      (shell-command cmd t)
      (setq jao-recoll--last-query query)
      (goto-char (point-min))
      (when (looking-at-p "Recoll query:")
        (setq jao-recoll--last-full-query
              (string-trim (thing-at-point 'line)))
        (let ((kill-whole-line nil)) (kill-line))
        (insert query)
        (forward-line 2))
      (open-line 1)
      (while (search-forward-regexp jao-recoll--file-regexp nil t)
        (let* ((mime (match-string 1))
               (ref (match-string 2))
               (desc (match-string 3))
               (start (match-beginning 0))
               (end (match-end 0))
               (lnk (jao-recoll--org-link ref desc mime))
               (desc (if (string= mime "text/x-orgmode-sub")
                         (org-link-display-format
                          (concat (file-name-nondirectory ref) " :: " desc))
                       desc)))
          (delete-region start end)
          (insert "* " (org-make-link-string lnk desc) " (" mime ")")
          (forward-line)
          (jao-recoll--format-snippets lnk)))
      (pop-to-buffer (current-buffer))
      (goto-char (point-min))
      (org-next-visible-heading 1)
      (org-overview)
      (jao-recoll-show-query))))

(define-key recoll-mode-map [?n] 'org-next-link)
(define-key recoll-mode-map [?p] 'org-previous-link)
(define-key recoll-mode-map [?q] 'bury-buffer)
(define-key recoll-mode-map [?r] 'jao-recoll-requery)
(define-key recoll-mode-map [?g] 'jao-recoll-requery)
(define-key recoll-mode-map [?w] 'jao-recoll-show-query)

;;; .
(provide 'jao-recoll)
;;; jao-recoll.el ends here