mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-02 23:50:56 -08:00
Code Issues Projects Releases Packages Wiki Activity

- Make caption and tabname handling more consistent

Browse source 
- Work around a problem in ECL with NULL terminating strings
This commit is contained in:
goffioul 2005-06-09 12:55:54 +00:00
parent 9c05e3a95c
commit c472c6c63f
1 changed files with 20 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

36
contrib/win32/txtedit.lisp
View file

@ -22,7 +22,7 @@
(defvar *txtedit-tab* *NULL*)
(defvar *txtedit-tab-proc* *NULL*)
(defvar *txtedit-current* nil)
(defstruct txtedit (handle *NULL*) (title "New") dirty)
(defstruct txtedit (handle *NULL*) title dirty)
(defvar *txtedit-default-title* "ECL Text Editor")
@ -110,17 +110,23 @@ Copyright (c) 2005, Michael Goffioul.")
(defun is-default-title (hwnd)
(string= (string-right-trim "*" (getwindowtext hwnd)) *txtedit-default-title*))
(defun update-caption (hwnd)
(let ((str (tab-name (current-editor) #'identity nil)))
(setwindowtext hwnd (format nil "~@[~A - ~]ECL Text Editor~C" str #\Null))))
(defun current-editor ()
(nth *txtedit-current* *txtedit-edit*))
(defun tab-name (full-name)
(file-namestring full-name))
(defun tab-name (editor &optional (fun #'file-namestring) (final-char #\Null))
(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 (txtedit-title editor)))
(setf (get-slot-value tab 'TCITEM 'pszText) (tab-name editor))
(sendmessage *txtedit-tab* *TCM_SETITEM* idx (make-lparam tab))
)))
@ -136,14 +142,14 @@ Copyright (c) 2005, Michael Goffioul.")
(setfocus (txtedit-handle new-ed))
(when (/= (sendmessage *txtedit-tab* *TCM_GETCURSEL* 0 0) idx)
(sendmessage *txtedit-tab* *TCM_SETCURSEL* idx 0))
(setwindowtext hwnd (txtedit-title new-ed))))))
(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 (format nil "Do you want to save changes?~2%~A~%"
(substitute #\\ #\/ (string-right-trim "*" (txtedit-title editor))))
(let ((m-result (messagebox hwnd (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)
@ -175,7 +181,7 @@ Copyright (c) 2005, Michael Goffioul.")
(sendmessage (txtedit-handle new-editor) *WM_SETFONT* (make-wparam (getstockobject *SYSTEM_FIXED_FONT*)) 0)
(with-foreign-object (tab 'TCITEM)
(setf (get-slot-value tab 'TCITEM 'mask) *TCIF_TEXT*)
(setf (get-slot-value tab 'TCITEM 'pszText) (tab-name (txtedit-title new-editor)))
(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
@ -205,18 +211,18 @@ Copyright (c) 2005, Michael Goffioul.")
(setwindowtext (txtedit-handle (current-editor)) (unix2dos buf))
(setf (txtedit-dirty (current-editor)) nil)
(setf (txtedit-title (current-editor)) (substitute #\\ #\/ (namestring pn)))
(setwindowtext hwnd (txtedit-title (current-editor)))
(update-caption hwnd)
(update-tab *txtedit-current*))))
(defun save-file (pn hwnd)
(unless pn
(setq pn (string-right-trim "*" (getwindowtext hwnd))))
(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)
(setwindowtext hwnd (txtedit-title (current-editor)))
(update-caption hwnd)
(update-tab *txtedit-current*))))
(defun tab-proc (hwnd umsg wparam lparam)
@ -284,10 +290,8 @@ Copyright (c) 2005, Michael Goffioul.")
(cond ((= ctrl-ID +EDITCTL_ID+)
(cond ((= nmsg *EN_CHANGE*)
(unless (txtedit-dirty (current-editor))
(setf (txtedit-title (current-editor))
(concatenate 'string (txtedit-title (current-editor)) "*"))
(setf (txtedit-dirty (current-editor)) t)
(setwindowtext hwnd (txtedit-title (current-editor)))
(update-caption hwnd)
(update-tab *txtedit-current*)))
(t
)))
@ -300,11 +304,11 @@ Copyright (c) 2005, Michael Goffioul.")
(create-editor hwnd)
(read-file pn hwnd))))
((and (= ctrl-ID +IDM_SAVE+)
(not (is-default-title hwnd)))
(txtedit-title (current-editor)))
(save-file nil hwnd))
((or (= ctrl-ID +IDM_SAVEAS+)
(and (= ctrl-ID +IDM_SAVE+)
(is-default-title hwnd)))
(null (txtedit-title (current-editor)))))
(let ((pn (get-open-filename :owner hwnd :filter '(("LISP source file (*.lisp)" . "*.lisp;*.lsp")
("All Files (*)" . "*"))
:dlgfn #'getsavefilename :flags *OFN_OVERWRITEPROMPT*)))