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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
;; Copyright (C) 2013 Tom Willemsen <tom at ryuslash dot org>
;; This file is part of CLark
;; CLark 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.
;; CLark 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 CLark. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(in-package :clark)
(defvar *db* nil
"The database connection.")
(defvar *help-messages* nil
"Help texts for commands.")
(defvar *max-command-name-length* 0
"Length of the longest command name.")
(defvar *script* nil
"Whether or not to output in a machine-readable format.")
(define-condition exiting ()
((exit-code :initform 0 :initarg :code :reader exit-code)))
(defmacro call-command (name &rest args)
(let ((command-name (make-command-name (symbol-name name))))
`(,command-name ,@args)))
(defmacro defcommand (name (&rest args) sdoc ldoc &body body)
"Define a new command usable on the command-line."
(let* ((sname (string-downcase (symbol-name name)))
(command-name (make-command-name (symbol-name name))))
`(progn
(defun ,command-name (,@args)
,sdoc
,@body)
(setf *help-messages*
(nconc *help-messages* '((,sname ,sdoc ,ldoc)))
*max-command-name-length*
(max *max-command-name-length* (length ,sname)))
(export ',command-name))))
(defmacro with-error-and-help (code cmd fmt &rest args)
"Call `with-error-status' with CODE, format FMT with ARGS and call
the help command."
`(with-error-status ,code
(format t ,fmt ,@args)
(call-command help ,cmd)))
(defmacro with-error-status (code &body body)
"Bind `*exit-status*' to CODE, `*standard-output*' to
`*error-output*' and execute BODY."
`(let ((*standard-output* *error-output*)
(exit-status ,code))
,@body
(when (> exit-status 0)
(signal 'exiting :code exit-status))))
(defparameter version "0.1.1"
"Clark's version.")
(defun add-tags (url-or-id tags)
"Add tags to the bookmark_tag table and possibly to tag."
(when url-or-id
(if (integerp url-or-id)
(map nil (lambda (tag)
(let ((tag-id (handler-case (insert-tag tag)
(sqlite-error () (get-tag-id tag)))))
(insert-bookmark-tag url-or-id tag-id))) tags)
(add-tags (get-bookmark-id url-or-id) tags))))
(defun clear-tags (url-or-id)
"Remove all tags from the bookmark URL."
(when url-or-id
(if (integerp url-or-id)
(delete-tags url-or-id)
(clear-tags (get-bookmark-id url-or-id)))))
(defun ensure-db-exists (name)
"Connect to the database, possibly creating it."
(let ((db-exists (probe-file name)))
(setf *db* (connect name))
(unless db-exists
(create-table-bookmark)
(create-table-tag)
(create-table-bookmark_tag))))
(defun get-db-location ()
"Get the location of the database."
(let ((xdg (sb-ext:posix-getenv "XDG_DATA_HOME"))
(home (sb-ext:posix-getenv "HOME")))
(pathname
(apply 'concatenate 'string
(or xdg home)
(unless xdg "/.local/share")
'("/clark/bookmarks.db")))))
(defun get-rc-location ()
"Get the location of the RC file."
(let ((xdg (sb-ext:posix-getenv "XDG_CONFIG_HOME"))
(home (sb-ext:posix-getenv "HOME")))
(pathname
(apply 'concatenate 'string
(or xdg home)
(unless xdg "/.config")
'("/clark/rc.lisp")))))
(defun help-message ()
(format t (concatenate
'string
"Usage: clark [options] [<command> [<options> ...]]~%"
"~%"
"Possible options:~%"
"~%"
" --script Output in a machine-readable format.~%"
"~%"
"Possible commands:~%"
"~%"))
(map nil (lambda (hlp)
(destructuring-bind (name short long) hlp
(declare (ignore long))
(format t " ~vA ~A~%" *max-command-name-length*
name short))) *help-messages*)
(format t "~%~A~%"
(concatenate 'string "Use `clark help <command>' to get more "
"information on a command.")))
(defun load-db ()
"Load the database."
(let ((db-location (get-db-location)))
(ensure-directories-exist db-location)
(ensure-db-exists db-location)))
(defun load-rc ()
"Load the RC file."
(let ((*package* (in-package :clark)))
(load (get-rc-location) :if-does-not-exist nil)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-command-name (base)
"Turn BASE into the name of a possible command."
(intern (concatenate 'string (string-upcase base) "-COMMAND")
:clark)))
(defun parse-args (args)
"Parse command-line arguments ARGS.
The executable name should already have been removed."
(loop while (and args (char= (char (car args) 0) #\-))
do (case (intern (string-upcase (string-left-trim "-" (car args)))
:clark)
(script (setf *script* t args (cdr args)))
(t (with-error-and-help
1 "help" "Unknown option: ~a~%" (car args)))))
(if args
(let ((cmd-name (make-command-name (car args))))
(if (fboundp cmd-name)
(handler-case (apply cmd-name (cdr args))
(sb-int:simple-program-error (err)
(if (string-equal (format nil "~A" err)
"invalid number of arguments" :end1 27)
(with-error-and-help
1 (car args) "Wrong number of arguments given.~%")
(signal err))))
(with-error-and-help
1 "help" "Unknown command: ~A~%" (car args))))
(map nil #'print-bookmark (bookmark-list))))
(defun print-bookmark (bm)
"Print information about bookmark BM.
BM should be a list containing the url, name and description of the
bookmark."
(destructuring-bind (url name description) bm
(if *script*
(format t "~A ~A ~A " url name description)
(format t "~A~% ~A~% ~A~%~%" url name description))))
(defun clark (args)
"Main function.
Connect to the database, parse command-line arguments, execute and
then disconnect."
(load-rc)
(load-db)
(handler-case
(unwind-protect (parse-args (cdr args))
(disconnect *db*))
(exiting (c) (sb-ext:exit :code (exit-code c)))))
|
