Tom Willemse
97d631db55
Practical Common Lisp suggested that most Lisp projects used Java-like naming schemes. I have not seen this happen in the real world so much.
130 lines
4.3 KiB
Common Lisp
130 lines
4.3 KiB
Common Lisp
;; 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)
|
|
|
|
(defcommand add (url name description &rest tags)
|
|
"Add a new bookmark."
|
|
"Usage: clark add <url> <name> <description> [<tags> ...]
|
|
|
|
Add URL with NAME, DESCRIPTION and TAGS to the database. TAGS may be
|
|
omitted or any number of tag names."
|
|
(if (not (bookmark-exists-p url))
|
|
(with-transaction *db*
|
|
(insert-bookmark url name description)
|
|
(add-tags (last-insert-rowid *db*) tags))
|
|
(format t "~A has already been bookmarked~%" url)))
|
|
|
|
(defcommand edit (url &rest rest)
|
|
"Edit a bookmark."
|
|
"Usage: clark edit <url> [--name <name>] \\
|
|
[--description <description>]
|
|
|
|
Edit the information for URL, specifying which part(s) to edit. Each
|
|
option will replace the previous value for that part."
|
|
(let ((name-lst (member "--name" rest :test #'string=))
|
|
(desc-lst (member "--description" rest :test #'string=))
|
|
query qargs)
|
|
(when name-lst
|
|
(setf query (concatenate 'string query "name = ? ")
|
|
qargs (nconc qargs (list (cadr name-lst)))))
|
|
(when desc-lst
|
|
(setf query (concatenate 'string query (when qargs ", ")
|
|
"description = ? ")
|
|
qargs (nconc qargs (list (cadr desc-lst)))))
|
|
(when qargs
|
|
(apply #'execute-non-query *db*
|
|
(format
|
|
nil (sql update "bookmark" set "~A" where "url" = ?) query)
|
|
(append qargs (list url))))))
|
|
|
|
(defcommand exists (url)
|
|
"Check if a bookmark exists in the database."
|
|
"Usage: clark exists <url>
|
|
|
|
Check if URL exists in the database. Prints `yes' when found and `no'
|
|
otherwise."
|
|
(format t "~:[no~;yes~]~%" (bookmark-exists-p url)))
|
|
|
|
(defcommand help (&optional command)
|
|
"Show help message."
|
|
help-message
|
|
(if command
|
|
(let ((ldoc
|
|
(nth 2 (car (member
|
|
command *help-messages*
|
|
:test #'(lambda (x y) (equal x (car y))))))))
|
|
(cond
|
|
((null ldoc)
|
|
(with-error-and-help
|
|
1 "help" "Unknown command: ~a~%" command))
|
|
((and (symbolp ldoc) (fboundp ldoc)) (funcall ldoc))
|
|
(t (format t "~A~%" ldoc))))
|
|
(call-command help "help")))
|
|
|
|
(defcommand remove (url)
|
|
"Remove a bookmark from the database."
|
|
"Usage: clark remove <url>
|
|
|
|
Remove URL from the database."
|
|
(clear-tags url)
|
|
(delete-bookmark url))
|
|
|
|
(defcommand search (str)
|
|
"Search through bookmarks."
|
|
"Usage: clark search <str>
|
|
|
|
Search the database for STR. Matches are made for substrings of a
|
|
bookmark's name or an exact match for a tag."
|
|
(map nil #'print-bookmark (bookmark-search str)))
|
|
|
|
(defcommand set-tags (url &rest tags)
|
|
"Set a bookmark's tags."
|
|
"Usage: clark set-tags <url> [<tags> ...]
|
|
|
|
Set bookmark URL's tags to the given list, overwriting the previous
|
|
list of tags."
|
|
(clear-tags url)
|
|
(add-tags url tags))
|
|
|
|
(defun random-item (lst)
|
|
(nth (random (length lst) (make-random-state t)) lst))
|
|
|
|
(defcommand random (&optional tag)
|
|
"Pick a random bookmark, possibly from TAG."
|
|
"Usage: clark random [<tag>]
|
|
|
|
Get a random bookmark. If TAG is given limit the result to a bookmark
|
|
having the tag TAG."
|
|
(format t "~a~%" (random-item (url-list tag))))
|
|
|
|
(defcommand remove-tags (url &rest tags)
|
|
"Remove given tags from bookmark's tag list."
|
|
"Usage: clark remove-tags <url> [<tags> ...]
|
|
|
|
Remove the given TAGS from URL's tag list. If no tags are given,
|
|
remove all tags from bookmark."
|
|
(delete-tags url tags))
|
|
|
|
(defcommand version ()
|
|
"Show version."
|
|
"Usage: clark version
|
|
|
|
Print the version number and exit."
|
|
(format t "clark version ~A~%" version))
|