Function Erroneously Returning Nil - lisp

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))

Related

How to use a cons cell to define and later remove overlays with `dolist`

I am looking for some guidance, please, to reduce the time needed to perform my custom overlay removal function. The delay of up to 0.1 seconds is caused because a plethora of variables all have values, however, not every variable is necessarily used.
My goal is to attach a second variable that can be set to non-nil whenever the first variable is used, but I am unsure how to set this up and how to incorporate that into the overlay removal function.
Perhaps something that looks like this would be useful:
if (variable-one . t), then (remove-overlays (point-min) (point-max) 'display character)
In the following example, M-x sub-char-mode will place an overlay over the characters 1, 2 or 3 whenever the cursor is visiting any of those characters:
1 will become |1
2 will become |2
3 will become |3
(defvar variable-one (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "1" 'face 'highlight 'cursor t) ))
(defvar variable-one-p (cons variable-one nil))
(defvar variable-two (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "2" 'face 'highlight 'cursor t) ))
(defvar variable-two-p (cons variable-two nil))
(defvar variable-three (concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "3" 'face 'highlight 'cursor t) ))
(defvar variable-three-p (cons variable-three nil))
(defun substitute-character ()
(cond
((eq (char-after (point)) 49)
(setq variable-one-p (cons variable-one t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-one))
((eq (char-after (point)) 50)
(setq variable-two-p (cons variable-two t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-two))
((eq (char-after (point)) 51)
(setq variable-three-p (cons variable-three t))
(overlay-put (make-overlay (point) (1+ (point))) 'display variable-three))))
(defun remove-sub-char ()
(dolist (character `(
,variable-one
,variable-two
,variable-three))
(remove-overlays (point-min) (point-max) 'display character))
(dolist (my-variable `(
,variable-one-p
,variable-two-p
,variable-three-p))
(setq my-variable nil)) )
(defun sub-char-post-command-hook ()
(remove-sub-char)
(substitute-character))
(define-minor-mode sub-char-mode
"A minor-mode for testing overlay-removal with cons cells."
:init-value nil
:lighter " OV-REMOVE"
:keymap nil
:global nil
:group 'lawlist
(cond
(sub-char-mode
(add-hook 'post-command-hook 'sub-char-post-command-hook nil t)
(message "Turned ON `sub-char-mode`."))
(t
(remove-hook 'post-command-hook 'sub-char-post-command-hook t)
(remove-sub-char)
(message "Turned OFF `sub-char-mode`."))))
Apologies for pasting this image here - feel free to remove it. But I couldn't paste it into a comment, to reply to your comment asking for the appearance. This is vline-style = compose and col-highlight-vline-face-flag = nil:
First Draft (August 24, 2014):  The first draft answer defines the variables as a cons cell -- the car is a predetermined overlay string, and the cdr is nil. When the cursor visits the characters 1, 2 or 3, an overlay is placed on top of those characters and the cdr of the applicable cons cell is set to t by using setcdr. The overlay removal function contains a list of variable names and the corresponding cons cells -- when the cdr of the cons cell is non-nil (i.e., t), the overlay is removed, and the cdr of the applicable cons cell is set back to nil using setcdr. The advantage of this type of setup is that the overlay removal function will quickly look at and then skip over variables whose cons cell cdr is nil -- thus saving a substantial amount of time when dealing with large quantities of variables with predetermined overlay strings.
EDIT (August 26, 2014):  Modified code to permit using the same variable names in different buffers and set buffer-local values. Related threads are: How to use `setcdr` with buffer-local variables and Incorporate variable name into `dolist` cycle and change its value .
(defvar variable-one
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "1" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-one)
(defvar variable-two
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "2" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-two)
(defvar variable-three
(cons
(concat
(propertize (char-to-string ?\u007C)
'face 'font-lock-warning-face
'cursor t)
(propertize "3" 'face 'highlight 'cursor t) )
nil))
(make-variable-buffer-local 'variable-three)
(defun sub-char ()
(cond
((eq (char-after (point)) 49)
(let ((newlist (copy-list variable-one)))
(setcdr newlist t)
(setq-local variable-one newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-one))))
((eq (char-after (point)) 50)
(let ((newlist (copy-list variable-two)))
(setcdr newlist t)
(setq-local variable-two newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-two))))
((eq (char-after (point)) 51)
(let ((newlist (copy-list variable-three)))
(setcdr newlist t)
(setq-local variable-three newlist)
(overlay-put (make-overlay (point) (1+ (point))) 'display (car variable-three))))))
(defun remove-sub-char ()
(dolist (character `(
(variable-one ,variable-one)
(variable-two ,variable-two)
(variable-three ,variable-three)))
(when (cdr (car (cdr character)))
(let* (
(var (car character))
(newlist (copy-list (car (cdr character)))) )
(remove-overlays (point-min) (point-max) 'display (car (car (cdr character))))
(setcdr newlist nil)
(set (car character) newlist)
(message "var1: %s | var2: %s | var3: %s" variable-one variable-two variable-three) ))))
(defun sub-char-post-command-hook ()
(remove-sub-char)
(sub-char))
(define-minor-mode sub-char-mode
"A minor-mode for testing overlay-removal with cons cells."
:init-value nil
:lighter " OV-REMOVE"
:keymap nil
:global nil
:group 'lawlist
(cond
(sub-char-mode
(add-hook 'post-command-hook 'sub-char-post-command-hook nil t)
(message "Turned ON `sub-char-mode`."))
(t
(remove-hook 'post-command-hook 'sub-char-post-command-hook t)
(remove-sub-char)
(message "Turned OFF `sub-char-mode`."))))
I suggest you start by getting rid of your variable-FOO-p vars: not only their names are wrong (the "-p" suffix is meant for use with predicates which are necessarily functions, and not variables) but they're unneeded. Rather than tell remove-overlays to remove all overlays with a particular display property, just add a property of your own (e.g. (overlay-put <youroverlay> 'vline t)) so you can then do a single (remove-overlays (point-min) (point-max) 'vline t). Of course, another approach which will work at least as well is to keep a single buffer-local variable (better yet, window-local) which holds a list of all the overlays you currently have placed. This way, you can remove those overlays with a single (mapc #'delete-overlay vline--overlays), which is more efficient. It can be made even more efficient by moving/reusing those overlays rather than deleting them and then creating new ones instead.

How to query syntax class constituents as string of char?

Using elisp I am trying to convert from an emacs syntax class \s_ to a string of characters that constitute this class using the syntax table. I have not been able to find some reference code or an example that I could identify.
Does anyone have a reference or a code snippet to share?
Thanks, Matt
Update 1 : After further reading, I have found that the table can be traversed with map-char-table, accumulating the required characters.
Some utilities in use here from
https://launchpad.net/s-x-emacs-werkstatt/
(defun ar-syntax-class-atpt (&optional pos)
"Return the syntax class part of the syntax at point. "
(interactive)
(let* ((pos (or pos (point)))
(erg (logand (car (syntax-after pos)) 65535)))
(when (interactive-p) (message "%s" erg)) erg))
(defun syntax-class-bfpt ()
"Return the syntax class part of the syntax at point. "
(interactive)
(let ((erg (logand (car (syntax-after (1- (point)))) 65535)))
(when (interactive-p) (message "%s" erg)) erg))
(defun ar-syntax-atpt (&optional docu pos)
(interactive)
(when pos
(goto-char pos))
(let* ((elt (car (if (featurep 'xemacs)
(char-syntax (char-after))
(syntax-after (point)))))
(stax (cond ((eq elt 0) "0 whitespace")
((eq elt 5) "5 close parenthesis")
((eq elt 10) "10 character quote")
((eq elt 1) "1 punctuation")
((eq elt 6) "6 expression prefix")
((eq elt 11) "11 comment-start")
((eq elt 2) "2 word")
((eq elt 7) "7 string quote")
((eq elt 12) "12 comment-end")
((eq elt 3) "3 symbol")
((eq elt 8) "8 paired delimiter")
((eq elt 13) "13 inherit")
((eq elt 4) "4 open parenthesis")
((eq elt 9) "9 escape")
((eq elt 14) "14 generic comment")
((eq elt 15) "15 generic string"))))
(when (interactive-p)
(message (format "%s" stax)))
(if docu
(format "%s" stax)
elt)))
(defun ar-syntax-in-region-atpt (beg end)
(interactive "r")
(save-excursion
(goto-char beg)
(let (erg)
(while (< (point) end)
(setq erg (concat erg "\n" "\"" (char-to-string (char-after)) "\"" " is " (ar-syntax-atpt t)))
(forward-char 1))
(message "%s" erg)
erg)))
(defun syntax-bfpt ()
(interactive)
(let ((stax (syntax-after (1- (point)))))
(when (interactive-p)
(message (format "%s" stax)))
stax))

How do I get all paragraphs in Emacs Lisp?

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)))

Building and maintaining a database in Emacs?

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"))

How do I get Ltk to display what the user is writing and what the functions print?

The kind of functions are of the sort of:
(defun display-all ()
"Display all items in the database."
(dolist (item *database*)
(format t "~{~a:~10t~a~%~}~%" item)))
(defun prompt-read (prompt)
(format *query-io* "~a: " prompt)
(force-output *query-io*)
(read-line *query-io*))
(defun prompt-for-item ()
(make-database
(prompt-read "Name")
(prompt-read "Price")))
I've read the Ltk documentation, but there doesn't seem to be any examples of text widget usage.
You create the text widget like every other widget. The Lisp-side object has text accessor function with writer method which sets the text on Tk side. Minimal example:
(with-ltk ()
(let* ((text-widget (make-instance 'text :width 15 :height 2))
(b1 (make-instance 'button
:text "Print"
:command #'(lambda () (princ (text text-widget)))))
(b2 (make-instance 'button :text "Reset"
:command #'(lambda () (setf (text text-widget) "reset")))))
(pack text-widget)
(pack b1)
(pack b2)))