DrRacket. Keybinding to join lines - racket

How can I make a keyboard shortcut in DrRacket to join the current and next lines without spaces between them? And when several lines are selected the command has to join them together.
#lang s-exp framework/keybinding-lang
(keybinding "m:j" (λ (editor evt)
(define pos (send editor get-start-position))
(define line (send editor position-line pos))
...
))

Join lines with Alt+J keyboard shortcut.
Save the file and add it to DrRacket:
Edit > Keybindings > Add User-defined Keybindings..
Then restart the program.
#lang s-exp framework/keybinding-lang
(keybinding
"m:j" ; Join lines - Alt+J
(λ (editor evt)
;;
(define (join-lines start-line end-line)
(cond [(>= start-line end-line) (void)]
[else (join-with-next-line (sub1 end-line))
(join-lines start-line (sub1 end-line))]))
;;
(define (join-with-next-line cur-line)
(remove-trailing-spaces cur-line)
(define start-del-pos (send editor line-end-position cur-line))
(define end-del-pos (send editor line-end-position (add1 cur-line)))
(define text (send editor get-text start-del-pos end-del-pos))
(define spaces (regexp-match #px"\\s+" text))
(when spaces
(define space-len (string-length (first spaces)))
(send editor delete start-del-pos (+ start-del-pos space-len))))
;;
(define (remove-trailing-spaces line)
(define start-pos (send editor line-start-position line))
(define end-pos (send editor line-end-position line))
(define text (send editor get-text start-pos end-pos))
(define spaces (regexp-match #px"\\s+$" text))
(when spaces
(define space-len (string-length (first spaces)))
(send editor delete (- end-pos space-len) end-pos)))
(define pos1 (send editor get-start-position))
(define pos2 (send editor get-end-position))
(define line1 (send editor position-line pos1))
(define line2 (send editor position-line pos2))
(define line1-end-pos (send editor line-end-position line1))
(cond [(= line1 line2) (join-with-next-line line2)]
[else
(send editor begin-edit-sequence)
(join-lines line1 line2)
(send editor set-position line1-end-pos line1-end-pos)
(send editor end-edit-sequence)])
))

Related

drracket & How to detect a word in contact with the cursor

(define CHAR-CANVAS%
(class canvas%
(define/override (on-char evt)
(let ((c (send evt get-key-code)) (dc(send this get-dc)))
(send dc clear)
(print c)
(cond
((equal? c 'release)(void))
((member c '( #\a #\i #\u #\e #\o #\q #\é #\x))
(begin(set! tampon-key (cons c tampon-key)) (send dc draw-text (cadr (member (list->string (reverse tampon-key)) alphabet )) 30 30)
(send R-k-text insert (cadr (member (list->string (reverse tampon-key)) alphabet ))) (set! tampon-key '())))
((equal? c #\;)(begin(send R-k-text insert "。") (set! tampon-key '())))
((equal? c #\,)(begin(send R-k-text insert "、") (set! tampon-key '())))
((equal? c #\()(begin(send R-k-text insert "「") (set! tampon-key '())))
((equal? c #\))(begin(send R-k-text insert " 」") (set! tampon-key '())))
((equal? c #\&)(begin(send R-k-text insert "々") (set! tampon-key '())))
((not(member c '(#\b #\c #\d #\f #\g #\j #\k #\m #\n #\p #\r #\i #\h #\t #\s #\w #\y #\a #\e #\o #\z #\u)))(void))
((begin (set! tampon-key (cons c tampon-key))(print tampon-key))))
))
(super-new)))
It works very well (it is for writing in hiragana katakana and other characters)
I want to add to this same canvas
a feature which tells me the position of the cursor on a text
is it possible? if yes
what is the code to add?
(define/override (on-char evt)......
Or do I need a another canvas?
in this case what will be my code?
(define/override (on-char evt)......
this in order to do something similar to a "RIKAICHAN"
(define (transform-syll->mot L-romanji L-hiragana)
(let ((a '())(b'()))
(set! a (map list->string (reverse L-romanji)))
(set! b (map char->string (string->list "たべます")))
(list a b)))
(define (foo-w1 tw) ;transforme syllabe en fichier wav (if exist)
(let ((l '()))
(while (not (null? tw))
(set! l(cons (string-append (car tw )".wav")l))
(set! tw (cdr tw)))
(reverse l)))
(define (transform-mot->son L-romanji L-hiragana)
(let* ((x (transform-syll->mot L-romanji L-hiragana))
(a (car x)))
(current-directory "/Users/izuko/Desktop/japonais-new/jap-syll")
(rs-append* (map rs-read (foo-w1 a)))))
(define syllabe-R '())
(define syllabe-H '())
(define clip "")
(define Bt-dir
(new button%
(parent GP-1 )
(label "Direct")
(callback (lambda (obj evt)
(begin (set! alphabet hiragana)
(set! lecture-feld (send R-k-tex-rech get-text))
(set! LECT-HI* (cons lecture-feld LECT-HI*))
(set! LECT-ID* (cons lecture-feld LECT-ID*))
(send R-k-text insert lecture-feld)
(set! syllabe-R (transform-syll->mot tampon-wort lecture-feld))
(set! clip (transform-mot->son tampon-wort lecture-feld))
(play clip))))))

Racket: Logging to a file

I was writing a Racket program that needed to log information but I wanted to store the logs in a file. My first attempt was to use "with-logging-to-port" and use "open-output-file" to create an output-port.
#lang racket
(require racket/logging)
(define (identity/log x)
(log-info "returning ~a" x) x)
(with-logging-to-port (open-output-file "testing.txt")
(λ () (identity/log 4)) 'info)
However when I open the file afterwards it is blank! In addition, I can't run this more than once because "open-output-file" gives me an error that the file already exists.
I'm pretty sure the reason is that you don't close the file properly. This should work:
(let ((out (open-output-file "testing.txt"
; just to not get an error on consecutive runs
#:exists 'append)))
(with-logging-to-port out
(λ () (identity/log 4)) 'info)
(close-output-port out))
Instead of doing housekeeping you can use call-with-output-file
(call-with-output-file "testing.txt"
(λ (out)
(with-logging-to-port out
(λ () (identity/log 4)) 'info))
#:exists 'append)
If log information is in a list of strings, say lst, one can also use following function:
(display-lines-to-file lst "mylog.txt"
#:exists 'append)
See: https://docs.racket-lang.org/reference/Filesystem.html?q=lines-file#%28def._%28%28lib._racket%2Ffile..rkt%29._display-lines-to-file%29%29
(require racket/file)
(display-lines-to-file lst path
[ #:separator separator
#:mode mode-flag
#:exists exists-flag]) → void?
I give you my log func's source :
(define my_logger (make-logger 'my-log))
(define logger_thread #f)
(define (log fmt . content)
(log-message my_logger 'info "" (string-append (format-time (now)) " " (apply format (cons fmt content)))))
(define (start-logger log_path)
(let ([r (make-log-receiver my_logger 'info)]
[riqi (format-riqi (now))])
(set! logger_thread
(thread
(lambda ()
(let ([log_dir (build-path log_path (substring riqi 0 4))])
(when (not (directory-exists? log_dir))
(make-directory log_dir))
(with-output-to-file
(build-path log_path (substring riqi 0 4) riqi) #:exists 'append
(lambda ()
(let loop ()
(match (sync r)
[(vector l m v v1)
(printf "~a\n" v)
(flush-output)])
(loop))))))))))
(define (restart-logger)
(kill-thread logger_thread)
(start-logger))
(define (launch-log-daemon log_path)
(start-logger log_path)
(thread
(lambda ()
(let loop ()
(sync
(alarm-evt (+ (current-inexact-milliseconds) (* 1000 60 60))))
(when (= 0 (date-hour (seconds->date (current-seconds))))
(restart-logger))
(loop)))))
At the beginning of the app, you should run:
(launch-log-daemon log_path)
then you can use it like this:
(log "~a:~a" "some1" "some2")
I use the date as the log file directory and name,
it will automatically start a new log file when date changed.
foramt-riqi and format-time is here:
(define (format-riqi the_date)
(format "~a~a~a"
(date-year the_date)
(~a (date-month the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (number->string (date-day the_date)) #:min-width 2 #:pad-string "0" #:align 'right)))
(define (format-time the_date)
(format "~a:~a:~a"
(~a (date-hour the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (date-minute the_date) #:min-width 2 #:pad-string "0" #:align 'right)
(~a (date-second the_date) #:min-width 2 #:pad-string "0" #:align 'right)))
Open your file with flag 'append. For example:
(open-output-file "testing.txt" #:exists 'append )

Find empy lines in text file

I've been learning racket for a few days and I'm puzzled with this task, I'm trying to find empty lines in a text file and select a random empty line to INSERT the text "calculation here", this is as far as I have gotten so far.
for example: myfile.txt has the contents:
line1
line2
line3
line4
after the script is run, myfile.txt should now look like:
line1
calculation here
line2
line3
line4
or:
line1
line2
line3
calculation here
line4
un-working code below:
#lang racket
(define (write-to-file host text) (
with-output-to-file host (
lambda () (
write text))
#:exists 'replace))
(define empty-lines '()) ;store line number of empty line (if any)
(define (file-lines text-file)
(file->lines text-file))
(define (add-to-list line-num)
(set! empty-lines (cons line-num empty-lines)))
(let loop ((l (file-lines "myfile.txt")))
(cond ((null? l) #f)
(else
(printf "~s\n" (first l)) ; just for debugging
(cond ((equal? (first l) "") (add-to-list (first l)))(else #f))
(loop (rest l)))))
;now i need to select a random line from the list of empty-lines.
;and write "calculations here" to that line
there's no problem with the read lines method i am using, the problem is detecting and selecting a random empty space to insert my text.
Given a file name, you can read it into a list of lines using file->lines. So for instance:
(for ([line (in-list (file->lines "some-file"))])
(displayln (cond [(zero? (string-length line)) (make-random-line)]
[else line])))
Where make-random-line is some function you define to return a
random string, as you said you wanted to do.
The above reads the entire file into a list in memory. For larger files, it would be better to process things line by line. You can do this using the in-lines sequence:
(with-input-from-file "some-file"
(thunk
(for ([line (in-lines)])
(displayln (cond [(zero? (string-length line)) (make-random-line)]
[else line])))))
Update
Now that I understand your question:
#lang racket
(define lines (file->lines "some-file-name"))
(define empty-line-numbers (for/list ([line (in-list lines)]
[n (in-naturals)]
#:when (zero? (string-length line)))
n))
(define random-line-number (list-ref empty-line-numbers
(random (length empty-line-numbers))))
(for ([line (in-list lines)]
[n (in-naturals)])
(displayln (cond [(= n random-line-number) "SOME NEW STRING"]
[else line])))
(define (read-next-line-iter file)
(let ((line (read-line file)))
(unless (eof-object? line)
(display line)
(newline)
(read-next-line-iter file))))
(call-with-input-file "foobar.txt" read-next-line-iter)
http://rosettacode.org/wiki/Read_a_file_line_by_line#Racket
this function can help you read a file line by line.
check if the length is 0. and replace that line with the comment
look for 2 concurrent \n in the file. I am pretty sure there is a way in racket to do that. store those indices in a list select a pair randomly and replace the second \n with "calculation here\n".

Permanently change the state of abbreviated display of a piece of code?

In *scratch* buffer in Emacs Lisp after you evaluated an expression that evaluates to a complex Lisp form, that form is "abbreviated", i.e. some long lists or its inner parts are replaced by ellipses. Looks something like:
(let* ((--3 (make-hash-table)) d c (--5 (let ... ... ...)) (--6 0) (--0 (make-
hash-table)) b a (--1 0) --7) (catch (quote --2) (maphash (lambda ... ... ...
... ... ... ...) --0)) (nreverse --7))
vs expanded version:
(let* ((--3 (make-hash-table)) d c (--5 (let (--4) (maphash (lambda (k v)
(setq --4(cons k --4))) --3) (nreverse --4))) (--6 0) (--0 (make-hash-table))
b a (--1 0) --7) (catch (quote --2) (maphash (lambda (k v) (when (or (> --6
150) (> --1 100)) (throw (quote --2) nil)) (setq a k b v) (setq c (car --5) d
(gethash (car --5) --3) --5 (cdr --5)) (incf --6) (setq --7 (cons (list (cons
a b) (cons c d)) --7)) (message "a: %s, b: %s, c: %s, d: %s" a b c d)) --0))
(nreverse --7))
If I press RET in the expanded or collapsed state, it toggles the state back. Obviously, my first reaction is to try to format the output, so I press RET! And then it will either collapse or expand, depends on whichever state it was in. If I copy and paste the whole thing, then it is treated as normal text, but is there a faster way of doing it? I.e. I would like to permanently expand it, w/o having to copy-paste.
I couldn't find the function which toggles the state (perhaps I'm calling it incorrectly). It took me a while to realize it was possible to toggle it anyway (yeah, it displays that in a tooltip, but who uses mouse in Emacs?).
Also, I, in general, like the idea, is it possible to apply it to other languages too? Where can I read more about this feature?
Two variables control the print out of results of eval-expression. in the *scratch* buffer:
eval-expression-print-length
eval-expression-print-level
You could set those to nil and the result would always be expanded.
If you just want the RET to switch to the fully expanded (and not to toggle), you can use this advice to strip the text properties which enable the toggling of display state:
(defadvice last-sexp-toggle-display (after last-sexp-toggle-display-only-long-form activate)
"After the function is called, check to see if the long form had been displayed, and if so, remove property enabling toggling"
(save-restriction
(widen)
(let ((value (get-text-property (point) 'printed-value)))
(when value
(let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
'printed-value)
(point)))
(end (or (next-single-char-property-change (point) 'printed-value) (point)))
(standard-output (current-buffer))
(point (point)))
(if (< (length (nth 1 value)) (length (nth 2 value)))
(remove-text-properties beg end '(printed-value))))))))

Moving beyond world/universe

I thought I'd try a simple GUI app using the world/universe mutation-free approach,  but trying to implement the 'world/universe' program design myself.
I've got my little sketch below, but I quickly came to conclusion that while I could use the teachpack, I don't know how to achieve the teachpack functionality myself.
I'm guessing I should use continuations, but that doesn't seem to be the approach in the universe.rkt source.
I could always just stuff the program into the canvas class, (as earlier games like slidey and same seem to do), but I really want to get a handle on  how to implement the 'world/universe' style of program control.
;;;;----
#lang racket/gui
; simple drawing program
; mousedown starts recording a list of points
; mousechanged starts recording a new list
; paint callback paints the list of lists as lines.
(define diagramframe (new frame% [label "paint"] [width 300]
[height 300] [x 1000][y 300]))
;(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))))
(define lines '(((0 . 0) (0 . 300) (250 . 250) (150 . 176))
                ((10 . 4) (280 . 10))))
(define paintcanvas%
  (class canvas%
    (init-field mouse-event-callback)
    (super-new)
    (define dc (send this get-dc))
    (define/override (on-event mouse-event)
      (mouse-event-callback mouse-event))))
(define (paint-cb c dc) 
  (for-each (λ (line) (send dc draw-lines line)) lines))
(define (me-cb mouse-event)
(let ((x (send mouse-event get-x))
        (y (send mouse-event get-y)))
    (when (and (send mouse-event get-left-down)
               (send mouse-event moving?))
      (if (send mouse-event button-changed?)
          ; if true append as new list
          '() 
          ; if false append existing list
          '()))))
(define Paintcanvas (new paintcanvas%
                         [parent diagramframe]
[paint-callback paint-cb]
[mouse-event-callback me-cb]))
(define (main world)
 (when world (main (??? world)))
  (send diagramframe show #t))
 
(main lines)
(send diagramframe show #t)
;;-----
Here is how I would do it.
Note that the GUI event loop acts as the program main.
Use timer events to implement on-tick.
#lang racket/gui
;;;
;;; WORLD
;;;
(define-struct world (lines))
(define the-world (make-world '((0 . 0) (0 . 300) (250 . 250) (150 . 176) (10 . 4) (280 . 10))))
;;;
;;; USER LAND
;;;
(define (on-mouse-event world event)
(if (and (send event get-left-down)
(send event moving?)
#; (send event button-changed?))
(let ((x (send event get-x))
(y (send event get-y)))
(make-world (cons (cons x y) (world-lines world))))
world))
(define (on-paint world dc)
(send dc draw-lines
(map pair->point (world-lines world))))
(define (pair->point p)
(make-object point% (car p) (cdr p)))
;;;
;;; SYSTEM
;;;
(define user:on-paint on-paint)
(define diagramframe (new frame% [label "paint"] [width 300] [height 300] [x 1000][y 300]))
(define paintcanvas%
(class canvas%
(inherit get-dc refresh)
(super-new)
(define/override (on-paint)
(send (get-dc) suspend-flush)
(user:on-paint the-world (get-dc))
(send (get-dc) resume-flush))
(define/override (on-event mouse-event)
(let* ([old-world the-world]
[new-world (on-mouse-event the-world mouse-event)])
(if (eq? old-world new-world)
(super on-event mouse-event)
(begin
(set! the-world new-world)
(refresh)))))))
(define paintcanvas (new paintcanvas% [parent diagramframe]))
(send diagramframe show #t)