From 02be3af2fd2706e69b555faf3f2aa165278995a0 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Sat, 23 Mar 2013 00:15:52 +0100 Subject: Move lisp sources to lisp/ --- Makefile | 5 +- clark.asd | 14 ----- clark.lisp | 157 --------------------------------------------------- lisp/Makefile | 2 + lisp/clark.asd | 14 +++++ lisp/clark.lisp | 157 +++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/make-image.lisp | 16 ++++++ lisp/package.lisp | 2 + make-image.lisp | 16 ------ package.lisp | 2 - 10 files changed, 194 insertions(+), 191 deletions(-) delete mode 100644 clark.asd delete mode 100644 clark.lisp create mode 100644 lisp/Makefile create mode 100644 lisp/clark.asd create mode 100644 lisp/clark.lisp create mode 100644 lisp/make-image.lisp create mode 100644 lisp/package.lisp delete mode 100644 make-image.lisp delete mode 100644 package.lisp diff --git a/Makefile b/Makefile index b79db48..b1ea327 100644 --- a/Makefile +++ b/Makefile @@ -1,2 +1,3 @@ -clark: clark.lisp make-image.lisp - sbcl --disable-debugger --load make-image.lisp +.PHONY: all +all: + $(MAKE) -C lisp/ diff --git a/clark.asd b/clark.asd deleted file mode 100644 index 3b5ef22..0000000 --- a/clark.asd +++ /dev/null @@ -1,14 +0,0 @@ -(defpackage :clark-system - (:use :cl :asdf)) -(in-package :clark-system) - -(defsystem :clark - :name "CLark" - :author "Tom Willemsen " - :version "0.0.1" - :maintainer "Tom Willemsen " - :description "Keep bookmarks, in lisp." - :serial t - :depends-on (:mcclim) - :components ((:file "package") - (:file "clark"))) diff --git a/clark.lisp b/clark.lisp deleted file mode 100644 index cfec4b4..0000000 --- a/clark.lisp +++ /dev/null @@ -1,157 +0,0 @@ -(in-package :org.ryuslash.clark) - -(export '(clark)) - -(defvar *db* nil - "The database connection.") - -(defvar *help-messages* nil - "Help texts for commands.") - -(defvar *max-command-name-length* 0 - "Lenght of the longest command name.") - -(defmacro defcommand (name doc &body body) - "Define a new command usable on the command-line." - (let* ((sname (symbol-name name)) - (command-name (make-command-name sname))) - `(progn - (defun ,command-name (args) - ,doc - ,@body) - (setf *help-messages* - (nconc *help-messages* - '((,(string-downcase sname) ,doc ""))) - *max-command-name-length* - (max *max-command-name-length* (length ,sname)))))) - -(defconstant *version* "0.1.0" - "Clark's version.") - -(defun add-tags (tags) - "Add tags to the bookmark_tag table and possibly to tag." - (let ((bookmark-id (last-insert-rowid *db*))) - (map nil (lambda (tag) - (let ((tag-id (handler-case (insert-tag tag) - (sqlite-error () (get-tag-id tag))))) - (insert-bookmark-tag bookmark-id tag-id))) tags))) - -(defun check-db (name) - "Connect to the database, possibly creating it." - (let ((db-exists (probe-file name))) - (setf *db* (connect name)) - (unless db-exists - (execute-non-query *db* "CREATE TABLE bookmark (url VARCHAR(255) UNIQUE, date INTEGER, name VARCHAR(255), description TEXT)") - (execute-non-query *db* "CREATE TABLE tag (name VARCHAR(255) UNIQUE)") - (execute-non-query *db* "CREATE TABLE bookmark_tag (bookmark_id INTEGER REFERENCES bookmark(rowid), tag_id INTEGER REFERENCES tag(rowid), PRIMARY KEY (bookmark_id, tag_id))")))) - -(defun get-bookmarks () - "Get a list of all bookmarks. - -The result contains the url and the name of the bookmark." - (let ((statement - (prepare-statement *db* "select url, name from bookmark"))) - (loop - while (step-statement statement) - collect (list (statement-column-value statement 0) - (statement-column-value statement 1)) - finally (finalize-statement statement)))) - -(defun get-tag-id (name) - "Get the rowid of tag NAME." - (execute-single *db* "SELECT rowid FROM tag WHERE name = ?" name)) - -(defun insert-bookmark (url name description) - "Insert URL, NAME and DESCRIPTION into the bookmark table." - (execute-non-query *db* "INSERT INTO bookmark VALUES (?, ?, ?, ?)" - url (get-universal-time) name description)) - -(defun insert-bookmark-tag (bookmark-id tag-id) - "Insert BOOKMARK-ID and TAG-ID into the bookmark_tag table." - (execute-non-query *db* "INSERT INTO bookmark_tag VALUES (?, ?)" - bookmark-id tag-id)) - -(defun insert-tag (name) - "Insert tag NAME into the database and return its rowid." - (execute-non-query *db* "INSERT INTO tag VALUES (?)" name) - (last-insert-rowid *db*)) - -(eval-when (:compile-toplevel :load-toplevel) - (defun make-command-name (base) - "Turn BASE into the name of a possible command." - (intern (concatenate 'string (string-upcase base) "-COMMAND") - :org.ryuslash.clark))) - -(defun parse-args (args) - "Parse command-line arguments ARGS. - -The executable name should already have been removed." - (let ((cmd-name (make-command-name (car args)))) - (if (fboundp cmd-name) - (funcall cmd-name (cdr args)) - (progn - (format t "Unknown command: ~A~%" (car args)) - (help-command nil))))) - -(defun print-bookmark (bm) - "Print information about bookmark BM. - -BM should be a list containing the url and name of the bookmark." - (destructuring-bind (url name) bm - (format t "~A~%~A~%~%" url name))) - -(defcommand add - "Add a new bookmark." - (with-transaction *db* - (destructuring-bind (url name description &rest tags) args - (insert-bookmark url name description) - (add-tags tags)))) - -(defcommand help - "Show help message." - (declare (ignore args)) - (format t (concatenate - 'string - "Usage: clark [ [ ...]]~%" - " clark add [ ...]~%" - "~%" - "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*)) - -(defcommand search - "Search through bookmarks." - (map - nil (lambda (bm) - (destructuring-bind (url name description) bm - (format t "~A~% ~A~% ~A~%~%" url name description))) - (execute-to-list - *db* (concatenate 'string - "SELECT url, name, description " - "FROM bookmark " - "WHERE name LIKE ? " - "OR ? IN (SELECT name " - "FROM tag " - "JOIN bookmark_tag ON (tag_id = tag.rowid) " - "WHERE bookmark_id = bookmark.rowid)") - (format nil "%~A%" (car args)) (car args)))) - -(defcommand version - "Show version." - (declare (ignore args)) - (format t "clark version ~A~%" *version*)) - -(defun clark (args) - "Main function. - -Connect to the database, parse command-line arguments, execute and -then disconnect." - (check-db "test2.db") - (if (> (length args) 1) - (parse-args (cdr args)) - (map nil #'print-bookmark (get-bookmarks))) - (disconnect *db*)) diff --git a/lisp/Makefile b/lisp/Makefile new file mode 100644 index 0000000..b79db48 --- /dev/null +++ b/lisp/Makefile @@ -0,0 +1,2 @@ +clark: clark.lisp make-image.lisp + sbcl --disable-debugger --load make-image.lisp diff --git a/lisp/clark.asd b/lisp/clark.asd new file mode 100644 index 0000000..3b5ef22 --- /dev/null +++ b/lisp/clark.asd @@ -0,0 +1,14 @@ +(defpackage :clark-system + (:use :cl :asdf)) +(in-package :clark-system) + +(defsystem :clark + :name "CLark" + :author "Tom Willemsen " + :version "0.0.1" + :maintainer "Tom Willemsen " + :description "Keep bookmarks, in lisp." + :serial t + :depends-on (:mcclim) + :components ((:file "package") + (:file "clark"))) diff --git a/lisp/clark.lisp b/lisp/clark.lisp new file mode 100644 index 0000000..cfec4b4 --- /dev/null +++ b/lisp/clark.lisp @@ -0,0 +1,157 @@ +(in-package :org.ryuslash.clark) + +(export '(clark)) + +(defvar *db* nil + "The database connection.") + +(defvar *help-messages* nil + "Help texts for commands.") + +(defvar *max-command-name-length* 0 + "Lenght of the longest command name.") + +(defmacro defcommand (name doc &body body) + "Define a new command usable on the command-line." + (let* ((sname (symbol-name name)) + (command-name (make-command-name sname))) + `(progn + (defun ,command-name (args) + ,doc + ,@body) + (setf *help-messages* + (nconc *help-messages* + '((,(string-downcase sname) ,doc ""))) + *max-command-name-length* + (max *max-command-name-length* (length ,sname)))))) + +(defconstant *version* "0.1.0" + "Clark's version.") + +(defun add-tags (tags) + "Add tags to the bookmark_tag table and possibly to tag." + (let ((bookmark-id (last-insert-rowid *db*))) + (map nil (lambda (tag) + (let ((tag-id (handler-case (insert-tag tag) + (sqlite-error () (get-tag-id tag))))) + (insert-bookmark-tag bookmark-id tag-id))) tags))) + +(defun check-db (name) + "Connect to the database, possibly creating it." + (let ((db-exists (probe-file name))) + (setf *db* (connect name)) + (unless db-exists + (execute-non-query *db* "CREATE TABLE bookmark (url VARCHAR(255) UNIQUE, date INTEGER, name VARCHAR(255), description TEXT)") + (execute-non-query *db* "CREATE TABLE tag (name VARCHAR(255) UNIQUE)") + (execute-non-query *db* "CREATE TABLE bookmark_tag (bookmark_id INTEGER REFERENCES bookmark(rowid), tag_id INTEGER REFERENCES tag(rowid), PRIMARY KEY (bookmark_id, tag_id))")))) + +(defun get-bookmarks () + "Get a list of all bookmarks. + +The result contains the url and the name of the bookmark." + (let ((statement + (prepare-statement *db* "select url, name from bookmark"))) + (loop + while (step-statement statement) + collect (list (statement-column-value statement 0) + (statement-column-value statement 1)) + finally (finalize-statement statement)))) + +(defun get-tag-id (name) + "Get the rowid of tag NAME." + (execute-single *db* "SELECT rowid FROM tag WHERE name = ?" name)) + +(defun insert-bookmark (url name description) + "Insert URL, NAME and DESCRIPTION into the bookmark table." + (execute-non-query *db* "INSERT INTO bookmark VALUES (?, ?, ?, ?)" + url (get-universal-time) name description)) + +(defun insert-bookmark-tag (bookmark-id tag-id) + "Insert BOOKMARK-ID and TAG-ID into the bookmark_tag table." + (execute-non-query *db* "INSERT INTO bookmark_tag VALUES (?, ?)" + bookmark-id tag-id)) + +(defun insert-tag (name) + "Insert tag NAME into the database and return its rowid." + (execute-non-query *db* "INSERT INTO tag VALUES (?)" name) + (last-insert-rowid *db*)) + +(eval-when (:compile-toplevel :load-toplevel) + (defun make-command-name (base) + "Turn BASE into the name of a possible command." + (intern (concatenate 'string (string-upcase base) "-COMMAND") + :org.ryuslash.clark))) + +(defun parse-args (args) + "Parse command-line arguments ARGS. + +The executable name should already have been removed." + (let ((cmd-name (make-command-name (car args)))) + (if (fboundp cmd-name) + (funcall cmd-name (cdr args)) + (progn + (format t "Unknown command: ~A~%" (car args)) + (help-command nil))))) + +(defun print-bookmark (bm) + "Print information about bookmark BM. + +BM should be a list containing the url and name of the bookmark." + (destructuring-bind (url name) bm + (format t "~A~%~A~%~%" url name))) + +(defcommand add + "Add a new bookmark." + (with-transaction *db* + (destructuring-bind (url name description &rest tags) args + (insert-bookmark url name description) + (add-tags tags)))) + +(defcommand help + "Show help message." + (declare (ignore args)) + (format t (concatenate + 'string + "Usage: clark [ [ ...]]~%" + " clark add [ ...]~%" + "~%" + "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*)) + +(defcommand search + "Search through bookmarks." + (map + nil (lambda (bm) + (destructuring-bind (url name description) bm + (format t "~A~% ~A~% ~A~%~%" url name description))) + (execute-to-list + *db* (concatenate 'string + "SELECT url, name, description " + "FROM bookmark " + "WHERE name LIKE ? " + "OR ? IN (SELECT name " + "FROM tag " + "JOIN bookmark_tag ON (tag_id = tag.rowid) " + "WHERE bookmark_id = bookmark.rowid)") + (format nil "%~A%" (car args)) (car args)))) + +(defcommand version + "Show version." + (declare (ignore args)) + (format t "clark version ~A~%" *version*)) + +(defun clark (args) + "Main function. + +Connect to the database, parse command-line arguments, execute and +then disconnect." + (check-db "test2.db") + (if (> (length args) 1) + (parse-args (cdr args)) + (map nil #'print-bookmark (get-bookmarks))) + (disconnect *db*)) diff --git a/lisp/make-image.lisp b/lisp/make-image.lisp new file mode 100644 index 0000000..733cb8c --- /dev/null +++ b/lisp/make-image.lisp @@ -0,0 +1,16 @@ +#-sbcl +(error "This lisp implementation iss not supported.") + +(require 'asdf) +(require 'sqlite) +(require 'mcclim) + +(asdf:oos 'asdf:load-op 'clark) + +(save-lisp-and-die + "clark" :toplevel + (lambda () + (sb-posix:putenv (format nil "SBCL_HOME=~A" #.(sb-ext:posix-getenv "SBCL_HOME"))) + (org.ryuslash.clark:clark sb-ext:*posix-argv*) + 0) + :executable t) diff --git a/lisp/package.lisp b/lisp/package.lisp new file mode 100644 index 0000000..9883445 --- /dev/null +++ b/lisp/package.lisp @@ -0,0 +1,2 @@ +(defpackage :org.ryuslash.clark + (:use :clim :clim-lisp :sqlite)) diff --git a/make-image.lisp b/make-image.lisp deleted file mode 100644 index 733cb8c..0000000 --- a/make-image.lisp +++ /dev/null @@ -1,16 +0,0 @@ -#-sbcl -(error "This lisp implementation iss not supported.") - -(require 'asdf) -(require 'sqlite) -(require 'mcclim) - -(asdf:oos 'asdf:load-op 'clark) - -(save-lisp-and-die - "clark" :toplevel - (lambda () - (sb-posix:putenv (format nil "SBCL_HOME=~A" #.(sb-ext:posix-getenv "SBCL_HOME"))) - (org.ryuslash.clark:clark sb-ext:*posix-argv*) - 0) - :executable t) diff --git a/package.lisp b/package.lisp deleted file mode 100644 index 9883445..0000000 --- a/package.lisp +++ /dev/null @@ -1,2 +0,0 @@ -(defpackage :org.ryuslash.clark - (:use :clim :clim-lisp :sqlite)) -- cgit v1.3-2-g0d8e