note description: "EiffelVision text component. Mswindows implementation." legal: "See notice at end of class." status: "See notice at end of class." date: "$Date$" revision: "$Revision$" deferred class EV_TEXT_COMPONENT_IMP inherit EV_TEXT_COMPONENT_I redefine interface, text_length end EV_PRIMITIVE_IMP redefine set_default_minimum_size, interface, make, wel_background_color, wel_foreground_color, background_color_internal, default_process_message, tab_action end WEL_SHARED_TEMPORARY_OBJECTS feature {NONE} -- Initialization make -- Initialize `Current'. do wel_set_font ((create {WEL_SHARED_FONTS}).gui_font) Precursor {EV_PRIMITIVE_IMP} end set_default_minimum_size -- Called after creation. Set current size and -- notify parent. do ev_set_minimum_size ( maximum_character_width * 4, internal_font_height + total_vertical_padding, False) end total_vertical_padding: INTEGER = 9 -- Number of pixels to be added to height of font used internally, -- to give us minimum height of `Current'. internal_font_height: INTEGER -- `Result' is height of font used by `Current'. deferred end feature -- Status report is_editable: BOOLEAN -- Is text editable? do Result := not read_only end is_replacing_nl_by_crnl: BOOLEAN -- Does current text control converts %N into %R%N? do Result := False end feature {EV_ANY, EV_ANY_I} -- Status report caret_position: INTEGER -- Current position of caret. local l_wel_string: WEL_STRING do -- Caret position is given in code units not in visible characters. l_wel_string := wel_text_substring (internal_wel_caret_position) Result := l_wel_string.unicode_character_count + 1 -- Offset start position of selection to take into account -- the conversion of %R%N into %N. if is_replacing_nl_by_crnl then -- Selection is given in code units not in visible characters. Result := Result - l_wel_string.occurrences ('%R') end end start_selection: INTEGER -- local l_wel_string: WEL_STRING do -- Selection is given in code units not in visible characters. l_wel_string := wel_text_substring (wel_selection_start) Result := l_wel_string.unicode_character_count + 1 -- Offset start position of selection to take into account -- the conversion of %R%N into %N. if is_replacing_nl_by_crnl then -- Selection is given in code units not in visible characters. Result := Result - l_wel_string.occurrences ('%R') end end end_selection: INTEGER -- local l_wel_string: WEL_STRING do -- Selection is given in code units not in visible characters. l_wel_string := wel_text_substring (wel_selection_end) Result := l_wel_string.unicode_character_count + 1 -- Offset start position of selection to take into account -- the conversion of %R%N into %N. if is_replacing_nl_by_crnl then -- Selection is given in code units not in visible characters. Result := Result - l_wel_string.occurrences ('%R') end end feature -- Access text_length: INTEGER -- local l_wel_string: WEL_STRING do -- Most efficient solution, we only count the number of Unicode characters. l_wel_string := wel_text_substring (wel_text_length) Result := l_wel_string.unicode_character_count if is_replacing_nl_by_crnl then -- We have to remove from the count the extra `%R' that Windows insert. Result := Result - l_wel_string.occurrences ('%R') end end feature {EV_ANY_I}-- Status setting set_editable (flag: BOOLEAN) -- If `flag' then make `Current' editable else -- make `Current' component read-only. do if flag then set_read_write else set_read_only end end set_caret_position (pos: INTEGER) -- set current caret position. --| This position is used for insertions. do wel_set_caret_position (actual_position_from_caret_position (pos)) end actual_position_from_caret_position (pos: INTEGER): INTEGER -- Return the actual WEL caret position from the logical caret position. require pos_positive: pos > 0 local l_text_length: INTEGER l_wel_string: WEL_STRING m: MANAGED_POINTER l_pos, i: INTEGER l_ignore_cr: BOOLEAN c: NATURAL_32 do l_text_length := wel_text_length if l_text_length > 0 then from l_wel_string := wel_text_substring (wel_text_length) m := l_wel_string.managed_data l_ignore_cr := is_replacing_nl_by_crnl until i > l_text_length loop c := m.read_natural_16 (i * 2) i := i + 1 if c < 0xD800 or c >= 0xE000 then -- Codepoint from Basic Multilingual Plane: one 16-bit code unit. if c /= ('%N').natural_32_code or else not l_ignore_cr then l_pos := l_pos + 1 if l_pos = pos then -- Get proper result and jump out of the loop Result := i - 1 i := l_text_length + 1 end else check new_line: c = ('%N').natural_32_code not_first_character: i - 2 >= 0 is_cr: m.read_natural_16 ((i - 2) * 2) = ('%R').natural_32_code end end else -- Supplementary Planes: surrogate pair with lead and trail surrogates. if i <= l_text_length then i := i + 1 l_pos := l_pos + 1 if l_pos = pos then -- Get proper result and jump out of the loop Result := i - 2 i := l_text_length + 1 end end end end end end occurrences_of_char_in_substring (a_text: STRING_32; c: CHARACTER_32; start_pos, end_pos: INTEGER_32): INTEGER_32 -- Number of occurrences of `c' in `a_text' between characters `start_pos' to `end_pos'. require valid_start: start_pos >= 1 valid_end: end_pos <= a_text.count local l_area: SPECIAL [CHARACTER_32] i, n: INTEGER do from l_area := a_text.area i := end_pos - 1 n := start_pos - 1 until i < n loop if l_area.item (i) = c then Result := Result + 1 end i := i - 1 end end set_capacity (value: INTEGER) -- Make `value' new maximal length in characters of text. do set_text_limit (value) end capacity: INTEGER -- Return maximum number of characters `Current' may hold. do Result := get_text_limit end feature {EV_ANY_I}-- element change insert_text (txt: READABLE_STRING_GENERAL) -- Insert `txt' at `caret_position'. local temp_text: STRING_32 previous_caret_position: INTEGER do previous_caret_position := internal_wel_caret_position temp_text := text if caret_position > temp_text.count then temp_text.append (txt.as_string_32) else temp_text.insert_string (txt.as_string_32, caret_position) end set_text (temp_text) wel_set_caret_position (previous_caret_position) end append_text (txt:READABLE_STRING_GENERAL) -- Append 'txt' to text of `Current'. local temp_text: STRING_32 previous_caret_position: INTEGER do previous_caret_position := internal_wel_caret_position temp_text := text temp_text.append_string_general (txt) set_text (temp_text) wel_set_caret_position (previous_caret_position) end prepend_text (txt: READABLE_STRING_GENERAL) -- Prepend 'txt' to text of `Current'. local temp_text: STRING_32 previous_caret_position: INTEGER do previous_caret_position := internal_wel_caret_position temp_text := text temp_text.prepend_string_general (txt) set_text (temp_text) wel_set_caret_position (previous_caret_position) end maximum_character_width: INTEGER -- `Result' is width of widest character (W), when displayed. local screen_dc: WEL_SCREEN_DC extent: WEL_SIZE do create screen_dc screen_dc.get screen_dc.select_font ((create {WEL_SHARED_FONTS}).gui_font) extent := screen_dc.string_size ("W") screen_dc.unselect_font screen_dc.quick_release Result := extent.width end feature {EV_ANY_I} -- Resizing set_minimum_width_in_characters (nb: INTEGER) -- Make a minimum of `nb' characters visible on one line. do set_minimum_width (nb * maximum_character_width) end feature -- Basic operation select_region (start_pos, end_pos: INTEGER) -- Select (hilight) text between -- 'start_pos' and 'end_pos' do -- Selection is using caret position whereas region is just using -- character indexes, thus the + 1 for the end position. set_selection (start_pos, end_pos + 1) end set_selection (a_start_pos, a_end_pos: INTEGER) -- local l_start_position, l_end_position: INTEGER do l_start_position := actual_position_from_caret_position (a_start_pos) l_end_position := actual_position_from_caret_position (a_end_pos) wel_set_selection (l_start_position, l_end_position) end paste (index: INTEGER) -- Insert string which is in Clipboard at -- `index' postion in text. -- If Clipboard is empty, it does nothing. local pos: INTEGER do pos := caret_position set_caret_position (index) clip_paste if pos <= index then set_caret_position (pos) else set_caret_position (pos + clipboard_content.count) end end wel_set_font (a_wel_font: WEL_FONT) -- Assign `a_wel_font' to font of `Current'. deferred end feature {NONE} -- Deferred features wel_text_item: POINTER -- Actual HWND of the text part of the text component. --| Useful for comboboxes where the main HWND is not a text. do Result := wel_item end internal_wel_caret_position: INTEGER -- Caret position in WEL units. local l_wel_point: WEL_POINT sel_start, sel_end: INTEGER_32 l_send_message_result: POINTER l_success: BOOLEAN do {WEL_API}.send_message (wel_text_item, {WEL_EM_CONSTANTS}.em_getsel, $sel_start, $sel_end) Result := sel_end if sel_start /= sel_end then -- We may have a reverse selection so we need to retrieve the caret position from the control. create l_wel_point.make (0, 0) l_success := {WEL_API}.get_caret_pos (l_wel_point.item) if l_success then if attached {WEL_RICH_EDIT} Current then Result := {WEL_API}.send_message_result_integer (wel_item, {WEL_RICH_EDIT_MESSAGE_CONSTANTS}.Em_charfrompos, default_pointer, l_wel_point.item) else l_send_message_result := {WEL_API}.send_message_result (wel_text_item, {WEL_RICH_EDIT_MESSAGE_CONSTANTS}.Em_charfrompos, default_pointer, cwin_make_long (l_wel_point.x, l_wel_point.y)) Result := {WEL_API}.loword (l_send_message_result) end end end end wel_set_caret_position (a_position: INTEGER) -- Set caret position with `a_position'. deferred end wel_set_selection (start_position, end_position: INTEGER) -- Set selection between `start_position' and `end_position' expressed -- in UTF-16 code units. require exists: exists selection_in_lower_bound: start_position >= 0 and end_position >= 0 selection_in_upper_bound: start_position <= wel_text_length and end_position <= wel_text_length deferred end set_text_limit (value: INTEGER) -- Make `value' new maximal length of text. deferred end get_text_limit: INTEGER -- Result is maximum text length. deferred end read_only: BOOLEAN -- Is `current' edit control read-only? deferred end set_read_only -- Set `Current' read only. deferred end set_read_write -- Set `Current' read/write. deferred end clip_paste -- Paste at current caret position -- content of clipboard. deferred end wel_font: WEL_FONT -- Font of `Current'. deferred end wel_selection_start: INTEGER require exists: exists deferred end wel_selection_end: INTEGER require exists: exists deferred end wel_text_length: INTEGER require exists: exists deferred end wel_text_substring (nb: INTEGER): WEL_STRING require exists: exists deferred end wel_background_color: WEL_COLOR_REF do if attached background_color_imp as l_background_color_imp then Result := l_background_color_imp else create Result.make_rgb (255, 255, 255) end end wel_foreground_color: WEL_COLOR_REF do if attached foreground_color_imp as l_foreground_color_imp then Result := l_foreground_color_imp else create Result.make_rgb (0, 0, 0) end end background_color_internal: EV_COLOR -- Color used for the background of `Current'. -- This has been redefined as the background color of -- text components is white, or `Color_read_write' by default. do if attached background_color_imp as l_background_color_imp then Result := l_background_color_imp.attached_interface else if is_sensitive then Result := (create {EV_STOCK_COLORS}).Color_read_write else Result := (create {EV_STOCK_COLORS}).color_read_only end end end feature {EV_PICK_AND_DROPABLE_IMP, EV_INTERNAL_COMBO_FIELD_IMP} -- Implementation override_context_menu: BOOLEAN -- Should the context menu be overridden, so -- it is not displayed? disable_context_menu -- Assign `True' to `override_context_menu'. -- This will stop the context menu appearing, the -- next time that `allow_pick_and_drop' is executed. do override_context_menu := True end enable_context_menu -- Assign `False' to `override_context_menu'. do override_context_menu := False end feature {EV_DIALOG_IMP_COMMON} -- Implementation tab_action (a_direction: BOOLEAN) -- do if application_imp.ctrl_pressed then -- Ignore tab navigation handling if control is pressed. if not is_multiline then -- For single line controls this prevents superflous tabs being inserted during tab navigation. disable_default_processing end else Precursor (a_direction) end end feature {NONE} -- Implementation is_multiline: BOOLEAN -- Is `Current' multi-line control? do Result := False end default_process_message (msg: INTEGER; wparam, lparam: POINTER) -- Process `msg' which has not been processed by -- `process_message'. do if msg = ({WEL_WINDOW_CONSTANTS}.Wm_contextmenu) then allow_pick_and_drop else Precursor {EV_PRIMITIVE_IMP} (msg, wparam, lparam) end end allow_pick_and_drop -- Override context menu on `Current' if pick and drop -- should be handled instead. We must handle two cases :- -- 1. We are attempting to pick from `Current'. -- 2. We are attempting to drop from `Current'. do if application_imp.pick_and_drop_source /= Void then disable_default_processing elseif pebble /= Void then disable_default_processing elseif override_context_menu then disable_default_processing end enable_context_menu end clipboard_content: STRING_32 -- `Result' is current clipboard content. local edit_control: WEL_MULTIPLE_LINE_EDIT do create edit_control.make (Default_parent, "", 0, 0, 0, 0, 0) edit_control.clip_paste Result := edit_control.text -- The multiline edit control gives us %R%N which we need to replace -- by just %N. Result.replace_substring_all ("%R%N", "%N") edit_control.destroy end feature {EV_ANY, EV_ANY_I} -- Implementation interface: detachable EV_TEXT_COMPONENT note option: stable attribute end; note copyright: "Copyright (c) 1984-2014, Eiffel Software and others" license: "Eiffel Forum License v2 (see http://www.eiffel.com/licensing/forum.txt)" source: "[ Eiffel Software 5949 Hollister Ave., Goleta, CA 93117 USA Telephone 805-685-1006, Fax 805-685-6869 Website http://www.eiffel.com Customer support http://support.eiffel.com ]" end -- class EV_TEXT_COMPONENT_IMP