(in-package "COMMON-LISP-USER")

;;; File: window-renaming.lisp
;;;
;;; An example of FFI that helps out a bit. Still need to find the
;;; ACLPC equivalent though. Currently this can only
;;; be loaded as a bit of Harlequin Lispworks under Windows.
;;; Should therefore be placed under the pclw-clim directory.
;;; It is used by patch 2.0.19 in the system-editing tool.

;;; ----------------------------------------------------------------------
;;; Code for changing the name of the active window under Windows.
;;; From the LWW documentation.
;;; ----------------------------------------------------------------------

;;; The  following example shows how  to define  a Lisp function which
;;; calls a Win32 API function to change the title of the active window.
;;; The first step involves defining an FLI type  to correspond to the
;;; Windows hwnd type, which is the window handle type.

(fli:define-c-typedef fli-hwnd
  (:unsigned :long))

;;; The  next step consists  of the  foreign function definitions. The
;;; first foreign function returns the window handle of the active window,
;;; by calling    the  Windows  function GetActiveWindow.   It    takes no
;;; arguments.

(fli:define-foreign-function (get-act-window "GetActiveWindow")
    ()
  :result-type fli-hwnd
  :documentation "Returns the window handle of the active window for the current thread. If no active window is associated with the current thread then it returns 0.")

;;; The next     foreign     function uses the   Windows      function
;;; SetWindowText    to set the   text  of  the active window
;;; titlebar. It takes a window  handle and a pointer  to an FLI string as
;;; its arguments.

(fli:define-foreign-function (set-win-text "SetWindowText" :dbcs)
    ((hwnd fli-hwnd)
     (lpstring :pointer))
  :result-type :boolean
  :documentation "Sets the text of the window titlebar.")

;;;  The foreign function set-win-text returns   a boolean to indicate
;;; whether it has  successfully changed the title  bar.  The required FLI
;;; data types  and  foreign functions  have  been  defined. What  is  now
;;; required is a Lisp function which uses  them to change the titlebar of
;;; the active window. The next function does this:

(defun SET-ACTIVE-WINDOW-TEXT (new-text)
  (let ((active-window (get-act-window))
        (external-format (if (string= (software-type)
                                      "Windows NT")
                             :unicode
                           :ascii)))
    (unless (zerop active-window)
      (fli:with-foreign-string (new-ptr element-count byte-count 
                                :external-format external-format)
                               new-text
        (declare (ignore element-count byte-count))
        (set-win-text active-window new-ptr)))))

;;;  The  function set-active-window-text  takes  a Lisp string as its
;;;argument, and does the following:
;;;
;;;1.  It calls the     foreign function get-act-window to     set the
;;; variable active-window  to be the handle  of the active window.  If no
;;; window is active, this will be zero.
;;;
;;;2.   The variable  external-format is set  to  be  :unicode if  the
;;; operating system is Windows NT (which expects strings  to be passed to
;;; it in unicode format), otherwise it is set to be :ascii.
;;;
;;;3.  If active-window  is zero, then  there is no active window, and
;;; the function terminates, returning nil.
;;;
;;;4.  If active-window is not zero, then it contains a window handle,
;;;and the following happens:
;;;
;;; The function uses fli:with-foreign-string  to convert the Lisp  string
;;; argument of the function into an FLI string,  and a pointer to the FLI
;;; string   is  allocated, ready to be    handed to  the foreign function
;;; set-win-text that we defined earlier. The  format of the string is set
;;; to be external-format, which is the  suitable format for the operating
;;; system  running on the  computer. Once the  window title has been set,
;;; with-foreign-string  automatically  deallocates  the  memory  that was
;;; allocated  for  the FLI   string and  the  pointer. The  function then
;;; terminates, returning t.

;;; You can test that this is what happens by entering the command:
;;;
;;; (set-active-window-text "A new title for the active window")


