;;; Copyright (c) 2005, Michael Goffioul (michael dot goffioul at swing dot be)

;;; Copyright (c) 2012, Jean-Claude Beaudoin

;;;
;;;   This program is free software; you can redistribute it and/or
;;;   modify it under the terms of the GNU Library General Public
;;;   License as published by the Free Software Foundation; either
;;;   version 2 of the License, or (at your option) any later version.
;;;
;;;   See file '../../Copyright' for full details.
;;;
;;; SAMPLE TEXT EDITOR APPLICATION USING THE WIN32 API
;;;

(require "WIN32" "win32")

(in-package "WIN32")

(defvar *txtedit-class-registered* nil)
(defvar *txtedit-width* 800)
(defvar *txtedit-height* 600)

(defvar *txtedit-edit* nil)
(defvar *txtedit-tab* *NULL*)
(defvar *txtedit-tab-proc* *NULL*)
(defvar *txtedit-current* nil)
(defvar *txtedit-edit-class* 0)
(defvar *txtedit-thread* nil)
(defvar *txtedit-handle* *NULL*)
(defvar *txtedit-files* nil)
(defvar *txtedit-dlg-handle* *NULL*)
(defvar *txtedit-findreplace-msg* (registerwindowmessage *FINDMSGSTRING*))
(defstruct txtedit (handle *NULL*) title dirty)

(defvar *txtedit-default-title* "MKCL Text Editor")

(defparameter +IDM_OPEN+ 100)
(defparameter +IDM_QUIT+ 101)
(defparameter +IDM_SAVE+ 102)
(defparameter +IDM_SAVEAS+ 103)
(defparameter +IDM_NEW+ 104)
(defparameter +IDM_CUT+ 105)
(defparameter +IDM_COPY+ 106)
(defparameter +IDM_PASTE+ 107)
(defparameter +IDM_UNDO+ 108)
(defparameter +IDM_SELECTALL+ 109)
(defparameter +IDM_ABOUT+ 110)
(defparameter +IDM_NEXTWINDOW+ 111)
(defparameter +IDM_PREVWINDOW+ 112)
(defparameter +IDM_CLOSE+ 113)
(defparameter +IDM_MATCH_PAREN+ 114)
(defparameter +IDM_FIND+ 115)
(defparameter +IDM_WINDOW_FIRST+ 500)
(defparameter +IDM_WINDOW_LAST+ 600)

(defparameter +EDITCTL_ID+  1000)
(defparameter +TABCTL_ID+ 1001)

(defparameter *txtedit-about-text*

"Text Editor for MKCL.

This application serves as a demonstrator

for a WIN32 UFFI interface of MKCL.

Copyright (c) 2005, Michael Goffioul.
Copyright (c) 2012, Jean-Claude Beaudoin, MKCL port.")

(defun create-menus ()
  ;(return *NULL*)
  (let ((bar (createmenu))
	(file_pop (createpopupmenu))
	(edit_pop (createpopupmenu))
	(win_pop (createpopupmenu))
	(help_pop (createpopupmenu)))
    ;; File menu
    (appendmenu bar (logior *MF_STRING* *MF_POPUP*) (make-wparam file_pop) "&File")
    (appendmenu file_pop *MF_STRING* +IDM_NEW+ "&New	Ctrl+N")
    (appendmenu file_pop *MF_STRING* +IDM_OPEN+ "&Open...	Ctrl+O")
    (appendmenu file_pop *MF_STRING* +IDM_CLOSE+ "&Close	Ctrl+W")
    (appendmenu file_pop *MF_SEPARATOR* 0 "")
    (appendmenu file_pop *MF_STRING* +IDM_SAVE+ "&Save	Ctrl+S")
    (appendmenu file_pop *MF_STRING* +IDM_SAVEAS+ "Save &As...")
    (appendmenu file_pop *MF_SEPARATOR* 0 "")
    (appendmenu file_pop *MF_STRING* +IDM_QUIT+ "&Exit	Ctrl+Q")
    ;; Edit menu
    (appendmenu bar (logior *MF_STRING* *MF_POPUP*) (make-wparam edit_pop) "&Edit")
    (appendmenu edit_pop *MF_STRING* +IDM_UNDO+ "&Undo	Ctrl+Z")
    (appendmenu edit_pop *MF_SEPARATOR* 0 "")
    (appendmenu edit_pop *MF_STRING* +IDM_CUT+ "&Cut	Ctrl+X")
    (appendmenu edit_pop *MF_STRING* +IDM_COPY+ "Cop&y	Ctrl+C")
    (appendmenu edit_pop *MF_STRING* +IDM_PASTE+ "&Paste	Ctrl+V")
    (appendmenu edit_pop *MF_SEPARATOR* 0 "")
    (appendmenu edit_pop *MF_STRING* +IDM_MATCH_PAREN+ "&Match parenthesis	Ctrl+D")
    (appendmenu edit_pop *MF_SEPARATOR* 0 "")
    (appendmenu edit_pop *MF_STRING* +IDM_SELECTALL+ "&Select All	Ctrl+A")
    ;; Windows menu
    (appendmenu bar (logior *MF_STRING* *MF_POPUP*) (make-wparam win_pop) "&Window")
    (appendmenu win_pop *MF_STRING* +IDM_NEXTWINDOW+ "&Next	Ctrl+Right")
    (appendmenu win_pop *MF_STRING* +IDM_PREVWINDOW+ "&Previous	Ctrl+Left")
    ;; Help menu
    (appendmenu bar (logior *MF_STRING* *MF_POPUP*) (make-wparam help_pop) "&Help")
    (appendmenu help_pop *MF_STRING* +IDM_ABOUT+ "&About...")
    bar))

(defun create-accels ()
  (macrolet ((add-accel (key ID accTable pos)
	       `(with-foreign-object (a 'ACCEL)
		  (setf (get-slot-value a 'ACCEL 'fVirt) (logior *FCONTROL* *FVIRTKEY*))
		  (setf (get-slot-value a 'ACCEL 'key) ,(if (characterp key) `(char-code ,key) key))
		  (setf (get-slot-value a 'ACCEL 'cmd) ,ID)
		  (setf (deref-array ,accTable '(* ACCEL) ,pos) a))))
    (let* ((accTableSize (if (= *txtedit-edit-class* 2) 10 9))
	   (accTable (allocate-foreign-object 'ACCEL accTableSize)))
      (add-accel #\Q +IDM_QUIT+ accTable 0)
      (add-accel #\N +IDM_NEW+ accTable 1)
      (add-accel #\O +IDM_OPEN+ accTable 2)
      (add-accel #\S +IDM_SAVE+ accTable 3)
      (add-accel #\A +IDM_SELECTALL+ accTable 4)
      (add-accel *VK_LEFT* +IDM_PREVWINDOW+ accTable 5)
      (add-accel *VK_RIGHT* +IDM_NEXTWINDOW+ accTable 6)
      (add-accel #\W +IDM_CLOSE+ accTable 7)
      (add-accel #\F +IDM_FIND+ accTable 8)
      (when (= *txtedit-edit-class* 2)
	(add-accel #\D +IDM_MATCH_PAREN+ accTable 9))
      (prog1
	(createacceleratortable accTable accTableSize)
	(free-foreign-object accTable)))))

(defun update-caption (hwnd)
  (let ((str (tab-name (current-editor) #'identity nil)))

    (setwindowtext hwnd (cstring (format nil "~@[~A - ~]~A~C" str *txtedit-default-title* #\Null)))))

(defun current-editor ()
  (nth *txtedit-current* *txtedit-edit*))

(defun tab-name (editor &optional (fun #'file-namestring) (final-char #\Null))

  (cstring (format nil "~:[New~;~:*~A~]~@[*~*~]~@[~C~]"
		   (and (txtedit-title editor) (funcall fun (txtedit-title editor)))
		   (txtedit-dirty editor) final-char)))

(defun update-tab (idx)
  (let ((editor (nth idx *txtedit-edit*)))
    (with-foreign-object (tab 'TCITEM)
      (setf (get-slot-value tab 'TCITEM 'mask) *TCIF_TEXT*)
      (setf (get-slot-value tab 'TCITEM 'pszText) (tab-name editor))
      (sendmessage *txtedit-tab* *TCM_SETITEM* idx (make-lparam tab))
      )))

(defun set-current-editor (idx hwnd &optional force-p)
  (when (<= 0 idx (1- (length *txtedit-edit*)))
    (let ((old-ed (and *txtedit-current*
		       (current-editor)))
	  (new-ed (nth idx *txtedit-edit*)))
      (unless (and (null force-p)
		   (eq old-ed new-ed))
	(setq *txtedit-current* idx)
	(setwindowpos (txtedit-handle new-ed) *HWND_TOP* 0 0 0 0 (logior *SWP_NOSIZE* *SWP_NOMOVE*))
	(setfocus (txtedit-handle new-ed))
	(when (/= (sendmessage *txtedit-tab* *TCM_GETCURSEL* 0 0) idx)
	  (sendmessage *txtedit-tab* *TCM_SETCURSEL* idx 0))
	(update-caption hwnd)))))

(defun close-editor (idx hwnd)
  (let ((editor (nth idx *txtedit-edit*)))
    (if (or (null (txtedit-dirty editor))
	    (and (set-current-editor idx hwnd) nil)

	    (let ((m-result (messagebox hwnd (cstring (format nil "Do you want to save changes?~@[~2%~A~%~]~C"
							      (txtedit-title editor) #\Null))

					"Confirmation" (logior *MB_YESNOCANCEL* *MB_ICONQUESTION*))))
	      (cond ((= m-result *IDNO*) t)
		    ((= m-result *IDCANCEL*) nil)
		    ((= m-result *IDYES*) (warn "Not implemented") nil))))
      (progn
	(destroywindow (txtedit-handle editor))
	(sendmessage *txtedit-tab* *TCM_DELETEITEM* idx 0)
	(setq *txtedit-edit* (remove editor *txtedit-edit*))
	(when *txtedit-edit*
	  (set-current-editor (min (1- (length *txtedit-edit*))
				   (max *txtedit-current*
					0))
			      hwnd t))
	t)
      nil)))

(ffi:def-struct SCNotification (NotifyHeader NMHDR) (position :int) (ch :int))

(defvar *txtedit-lisp-kw* nil)
(defvar *txtedit-lisp-kw2* nil)
(defvar *txtedit-decl-forms* nil)

(defun init-scintilla-component (hnd)
  ;; Set LISP lexer
  (sendmessage hnd 4001 21 0)
  ;(sendmessage hnd 2090 7 0)
  ;; Define default style attributes
  (with-foreign-string (fn "Courier New")
    (sendmessage hnd 2056 32 (make-lparam fn)))
  (sendmessage hnd 2050 0 0)
  ;; Define comment style
  (sendmessage hnd 2051 1 #xDD0000)
  (sendmessage hnd 2054 1 0)
  (sendmessage hnd 2051 12 #xDD0000)
  (sendmessage hnd 2054 12 0)
  ;; Define string style
  (sendmessage hnd 2051 6 #x0000C8)
  ;; Define number style
  (sendmessage hnd 2051 2 #x0000C8)
  ;; Define operator style
  (sendmessage hnd 2051 10 #xC800C8)
  ;; Define symbol style
  (sendmessage hnd 2051 5 #xC8C800)
  ;; Define brace style
  (sendmessage hnd 2052 34 #xFFCCCC)
  (sendmessage hnd 2051 35 #xFFFFFF)
  (sendmessage hnd 2052 35 #x0000CC)
  ;; Define keyword style
  (sendmessage hnd 2051 3 #x00C8C8)
  (sendmessage hnd 2053 3 0)
  (sendmessage hnd 2051 4 #x00C800)
  (sendmessage hnd 2051 11 #x00C800)
  (unless (boundp '*txtedit-lisp-kw*)
    (load "lisp-kw.lisp"))
  (with-foreign-strings ((kwList *txtedit-lisp-kw*)
			 (kwList2 *txtedit-lisp-kw2*))
    (sendmessage hnd 4005 0 (make-lparam kwList))
    (sendmessage hnd 4005 1 (make-lparam kwList2)))
  ;; Define margins
  (sendmessage hnd 2242 1 0)
  (with-foreign-string (s "_9999")
    (sendmessage hnd 2242 0 (sendmessage hnd 2276 33 (make-lparam s))))
  ;; Define selection style
  (sendmessage hnd 2067 1 #xFFFFFF)
  )

(defun scintilla-indent-position (pos line hnd)
  (+ (sendmessage hnd 2127 line 0)
     (- pos
	(sendmessage hnd 2128 line 0))))

(defun scintilla-read-form (pos hnd)
  (read-from-string
    (with-output-to-string (s)
      (loop for k from pos
	    with style = (sendmessage hnd 2010 pos 0)
	    for ch = (code-char (sendmessage hnd 2007 k 0))
	    for st = (sendmessage hnd 2010 k 0)
	    if (and (= st style)
		    (graphic-char-p ch)
		    (not (eq ch #\Space)))
	    do (write-char ch s)
	    else
	      return nil))
    nil nil))

(defun scintilla-declare-form-p (form)
  (member form *txtedit-decl-forms*))

(defun scintilla-compute-indentation (curPos curLine hnd)
  (loop for k from curPos downto 0
	for ch = (code-char (sendmessage hnd 2007 k 0))
	for st = (sendmessage hnd 2010 k 0)
	with depth = 0
	with lineIndent = 0
	with lastCharPos = nil
	with prevCharPos = nil
	when (= st 10)
	do (cond ((and (= depth 0) (eq ch #\())
		  (if lastCharPos
		    (let ((lastChar (code-char (sendmessage hnd 2007 lastCharPos 0)))
			  lastForm)
		      (cond ((member lastChar (list #\( #\;))
			     (return (scintilla-indent-position lastCharPos curLine hnd)))
			    ((and (setq lastForm (scintilla-read-form lastCharPos hnd))
				  (scintilla-declare-form-p lastForm))
			     (return (+ (scintilla-indent-position k curLine hnd) 2)))
			    ((and prevCharPos (not (eq prevCharPos lastCharPos)))
			     (return (scintilla-indent-position prevCharPos curLine hnd)))
			    (t
			     (return (+ (scintilla-indent-position lastCharPos curLine hnd) 1)))))
		    (progn
		      (return (+ (scintilla-indent-position k curLine hnd) 1)))))
		 ((eq ch #\() (decf depth))
		 ((eq ch #\)) (incf depth)))
	if (and (graphic-char-p ch) (not (eq ch #\Space)))
	  do (setq lastCharPos k)
	else
	  do (setq prevCharPos lastCharPos)
	when (eq ch #\Newline)
	  do (decf curLine) and
	  do (case lineIndent
	       (0 (incf lineIndent))
	       (1 (when (= depth 0) (return (sendmessage hnd 2127 (1+ curLine) 0)))))
	finally (return -1)))

(defun scintilla-char-added (hnd ch)
  (cond ((eq ch #\Newline)
	 (let* ((curPos (sendmessage hnd 2008 0 0))
		(curLine (sendmessage hnd 2166 curPos 0))
		(indent (scintilla-compute-indentation (1- curPos) curLine hnd)))
	   (when (>= indent 0)
	     (sendmessage hnd 2126 curLine indent)
	     (sendmessage hnd 2025 (sendmessage hnd 2128 curLine 0) 0)
	     )))
	;((eq ch #\()
	; (let ((curPos (1- (sendmessage hnd 2008 0 0))))
	;   (when (scintilla-valid-brace-p curPos hnd)
	;     (with-foreign-string (s ")")
	;       (sendmessage hnd 2003 (1+ curPos) (make-lparam s))))))
	(t
	  )))

(defun scintilla-get-matching-braces (hnd &aux curPos)
  (when (>= (setq curPos (1- (sendmessage hnd 2008 0 0))) 0)
    (let ((ch (code-char (sendmessage hnd 2007 curPos 0))))
      (when (and (or (eq ch #\() (eq ch #\)))
		 (= (sendmessage hnd 2010 curPos 0) 10))
	(let ((matchPos (sendmessage hnd 2353 curPos 0)))
	  (return-from scintilla-get-matching-braces (values curPos matchPos))))))
  (values nil nil))

(defun scintilla-check-for-brace (hnd)
  (multiple-value-bind (curPos matchPos) (scintilla-get-matching-braces hnd)
    (if curPos
      (if (>= matchPos 0)
	(sendmessage hnd 2351 curPos matchPos)
	(sendmessage hnd 2352 curPos 0))
      (sendmessage hnd 2351 #xFFFFFFFF -1))))

(defun create-editor (parent &optional (set-current t))
  (with-foreign-object (r 'RECT)
    (getclientrect parent r)
    (sendmessage *txtedit-tab* *TCM_ADJUSTRECT* *FALSE* (make-lparam r))
    (let ((new-editor (make-txtedit :handle (createwindowex *WS_EX_CLIENTEDGE* (txtedit-class-name) ""
							    (logior *WS_CHILD* *WS_HSCROLL* *WS_VSCROLL* *WS_VISIBLE* *WS_CLIPSIBLINGS*
								    *ES_AUTOHSCROLL* *ES_AUTOVSCROLL* *ES_MULTILINE* *ES_LEFT*)
							    (get-slot-value r 'RECT 'left)
							    (get-slot-value r 'RECT 'top)
							    (- (get-slot-value r 'RECT 'right) (get-slot-value r 'RECT 'left))
							    (- (get-slot-value r 'RECT 'bottom) (get-slot-value r 'RECT 'top))
							    *txtedit-tab* (make-ID +EDITCTL_ID+) *NULL* *NULL*))))
      (sendmessage (txtedit-handle new-editor) *WM_SETFONT* (make-wparam (getstockobject *SYSTEM_FIXED_FONT*)) 0)
      (case *txtedit-edit-class*
	(1 (sendmessage (txtedit-handle new-editor) *EM_SETEVENTMASK* 0 *ENM_CHANGE*))
	(2 (init-scintilla-component (txtedit-handle new-editor))))
      (with-foreign-object (tab 'TCITEM)
        (setf (get-slot-value tab 'TCITEM 'mask) *TCIF_TEXT*)
	(setf (get-slot-value tab 'TCITEM 'pszText) (tab-name new-editor))
	(sendmessage *txtedit-tab* *TCM_INSERTITEM* (length *txtedit-edit*) (make-lparam tab)))
      (setq *txtedit-edit* (append *txtedit-edit* (list new-editor)))
      (when set-current
	(set-current-editor (1- (length *txtedit-edit*)) parent))
      new-editor)))

(defun unix2dos (str)

  (let ((new-str (make-array (length str) :element-type 'base-char :adjustable t :fill-pointer 0))

	(return-p nil)
	c)
    (with-output-to-string (out new-str)
      (do ((it (si::make-seq-iterator str) (si::seq-iterator-next str it)))
	  ((null it))
        (case (setq c (si::seq-iterator-ref str it))
	  (#\Return (setq return-p t))
	  (#\Newline (unless return-p (write-char #\Return out)) (setq return-p nil))
	  (t (setq return-p nil)))
	(write-char c out)))
    new-str))

(defun read-file (pn hwnd)
  (setq pn (probe-file pn))
  (if pn
    (with-open-file (f pn)
      (let* ((len (file-length f))

	     (buf (make-string len :element-type 'base-char)))

	(read-sequence buf f)
	(setwindowtext (txtedit-handle (current-editor)) (unix2dos buf))
	(setf (txtedit-dirty (current-editor)) nil)
	(setf (txtedit-title (current-editor)) (substitute #\\ #\/ (namestring pn)))
	(update-caption hwnd)
	(update-tab *txtedit-current*)))
    (messagebox hwnd "File does not exist." "Error" (logior *MB_OK* *MB_ICONERROR*))))

(defun save-file (pn hwnd)
  (unless pn
    (setq pn (txtedit-title (current-editor))))
  (with-open-file (f pn :direction :output :if-does-not-exist :create :if-exists :supersede)
    (let ((txt (getwindowtext (txtedit-handle (current-editor)))))
      (write-sequence txt f)
      (setf (txtedit-title (current-editor)) (substitute #\\ #\/(namestring pn)))
      (setf (txtedit-dirty (current-editor)) nil)
      (update-caption hwnd)
      (update-tab *txtedit-current*))))

(defun close-or-exit (idx hwnd)
  (if (= (length *txtedit-edit*) 1)
    (postmessage hwnd *WM_CLOSE* 0 0)
    (close-editor idx hwnd)))

(defun tab-proc (hwnd umsg wparam lparam)
  (cond ((or (= umsg *WM_COMMAND*)
	     (= umsg *WM_NOTIFY*))
	 (txtedit-proc (getparent hwnd) umsg wparam lparam))
	(t
	  (callwindowproc *txtedit-tab-proc* hwnd umsg wparam lparam))))

(defvar *txtedit-level* 0)
(defun txtedit-proc (hwnd umsg wparam lparam &aux (*txtedit-level* (1+ *txtedit-level*)))
  ;(format t "txtedit-proc: ~D~%" *txtedit-level*)
  (cond ((= umsg *WM_DESTROY*)
	 (postquitmessage 0)
	 0)
	((= umsg *WM_CLOSE*)
	 (if (do ((flag t))
	         ((not (and *txtedit-edit* flag)) flag)
	       (setq flag (close-editor 0 hwnd)))
	   (destroywindow hwnd)
	   0))
	((= umsg *WM_CREATE*)
	 (when (null-pointer-p (getmodulehandle "comctl32"))
	   (initcommoncontrols))
	 (setq *txtedit-tab* (createwindowex 0 *WC_TABCONTROL* ""
					     (logior *WS_CHILD* *WS_VISIBLE* *WS_CLIPCHILDREN*) 0 0 0 0
					     hwnd (make-ID +TABCTL_ID+) *NULL* *NULL*))
	 (setq *txtedit-tab-proc* (register-wndproc *txtedit-tab* #'tab-proc))
	 (sendmessage *txtedit-tab* *WM_SETFONT* (make-wparam (getstockobject *DEFAULT_GUI_FONT*)) 0)
	 (create-editor hwnd)
	 (with-cast-int-pointer (lparam CREATESTRUCT)
	   (let ((params (get-slot-value lparam 'CREATESTRUCT 'lpCreateParams)))
	     (unless (null-pointer-p params)
	       (read-file (convert-from-foreign-string params) hwnd))))
	 0)
	((= umsg *WM_SIZE*)
	 (unless (null-pointer-p *txtedit-tab*)
	   (movewindow *txtedit-tab* 0 0 (loword lparam) (hiword lparam) *TRUE*)
	   (with-foreign-object (r 'RECT)
	     (setrect r 0 0 (loword lparam) (hiword lparam))
	     (sendmessage *txtedit-tab* *TCM_ADJUSTRECT* *FALSE* (make-lparam r))
	     (dotimes (k (length *txtedit-edit*))
	       (movewindow (txtedit-handle (nth k *txtedit-edit*))
			   (get-slot-value r 'RECT 'left) (get-slot-value r 'RECT 'top)
			   (- (get-slot-value r 'RECT 'right) (get-slot-value r 'RECT 'left))
			   (- (get-slot-value r 'RECT 'bottom) (get-slot-value r 'RECT 'top))
			   (if (= k *txtedit-current*) *TRUE* *FALSE*)))))
	 0)
	((= umsg *WM_SETFOCUS*)
	 (unless (null-pointer-p (txtedit-handle (current-editor)))
	   (setfocus (txtedit-handle (current-editor))))
	 0)
	((= umsg *WM_NOTIFY*)
	 (with-cast-int-pointer (lparam NMHDR)
	   (let ((ctrl-ID (get-slot-value lparam 'NMHDR 'idFrom))
		 (code (get-slot-value lparam 'NMHDR 'code))
		 (hnd (get-slot-value lparam 'NMHDR 'hwndFrom)))
	     (cond ((= ctrl-ID +TABCTL_ID+)
		    (cond ((= code *TCN_SELCHANGE*)
			   (set-current-editor (sendmessage hnd *TCM_GETCURSEL* 0 0) hwnd))
			  (t
			    )))
		   ((and (= *txtedit-edit-class* 2)
			 (= code 2001))
		    (with-cast-pointer (lparam SCNotification)
		      (scintilla-char-added hnd (code-char (get-slot-value lparam 'SCNotification 'ch)))))
		   ((and (= *txtedit-edit-class* 2)
			 (= code 2007))
		    (scintilla-check-for-brace hnd))
		   (t
		     ))))
	 0)
	((= umsg *WM_CONTEXTMENU*)
	 (let ((hnd (make-handle wparam))
	       (x (get-x-lparam lparam))
	       (y (get-y-lparam lparam)))
	   (cond ((equal hnd *txtedit-tab*)
		  (with-foreign-objects ((ht 'TCHITTESTINFO)
					 (pt 'POINT))
		    (setf (get-slot-value pt 'POINT 'x) x)
		    (setf (get-slot-value pt 'POINT 'y) y)
		    (screentoclient *txtedit-tab* pt)
		    (setf (get-slot-value ht 'TCHITTESTINFO 'pt) pt)
		    (let ((tab (sendmessage *txtedit-tab* *TCM_HITTEST* 0 (make-lparam ht))))
		      (when (>= tab 0)
			(let ((hMenu (createpopupmenu))
			      menu-ID)
			  (appendmenu hMenu *MF_STRING* +IDM_CLOSE+ "&Close")
			  (when (/= (setq menu-ID (trackpopupmenuex hMenu (logior *TPM_NONOTIFY* *TPM_RETURNCMD*) x y hwnd *NULL*)) 0)
			    (close-or-exit tab hwnd))
			  (destroymenu hMenu))))))))
	 0)
	((= umsg *WM_INITMENUPOPUP*)
	 (case (loword lparam)
	   (2 (let* ((wMenu (make-handle wparam))
		     (nPos (loword lparam))
		     (nItems (getmenuitemcount wMenu)))

		(declare (ignore nPos))

		(dotimes (j (- nItems 2))
		  (deletemenu wMenu 2 *MF_BYPOSITION*))
		(when *txtedit-edit*
		  (appendmenu wMenu *MF_SEPARATOR* 0 "")
		  (loop for e in *txtedit-edit*
			for k from 0
			do (progn
			     (appendmenu wMenu *MF_STRING* (+ +IDM_WINDOW_FIRST+ k) (tab-name e))
			     (when (= k *txtedit-current*)
			       (checkmenuitem wMenu (+ k 3) (logior *MF_BYPOSITION* *MF_CHECKED*))))))
		(enablemenuitem wMenu +IDM_PREVWINDOW+ (if (= *txtedit-current* 0) *MF_GRAYED* *MF_ENABLED*))
		(enablemenuitem wMenu +IDM_NEXTWINDOW+ (if (< *txtedit-current* (1- (length *txtedit-edit*))) *MF_ENABLED* *MF_GRAYED*))
		))
	   )
	 0)
	((= umsg *WM_COMMAND*)
	 (let ((ctrl-ID (loword wparam))
	       (nmsg (hiword wparam))
	       (hnd (make-pointer lparam 'HANDLE)))

	   (declare (ignorable hnd))