Skip to content

Commit 168d26b

Browse files
da-liiiclaude
da-liii
and
claude
authored
[0102] bin/format 加入 gf fix TeXmacs/progs/kernel/boot (#3313)
Co-authored-by: Claude Opus 4.7 <noreply@anthropic.com>
1 parent 6d9a791 commit 168d26b

11 files changed

Lines changed: 968 additions & 664 deletions

File tree

‎TeXmacs/progs/kernel/boot/abbrevs.scm‎

Lines changed: 123 additions & 97 deletions
Original file line numberDiff line numberDiff line change
@@ -60,179 +60,205 @@
6060
(provide-public (ignore . l) (noop))
6161
(provide-public (negate pred?) (lambda x (not (apply pred? x))))
6262

63-
(define-public (keyword->string x)
64-
(symbol->string (keyword->symbol x)))
65-
(define-public (string->keyword x)
66-
(symbol->keyword (string->symbol x)))
63+
(define-public (keyword->string x) (symbol->string (keyword->symbol x)))
64+
(define-public (string->keyword x) (symbol->keyword (string->symbol x)))
6765
(define-public (keyword->number x)
68-
(string->number (string-tail (symbol->string (keyword->symbol x)) 1)))
66+
(string->number (string-tail (symbol->string (keyword->symbol x)) 1))
67+
) ;define-public
6968
(define-public (number->keyword x)
70-
(symbol->keyword (string->symbol (string-append "%" (number->string x)))))
69+
(symbol->keyword (string->symbol (string-append "%" (number->string x))))
70+
) ;define-public
7171

7272
(define-public (save-object file value)
73-
(string-save
74-
(let-temporarily (((*s7* 'print-length) 9223372036854775807))
75-
(object->string value))
76-
file))
73+
(string-save (let-temporarily (((*s7* 'print-length) 9223372036854775807))
74+
(object->string value)
75+
) ;let-temporarily
76+
file
77+
) ;string-save
78+
) ;define-public
7779

7880
(define-public (load-object file)
79-
(with-input-from-string (string-load file)
80-
(lambda () (read))))
81+
(with-input-from-string (string-load file) (lambda () (read)))
82+
) ;define-public
8183

8284
(define-public (persistent-ref dir key)
83-
(and (persistent-has? dir key)
84-
(persistent-get dir key)))
85+
(and (persistent-has? dir key) (persistent-get dir key))
86+
) ;define-public
8587

8688
(define-public (sourcify x)
87-
(if (and (procedure? x) (procedure-source x)) (procedure-source x) x))
89+
(if (and (procedure? x) (procedure-source x)) (procedure-source x) x)
90+
) ;define-public
8891

8992
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9093
;; Common programming constructs
9194
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9295

9396
(define-public-macro (with var val . body)
9497
(if (or (pair? var) (null? var))
95-
`(apply (lambda ,var ,@body) ,val)
96-
`(let ((,var ,val)) ,@body)))
98+
`(apply (lambda ,var ,@body) ,val)
99+
`(let ((,var ,val)) ,@body)
100+
) ;if
101+
) ;define-public-macro
97102

98103
(define-public-macro (with-define fun fun-body . body)
99-
`(let ((,(car fun) (lambda ,(cdr fun) ,fun-body)))
100-
,@body))
104+
`(let ((,(car fun) (lambda ,(cdr fun) ,fun-body))) ,@body)
105+
) ;define-public-macro
101106

102107
;; handle multiple values in a way compatible with s7 (and backcompatible with guile)
103108
(define-public-macro (with-global var val . body)
104109
(let ((old (gensym)) (new (gensym)))
105110
`(let ((,old ,var))
106111
(set! ,var ,val)
107-
(call-with-values
108-
(lambda () ,@body)
109-
(lambda vals
110-
(set! ,var ,old)
111-
(apply values vals))))))
112+
(call-with-values (lambda ,() ,@body)
113+
(lambda vals (set! ,var ,old) (apply values vals))))
114+
) ;let
115+
) ;define-public-macro
112116

113117
(define-public-macro (and-with var val . body)
114-
`(with ,var ,val
115-
(and ,var (begin ,@body))))
118+
`(with ,var ,val (and ,var (begin ,@body)))
119+
) ;define-public-macro
116120

117121
(define-public-macro (with-result result . body)
118-
`(let* ((return ,result)
119-
(dummy (begin ,@body)))
120-
return))
122+
`(let* ((return ,result) (dummy (begin ,@body))) return)
123+
) ;define-public-macro
121124

122125
(define (range-list start end delta)
123-
(if (< start end)
124-
(cons start (range-list (+ start delta) end delta))
125-
'()))
126+
(if (< start end) (cons start (range-list (+ start delta) end delta)) '())
127+
) ;define
126128

127129
(define (range-list* start end delta)
128-
(if (<= start end)
129-
(cons start (range-list* (+ start delta) end delta))
130-
'()))
130+
(if (<= start end) (cons start (range-list* (+ start delta) end delta)) '())
131+
) ;define
131132

132133
(define-public (.. start end . delta)
133-
(if (null? delta)
134-
(range-list start end 1)
135-
(range-list start end (car delta))))
134+
(if (null? delta) (range-list start end 1) (range-list start end (car delta)))
135+
) ;define-public
136136

137137
(define-public (... start end . delta)
138-
(if (null? delta)
139-
(range-list* start end 1)
140-
(range-list* start end (car delta))))
138+
(if (null? delta) (range-list* start end 1) (range-list* start end (car delta)))
139+
) ;define-public
141140

142141
(define-public-macro (for what . body)
143142
(let ((n (length what)))
144143
(cond ((== n 2)
145144
;; range over values of a list
146-
`(for-each (lambda (,(car what)) ,@body)
147-
,(cadr what)))
145+
`(for-each (lambda (,(car what)) ,@body) ,(cadr what))
146+
) ;
148147
((== n 3)
149148
;; range over values from start to end with step 1
150-
`(do ((,(car what) ,(cadr what) (+ ,(car what) 1)))
151-
((>= ,(car what) ,(caddr what)) (noop))
152-
,@body))
149+
`(do ((,(car what) ,(cadr what) (+ ,(car what) ,1)))
150+
((>= ,(car what) ,(caddr what)) (noop))
151+
,@body)
152+
) ;
153153
((== n 4)
154154
;; range over values from start to end with step
155-
`(if (> ,(cadddr what) 0)
156-
(do ((,(car what) ,(cadr what) (+ ,(car what) ,(cadddr what))))
157-
((>= ,(car what) ,(caddr what)) (noop))
158-
,@body)
159-
(do ((,(car what) ,(cadr what) (+ ,(car what) ,(cadddr what))))
160-
((<= ,(car what) ,(caddr what)) (noop))
161-
,@body)))
155+
`(if (> ,(cadddr what) ,0)
156+
(do ((,(car what) ,(cadr what) (+ ,(car what) ,(cadddr what))))
157+
((>= ,(car what) ,(caddr what)) (noop))
158+
,@body)
159+
(do ((,(car what) ,(cadr what) (+ ,(car what) ,(cadddr what))))
160+
((<= ,(car what) ,(caddr what)) (noop))
161+
,@body))
162+
) ;
162163
((== n 5)
163164
;; range over values from start to end with step and comparison
164165
`(do ((,(car what) ,(cadr what) (+ ,(car what) ,(cadddr what))))
165-
((not (,(car (cddddr what)) ,(car what) ,(caddr what))) (noop))
166-
,@body))
167-
(else '(noop)))))
166+
((not (,(car (cddddr what)) ,(car what) ,(caddr what))) (noop))
167+
,@body)
168+
) ;
169+
(else '(noop))
170+
) ;cond
171+
) ;let
172+
) ;define-public-macro
168173

169174
(define-public-macro (repeat n . body)
170175
(let ((x (gensym)))
171-
`(for (,x 0 ,n) ,@body)))
176+
`(for (,x ,0 ,n) ,@body)
177+
) ;let
178+
) ;define-public-macro
172179

173-
(define-public-macro (twice . body)
174-
`(begin ,@body ,@body))
180+
(define-public-macro (twice . body) `(begin ,@body ,@body))
175181

176182
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177183
;; Small rewritings on top of C++ interface
178184
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
179185

180-
(define-public (path->tree p)
181-
(and (path-exists? p) (cpp-path->tree p)))
186+
(define-public (path->tree p) (and (path-exists? p) (cpp-path->tree p)))
182187

183188
(define-public selection-active? selection-active-any?)
184189

185190
(define-public (selection-active-non-small?)
186-
(and (selection-active?)
187-
(not (selection-active-small?))))
191+
(and (selection-active?) (not (selection-active-small?)))
192+
) ;define-public
188193

189194
(define-public (selection-active-large?)
190195
(and (selection-active?)
191-
(not (selection-active-small?))
192-
(not (selection-active-table?))))
196+
(not (selection-active-small?))
197+
(not (selection-active-table?))
198+
) ;and
199+
) ;define-public
193200

194201
(define-public (go-to p)
195-
(let* ((r (buffer-path))
196-
(lp (length p))
197-
(lr (length r)))
202+
(let* ((r (buffer-path)) (lp (length p)) (lr (length r)))
198203
(and (or (and (<= lr lp) (== (sublist p 0 lr) r))
199-
(and-with buf (path->buffer p)
200-
(switch-to-buffer buf) #t))
201-
(go-to-path p))))
204+
(and-with buf (path->buffer p) (switch-to-buffer buf) #t)
205+
) ;or
206+
(go-to-path p)
207+
) ;and
208+
) ;let*
209+
) ;define-public
202210

203211
(define-public (choose-file fun title type . opts)
204212
(when (null? opts)
205-
(with prompt (cond ((string-starts? title "Save") "Save as:")
206-
((string-starts? title "Export") "Export as:")
207-
((== title "Select database") "Selected database:")
208-
(else ""))
209-
(set! opts (list prompt))))
213+
(with prompt
214+
(cond ((string-starts? title "Save") "Save as:")
215+
((string-starts? title "Export") "Export as:")
216+
((== title "Select database") "Selected database:")
217+
(else "")
218+
) ;cond
219+
(set! opts (list prompt))
220+
) ;with
221+
) ;when
210222
(when (null? (cdr opts))
211223
;; Issue #327: Use last file dialog directory if current buffer is scratch
212224
(let* ((master (buffer-get-master (current-buffer)))
213225
(last-dir (and (url-scratch? master)
214-
(defined? 'get-last-file-dialog-directory)
215-
(get-last-file-dialog-directory))))
226+
(defined? 'get-last-file-dialog-directory)
227+
(get-last-file-dialog-directory)
228+
) ;and
229+
) ;last-dir
230+
) ;
216231
(if (and last-dir (string? last-dir) (not (string-null? last-dir)))
217-
(set! opts (list (car opts) (system->url last-dir)))
218-
(set! opts (list (car opts) master)))))
219-
(cpp-choose-file
220-
(lambda (u)
221-
;; u is return from tm_frame_rep::choose_file in tm_dialogue.cpp
222-
;; make sure u is a url, or car of u is a url
223-
;; and that it does not contain a wildcard
224-
(if (or (url? u) (and (pair? u) (url? (car u))))
225-
(let ((u-url (if (url? u) u (car u))))
226-
(if (and (not (url-none? u-url)) (url-contains-wildcard? u-url))
227-
(dialogue-window (message-widget "File name and path cannot contain ' * '")
228-
(lambda () (choose-file fun title type (car opts) (cadr opts)))
229-
"Invalid file name")
230-
(fun u)))
231-
(fun u)))
232-
title type (car opts) (cadr opts)))
233-
234-
(define-public (alt-windows-delete l)
235-
(for-each alt-window-delete l))
232+
(set! opts (list (car opts) (system->url last-dir)))
233+
(set! opts (list (car opts) master))
234+
) ;if
235+
) ;let*
236+
) ;when
237+
(cpp-choose-file (lambda (u)
238+
;; u is return from tm_frame_rep::choose_file in tm_dialogue.cpp
239+
;; make sure u is a url, or car of u is a url
240+
;; and that it does not contain a wildcard
241+
(if (or (url? u) (and (pair? u) (url? (car u))))
242+
(let ((u-url (if (url? u) u (car u))))
243+
(if (and (not (url-none? u-url)) (url-contains-wildcard? u-url))
244+
(dialogue-window (message-widget "File name and path cannot contain ' * '")
245+
(lambda () (choose-file fun title type (car opts) (cadr opts)))
246+
"Invalid file name"
247+
) ;dialogue-window
248+
(fun u)
249+
) ;if
250+
) ;let
251+
(fun u)
252+
) ;if
253+
) ;lambda
254+
title
255+
type
256+
(car opts)
257+
(cadr opts)
258+
) ;cpp-choose-file
259+
) ;define-public
260+
261+
(define-public (alt-windows-delete l) (for-each alt-window-delete l))
236262

237263
(define-public (qt4-gui?) (== (gui-version) "qt4"))
238264
(define-public (qt4-or-later-gui?) (in? (gui-version) (list "qt4" "qt5" "qt6")))

0 commit comments

Comments
 (0)