clark/lisp/commands.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 :org.ryuslash.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))