I was reading the Simple Database section of Peter Siebel's book Practical Common Lisp with the idea of maintaining a small database of around 50,000 records. I thought doing this in Emacs might be an interesting, and useful, exercise. Emacs Lisp is somewhat compatible with CL except for a few notable differences. The format function used in the above example being one major difference.
Here's the code that contains everything needed to construct, save, and load the database in CL. Can this be modified to work well in Emacs? I omitted the select and where functions but I'd like to include them. Maybe there is a better Emacs way of building and maintaining a database? Personally, I'm using this as an exercise to learn CL and solve an existing problem.
;; Simple Common Lisp database
;; http://www.gigamonkeys.com/book/practical-a-simple-database.html
;;
(defvar *db* nil)
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun add-record (cd) (push cd *db*))
(defun dump-db ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
(defun save-db (filename)
(with-open-file (out filename
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
(defun load-db (filename)
(with-open-file (in filename)
(with-standard-io-syntax
(setf *db* (read in)))))
; ===
;
; Add some records
;
(add-record (make-cd "Roses" "Kathy Mattea" 7 t))
(add-record (make-cd "Fly" "Dixie Chicks" 8 t))
(add-record (make-cd "Home" "Dixie Chicks" 9 t))
; (dump-db)
; (save-db "cd.db")
; (load-db "cd.db")
Here's my solution:
(defvar *db* nil)
(setq *db* ())
(defun make-cd (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defun add-record (cd) (push cd *db*))
(defun init ()
(progn
(add-record (make-cd "Roses" "Kathy Mattea" 7 t))
(add-record (make-cd "Fly" "Dixie Chicks" 8 t))
(add-record (make-cd "Home" "Dixie Chicks" 9 t))
))
(defun save-db (filename)
(with-temp-buffer
(print *db* (current-buffer))
(write-file filename))
(message "Saving database...done")
)
(defun load-db (filename)
(with-temp-buffer
(insert-file-contents filename)
(setq *db* (read (current-buffer)))))
(defun dump-db ()
(dolist (cd *db*)
(print cd)))
;; Test in M-x lisp-interaction-mode
;;(init)
;;(save-db "cd.db")
;*db*
;(add-record (make-cd "Born To Run" "Bruce Springsteen" 10 t))
;(add-record (make-cd "The River" "Bruce Springsteen" 10 t))
;(add-record (make-cd "Nebraska" "Bruce Springsteen" 10 t))
;(add-record (make-cd "Human Touch" "Bruce Springsteen" 10 nil))
;;(save-db "cd.db")
;(setq *db* ())
;;(load-db "cd.db")
;*db*
When I tried to write a ebook library for Emacs, I stored the records in a list, saving it to disk from time to time. When the list length exceeded about five thousand records, the performance suffered.
Here are some functions from the code:
(defun bread-library-load-db ()
"Loads the list of books from disk file to the variable bread-library-db"
(if (file-exists-p bread-library-file)
(with-temp-buffer
(insert-file-contents bread-library-file)
(setq bread-library-db (read (current-buffer))))
(setq bread-library-db '())))
(defun bread-library-add-book (file)
"Attempts to get metadata from file, then prompts for
confirmation (or modification) of these metadata, then adds the
book to the database and saves it. Intended use: from dired."
(if (assoc file bread-library-db)
(error "File is already in the database")
(progn
(let ((metadata (bread-get-metadata file)))
(let ((filename (nth 0 metadata))
(author (read-from-minibuffer
"Author: "
(nth 1 metadata)))
(title (read-from-minibuffer
"Title: "
(nth 2 metadata)))
(genre (read-from-minibuffer "Genre: " (nth 3 metadata)))
(tags (read-from-minibuffer "Tags (separated and surrounded by colons): " ":"))
(desc (nth 4 metadata)))
(setq bread-library-db (cons
(list filename author title tags "TOREAD" genre nil desc)
bread-library-db))))
(bread-library-save-db bread-library-db))))
(defun bread-library-save-db (db)
"Save the library database to a file."
(message "Saving Bread library database...")
(with-temp-buffer
(insert "; 1.path 2.author 3.title 4.tags 5.state 6.genre 7.priority 8.description")
(print db (current-buffer))
(write-file bread-library-file))
(message "Saving Bread library database...done"))
Related
I'm looking for some assistance please, to distinguish between a single file extension in dired-mode (e.g., *.gz) and a double file extension (e.g., *.tar.gz).
The following is an excerpt of the function that I use when selecting one or more files in dired-mode to take specific actions -- e.g., open in Emacs, start a process and open externally, or compress / decompress. I originally wrote this function (borrowing excerpts from dired-do-create-files within dired-aux.el) with only single file type extensions in mind, and would now like to expand its functionality to include potential double file type extensions.
(defun test-for-tar-gz-extension ()
(interactive)
(let* (
(fn-list (dired-get-marked-files))
(rfn-list (mapcar (function dired-make-relative) fn-list))
(dired-one-file (and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(input-filename (if dired-one-file dired-one-file fn-list))
(ext
(cond
((stringp input-filename)
(file-name-extension input-filename))
((listp input-filename)
(file-name-extension (car input-filename)))))
(path (if (stringp input-filename) (file-name-directory input-filename)))
(dired-buffer-name (buffer-name))
(msword-regexp '("doc" "docx"))
(dired-tar '("tar.gz")))
(cond
;; http://www.emacswiki.org/emacs/DiredTar
((extension equals ".tar.gz")
(dired-tar-pack-unpack))
((extension equals ".gz" (but not .tar.gz))
(dired-do-compress))
((regexp-match-p msword-regexp ext)
(start-process "ms-word" nil "open" "-a" "Microsoft Word" input-filename))
(t
(message "Go fish.")))))
;; https://github.com/kentaro/auto-save-buffers-enhanced
;; `regexp-match-p` function modified by #sds on stackoverflow
;; http://stackoverflow.com/a/20343715/2112489
(defun regexp-match-p (regexps string)
(and string
(catch 'matched
(let ((inhibit-changing-match-data t)) ; small optimization
(dolist (regexp regexps)
(when (string-match regexp string)
(throw 'matched t)))))))
Not sure IIUC, here a draft how to do that part in question:
(defun gz-only ()
"List marked files in dired-buffer ending at `.gz', but not ending at `.tar.gz'"
(interactive)
(let ((flist (dired-get-marked-files))
erg)
(dolist (ele flist)
(and (string-match "\.gz$" ele)(not (string-match "\.tar\.gz$" ele))
(add-to-list 'erg ele)))
(when (interactive-p) (message "%s" erg))))
I can view man pages using info in the terminal:
info pthread_create
However, it is not possible with info in Emacs, even with info-apropos or info-menu.
EDIT:
It seems that fall-backs are not in the concept of Info-mode.
There follows a work-around applying advice. It does not work perfect but around the missing feature ;-).
It defines a fall-back for Info-goto-node (in Info-mode bound to g) and for Info-menu (in Info-mode bound to m).
Furthermore, it adds manual-apropos to info-apropos.
(require 'woman)
(defun Info-man-completion (_caller _info string predicate action)
"Add man entries to info completion."
;; prepare woman:
(unless (and woman-expanded-directory-path woman-topic-all-completions)
(setq woman-expanded-directory-path
(woman-expand-directory-path woman-manpath woman-path)
woman-topic-all-completions
(woman-topic-all-completions woman-expanded-directory-path)))
;; do completions:
(cond
((null action) ;; try-completion
;; shortest wins
(let ((_man (try-completion string woman-topic-all-completions)))
(cond
((eq _info t)
t)
((eq _man t)
t)
((and (stringp _info) (stringp _man))
(if (> (length _info) (length _man))
_man
_info))
((stringp _info)
_info)
(t _man)
)))
((eq action t) ;; all-completions
(let ((_man (all-completions string woman-topic-all-completions)))
(append _info _man)
))
((eq action 'lambda) ;; test-completion
(try-completion string _caller))
((eq action 'metadata) ;; state of current completion
'(metadata) ;; no specification
)))
;; args: string predicate code
(defadvice Info-read-node-name-1 (around man activate)
"Add man entries to info completion."
(setq ad-return-value (apply 'Info-man-completion 'Info-read-node-name-1 ad-do-it (ad-get-args 0))))
;;
(defadvice Info-complete-menu-item (around man activate)
"Add man entries to info completion."
(setq ad-return-value (apply 'Info-man-completion 'Info-complete-menu-item ad-do-it (ad-get-args 0))))
(defadvice Info-goto-node (around man activate)
"If no info node is found for string lookup and show man entry."
(condition-case err
ad-do-it
(user-error
(let ((err-str (car-safe (cdr err))))
(if (and (stringp err-str)
(string-match "No such node or anchor:" err-str))
(man (ad-get-arg 0))
(signal 'user-error err-str)
)))))
(defadvice Info-menu (around man activate)
"If no info menu entry is found for string lookup and show man entry."
(condition-case err
ad-do-it
(user-error
(let ((err-str (car-safe (cdr err))))
(if (and (stringp err-str)
(string-match "No such item in menu" err-str))
(man (ad-get-arg 0))
(signal 'user-error err-str)
)))))
(defadvice Info-apropos-find-node (after man activate)
"Add man appropos to info appropos."
(let (item)
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert "\nMatches found by man-apropos\n\n")
(let ((beg (point))
(nodeinfo (assoc nodename Info-apropos-nodes)))
(if nodeinfo
(let ((search-string (nth 1 nodeinfo)))
(call-process "apropos" nil t t search-string)
(goto-char beg)
(while (re-search-forward "^\\(\\(?:[[:alnum:]]\\|\\s_\\)+\\)\\(?:[[:blank:]]+\\[\\]\\)?\\([[:blank:]]+([[:alnum:]]+)\\)[[:blank:]]+-[[:blank:]]+\\(.*\\)$" nil t)
(replace-match (replace-regexp-in-string "\\\\" "\\\\\\\\" (format "* %-38s.%s"
(format "%s:" (match-string 1))
(concat (match-string 1) (match-string 2))
(match-string 3))))))
(man nodename)
)))))
Info gives an error that the node is not available. Thereafter, the manual page is shown if there is one.
[Edited]
EmacsWiki says that iman:
Opens either an info format manual with InfoMode or a man page with
ManMode.
It links to the author's website:
http://homepage1.nifty.com/bmonkey/emacs/elisp/iman.el
Found M-x woman MANPAGE RET to most convenient way to call manpages from inside Emacs.
I am defining a major mode that works on paragraphs of the following nature:
: Identifier
1. some text
2. ...
3. some more text
: New Identifier
: Another Identifier
some text
I want to write a defun called get-paragraphs that will return a list that looks like:
( ("Identifier", ("1. some text", "2. ...", "3. some more text")),
("New Identifier", ()),
("Another Identifier", ("some text"))
)
How do I go about cutting up the text like this in Emacs Lisp:
Is there a function to iterate through them (and subsequently chop them up to my liking)? Should I use regular expressions? Is there an easier way?
You should iterate over the buffer and collect your text (untested):
(defun get-paragraphs ()
(save-excursion
(goto-char (point-min))
(let ((ret '()))
(while (search-forward-regexp "^: " nil t)
(let ((header (buffer-substring-no-properties (point) (line-end-position)))
(body '()))
(forward-line)
(while (not (looking-at "^$"))
(push (buffer-substring-no-properties (point) (line-end-position)) body)
(forward-line))
(push (cons header (list (reverse body))) ret)))
(nreverse ret))))
Here, take this Lisp code:
(defun chopchop ()
(mapcar
(lambda (x)
(destructuring-bind (head &rest tail)
(split-string x "\n" t)
(list head tail)))
(split-string (buffer-substring-no-properties
(point-min)
(point-max)) "\n?: *" t)))
How can I display the name of a bookmark (from 'bookmark' or 'bookmark+') in the mode line of emacs, instead of the file name?
A slightly strange request, but here you go (works for files and dired buffers):
(defun show-bookmarks-mode-line ()
(interactive)
(let (bname text)
(and
(setq bname (if (eq major-mode 'dired-mode)
default-directory
(buffer-file-name)))
(setq bname (expand-file-name bname))
(setq text
(delq nil
(mapcar
(lambda (x)
(and (equal bname
(expand-file-name
(bookmark-get-filename x)))
(substring-no-properties (car x))))
bookmark-alist)))
(setq text
(mapconcat
#'identity
text
", "))
(let ((mode-line-buffer-identification
(propertize text 'face 'mode-line-buffer-id)))
(force-mode-line-update)
(sit-for 5))
(force-mode-line-update))))
Could you elaborate on why you need it?
I'm trying to learn Lisp now, as a supplement to my CS1 course because the class was moving too slow for me. I picked up "Practical Common Lisp," which so far has turned out to be a great book, but I'm having some trouble getting some examples to work. For instance, if I load the following file into the REPL:
;;;; Created on 2010-09-01 19:44:03
(defun makeCD (title artist rating ripped)
(list :title title :artist artist :rating rating :ripped ripped))
(defvar *db* nil)
(defun addRecord (cd)
(push cd *db*))
(defun dumpDB ()
(dolist (cd *db*)
(format t "~{~a:~10t~a~%~}~%" cd)))
(defun promptRead (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun promptForCD ()
(makeCD
(promptRead "Title")
(promptRead "Artist")
(or (parse-integer (promptRead "Rating") :junk-allowed t) 0)
(y-or-n-p "Ripped [y/n]: ")))
(defun addCDs ()
(loop (addRecord (promptForCD))
(if (not (y-or-n-p "Another? [y/n]: ")) (return))))
(defun saveDB (fileName)
(with-open-file (out fileName
:direction :output
:if-exists :supersede)
(with-standard-io-syntax
(print *db* out))))
(defun loadDB (fileName)
(with-open-file (in fileName)
(with-standard-io-syntax
(setf *db* (read in)))))
(defun select (selectorFn)
(remove-if-not selectorFn *db*))
(defun artistSelector (artist)
#'(lambda (cd) (equal (getf cd :artist) artist)))
And query the 'database' using (select (artistSelector "The Beatles")), even if I do indeed have an entry in the database where :artist is equal to "The Beatles", the function returns NIL.
What am I doing incorrectly here?
Nothing, AFAICT:
$ sbcl
This is SBCL 1.0.34.0...
[[pasted in code above verbatim, then:]]
* (addRecord (makeCD "White Album" "The Beatles" 5 t))
((:TITLE "White Album" :ARTIST "The Beatles" :RATING 5 :RIPPED T))
* (select (artistSelector "The Beatles"))
((:TITLE "White Album" :ARTIST "The Beatles" :RATING 5 :RIPPED T))
CL-USER 18 > (addcds)
Title: Black Album
Artist: Prince
Rating: 10
Title: White Album
Artist: The Beatles
Rating: 10
NIL
CL-USER 19 > (select (artistSelector "The Beatles"))
((:TITLE "White Album" :ARTIST "The Beatles" :RATING 10 :RIPPED T))