gdk/gdk.screen.lisp

   1 (in-package :gdk)
   2
   3 (defcfun gdk-screen-get-monitor-geometry :void
   4   (screen (g-object screen))
   5   (monitor-num :int)
   6   (dest (g-boxed-foreign rectangle)))
   7
   8 (defun screen-get-monitor-geometry (screen monitor-num)
   9   (let ((dest (make-rectangle)))
  10     (gdk-screen-get-monitor-geometry screen monitor-num dest)
  11     dest))
  12
  13 (export 'screen-get-monitor-geometry)
  14
  15 (defcfun (screen-get-monitor-at-point "gdk_screen_get_monitor_at_point") :int
  16   (screen (g-object screen))
  17   (x :int)
  18   (y :int))
  19
  20 (export 'screen-get-monitor-at-point)
  21
  22 (defcfun (screen-get-monitor-at-window "gdk_screen_get_monitor_at_window") :int
  23   (screen (g-object screen))
  24   (window (g-object gdk-window)))
  25
  26 (export 'screen-get-monitor-at-window)
  27
  28 (defcfun (screen-get-monitor-height-mm "gdk_screen_get_monitor_height_mm") :int
  29   (screen (g-object screen))
  30   (monitor-num :int))
  31
  32 (defcfun (screen-get-monitor-width-mm "gdk_screen_get_monitor_width_mm") :int
  33   (screen (g-object screen))
  34   (monitor-num :int))
  35
  36 (export '(screen-get-monitor-height-mm screen-get-monitor-width-mm))
  37
  38 (defcfun (screen-get-monitor-plug-name "gdk_screen_get_monitor_plug_name") (glib:g-string :free-from-foreign t)
  39   (screen (g-object screen))
  40   (monitor-num :int))
  41
  42 (export 'screen-get-monitor-plug-name)
  43
  44 (defcfun (screen-broadcast-client-message "gdk_screen_broadcast_client_message") :void
  45   (screen (g-object screen))
  46   (event (g-boxed-foreign event)))
  47
  48 (export 'screen-broadcast-client-message)
  49
  50 (defcfun gdk-screen-get-setting :boolean
  51   (screen (g-object screen))
  52   (name :string)
  53   (value :pointer))
  54
  55 (defun screen-get-setting (screen name)
  56   (with-foreign-object (value 'g-value)
  57     (g-value-zero value)
  58     (when (gdk-screen-get-setting screen name value)
  59       (prog1 (parse-g-value value)
  60         (g-value-unset value)))))
  61
  62 (export 'screen-get-setting)
  63
  64 (defcfun gdk-spawn-command-line-on-screen :boolean
  65   (screen (g-object screen))
  66   (command-line :string)
  67   (error :pointer))
  68
  69 (defun spawn-command-line-on-screen (screen command-line)
  70   (glib:with-g-error (err)
  71     (gdk-spawn-command-line-on-screen screen command-line err)))
  72
  73 (export 'spawn-command-line-on-screen)
  74
  75 (defcfun gdk_spawn_on_screen :boolean
  76   (screen (g-object screen))
  77   (working-directory :string)
  78   (argv :pointer)
  79   (envp :pointer)
  80   (flags glib:g-spawn-flags)
  81   (child-setup :pointer)
  82   (user-data :pointer)
  83   (child-pid (:pointer :int))
  84   (g-error :pointer))
  85
  86 (defcfun gdk_spawn_on_screen_with_pipes :boolean
  87   (screen (g-object screen))
  88   (working-directory :string)
  89   (argv :pointer)
  90   (envp :pointer)
  91   (flags glib:g-spawn-flags)
  92   (child-setup :pointer)
  93   (user-data :pointer)
  94   (child-pid (:pointer :int))
  95   (std-input (:pointer :int))
  96   (std-output (:pointer :int))
  97   (std-err (:pointer :int))
  98   (g-error :pointer))
  99
 100 (defmacro with-foreign-string-array ((var strings &key (null-terminated t)) &body body)
 101   (let ((strings-var (gensym))
 102         (s (gensym))
 103         (i (gensym))
 104         (n (gensym)))
 105     `(let* ((,strings-var ,strings)
 106             (,n (length ,strings-var)))
 107        (with-foreign-object (,var :pointer ,(if null-terminated `(1+ ,n) `,n))
 108          (iter (for ,s in ,strings-var)
 109                (for ,i from 0)
 110                (setf (mem-aref ,var :pointer ,i) (foreign-string-alloc ,s))
 111                ,@(when null-terminated
 112                        (list `(finally (setf (mem-aref ,var :pointer ,n) (null-pointer))))))
 113          (unwind-protect (progn ,@body)
 114            (iter (for ,i from 0 below ,n)
 115                  (foreign-string-free (mem-aref ,var :pointer ,i))))))))
 116
 117 (defun gdk-spawn-on-screen (screen argv &key working-directory env (flags '(:search-path)) with-pipes)
 118   (unless working-directory (setf working-directory (null-pointer)))
 119   (glib:with-g-error (err)
 120     (with-foreign-objects ((pid :int) (stdin :int) (stdout :int) (stderr :int))
 121       (with-foreign-string-array (argvp argv)
 122         (if (null env)
 123             (if with-pipes
 124                 (gdk_spawn_on_screen_with_pipes screen
 125                                                 working-directory
 126                                                 argvp
 127                                                 (null-pointer)
 128                                                 flags
 129                                                 (null-pointer)
 130                                                 (null-pointer)
 131                                                 pid stdin stdout stderr err)
 132                 (gdk_spawn_on_screen screen
 133                                      working-directory
 134                                      argvp
 135                                      (null-pointer)
 136                                      flags
 137                                      (null-pointer)
 138                                      (null-pointer)
 139                                      pid err))
 140             (with-foreign-string-array (envp env)
 141               (if with-pipes
 142                   (gdk_spawn_on_screen_with_pipes screen
 143                                                   working-directory
 144                                                   argvp envp flags
 145                                                   (null-pointer) (null-pointer)
 146                                                   pid stdin stdout stderr err)
 147                   (gdk_spawn_on_screen screen
 148                                        working-directory
 149                                        argvp envp
 150                                        flags (null-pointer) (null-pointer)
 151                                        pid err)))))
 152       (if with-pipes
 153           (values (mem-ref pid :int) (mem-ref stdin :int) (mem-ref stdout :int) (mem-ref stderr :int))
 154           (mem-ref pid :int)))))
 155
 156 (export 'gdk-spawn-on-screen)