Changeset 12275


Ignore:
Timestamp:
Jun 21, 2009, 3:57:46 AM (10 years ago)
Author:
rme
Message:

STRING-TO-REGION: accept charprops keyword arg, apply those charprops to
the lines forming the result region.

%SET-NEXT-CHARACTER: adjust charprops when replacing character.

Tweaks to debugging functions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/htext2.lisp

    r11825 r12275  
    6060
    6161
    62 (defun string-to-region (string)
     62(defun string-to-region (string &key charprops)
    6363  "Returns a region containing the characters in the given String."
    6464  (let* ((string (if (simple-string-p string)
     
    7272          (first-line line))
    7373         (())
     74      (set-line-charprops line charprops)
    7475      (let ((right-index (%sp-find-character string index end #\newline)))
    7576        (cond (right-index
     
    145146(defun %set-next-character (mark character)
    146147  (let* ((line (mark-line mark))
     148         (charpos (mark-charpos mark))
    147149         (next (line-next line))
    148150         (buffer (line-%buffer line)))
     
    167169                 (setf (schar (current-open-chars) (current-left-open-pos)) character)
    168170                 (incf (current-left-open-pos)))
     171
     172               ;; merge charprops
     173               (join-line-charprops line (line-next line))
     174                   
    169175               (move-some-marks (charpos next line)
    170176                                (+ charpos (current-left-open-pos)))
     
    180186                                    :next next  :%buffer buffer)))
    181187               (%sp-byte-blt (current-open-chars) (current-right-open-pos) chars 0 len)
     188
     189               ;; split charprops
     190               (multiple-value-bind (left right)
     191                                    (split-line-charprops line charpos)
     192                 (setf (line-charprops-changes line) left
     193                       (line-charprops-changes new) right))
     194
    182195               (maybe-move-some-marks* (charpos line new) (current-left-open-pos)
    183196                                       (- charpos (current-left-open-pos) 1))
     
    383396
    384397(defun %print-whole-line (structure stream)
    385   (let* ((hi::*current-buffer* (line-buffer structure)))
     398  (let* ((hi::*current-buffer* (or (line-buffer structure) hi::*current-buffer*)))
    386399    (cond ((current-open-line-p structure)
    387400           (write-string (current-open-chars) stream :end (current-left-open-pos))
     
    392405
    393406(defun %print-before-mark (mark stream)
    394   (let* ((hi::*current-buffer* (mark-buffer mark)))
     407  (let* ((hi::*current-buffer* (or (mark-buffer mark) hi::*current-buffer*)))
    395408    (if (mark-line mark)
    396409        (let* ((line (mark-line mark))
     
    415428
    416429(defun %print-after-mark (mark stream)
    417   (let* ((hi::*current-buffer* (mark-buffer mark)))
     430  (let* ((hi::*current-buffer* (or (mark-buffer mark) hi::*current-buffer*)))
    418431    (if (mark-line mark)
    419432        (let* ((line (mark-line mark))
     
    446459(defun %print-hmark (structure stream d)
    447460  (declare (ignore d))
    448   (let ((hi::*current-buffer* (mark-buffer structure)))
     461  (let ((hi::*current-buffer* (or (mark-buffer structure) hi::*current-buffer*)))
    449462    (write-string "#<Hemlock Mark \"" stream)
    450463    (%print-before-mark structure stream)
     
    461474  (let* ((start (region-start region))
    462475         (end (region-end region))
    463          (hi::*current-buffer* (mark-buffer start))
     476         (hi::*current-buffer* (or (mark-buffer start) hi::*current-buffer*))
    464477         (first-line (mark-line start))
    465478         (last-line (mark-line end)))
Note: See TracChangeset for help on using the changeset viewer.