Open File-menu “New…” and “Open…” in new process
… instead of overburdening our own with several windows and contact states. :^)
This commit is contained in:
parent
52ab0cc458
commit
3cefb2fa75
41
contact.scm
41
contact.scm
|
@ -18,12 +18,14 @@
|
||||||
(chicken condition)
|
(chicken condition)
|
||||||
(chicken file)
|
(chicken file)
|
||||||
(chicken pathname)
|
(chicken pathname)
|
||||||
|
(chicken process)
|
||||||
(chicken io)
|
(chicken io)
|
||||||
(chicken repl)
|
(chicken repl)
|
||||||
(chicken process-context)
|
(chicken process-context)
|
||||||
(chicken string)
|
(chicken string)
|
||||||
(chicken time)
|
(chicken time)
|
||||||
(srfi 1)
|
(srfi 1)
|
||||||
|
(srfi 13)
|
||||||
(srfi 18)
|
(srfi 18)
|
||||||
(prefix getopt-long getopt:)
|
(prefix getopt-long getopt:)
|
||||||
(prefix nrepl nrepl:)
|
(prefix nrepl nrepl:)
|
||||||
|
@ -59,7 +61,7 @@
|
||||||
;; That is, like `$ contact freeArgFile.vcf`.
|
;; That is, like `$ contact freeArgFile.vcf`.
|
||||||
(let [(qt-thread (thread-start! qt-loop))
|
(let [(qt-thread (thread-start! qt-loop))
|
||||||
(last-free-arg (condition-case (last (car cli-args)) (var () #f)))]
|
(last-free-arg (condition-case (last (car cli-args)) (var () #f)))]
|
||||||
(if last-free-arg
|
(if (and last-free-arg (string? last-free-arg) (file-exists? last-free-arg))
|
||||||
(open-vcard-file qt-win last-free-arg))
|
(open-vcard-file qt-win last-free-arg))
|
||||||
qt-thread))
|
qt-thread))
|
||||||
|
|
||||||
|
@ -137,28 +139,53 @@
|
||||||
(define (menubar-callbacks window)
|
(define (menubar-callbacks window)
|
||||||
(let* [(menu-file-exit (qt:find window "actionQuit"))
|
(let* [(menu-file-exit (qt:find window "actionQuit"))
|
||||||
(menu-file-save (qt:find window "actionSave"))
|
(menu-file-save (qt:find window "actionSave"))
|
||||||
(menu-file-open (qt:find window "actionOpen"))]
|
(menu-file-open (qt:find window "actionOpen"))
|
||||||
|
(menu-file-new (qt:find window "actionNew"))]
|
||||||
;; We connect to https://doc.qt.io/qt-6/qaction.html#triggered
|
;; We connect to https://doc.qt.io/qt-6/qaction.html#triggered
|
||||||
|
;; Simply kill the program.
|
||||||
(if menu-file-exit
|
(if menu-file-exit
|
||||||
(qt:connect
|
(qt:connect
|
||||||
menu-file-exit "triggered()"
|
menu-file-exit "triggered()"
|
||||||
(qt:receiver exit)))
|
(qt:receiver exit)))
|
||||||
|
;; If they try to Save, tell them it’s not supported.
|
||||||
(if menu-file-save
|
(if menu-file-save
|
||||||
(qt:connect
|
(qt:connect
|
||||||
menu-file-save "triggered()"
|
menu-file-save "triggered()"
|
||||||
(qt:receiver
|
(qt:receiver
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(qt:message "Saving is not implemented.")))))
|
(qt:message "Saving is not implemented.")))))
|
||||||
|
;; If they want a new contact, create a new, blank, window.
|
||||||
|
;; That is, a new process.
|
||||||
|
(if menu-file-new
|
||||||
|
(qt:connect
|
||||||
|
menu-file-new "triggered()"
|
||||||
|
(qt:receiver
|
||||||
|
(lambda ()
|
||||||
|
(let [(program-args
|
||||||
|
;; If we opened a pre-existing contact (last arg is a file),
|
||||||
|
;; remove that argument.
|
||||||
|
(drop-right (cdr (argv))
|
||||||
|
(if (file-exists? (last (argv)))
|
||||||
|
1
|
||||||
|
0)))]
|
||||||
|
(process-run (executable-pathname) program-args))))))
|
||||||
|
;; If they want to open a contact through the Open… dialogue, we should open
|
||||||
|
;; the contact in a new window.
|
||||||
(if menu-file-open
|
(if menu-file-open
|
||||||
(qt:connect
|
(qt:connect
|
||||||
menu-file-open "triggered()"
|
menu-file-open "triggered()"
|
||||||
(qt:receiver
|
(qt:receiver
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(open-vcard-file
|
(let* [(contacts-dir (conc (get-environment-variable "HOME") "/Contacts"))
|
||||||
window
|
(selected-file (qt:get-open-filename
|
||||||
(qt:get-open-filename
|
"Select a contact file to open…"
|
||||||
"Select a contact file…"
|
contacts-dir))
|
||||||
(conc (get-environment-variable "HOME") "/Contacts")))))))))
|
(program-args (append (cdr (argv)) (list selected-file)))]
|
||||||
|
(if (not (string-null? selected-file))
|
||||||
|
(process-run
|
||||||
|
(executable-pathname)
|
||||||
|
program-args)))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; Parse a vCard file and populate the window’s forms with its contents.
|
;; Parse a vCard file and populate the window’s forms with its contents.
|
||||||
|
|
|
@ -225,6 +225,7 @@
|
||||||
<property name="title">
|
<property name="title">
|
||||||
<string>File</string>
|
<string>File</string>
|
||||||
</property>
|
</property>
|
||||||
|
<addaction name="actionNew"/>
|
||||||
<addaction name="actionOpen"/>
|
<addaction name="actionOpen"/>
|
||||||
<addaction name="actionSave"/>
|
<addaction name="actionSave"/>
|
||||||
<addaction name="separator"/>
|
<addaction name="separator"/>
|
||||||
|
@ -251,6 +252,11 @@
|
||||||
<string>Open…</string>
|
<string>Open…</string>
|
||||||
</property>
|
</property>
|
||||||
</action>
|
</action>
|
||||||
|
<action name="actionNew">
|
||||||
|
<property name="text">
|
||||||
|
<string>New…</string>
|
||||||
|
</property>
|
||||||
|
</action>
|
||||||
</widget>
|
</widget>
|
||||||
<resources/>
|
<resources/>
|
||||||
<connections/>
|
<connections/>
|
||||||
|
|
Ŝarĝante…
Reference in New Issue