From c472c6c63f71bb3a9bfb1670f2960aff4512b07e Mon Sep 17 00:00:00 2001 From: goffioul Date: Thu, 9 Jun 2005 12:55:54 +0000 Subject: [PATCH] - Make caption and tabname handling more consistent - Work around a problem in ECL with NULL terminating strings --- contrib/win32/txtedit.lisp | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/contrib/win32/txtedit.lisp b/contrib/win32/txtedit.lisp index 615f2e948..d79cefc24 100644 --- a/contrib/win32/txtedit.lisp +++ b/contrib/win32/txtedit.lisp @@ -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*)))