Menu

Show posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.

Show posts Menu

Messages - axtens

Pages1 2
#1
newLISP and the O.S. / Re: Finding the attributes of Chinese filenames (Win32)
June 22, 2010, 09:45:25 PM
@m35, your help is very much appreciated.



It seems a little weird to me doing the slice on the reverse of the bits but I couldn't find any bit_and functionality anywhere (quickly).



Thanks,

Bruce.


Code Select
;code from m35
(constant 'SIZEOF_WCHAR 2) ; assumption
(constant 'CP_UTF8 65001)

(define (utf8->16 lpMultiByteStr , cchWideChar lpWideCharStr ret)
(if (not MultiByteToWideChar)
(begin
(import "kernel32.DLL" "MultiByteToWideChar")
)
)
; calculate the size of buffer (in WCHAR's)
(setq cchWideChar
(
MultiByteToWideChar
CP_UTF8 ; from UTF-8
0       ; no flags necessary
lpMultiByteStr
-1      ; convert until NULL is encountered
0
0
)
)
   
; allocate the buffer
(setq lpWideCharStr (dup " " (* cchWideChar SIZEOF_WCHAR)))
   
; convert
(setq ret
(
MultiByteToWideChar
CP_UTF8 ; from UTF-8
0       ; no flags necessary
lpMultiByteStr
-1      ; convert until NULL is encountered
lpWideCharStr
cchWideChar
)
)
(if (> ret 0) lpWideCharStr nil)
)

; resets the Win32 archive flag on a file
; By CaveGuy 2009

(define (get-archive-flag file-name)
(if (not GetFileAttributesW)
(begin
(import "kernel32.DLL" "GetFileAttributesW")
)
)
(setq fname file-name
file-attrib (GetFileAttributesW (utf8->16 fname))
)  
file-attrib  
)

; walks a disk directory and prints all path-file names
;
(define (show-tree dir)
(if (directory dir)
(dolist (nde (directory dir))
(if (and (directory? (append dir "/" nde)) (!= nde ".") (!= nde "..") )
(show-tree (append dir "/" nde))
(begin
(setq fname (append dir "/" nde))
(setq fflag (get-archive-flag fname))
(setq fbits (bits fflag))
(if (= (slice (reverse fbits) 5 1) "1") (println fname))
)
)
)
)
)

(show-tree "//iibt-spare/temp/Scans")
#2
newLISP and the O.S. / Re: Finding the attributes of Chinese filenames (Win32)
June 22, 2010, 08:12:37 PM
Wow, cool code!


QuoteIs there a reason you can't use the built in file-info function?


Perhaps I'm not seeing something that's right in front of me, but the manual doesn't say anything about returning the 'archive bit' status when using file-info.
#3
newLISP and the O.S. / Finding the attributes of Chinese filenames (Win32)
June 21, 2010, 07:32:56 PM
The following NewLISP code shows me the file attributes of files under Win32. However, some of the filenames retrieved have Chinese characters in the name. When the GetFileAttributesA function encounters them, it gives me a -1 for the attribute. I looked at GetFileAttributesW but don't know how to make the contents of the fname available to the function in a form it recognises.



How does one handle this situation?


Code Select
(define (get-archive-flag file-name)
    (if (not GetFileAttributesA)
        (begin
        (import "kernel32.DLL" "GetFileAttributesA")
        )
    )
    (setq fname file-name file-attrib (GetFileAttributesA (address fname)))  
    (append fname " " ( string file-attrib))    
)

; walks a disk directory and prints all path-file names
;
(define (show-tree dir)
    (if (directory dir)
        (dolist (nde (directory dir))
            (if (and (directory? (append dir "/" nde))
                (!= nde ".") (!= nde ".."))
                (show-tree (append dir "/" nde))
                (println (get-archive-flag (append dir "/" nde)))
            )
        )
    )
)

(show-tree "z:\working files\Cathy")
#4
newLISP in the real world / Re: Parsing another lisp-ish language
January 16, 2010, 11:04:31 PM
kks,



Yes, that's marvellous. Thanks very much. I can now get on with the rest of the project (and figure out why your fix works.)



Kind regards,

Bruce.
#5
newLISP in the real world / Re: Parsing another lisp-ish language
January 16, 2010, 07:01:44 AM
Nope. Dead end.


Code Select

s(setq res "")
(define (proc procode)
   (local (codelen code separator elider)
      (begin
         (setq codelen (length procode))
         (for (i 0 (- codelen 1) 1)
            (begin
               (setq code (procode i))
               (when (= i 0) (setq res (append res "<@ " (string code) ">" )))
               ;at this point, check to see whether OMT and SAI things are used
               ;if so, set the separator to empty string
               (setq elider (find (upper-case (string code)) '("OMT" "SAO" "OSA" "SAI" "OSI" "SAW" "OSW")))
               (if (nil? elider)
                  (setq separator "|")
                  (setq separator "")
               )
               (when (> i 0 )
                  (if    
                     (list? code) (proc code)
                     (atom? code) (setq res (append res (string code) )  )
                  )
)
                (when (> i 0)
 (if (< i (- codelen 1))
                        (setq res (append res separator ))
                     )
                )
                (when (= i (- codelen 1))
                  (setq res (append res "</@>" ))
                )
            )      
         )
      )
   )
)

(setq code "(sai (ITEFORLITLITLITLIT 999999999 1 1 (SAYOPRCAP (SAYVALFOR ...) "thing"))(sayvar goose))")
(setq parsed (read-expr code))(println $0)
(proc parsed)
(print res)
(exit)
#6
newLISP in the real world / Re: Parsing another lisp-ish language
January 16, 2010, 06:58:20 AM
I think I've got it partly figured out. Still have to come up with a solution, though.


Code Select
              (when (> i 0 )
                  (if    
                     (list? code) (proc code)
                     (atom? code) (setq res (append res (string code) )  )
                  )
                  (if (< i (- codelen 1))
                     (begin
                        (setq res (append res separator ))
                     )
                  )
               )

When one returns from the 'proc' routine, control falls to the end of the (when) thus missing the separator stuff.



Is that really the problem? I just don't know.



Bruce.
#7
newLISP in the real world / Parsing another lisp-ish language
January 16, 2010, 12:20:15 AM
G'day everyone



I'm writing a translator which will take a Lisp-ish way of writing a language and outputting it in a more XML-ish form.



This means taking this:
Code Select
(sai (ITEFORLITLITLITLIT 999999999 1 1 (SAYOPRCAP (SAYVALFOR ...) "thing"))(sayvar goose))

and changing it into this:
Code Select
<@ sai><@ ITEFORLITLITLITLIT>999999999|1|1|<@ SAYOPRCAP><@ SAYVALFOR>...</@>|thing</@></@><@ sayvar>goose</@></@>

My problem is that the code below almost works, except that it converts to this:
Code Select
<@ sai><@ ITEFORLITLITLITLIT>999999999|1|1|<@ SAYOPRCAP><@ SAYVALFOR>...</@>|thing</@></@>|<@ sayvar>goose</@></@>

In case you missed it, the difference is the presence of the bar character just before the <@ sayvar>goose, which is clearly "the wrong thing"



Given the recursive nature of the 'proc' define, why am I always getting the bar appearing? The rule, BTW, is that SAI's arguments (and a few others) are never bar separated, but all others have arguments separated by bar.



Kind regards,

Bruce.

P.S. Windows version of newLisp. Development version. UTF-8 EXE.


Code Select
(setq res "")
(define (proc procode)
(local (codelen code separator elider)
(begin
(setq codelen (length procode))
(for (i 0 (- codelen 1) 1)
(begin
(setq code (procode i))
(when (= i 0) (setq res (append res "<@ " (string code) ">" )))
;at this point, check to see whether OMT and SAI things are used
;if so, set the separator to empty string
(setq elider (find (upper-case (string code)) '("OMT" "SAO" "OSA" "SAI" "OSI" "SAW" "OSW")))
(if (nil? elider)
(setq separator "|")
(setq separator "")
)
(when (> i 0 )
(if
(list? code) (proc code)
(atom? code) (setq res (append res (string code) )  )
)
(if (< i (- codelen 1))
(begin
(setq res (append res separator ))
)
)
)
(when (= i (- codelen 1))
(setq res (append res "</@>" ))
)
)
)
)
)
)

(setq code "(sai (ITEFORLITLITLITLIT 999999999 1 1 (SAYOPRCAP (SAYVALFOR ...) "thing"))(sayvar goose))")
(setq parsed (read-expr code))(println $0)
(proc parsed)
(print res)
(exit)
#8
Whither newLISP? / Complex numbers and multiple answers
April 30, 2009, 09:46:33 PM
G'day everyone



W.r.t. complex numbers, how easy would it be to have

  (sqrt -1)

return

  (0.0 1.0)



and on the question of multiple answers, there are two correct answers to the square root of 4

  (sqrt 4)

-->

  (2 -2)



Could there be a way in future newLISPs to be able to do complexes and also some system setting that would return both answers from things like (sqrt)?



Kind regards,

Bruce.
#9
So, what can you actually DO with newLISP? / Re: Twitter command-line utility update v.03
April 15, 2009, 01:13:20 AM
Lutz,



Here's my take on the twitter.lsp (v0.3ax) which uses my linked? and command-line stuff. This way the script can be executed either by newlisp.exe on the commandline or after use of link.lsp.



Kind regards,

Bruce.
Code Select
#!/usr/bin/newlisp

; post, delete and see user and friends messages and followers on http://twitter.com
; February 12th, 2009, L.M.
; version 0.1
; version 0.2
;    added twitter seach
;    fields now separated by CR-LF
;    records now separated by CR-LF CR-LF
; version 0.3
;    eliminated spurious nil in search
;    added xml option to search
; version 0.4ax
; better main-args handling. Now using linked? and command-line
; not very graceful about failures, e.g. search without search term
; when no parameters are given, show help text

(define (linked?) (not (starts-with (lower-case (main-args 0)) "newlisp")))
(setq command-line (if (linked?) (main-args) (rest (main-args))))

(setq helptext "EXAMPLES:
    twitter userid:pass followers
    twitter userid:pass followers xml
    twitter userid:pass user
    twitter userid:pass user 10
    twitter userid:pass friends
    twitter userid:pass friends 10
    twitter userid:pass delete 1234567890
    twitter userid:pass post "this is a test"
    twitter search the-word-to-search

append "xml" to return results as XML"
)

(unless (>= (length command-line) 2)
(println helptext)
(exit)
)

; (println "foo")
(when (= (command-line 1) "search")
  ; this is a search, no user authentication is required
  (setq xml (get-url (string "http://search.twitter.com/search.atom?q=" (command-line 2))))
  (when (= (command-line -1) "xml")
    (println xml)
(exit))
  (xml-type-tags nil nil nil nil) ; no extra tags
  (setq sxml (xml-parse xml 31)) ; turn on SXML options
  (setq entry-index (ref-all '(entry *) sxml match))
  (when (empty? entry-index)
    (println "No entries found")
    (exit))
  (dolist (idx entry-index)
    (setq entry (sxml idx))
    (println (lookup 'published entry) "rn"
             (lookup '(author name) entry ) "rn"
             (lookup 'title entry) "rnrn"))
  (exit))

(define (url-encode str)
  (replace {([^a-zA-Z0-9])} str (format "%%%2X" (char $1)) 0))

; authorization user id and password
(setq user-pass (command-line 1))
(setq auth (append "Authorization: Basic " (base64-enc user-pass) "rn"))

(when (= (command-line 2) "followers")
  (setq xml (get-url "http://twitter.com/statuses/followers.xml" 5000 auth))
  (if (= (command-line -1) "xml")
    (println xml)
    (println (join (find-all "<screen_name>(.*)</screen_name>" xml $1) "rn") "rn"))
  (exit))

(when (= (command-line 2) "user")
  (if (> (length command-line) 3) (setq cnt (command-line 3)) (setq cnt "1"))
  ;(if-not cnt (setq cnt "1")) ; return only the last post by default
  (setq url (append "http://twitter.com/statuses/user_timeline.xml?count=" cnt))
  (setq xml (get-url url 5000 auth))
  (if (= (command-line -1) "xml")
    (println xml)
    (begin
      (xml-type-tags nil nil nil nil)
      (setq sxml (xml-parse xml 31))
      (setq sxml (2 (sxml 0)))
      (dolist (post sxml)
        (println (0 19 (post 1 1)) "rn" (post 2 1) "rn" (post 3 1) "rnrn"))
    ))
  (exit))
   
(when (= (command-line 2) "friends")
  (if (> (length command-line) 3) (setq cnt (command-line 3)) (setq cnt "1"))
  ;(if-not cnt (set 'cnt "1")) ; return only the last post by default
  (setq url (append "http://twitter.com/statuses/friends_timeline.xml?count=" cnt))
  (setq xml (get-url url 5000 auth))
  (if (= (command-line -1) "xml")
    (println xml)
    (begin
      (xml-type-tags nil nil nil nil)
      (setq sxml (xml-parse xml 31))
      (setq sxml (2 (sxml 0)))
      (dolist (post sxml)
        (println (0 19 (post 1 1)) "rn" (post 10 2 1) "rn" (post 3 1) "rnrn"))
    ))
  (exit))
   
(when (= (command-line 2) "delete")
  (setq url (string "http://twitter.com/statuses/destroy/" (command-line 3) ".xml"))
  (setq xml (delete-url url 5000 auth))
  (if (= (command-line -1) "xml")
    (println xml)
    (begin
      (if (find "<text>(.*)</text>" xml 0)
        (println "deleted: " $1))
      (if (find "<error>(.*)</error>" xml 0)
        (println "error: " $1))
    ))
  (exit))

(when (= (command-line 2) "post")
  (setq url (string "http://twitter.com/statuses/update.xml"))
  (setq msg (join (3 command-line) " "))
  (setq text (append "status=" (url-encode msg)))
  (setq content-type "application/x-www-form-urlencoded")
  (setq xml (post-url url text content-type 5000 auth))
  (if (= (command-line -1) "xml")
    (println xml)
    (begin
      (if (find "<text>(.*)</text>" xml 0)
        (println "posted: " $1))
      (if (find "<error>(.*)</error>" xml 0)
        (println "error: " $1))
    ))
  (exit))

(println "wrong command")
(println helptext)
(exit)

;eof



P.S. I'm not exactly sure where to post this.
#10
newLISP in the real world / Re: How do I detect if a script is "linked" or not
April 14, 2009, 11:45:00 PM
Quote from: "xytroxon"Change the link.lsp program so that after the script to be appended is loaded into memory, push a (set 'link.lsp? true) flag to the front of the code string, before the string is written to the .exe file being created.



...



-- xytroxon


Therein lies the difference between the guru and the disciple.



My solution was as below, and happens entirely within the script being developed rather than in link.lsp.


Code Select
(define (linked?)
(not (starts-with (lower-case (main-args 0)) "newlisp"))
)

(setq command_line (if (linked?) (main-args) (rest (main-args))))


With this approach I end up with a list, command_line, that works properly no matter what, as below.
Code Select
S:>type linkage.lsp
(define (linked?) (not (starts-with (lower-case (main-args 0)) "newlisp")))
(setq command_line (if (linked?) (main-args) (rest (main-args))))
(println command_line)
(exit)

Code Select

S:>newlisp linkage.lsp "newLISP rules" OK!
("linkage.lsp" "newLISP rules" "OK!")

S:>linkage.exe "newLISP rules" OK!
("linkage.exe" "newLISP rules" "OK!")

So thanks very much xytroxon, you've been really helpful. Jam your stuff and my stuff together, and we have the solution.



Kind regards,

Bruce.
#11
newLISP in the real world / How do I detect if a script is "linked" or not
April 13, 2009, 07:52:36 PM
G'day everyone



With this code
Code Select

;margs.lsp
(dolist (i (main-args)) (println $idx ": " i))
(exit)


If I evaluate it using the interpreter I get the following
Code Select

>newlisp margs.lsp 1 2 3
0: newlisp
1: margs.lsp
2: 1
3: 2
4: 3

but if I link it using link.lsp I get the similar stuff but in different places
Code Select

>emargs 1 2 3
0: emargs
1: 1
2: 2
3: 3

This is problematic, particularly as I tried to link the twitter.lsp code yesterday and had to tweak the code to make the main-args work properly. It would be better, I reckon, to be able to write into the script itself a means of detecting whether it's running interpreted or linked.



I suppose one could check for the "newlisp" in (main-args 0) but v10.3.4 could have a predicate (linked?), viz
Code Select

(if (linked?) (println (uppercase (main-args 1))) (println (uppercase (main-args 2))))


Am I missing something? It happens all the time.



Kind regards,

Bruce.
#12
Whither newLISP? /
April 12, 2009, 08:30:36 AM
Quote from: "axtens"
Quote from: "HPW"
Code Select

(setq j 20)
(for (i 1 10 1 (= j 0))
 (println (string "i=" i "j=" j))
 (setq j (- j 2))
)


However, what I ended up doing was:


Code Select
(setq i ?TestRange1Low)
(setq j ?TestRange2Low)
(while (and (!= i ?TestRange1High) (!= j ?TestRange2High))
(begin
(inc i ?TestIncr1)
(inc j ?TestIncr2)
)
)


which, whilst not brilliant, does work. I suppose what I was thinking of was some new kind of syntax that would enable me to set up a co-enumeration, e.g.
Code Select

   (co-for (i 1 10 1) (j 20 2 -2) (begin ... ) )


--Bruce
#13
Whither newLISP? /
April 12, 2009, 06:02:39 AM
Quote from: "HPW"
Code Select

(setq j 20)
(for (i 1 10 1 (= j 0))
 (println (string "i=" i "j=" j))
 (setq j (- j 2))
)


Wow, would never of thought of that approach. Thanks!!



Kind regards,

Bruce.
#14
Whither newLISP? / need an enhanced (for)
April 12, 2009, 02:49:44 AM
G'day everyone



I'm not sure how I'd handle this, as I'm just thinking about it now, but how would one implement a (for) that had two indices rather than the usual one?



For example (pseudopseudocode):

  for i = 1 to 10 with j=20 to 2 step -2 do

    println i,j

  next



The usual thing is to have the for j inside the for i and to get about 100 results. I was thinking more of getting as many results as it takes for either i or j to terminate. That is, if i gets to 10 before j gets to 2 then terminate or vice versa.



I may come up with something soon, but if anyone wants to offer a solution, I'd be very interested.



Kind regards,

Bruce.
#15
newLISP and the O.S. /
April 10, 2009, 08:39:21 AM
Quote from: "m35"Good to see you're exploring and trying new things. You might also be interested in http://www.newlisp.org/modules/various/winscript.lsp.html">this. ;)


Oh wow, that looks so cool. I've gotta try that out real soon.



Thanks.



Bruce.
Pages1 2