Im pretty new in Lisp programming language and I got an error that I can't fix :/
Hope someone can help me. (Sorry if it's a newbie mistake)
Here's my code:
(defun inicia()
(princ "Ingresa la infija")
(setf temp(read-line))
(setf final nil)
(setf pilatemp nil)
(setf tamaño (length temp))
(setf cont 0)
(loop
(setf cadena (reverse temp))
(if (= cont tamaño) (return ))
(setf caracter (string (char temp cont)))
(if (= (operando caracter) 1) (push caracter final))
(if (= (operador caracter) 1) (PROGN (loop
(if (and (= cont tamaño) (<= (jerarquia caracter) (jerarquia (first pilatemp)))) (return))
(push (first pilatemp) final)
(pop pilatemp)
(setf cont (+ cont 1))))
(push caracter pilatemp)))
(if (equal caracter ")") (push caracter pilatemp))
(if (equal caracter "(") (PROGN (loop
(if (string= (first pila) ")") (return))
(push (pop pilatemp) final))
(pop pilatemp)))
(setf cont (+ cont 1)))
(loop
(setf tamaño (length pilatemp))
(if (<= tamaño 0) (return))
(if (equal (first pilatemp) ")") (pop pilatemp) (push (pop pilatemp) final))
(setf final (reverse final))))
(defun jerarquia(operan)
(cond
((string/= operan "^") 8)
((string/= operan "$") 8)
((string/= operan "*") 7)
((string/= operan "/") 6)
((string/= operan "+") 5)
((string/= operan "-") 4)
((string/= operan "(") 3)
((string/= operan ")") 2)
((string/= operan "=") 1)
(T 0)))
(defun operando (operan)
(cond
((= (operador operan) 0) 1)
;ojo con el retorno del siguiente if
((string/= operan "(") 1)
((string/= operan ")") 1)
(T 0)))
(defun operador (operan)
(cond
((string/= operan "+") 1)
((string/= operan "-") 1)
((string/= operan "*") 1)
((string/= operan "/") 1)
((string/= operan "^") 1)
((string/= operan "$") 1)
((string/= operan "=") 1)
(T 0)))
And the error I'm getting is the next one:
-SETQ: variable PILATEMP has no value
Thanks :)
You're getting this error because of one closing parenthesis too many:
(setf cont (+ cont 1)) ; <--- you had 3 closing parentheses here
(loop
(setf tamaño (length pilatemp))
(if (<= tamaño 0) (return))
(if (equal (first pilatemp) ")") (pop pilatemp) (push (pop pilatemp) final))
(setf final (reverse final))))
so the loop got executed at the top level, and not inside the function.
Related
I have this code below. It exports the selected polylines lenght to a CSV but it does not give it a name so i cant make a difference between two(or more) types of polyline.
My question is how to modify this code in order to be able to export the lenghts with the name of the linetype.
For example: I loaded ZIGZAG and TRACKS linetype, next I run my function and select all of the drawn polylines and I want to see in my CSV that which linetype is how long by name.
(defun c:Polyline_számoló (/ s i e l fn)
(if (and(setq s (ssget '((0 . "LWPOLYLINE"))))
(setq fn (getfiled "Create Output File" "" "csv" 1)))
(progn
(setq s (_SortSSByXValue s))
(setq i (sslength s))
(while (setq e(ssname s (setq i (1- i))))
(setq l (cons (vla-get-length (vlax-ename->vla-object e)) l))
(ssdel e s)
)
)
)
(setq l (list (cd:CON_All2Str l nil)))
(if (LM:WriteCSV l fn)
(startapp "explorer" fn)
)
(princ)
)
(defun cd:CON_All2Str (Lst Mode)
(mapcar
(function
(lambda (%)
(if Mode
(vl-prin1-to-string %)
(vl-princ-to-string %)
)
)
)
Lst
)
)
(defun _SortSSByXValue (ss / lst i e add)
(if (eq (type ss) 'PICKSET)
(progn
(repeat (setq i (sslength ss))
(setq lst (cons (cons (setq e (ssname ss (setq i (1- i))))
(cadr (assoc 10 (entget e)))
)
lst
)
)
)
(setq add (ssadd))
(foreach e (vl-sort lst (function (lambda (a b) (< (cdr a) (cdr b))))) (ssadd (car e) add))
(if (> (sslength add) 0)
add
)
)
)
)
(defun LM:writecsv ( lst csv / des sep )
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)
(defun LM:lst->csv ( lst sep )
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)
(defun LM:csv-addquotes ( str sep / pos )
(cond
( (wcmatch str (strcat "*[`" sep "\"]*"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
( str )
)
)
Here's a lisp function that will export a csv file.
The csv file contains two sections:
1.) a length summary by linetype name
2.) an individual line summary with length and linetype
csv example:
--Length Summary By LineType--
LineType,Length
CENTER,739.97
HIDDEN,1858.61
--Length Breakdown By Individual Line--
LineType,Length
CENTER,246.656
HIDDEN,309.768
HIDDEN,309.768
CENTER,246.656
HIDDEN,309.768
HIDDEN,309.768
CENTER,246.656
HIDDEN,309.768
HIDDEN,309.768
Lisp code
;;www.cadwiki.net
(defun c:test (/ s i e l fn CSVSTRING CSVSTRINGLIST DATAITEM individualLineDataList LINELENGTH LINETYPE VLAOBJECT NEWASSOC NEWLENGTH PREVIOUSLENGTH lineTypeToLengthAssoc SUMMARYENTRY
)
(if (and (setq s (ssget '((0 . "LWPOLYLINE"))))
(setq fn (getfiled "Create Output File" "" "csv" 1))
)
(progn
(setq s (_SortSSByXValue s))
(setq i (sslength s))
(setq individualLineDataList (list))
(while (setq e (ssname s (setq i (1- i))))
(setq vlaObject (vlax-ename->vla-object e))
(setq lineType (vla-get-linetype vlaObject))
(setq lineLength (vla-get-length vlaObject))
(setq dataItem (list lineType lineLength))
(setq individualLineDataList (cons dataItem individualLineDataList))
(setq summaryEntry (assoc lineType lineTypeToLengthAssoc))
(if (/= summaryEntry nil)
(progn
(setq previousLength (cdr summaryEntry))
(setq newLength (+ previousLength lineLength))
(setq newAssoc (cons lineType newLength))
(setq lineTypeToLengthAssoc (REMOVE-ASSOC-BY-KEY lineType lineTypeToLengthAssoc))
(setq lineTypeToLengthAssoc (cons newAssoc lineTypeToLengthAssoc))
)
(progn
(setq newAssoc (cons lineType lineLength))
(setq lineTypeToLengthAssoc (cons newAssoc lineTypeToLengthAssoc))
)
)
(ssdel e s)
)
)
)
(setq csvStringList (list (list "--Length Summary By LineType--")))
(setq csvStringList (cons (list "LineType" "Length") csvStringList))
(foreach assocItem lineTypeToLengthAssoc
(setq csvString (summaryAssocToStringList assocItem))
(setq csvStringList (cons csvString csvStringList))
)
(setq csvStringList (cons (list "--Length Breakdown By Individual Line--") csvStringList))
(setq csvStringList (cons (list "LineType" "Length") csvStringList))
(foreach item individualLineDataList
(setq csvString (cd:CON_All2Str item nil))
(setq csvStringList (cons csvString csvStringList))
)
(setq csvStringList (reverse csvStringList))
(if (LM:WriteCSV csvStringList fn)
(startapp "explorer" fn)
)
(princ)
)
(defun REMOVE-ASSOC-BY-KEY (assocKey assocList / newAssocList item)
(setq newAssocList nil)
(foreach item assocList
(if (not (= (car item) assocKey))
(setq newAssocList (append newAssocList (list item)))
)
)
newAssocList
)
(defun summaryAssocToStringList (assocItem / LINELENGTH LINETYPE STRINGLIST)
(setq lineType (car assocItem))
(setq lineLength (cdr assocItem))
(setq stringList (list lineType (rtos lineLength 2 2)))
)
(defun cd:CON_All2Str (Lst Mode)
(mapcar
(function
(lambda (%)
(if Mode
(vl-prin1-to-string %)
(vl-princ-to-string %)
)
)
)
Lst
)
)
(defun _SortSSByXValue (ss / lst i e add)
(if (eq (type ss) 'PICKSET)
(progn
(repeat (setq i (sslength ss))
(setq lst (cons (cons (setq e (ssname ss (setq i (1- i))))
(cadr (assoc 10 (entget e)))
)
lst
)
)
)
(setq add (ssadd))
(foreach e (vl-sort lst (function (lambda (a b) (< (cdr a) (cdr b))))) (ssadd (car e) add))
(if (> (sslength add) 0)
add
)
)
)
)
(defun LM:writecsv (lst csv / des sep)
(if (setq des (open csv "w"))
(progn
(setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList"))
(",")
)
)
(foreach row lst (write-line (LM:lst->csv row sep) des))
(close des)
t
)
)
)
(defun LM:lst->csv (lst sep)
(if (cdr lst)
(strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep))
(LM:csv-addquotes (car lst) sep)
)
)
(defun LM:csv-addquotes (str sep / pos)
(cond
((wcmatch str (strcat "*[`" sep "\"]*"))
(setq pos 0)
(while (setq pos (vl-string-position 34 str pos))
(setq str (vl-string-subst "\"\"" "\"" str pos)
pos (+ pos 2)
)
)
(strcat "\"" str "\"")
)
(str)
)
)
I have this macro which is a "for" loop and it works great.
(defmacro for ((parameter start-value end-value
&optional (step 1))
&body e)
(let ((func-name (gensym))
(step-name (gensym))
(end (gensym)))
`(labels ((,func-name (,parameter ,end ,step-name)
(when (<= ,parameter ,end)
,#e
(,func-name (+ ,parameter ,step-name)
,end
,step-name))))
(,func-name ,start-value ,end-value ,step))))
But i need the result of my macro to be the value of the last expression in the body (of the body). Right now (in this code) the result is always nil. So what do i do?
Example for a single return value:
CL-USER 38 > (defmacro for ((parameter start-value end-value
&optional (step 1))
&body e)
(let ((func-name (gensym))
(step-name (gensym))
(end (gensym))
(last-name (gensym)))
`(labels ((,func-name (,parameter ,end ,step-name ,last-name)
(if (<= ,parameter ,end)
(,func-name (+ ,parameter ,step-name)
,end
,step-name
(progn ,#e))
,last-name)))
(,func-name ,start-value ,end-value ,step nil))))
FOR
CL-USER 39 > (let ((j 0) (k 1))
(for (i 1 10 (incf k))
(print i)))
1
3
5
7
9
9 ; the return value
I'm trying to write let over lambda defmacro/g! in guile scheme. I have this:
(use-modules (srfi srfi-1))
(define (flatten x)
(let rec ((x x) (acc '()))
(cond ((null? x) acc)
((not (pair? x)) (cons x acc))
(else
(rec (car x)
(rec (cdr x) acc))))))
(define (g!-symbol? s)
(and (symbol? s)
(let ((symbol-string (symbol->string s)))
(and (> (string-length symbol-string) 2)
(equal? (string-downcase (substring symbol-string 0 2)) "g!")))))
(define-macro (define-macro/g! name-args . body)
(let ((syms (delete-duplicates
(filter g!-symbol? (flatten body)))))
`(define-macro ,name-args
(let ,(map
(lambda (s)
`(,s (gensym ,(substring (symbol->string s) 2))))
syms)
,#body))))
but when I try to macro expand define-macro/g! using this:
(use-modules (language tree-il))
(tree-il->scheme (macroexpand '(define-macro/g! (foo . body) `(let ((g!car ,(car body))) g!car))))
I've got this:
$15 = (if #f #f)
why I've got this result? How can I expand define-macro/g!?
I need to use this code:
(define macro '(define-macro/g! (foo . body) `(let ((g!car ,(car body))) g!car)))
(tree-il->scheme (macroexpand macro 'c '(compile load eval)))
every time I add a new line, it would indent automatically but it indents 2 spaces, not 4 spaces.
Below is my .emacs snippet.
(defun make-vline-xpm (width height color &optional lor)
(let* ((w width)
(h height)
(s1 (concat "\"" (make-string w (string-to-char " ")) "\""))
(s2 (cond
((eq lor 0)
(concat "\"." (make-string (1- w) (string-to-char " ")) "\""))
((eq lor 1)
(concat "\"" (make-string (1- w) (string-to-char " ")) ".\""))
((null lor)
(concat "\"" (make-string (- (1- w)(/ (1- w) 2))(string-to-char " "))
"." (make-string (/ (1- w) 2)(string-to-char " ")) "\""))))
(sa (concat s1 ",\n" s2 ",\n")))
(eval `(concat "/* XPM */
static char * dot_vline_xpm[] = {
\"" (number-to-string w) " " (number-to-string h) " 2 1\",
\" c None\",
\". c " color "\",\n"
,#(mapcar (lambda(x) sa)
(make-list (1- (/ h 2)) 0))
s1 ",\n" s2 "};"
))))
(defvar indent-vline-img (make-vline-xpm 9 20 "#4D4D4D"))
(defun draw-indent-tab (beg end &optional color)
(if window-system
(set-text-properties
beg end
`(display (image
:type xpm
:data ,indent-vline-img
:pointer text
:ascent center
:mask (heuristic t))
rear-nonsticky (display)
fontified t))
(compose-region
beg end
(prog1 "|"
(set-text-properties beg end '(font-lock-face (:foreground "#4D4D4D"))))
'decompose-region)))
(defun draw-indent-vline ()
(interactive)
(save-excursion
(beginning-of-line)
(let* ((i (current-indentation))
(l (save-excursion
(count-lines (point)
(forward-list)))))
(while (> l 0)
(let* ((p1 (progn (move-to-column i)(point)))
(p2 (1+ p1)))
(if (and (eq (get-byte p1) 32)
(save-excursion
(skip-chars-backward " ")(bolp)))
(draw-indent-tab p1 p2))
nil)
(forward-line)
(setq l (1- l))))))
(defun indent-vline-lisp ()
(interactive)
(funcall
(lambda (x)
(font-lock-add-keywords
nil `((,x
(0 (draw-indent-vline))))))
"^[ \t]*[,`#'(]")
(defadvice delete-char (after indent-vline activate compile)
(save-excursion
(let* ((p (point))
(q (skip-chars-forward " "))
(x (progn (skip-chars-backward " ")(bolp))))
(if x
(remove-text-properties p (+ p q) '(display)))))))
(defun indent-vline ()
(interactive)
(funcall
(lambda (x)
(font-lock-add-keywords
nil `((,x
(0 (if (save-excursion
(skip-chars-backward " ")(bolp))
(let* ((p1 (point))
(p2 (1+ p1)))
(if (or (null (eq (get-byte p1) 32))
(get-text-property p1 'display))
nil
(draw-indent-tab p1 p2)
nil))))))))
" \\( \\)")
(defadvice delete-char (after indent-vline activate compile)
(save-excursion
(let* ((p (point))
(q (skip-chars-forward " "))
(x (progn (skip-chars-backward " ")(bolp))))
(if x
(remove-text-properties p (+ p q) '(display)))))))
I do not know lisp language. This .emscs is copied from others'. So my problem is how to set 4 space indent?
I have tried to add below to my .emacs, but it does not work.
(setq-default indent-tabs-mode nil)
(setq-default tab-width 4)
(setq indent-line-function 'insert-tab)
How about using custom-set-variables:
(custom-set-variables
'(tab-width 4))
I have a list of strings that I need to format using emacs lisp. This was the only way I could think of going about it:
(setq slist '("is there" "any" "way" "directed iteration"))
(format "%s _%s_ %s to do %S in elisp?"
(elt slist 0)
(elt slist 1)
(elt slist 2)
(elt slist 3)
(elt slist 4))
Giving me what I want.
is there _any_ way to do "directed iteration" in elisp?
There must be a more elegant way, but after much thought, I'm not seeing it. I'm very new to emacs lisp and I might be missing something obvious.
Use apply:
(apply 'format "%s _%s_ %s to do %S in elisp?" slist)
The apply function takes a function (or symbol) as its first argument, then a number of individual arguments, finishing with a list of arguments.
I've decided to make it into a standalone project by adding some more features, fixing some bugs and adding more bugs! yey :)
You can find the project here: http://code.google.com/p/formatting-el/source/browse/trunk/formatting.el
Not sure how much buggy this is, but at the first sight it seems to work:
(defun directive-end (c)
(member c "csdoxXeg%"))
(defun pp-if-nil (spec)
(position ?\% spec))
(defun pp-list (spec args)
(let ((pos 0) (last 0) (fstring "% ") current seen-^)
(catch 't
(while t
(setq pos (1+ (or (position ?% spec :start pos) -1))
current (aref spec pos))
(unless (and seen-^ (char-equal current ?\}) (null args))
(princ (substring spec last (1- pos))))
(setq last pos pos (1+ pos))
(cond
((char-equal current ?^)
(incf last)
(setq seen-^ t))
((char-equal current ?\{)
(setq pos (+ pos (pp-list (substring spec pos) (car args)))
args (cdr args)
last pos
seen-^ nil ))
((char-equal current ?\})
(if args (setq pos 0 last 0)
(throw 't nil)))
((char-equal current ?%)
(setq seen-^ nil last (1+ last))
(write-char ?%))
(t (unless args (error "Not enough argumens for list iteration"))
(setf (aref fstring 1) current)
(princ (format fstring (car args)))
(setq args (cdr args)
seen-^ nil
last
(or (position-if #'directive-end spec :start pos)
pos)))))) pos))
(defun cl-format (spec &rest args)
(with-output-to-string
(let ((pos 0) (last 0) (fstring "% ") current)
(catch 't
(while t
(setq pos (1+ (or (position ?\% spec :start pos) -1))
current (aref spec pos))
(when (= pos 0) (throw 't nil))
(princ (substring spec last (1- pos)))
(setq last pos pos (1+ pos))
(cond
((char-equal current ?^)
(unless args
(setq last (pp-if-nil spec)
pos last)))
((char-equal current ?\{)
(setq pos (+ pos (pp-list (substring spec pos) (car args)))
args (cdr args)
last pos))
((char-equal current ?\})
(error "Unmatched list iteration termination directive"))
((char-equal current ?%)
(write-char ?%)
(incf last))
(t (unless args (error "Not enough argumens"))
(setf (aref fstring 1) current)
(princ (format fstring (car args)))
(setq args (cdr args)
last
(or (position-if #'directive-end spec :start pos)
pos))))
(incf pos))))))
(cl-format "begin: %{%s = %d%^,%}; %% %c %% %{%{%s -> %d%^.%},%}"
'(a 1 b 2 c 3) ?\X '((a 2 b 4 c 6) (a 1 b 3 c 5)))
"begin: a = 1,b = 2,c = 3; % X % a -> 2.b -> 4.c -> 6,a -> 1.b -> 3.c -> 5,"
This tries to replicate some (very simplistic) Common Lisp-like printing behaviour of the ~{ ... ~} directives.