How to do auto input in multiple read-lines? - lisp

How to do auto input in multiple read-line?
(let ((out (with-output-to-string (*standard-output*)
(let ((*standard-input* (make-string-input-stream "y y")))
(when (find (read-line) '("yes" "y" "t") :test #'string-equal)
(print "aaaaa"))
(when (find (read-line) '("yes" "y" "t") :test #'string-equal)
(print "bbbbbb"))
))))
out)
I try like this, and I get:
; Evaluation aborted on #<END-OF-FILE {10048FD503}>.
This code work with read, but I need with read-line.

Another possibility is to use the parameter of read-line that requires to return nil on end of file:
(let ((out (with-output-to-string (*standard-output*)
(let ((*standard-input* (make-string-input-stream "y y")))
(when (find (read-line *standard-input* nil) '("yes" "y" "t") :test #'string-equal)
(print "aaaaa"))
(when (find (read-line *standard-input* nil) '("yes" "y" "t") :test #'string-equal)
(print "bbbbbb"))))))
out)

I made it work like this:
(with-output-to-string (*standard-output*)
(with-input-from-string (*standard-input* (format nil "y~%y"))
(when (find (read-line) '("yes" "y" "t") :test #'string-equal)
(print "aaaaa"))
(when (find (read-line) '("yes" "y" "t") :test #'string-equal)
(print "bbbbbb"))))

The without-to-string is unnecessary for an example...
CL-USER 177 > (flet ((yes-p (input-string &aux (yes-words '("yes" "y" "t")))
"returns T when the input-string is one of yes, y or t."
(find input-string yes-words :test #'string-equal)))
(with-input-from-string (*standard-input* (format nil "y~%y"))
(when (yes-p (read-line))
(print "aaaaa"))
(when (yes-p (read-line))
(print "bbbbbb"))
(values)))
"aaaaa"
"bbbbbb"

Related

read words from a file into nested list in common lisp programming language

I have a file named test.txt, it contains
"hello this is a test file"
I want to read it from the file so that every word represents lists of character and every paragraph represents lists of words means that I want to store them into a nested list like:
(list(list (h e l l o)) (list(t h i s))(list(i s)) (list(a)) (list(t e s t)) (list(f i l e))))
I am totally new in lisp and have a lot of confusion about this problem.
Solution without any dependencies
(defun split (l &key (separators '(#\Space #\Tab #\Newline)) (acc '()) (tmp '()))
(cond ((null l) (nreverse (if tmp (cons (nreverse tmp) acc) acc)))
((member (car l) separators)
(split (cdr l) :separators separators
:acc (if tmp (cons (nreverse tmp) acc) acc)
:tmp '()))
(t
(split (cdr l) :separators separators
:acc acc
:tmp (cons (car l) tmp)))))
(defun read-file-lines (file-path)
(with-open-file (f file-path :direction :input)
(loop for line = (read-line f nil)
while line
collect line)))
(defun read-file-to-word-characters (file-path)
(mapcan (lambda (s) (split (coerce s 'list)))
(read-file-lines file-path)))
(read-file-to-word-characters "~/test.lisp.txt")
;; ((#\h #\e #\l #\l #\o) (#\t #\h #\i #\s) (#\i #\s) (#\a) (#\t #\e #\s #\t)
;; (#\f #\i #\l #\e))
Convert the characters to one-letter strings:
;; apply to elements of nested list (= a tree) the conversion function `string`
(defun map-tree (fn tree)
(cond ((null tree) '())
((atom tree) (funcall fn tree))
(t (mapcar (lambda (branch) (map-tree fn branch)) tree))))
(map-tree #'string (read-file-to-word-characters "~/test.lisp.txt"))
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))
Content of "~/test.lisp.txt":
hello this
is a test file
Solution using cl-ppcre (Edi Weitz's congenial regex package)
;; look here in an answer how to use cl-ppcre:split
;; https://stackoverflow.com/questions/15393797/lisp-splitting-input-into-separate-strings
(ql:quickload :cl-ppcre)
(defun read-file-lines (file-path)
(with-open-file (f file-path :direction :input)
(loop for line = (read-line f nil)
while line
collect line)))
(defun string-to-words (s) (cl-ppcre:split "\\s+" s))
(defun to-single-characters (s) (coerce s 'list))
(defun read-file-to-character-lists (file-path)
(mapcan (lambda (s)
(mapcar #'to-single-characters
(string-to-words s)))
(read-file-lines file-path)))
(read-file-to-character-lists "~/test.lisp.txt")
;; ((#\h #\e #\l #\l #\o) (#\t #\h #\i #\s) (#\i #\s) (#\a) (#\t #\e #\s #\t)
;; (#\f #\i #\l #\e))
;; or use above's function:
(map-tree #'string (read-file-to-character-lists "~/test.lisp.txt"))
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))
;; or:
(defun to-single-letter-strings (s) (cl-ppcre:split "\\s*" s))
(defun read-file-to-letter-lists (file-path)
(mapcan (lambda (s)
(mapcar #'to-single-letter-strings
(string-to-words s)))
(read-file-lines file-path)))
(read-file-to-letter-lists "~/test.lisp.txt")
;; (("h" "e" "l" "l" "o") ("t" "h" "i" "s") ("i" "s") ("a") ("t" "e" "s" "t")
;; ("f" "i" "l" "e"))

Destructuring bind for regex matches

In elisp, how can I get a destructuring bind for regex matches?
For example,
;; what is the equivalent of this with destructuring?
(with-temp-buffer
(save-excursion (insert "a b"))
(re-search-forward "\\(a\\) \\(b\\)")
(cons (match-string 1)
(match-string 2)))
;; trying to do something like the following
(with-temp-buffer
(save-excursion (insert "a b"))
(cl-destructuring-bind (a b) (re-search-forward "\\(a\\) \\(b\\)")
(cons a b)))
I was thinking I would have to write a macro to expand matches if there isn't another way.
Here is one way: you first extend pcase to accept a new re-match pattern, with a definition such as:
(pcase-defmacro re-match (re)
"Matches a string if that string matches RE.
RE should be a regular expression (a string).
It can use the special syntax \\(?VAR: to bind a sub-match
to variable VAR. All other subgroups will be treated as shy.
Multiple uses of this macro in a single `pcase' are not optimized
together, so don't expect lex-like performance. But in order for
such optimization to be possible in some distant future, back-references
are not supported."
(let ((start 0)
(last 0)
(new-re '())
(vars '())
(gn 0))
(while (string-match "\\\\(\\(?:\\?\\([-[:alnum:]]*\\):\\)?" re start)
(setq start (match-end 0))
(let ((beg (match-beginning 0))
(name (match-string 1 re)))
;; Skip false positives, either backslash-escaped or within [...].
(when (subregexp-context-p re start last)
(cond
((null name)
(push (concat (substring re last beg) "\\(?:") new-re))
((string-match "\\`[0-9]" name)
(error "Variable can't start with a digit: %S" name))
(t
(let* ((var (intern name))
(id (cdr (assq var vars))))
(unless id
(setq gn (1+ gn))
(setq id gn)
(push (cons var gn) vars))
(push (concat (substring re last beg) (format "\\(?%d:" id))
new-re))))
(setq last start))))
(push (substring re last) new-re)
(setq new-re (mapconcat #'identity (nreverse new-re) ""))
`(and (pred stringp)
(app (lambda (s)
(save-match-data
(when (string-match ,new-re s)
(vector ,#(mapcar (lambda (x) `(match-string ,(cdr x) s))
vars)))))
(,'\` [,#(mapcar (lambda (x) (list '\, (car x))) vars)])))))
and once that is done, you can use it as follows:
(pcase X
((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)")
(cons var val)))
or
(pcase-let
(((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)") X))
(cons var val))
This has not been heavily tested, and as mentioned in the docstring it doesn't work as efficiently as it (c|sh)ould when matching a string against various regexps at the same time. Also you only get the matched substrings, not their position. And finally, it applies the regexp search to a string, whereas in manny/most cases regexps searches are used in a buffer. But you may still find it useful.

Functions inside a loop behaves differently

So I have a loop to just repeat the little text game I have made about dota, but when the function 'play' is called within a loop it doesn't return the result of my cond function, it just takes an input and then moves on to the next loop.
;;;;learn the invoker combo's
(defparameter *invoker-combo* '((cold-snap (3 0 0) 'QQQ);all of the possible invoker combo's
(ghost-walk (2 1 0) 'QQW)
(Ice-Wall (2 0 1) 'QQE)
(EMP (0 3 0) 'WWW)
(Tornado (1 2 0) 'QWW)
(Alacrity (0 2 1) 'WWE)
(Sun-Strike (0 0 3) 'EEE)
(Forge-Spirit (1 0 2) 'QEE)
(Chaos-Meteor (0 1 2) 'WEE)
(Deafening-Blast (1 1 1) 'QWE)))
(defun rand-combo (invoker-combo);returns a random combo
(nth (random (length invoker-combo))invoker-combo))
(defun count-letters (input);converts the keyboard strokes into numbers to be compared as it doesn't matter what order they are in, just that there is the correct quantity of them e.g QQE could also be written QEQ.
(append
(list (count #\Q input)
(count #\W input)
(count #\E input))))
(defun try-for-combo (rand-combo);takes i-p and compares it with the value for the random combo
(print(car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))'Good-job)
((equal i-p "END")(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo)*invoker-combo*)))))))
(defun play ()
(try-for-combo (rand-combo *invoker-combo*)))
(defun loop-play (x)
(loop for i from 0 to x
:do (play)))
If I call the function 'play' I get the following o/p:
FORGE-SPIRIT asdf
("ASDF" WAS WRONG CORRECT IS 'QEE)
or
ALACRITY wwe
GOOD-JOB
But if I call the function 'loop-play' I get the following o/p:
Break 3 [7]> (loop-play 2)
SUN-STRIKE eee
ALACRITY wwe
TORNADO qww
NIL
Can someone explain to me why this is happening?
EDIT: feel free to change the title, I didn't really know what to put.
The indentation and formatting of the code is poor. Please make it easier for you and for us to read the code.
(defun try-for-combo (rand-combo);takes i-p and compares it with the value for the random combo
(print(car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))'Good-job) ; wrong indent level
((equal i-p "END")(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo)*invoker-combo*)))))))
lacks spaces between s-expressions
wrong indentation levels
structure of the code unclear
does not use built-in documentation features
some lines are too long
Better:
(defun try-for-combo (rand-combo)
"takes i-p and compares it with the value for the random combo" ; built in doc
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo)) ; indentation
'Good-job)
((equal i-p "END")
(list 'Thanks 'for 'playing))
(t
(list i-p 'was 'wrong 'correct 'is ; several lines
(caddr (assoc (car rand-combo)
*invoker-combo*)))))))
I would propose to use an editor which actually understands some Lisp formatting. like GNU Emacs / SLIME, Clozure CL's Hemlock, LispWorks' editor...
If you are unsure about formatting, you can also ask Lisp to do it. Clisp is not that good at formatting, but something like SBCL or CCL would do:
* (let ((*print-case* :downcase))
(pprint '(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line)))
(try (count-letters i-p)))
(cond ((equal try (cadr rand-combo))
'Good-job) ((equal i-p "END")
(list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is
(caddr (assoc (car rand-combo)
*invoker-combo*)))))))))
And you get nicely formatted code:
(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase (read-line))) (try (count-letters i-p)))
(cond ((equal try (cadr rand-combo)) 'good-job)
((equal i-p "END") (list 'thanks 'for 'playing))
(t
(list i-p 'was 'wrong 'correct 'is
(caddr (assoc (car rand-combo) *invoker-combo*)))))))
Automatic indenting of Lisp code by the editor saves you a lot of work.
There are hints for manual indentation.
Your try-for-combo function doesn't actually output anything. Rather, it returns values.
In the REPL, if you evaluate a form, like (+ 1 2), it will always print the evaluation of that form at the end (in this case, 3). However, consider instead (+ 1 (print 2)). The print function actually outputs the argument to standard output, then returns the value itself. So this will show (on the repl)
2
3
The 2 is outputted first, because (print 2) itself prints 2. Then, the form (+ 1 (print 2)) is evaluates to the same things as (+ 1 2), or 3.
In your case, your try-for-combo function should look like:
(defun try-for-combo (rand-combo)
(print (car rand-combo))
(let* ((i-p (string-upcase(read-line)))
(try (count-letters i-p)))
(print
(cond
((equal try (cadr rand-combo)) 'Good-job)
((equal i-p "END") (list 'Thanks 'for 'playing))
(t (list i-p 'was 'wrong 'correct 'is (caddr(assoc (car rand-combo) *invoker-combo*))))))
nil))
This will print the result of that cond form, and return 'nil'.
That's just the difference between the output your program does and the output the Lisp system does for each evaluation:
print prints something (a newline and then its argument) and returns a value. The value is printed by the REPL. Thus we see output twice:
[3]> (print "3")
"3"
"3"
Next we do several call to print in a progn. The value of the progn form is printed by the REPL. The first three strings are printed by the code and the last string is printed because of the Lisp REPL printing the value:
[4]> (progn (print "1") (print "2") (print "3"))
"1"
"2"
"3"
"3"

Emacs -- How to extract all elements of a list

I am looking for some assistance, please, to extract all elements of a list of files and/or directories that have been marked in dired-mode. Essentially, if there were some way to just remove the parentheses from around the result of (mapcar (lambda (filename) (file-name-nondirectory filename)) (dired-get-marked-files)), then that would do the trick.
(start-process
"name-of-process"
"*output-buffer*"
"/usr/bin/zip"
"zip-file-name.zip"
(mapcar
(lambda (filename) (file-name-nondirectory filename))
(dired-get-marked-files)) )
The result I am seeking will look like this:
(start-process
"name-of-process"
"*output-buffer*"
"/usr/bin/zip"
"zip-file-name.zip"
"filename-number-one"
"filename-number-two"
"filename-number-three" )
EDIT:
The start-process function does not generally accept a single concatenated string of arguments. Instead, each argument must be separately spelled out (with quotation marks around each argument), or the argument can be a variable.
Here is the debugger message from the first example above -- the error occurs because there is a parentheses around the file names -- i.e., it cannot be a list.
Debugger entered--Lisp error: (wrong-type-argument stringp ("file-name-number-one" "file-name-number-two" "file-name-number-three"))
start-process("name-of-process" "*output-buffer*" "/usr/bin/zip" "zip-file-name.zip" ("file-name-number-one" "file-name-number-two" "file-name-number-three"))
eval((start-process "name-of-process" "*output-buffer*" "/usr/bin/zip" "zip-file-name.zip" (mapcar (lambda (filename) (file-name-nondirectory filename)) (dired-get-marked-files))) nil)
(cons (eval exp lexical-binding) values)
(setq values (cons (eval exp lexical-binding) values))
(let ((debug-on-error old-value)) (setq values (cons (eval exp lexical-binding) values)) (setq new-value debug-on-error))
(let ((old-value (make-symbol "t")) new-value) (let ((debug-on-error old-value)) (setq values (cons (eval exp lexical-binding) values)) (setq new-value debug-on-error)) (if (eq old-value new-value) nil (setq debug-on-error new-value)))
(if (null eval-expression-debug-on-error) (setq values (cons (eval exp lexical-binding) values)) (let ((old-value (make-symbol "t")) new-value) (let ((debug-on-error old-value)) (setq values (cons (eval exp lexical-binding) values)) (setq new-value debug-on-error)) (if (eq old-value new-value) nil (setq debug-on-error new-value))))
(let ((exp (if exp exp (read--expression "Eval: ")))) (if (null eval-expression-debug-on-error) (setq values (cons (eval exp lexical-binding) values)) (let ((old-value (make-symbol "t")) new-value) (let ((debug-on-error old-value)) (setq values (cons (eval exp lexical-binding) values)) (setq new-value debug-on-error)) (if (eq old-value new-value) nil (setq debug-on-error new-value)))) (let ((print-length (and (not (= 0 (prefix-numeric-value insert-value))) eval-expression-print-length)) (print-level (and (not (= 0 (prefix-numeric-value insert-value))) eval-expression-print-level)) (deactivate-mark)) (if insert-value (with-no-warnings (let ((standard-output (current-buffer))) (prog1 (prin1 (car values)) (if (= 0 ...) (progn ...))))) (prog1 (prin1 (car values) t) (let ((str (eval-expression-print-format ...))) (if str (princ str t)))))))
(if (active-minibuffer-window) nil (let ((exp (if exp exp (read--expression "Eval: ")))) (if (null eval-expression-debug-on-error) (setq values (cons (eval exp lexical-binding) values)) (let ((old-value (make-symbol "t")) new-value) (let ((debug-on-error old-value)) (setq values (cons (eval exp lexical-binding) values)) (setq new-value debug-on-error)) (if (eq old-value new-value) nil (setq debug-on-error new-value)))) (let ((print-length (and (not (= 0 ...)) eval-expression-print-length)) (print-level (and (not (= 0 ...)) eval-expression-print-level)) (deactivate-mark)) (if insert-value (with-no-warnings (let ((standard-output ...)) (prog1 (prin1 ...) (if ... ...)))) (prog1 (prin1 (car values) t) (let ((str ...)) (if str (princ str t))))))))
lawlist-eval-expression()
funcall-interactively(lawlist-eval-expression)
call-interactively(lawlist-eval-expression nil nil)
command-execute(lawlist-eval-expression)
What you want is to use apply with (mapcar ...) as its last argument:
(apply 'start-process
"name-of-process"
"*output-buffer*"
"/usr/bin/zip"
"zip-file-name.zip"
(mapcar #'file-name-nondirectory (dired-get-marked-files)))
Note that (mapcar #'function list) is a shorter spelling of (mapcar (lambda (arg) (function arg)) list).
combine-and-quote-strings is what you want:
(combine-and-quote-strings (mapcar (lambda (x)
(file-name-nondirectory x))
(dired-get-marked-files)))
EDIT: the following will give you a single, quoted string with internal quotes. Not sure if it'll play nicely with start-process:
(mapconcat
(lambda (x)
(concat "\"" (file-name-nondirectory x) "\""))
(dired-get-marked-files) " ")
EDIT: Righty-o, let's try this. Splice the backquoted list with ,#, then eval the whole thing:
(eval `(start-process
"name-of-process"
"*output-buffer*"
"/usr/bin/zip"
"zip-file-name.zip"
,#(mapcar
(lambda (x)
(file-name-nondirectory x))
(dired-get-marked-files))))

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