+ (let* ((text-view (make-instance 'text-view
+ :border-width 10 :visible t :wrap-mode :word))
+ (buffer (text-view-buffer text-view))
+ (active-tags ()))
+
+ (text-buffer-create-tag buffer "Bold" :weight :bold)
+ (text-buffer-create-tag buffer "Italic" :style :italic)
+ (text-buffer-create-tag buffer "Underline" :underline :single)
+
+ (flet ((create-toggle-callback (tag-name)
+ (let ((tag (text-tag-table-lookup
+ (text-buffer-tag-table buffer) tag-name)))
+ #'(lambda (active)
+ (unless (eq (and (find tag active-tags) t) active)
+ ;; user activated
+ (if active
+ (push tag active-tags)
+ (setq active-tags (delete tag active-tags)))
+ (multiple-value-bind (start end)
+ (text-buffer-get-selection-bounds buffer)
+ (if active
+ (text-buffer-apply-tag buffer tag start end)
+ (text-buffer-remove-tag buffer tag start end))))))))
+
+ (let* ((actions
+ (make-instance 'action-group
+ :action (create-toggle-action
+ "Bold" "gtk-bold" "Bold" "<control>B" "Bold" nil
+ (create-toggle-callback "Bold"))
+ :action (create-toggle-action
+ "Italic" "gtk-italic" "Italic" "<control>I" "Italic" nil
+ (create-toggle-callback "Italic"))
+ :action (create-toggle-action
+ "Underline" "gtk-underline" "Underline" "<control>U" "Underline" nil
+ (create-toggle-callback "Underline"))))
+ (ui (make-instance 'ui-manager)))
+
+ (ui-manager-insert-action-group ui actions)
+ (ui-manager-add-ui ui
+ '((:toolbar "ToolBar"
+ (:toolitem "Bold")
+ (:toolitem "Italic")
+ (:toolitem "Underline"))))
+
+ ;; Callback to activate/deactivate toolbar buttons when cursor
+ ;; is moved
+ (signal-connect buffer 'mark-set
+ #'(lambda (location mark)
+ (declare (ignore mark))
+ (text-tag-table-foreach (text-buffer-tag-table buffer)
+ #'(lambda (tag)
+ (let ((active
+ (or
+ (and
+ (text-iter-has-tag-p location tag)
+ (not (text-iter-begins-tag-p location tag)))
+ (text-iter-ends-tag-p location tag))))
+ (unless (eq active (and (find tag active-tags) t))
+ (if active
+ (push tag active-tags)
+ (setq active-tags (delete tag active-tags)))
+ (setf
+ (toggle-action-active-p
+ (action-group-get-action actions (text-tag-name tag)))
+ active)))))))
+
+ ;; Callback to apply active tags when a character is inserted
+ (signal-connect buffer 'insert-text
+ #'(lambda (iter &rest args)
+ (declare (ignore args))
+ (let ((before (text-buffer-get-iter-at-offset buffer
+ (1- (text-iter-offset iter)))))
+ (loop
+ for tag in active-tags
+ do (text-buffer-apply-tag buffer tag before iter))))
+ :after t)
+
+ (container-add dialog (ui-manager-get-widget ui "/ToolBar") :expand nil)
+ (container-add dialog text-view)))))
+