linkhut-dmenu.scm (4155B)

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

#!/bin/guile \
-l ./linkhut.scm -e main -s
!#
;;; linkhut interaction via dmenu

;; Copyright (C) 2026 lou woell <lou@repetitions.de>
;;
;; This library is free software; you can redistribute it and/or modify it under
;; the terms of the GNU Lesser General Public License as published by the Free
;; Software Foundation; either version 3 of the License, or (at your option) any
;; later version.
;;
;; This library 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 Lesser General Public License for more
;; details.
;;
;; You should have received a copy of the GNU Lesser General Public License
;; along with this library; if not, write to the Free Software Foundation, Inc.,
;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Dependencies:
;; - guile 3.0
;; - linkhut account
;; - some dmenu equivalent
;;
;; Executing actions other than opening the link from dmenu depends on bemenu
;; style alternative actions communicated via exit code.
;;
;; Expects config file at $XDG_CONFIG_HOME/linkhut-dmenu/config
;;
;; The config file should contain an alist with entries for HOST and TOKEN.
;; e.g.:
;; `((token . "Bearer <TOKEN>")
;;   (host  . "api.ln.ht"))'

;;; Features:
;; - show dmenu of posts marked 'unread'
;; - open link in browser via `xdg-open'
;; - mark post as read
;;; Code:

(use-modules
 (linkhut)
 (rnrs io ports)
 ;; let-values
 (srfi srfi-11)
 ;; readline
 (ice-9 rdelim))

(define prompt "Bookmark: ")

(define (read-config)
  (let ((config-path
         (string-join
          (list (or (getenv "XDG_CONFIG_HOME")
                    ".")
                "linkhut-dmenu"
                "config") "/")))
    (call-with-input-file config-path read)))

;; (post ...) -> ((format-string . post) ...)
(define (show posts)
  (map (lambda (post)
         (cons (format #f "~A, ~A"
                       (get-post-value 'title post)
                       (get-post-value 'tags post))
               post))
       posts))

;; Spawn a menu let the user select a post.
;; Returns two values:
;; 1. Menu exit code.
;; 2. The selected post.
(define (menu posts)
  (let* ((entries (show posts))
         (in-pipe  (pipe))
         (out-pipe (pipe))
         (pid (spawn "dmenu" `("dmenu"
                               "-p" ,prompt
                               "-P" ">")
                     #:input (car in-pipe)
                     #:output (cdr out-pipe))))
    (close-port (cdr out-pipe))

    (map (lambda (entry) (write-line (car entry) (cdr in-pipe)))
         entries)

    (close-port (cdr in-pipe))

    (let* ((return-code (/ (cdr (waitpid pid)) 256))
           (result (read-line (car out-pipe)))
           (selected-post (assoc result entries))
           (selection (if selected-post
                          (cdr selected-post)
                          (format #f "No post selected.~%Result: ~A." result))))
      (close-port (car out-pipe))
      (values return-code selection))))

(define* (mark-read post #:optional (read #t) #:key (shared #t))
  (post-add (get-post-value 'link post)
            (get-post-value 'title post)
            #:extended (get-post-value 'note post)
            #:tags (filter (lambda (x) (not (string= x "unread")))
                           (get-post-value 'tags post))
            #:shared shared
            #:replace #t
            #:toread read))

(define (open-link post)
  (waitpid (spawn "xdg-open" `("xdg-open" ,(get-post-value 'link post)))))

(define (main args)
  (let ((config (read-config)))
    (parameterize ((token (assoc-ref config 'token))
                   (host (assoc-ref config 'host)))
      (let-values
          (((code post) (menu (post-get #:tag "unread"))))
        (case code
          ((01) (format #t "menu aborted.~%~A" post))
          ((00) (open-link post))             ;; RET.
          ((10) (mark-read post))             ;; bemenu: selecting with M-1.
          ((11) (mark-read post #:shared #f)) ;; bemenu: selecting with M-2.
          ;; ...
          (else (display post)))
        (newline)))))