macOS port: optional Scintilla FFI, new key/screenshot wrappers
ober
7bc31b41b3e00127aafd5244a6f5c8678f318f53
--- a/chez-qt/ffi.ss +++ b/chez-qt/ffi.ss @@ -17,7 +17,8 @@ ffi-qt-widget-create ffi-qt-widget-show ffi-qt-widget-hide ffi-qt-widget-close ffi-qt-widget-set-enabled ffi-qt-widget-is-enabled ffi-qt-widget-set-visible ffi-qt-widget-is-visible - ffi-qt-widget-set-updates-enabled + ffi-qt-widget-set-updates-enabled ffi-qt-widget-set-attribute + ffi-qt-send-key-event ffi-qt-widget-set-fixed-size ffi-qt-widget-set-minimum-size ffi-qt-widget-set-maximum-size ffi-qt-widget-set-minimum-width ffi-qt-widget-set-minimum-height @@ -212,10 +213,12 @@ ;; Keyboard Events ffi-qt-install-key-handler ffi-qt-install-key-handler-consuming ffi-qt-last-key-code ffi-qt-last-key-modifiers ffi-qt-last-key-text + ffi-qt-last-key-autorepeat ;; Pixmap ffi-qt-pixmap-load ffi-qt-pixmap-width ffi-qt-pixmap-height ffi-qt-pixmap-is-null ffi-qt-pixmap-scaled ffi-qt-pixmap-destroy + ffi-qt-pixmap-save ffi-qt-widget-grab ffi-qt-label-set-pixmap ;; Icon @@ -770,6 +773,8 @@ ffi-qt-scintilla-receive-string ffi-qt-scintilla-set-text ffi-qt-scintilla-get-text ffi-qt-scintilla-get-text-length ffi-qt-scintilla-set-lexer-language ffi-qt-scintilla-get-lexer-language + ffi-qt-scintilla-lexer-set-color ffi-qt-scintilla-lexer-set-paper + ffi-qt-scintilla-lexer-set-font-attr ffi-qt-scintilla-set-read-only ffi-qt-scintilla-is-read-only ffi-qt-scintilla-set-margin-width ffi-qt-scintilla-set-margin-type ffi-qt-scintilla-set-focus @@ -796,21 +801,28 @@ (let ([v (getenv "JEMACS_STATIC")]) (and v (not (string=? v "")) (not (string=? v "0"))))) - ;; libqt_shim.so comes from gerbil-qt's vendor/ dir — use LD_LIBRARY_PATH or explicit env var + (define shlib-ext + (let ((mt (symbol->string (machine-type)))) + (if (and (>= (string-length mt) 3) + (string=? (substring mt (- (string-length mt) 3) (string-length mt)) "osx")) + "dylib" + "so"))) + + ;; libqt_shim.{so,dylib} comes from gerbil-qt's vendor/ dir — use DYLD_LIBRARY_PATH/LD_LIBRARY_PATH or explicit env var (define qt-shim-loaded (if static-build? #f ; symbols already linked in; --export-dynamic makes them visible (load-shared-object (let ([qt-shim-dir (getenv "CHEZ_QT_SHIM_DIR")]) (if qt-shim-dir - (format "~a/libqt_shim.so" qt-shim-dir) - "libqt_shim.so"))))) + (format "~a/libqt_shim.~a" qt-shim-dir shlib-ext) + (format "libqt_shim.~a" shlib-ext)))))) (define chez-shim-loaded (if static-build? #f ; qt_chez_shim.c compiled into binary (load-shared-object - (format "~a/qt_chez_shim.so" shim-dir)))) + (format "~a/qt_chez_shim.~a" shim-dir shlib-ext)))) ;; ----------------------------------------------------------------------- ;; Callback registration (Chez → C shim) @@ -931,6 +943,12 @@ (define ffi-qt-widget-set-updates-enabled (foreign-procedure "qt_widget_set_updates_enabled" (void* int) void)) + (define ffi-qt-widget-set-attribute + (foreign-procedure "qt_widget_set_attribute" (void* int int) void)) + + (define ffi-qt-send-key-event + (foreign-procedure "qt_send_key_event" (void* int int int string) void)) + (define ffi-qt-widget-set-fixed-size (foreign-procedure "qt_widget_set_fixed_size" (void* int int) void)) @@ -1648,6 +1666,8 @@ (foreign-procedure "qt_last_key_modifiers" () int)) (define ffi-qt-last-key-text (foreign-procedure "qt_last_key_text" () string)) + (define ffi-qt-last-key-autorepeat + (foreign-procedure "qt_last_key_autorepeat" () int)) ;; ----------------------------------------------------------------------- ;; Pixmap @@ -1665,6 +1685,10 @@ (foreign-procedure "qt_pixmap_scaled" (void* int int int) void*)) (define ffi-qt-pixmap-destroy (foreign-procedure "qt_pixmap_destroy" (void*) void)) + (define ffi-qt-pixmap-save + (foreign-procedure "qt_pixmap_save" (void* string string) int)) + (define ffi-qt-widget-grab + (foreign-procedure "qt_widget_grab" (void*) void*)) ;; ----------------------------------------------------------------------- ;; Icon @@ -3007,6 +3031,9 @@ (define-optional-ffi ffi-qt-scintilla-get-text-length "qt_scintilla_get_text_length" (void*) int) (define-optional-ffi ffi-qt-scintilla-set-lexer-language "qt_scintilla_set_lexer_language" (void* string) void) (define-optional-ffi ffi-qt-scintilla-get-lexer-language "qt_scintilla_get_lexer_language" (void*) string) + (define-optional-ffi ffi-qt-scintilla-lexer-set-color "qt_scintilla_lexer_set_color" (void* int int) void) + (define-optional-ffi ffi-qt-scintilla-lexer-set-paper "qt_scintilla_lexer_set_paper" (void* int int) void) + (define-optional-ffi ffi-qt-scintilla-lexer-set-font-attr "qt_scintilla_lexer_set_font_attr" (void* int int int) void) (define-optional-ffi ffi-qt-scintilla-set-read-only "qt_scintilla_set_read_only" (void* int) void) (define-optional-ffi ffi-qt-scintilla-is-read-only "qt_scintilla_is_read_only" (void*) int) (define-optional-ffi ffi-qt-scintilla-set-margin-width "qt_scintilla_set_margin_width" (void* int int) void) --- a/chez-qt/qt.ss +++ b/chez-qt/qt.ss @@ -24,7 +24,8 @@ qt-widget-create qt-widget-show! qt-widget-hide! qt-widget-close! qt-widget-set-enabled! qt-widget-enabled? qt-widget-set-visible! qt-widget-visible? - qt-widget-set-updates-enabled! + qt-widget-set-updates-enabled! qt-widget-set-attribute! + qt-send-key-press! qt-send-key-release! qt-widget-set-fixed-size! qt-widget-set-minimum-size! qt-widget-set-maximum-size! qt-widget-set-minimum-width! qt-widget-set-minimum-height! @@ -211,11 +212,12 @@ ;; Keyboard Events qt-on-key-press! qt-on-key-press-consuming! - qt-last-key-code qt-last-key-modifiers qt-last-key-text + qt-last-key-code qt-last-key-modifiers qt-last-key-text qt-last-key-autorepeat? ;; Pixmap qt-pixmap-load qt-pixmap-width qt-pixmap-height qt-pixmap-null? qt-pixmap-scaled qt-pixmap-destroy! + qt-pixmap-save! qt-widget-grab qt-widget-screenshot! qt-label-set-pixmap! ;; Icon @@ -486,6 +488,10 @@ qt-plain-text-edit-line-from-position qt-plain-text-edit-line-end-position qt-plain-text-edit-find-text qt-plain-text-edit-ensure-cursor-visible! qt-plain-text-edit-center-cursor! + qt-plain-text-edit-clear-extra-selections! + qt-plain-text-edit-add-extra-selection-line! + qt-plain-text-edit-add-extra-selection-range! + qt-plain-text-edit-apply-extra-selections! qt-text-document-create qt-plain-text-document-create qt-text-document-destroy! qt-plain-text-edit-document qt-plain-text-edit-set-document! @@ -590,12 +596,6 @@ qt-line-number-area-set-visible! qt-line-number-area-set-bg-color! qt-line-number-area-set-fg-color! - ;; Extra selections - qt-plain-text-edit-clear-extra-selections! - qt-plain-text-edit-add-extra-selection-line! - qt-plain-text-edit-add-extra-selection-range! - qt-plain-text-edit-apply-extra-selections! - ;; Completer on editor qt-completer-set-widget! qt-completer-complete-rect! @@ -605,6 +605,8 @@ qt-scintilla-receive-string qt-scintilla-set-text! qt-scintilla-get-text qt-scintilla-get-text-length qt-scintilla-set-lexer-language! qt-scintilla-get-lexer-language + qt-scintilla-lexer-set-color! qt-scintilla-lexer-set-paper! + qt-scintilla-lexer-set-font-attr! qt-scintilla-set-read-only! qt-scintilla-read-only? qt-scintilla-set-margin-width! qt-scintilla-set-margin-type! qt-scintilla-set-focus! @@ -902,6 +904,15 @@ (define (qt-widget-set-updates-enabled! w enabled) (ffi-qt-widget-set-updates-enabled w (if enabled 1 0))) + (define (qt-widget-set-attribute! w attribute on) + (ffi-qt-widget-set-attribute w attribute (if on 1 0))) + + (define (qt-send-key-press! w key mods text) + (ffi-qt-send-key-event w 0 key mods text)) + + (define (qt-send-key-release! w key mods text) + (ffi-qt-send-key-event w 1 key mods text)) + (define (qt-widget-set-fixed-size! w width height) (ffi-qt-widget-set-fixed-size w width height)) (define (qt-widget-set-minimum-size! w width height) @@ -1556,6 +1567,7 @@ (define (qt-last-key-code) (ffi-qt-last-key-code)) (define (qt-last-key-modifiers) (ffi-qt-last-key-modifiers)) (define (qt-last-key-text) (ffi-qt-last-key-text)) + (define (qt-last-key-autorepeat?) (not (zero? (ffi-qt-last-key-autorepeat)))) ;; ----------------------------------------------------------------------- ;; Pixmap @@ -1567,6 +1579,16 @@ (define (qt-pixmap-null? p) (not (zero? (ffi-qt-pixmap-is-null p)))) (define (qt-pixmap-scaled p w h mode) (ffi-qt-pixmap-scaled p w h mode)) (define (qt-pixmap-destroy! p) (ffi-qt-pixmap-destroy p)) + (define (qt-pixmap-save! p path format) + (not (zero? (ffi-qt-pixmap-save p path (or format "PNG"))))) + (define (qt-widget-grab w) (ffi-qt-widget-grab w)) + (define (qt-widget-screenshot! w path) + (let ((px (ffi-qt-widget-grab w))) + (if (eqv? px 0) + #f + (let ((ok (not (zero? (ffi-qt-pixmap-save px path "PNG"))))) + (ffi-qt-pixmap-destroy px) + ok)))) ;; ----------------------------------------------------------------------- ;; Icon @@ -2816,6 +2838,9 @@ (define (qt-scintilla-get-text-length sci) (ffi-qt-scintilla-get-text-length sci)) (define (qt-scintilla-set-lexer-language! sci lang) (ffi-qt-scintilla-set-lexer-language sci lang)) (define (qt-scintilla-get-lexer-language sci) (ffi-qt-scintilla-get-lexer-language sci)) + (define (qt-scintilla-lexer-set-color! sci style color) (ffi-qt-scintilla-lexer-set-color sci style color)) + (define (qt-scintilla-lexer-set-paper! sci style color) (ffi-qt-scintilla-lexer-set-paper sci style color)) + (define (qt-scintilla-lexer-set-font-attr! sci style bold italic) (ffi-qt-scintilla-lexer-set-font-attr sci style bold italic)) (define (qt-scintilla-set-read-only! sci val) (ffi-qt-scintilla-set-read-only sci (if val 1 0))) (define (qt-scintilla-read-only? sci) (not (zero? (ffi-qt-scintilla-is-read-only sci)))) (define (qt-scintilla-set-margin-width! sci margin width) (ffi-qt-scintilla-set-margin-width sci margin width))