| [12268] | 1 | (in-package "HI")
|
|---|
| 2 |
|
|---|
| 3 | (defun make-empty-charprops-changes (&optional (size 2))
|
|---|
| 4 | (make-array size :adjustable t :fill-pointer 0))
|
|---|
| 5 |
|
|---|
| 6 | (defun insert-charprops-change (changes index new)
|
|---|
| 7 | "Insert a new change into the charprops changes vector at index. Objects
|
|---|
| 8 | at and beyond INDEX are shifted right to make room."
|
|---|
| 9 | (vector-push-extend nil changes)
|
|---|
| 10 | (replace changes changes :start1 (1+ index) :start2 index)
|
|---|
| 11 | (setf (aref changes index) new))
|
|---|
| 12 |
|
|---|
| 13 | (defun delete-charprops-change (changes index)
|
|---|
| 14 | "Delete the change at index from the charprops changes vector. Objects
|
|---|
| 15 | beyond INDEX are shifted left to fill the empty spot."
|
|---|
| 16 | (unless (= (fill-pointer changes) index)
|
|---|
| 17 | (replace changes changes :start1 index :start2 (1+ index)))
|
|---|
| 18 | (decf (fill-pointer changes)))
|
|---|
| 19 |
|
|---|
| 20 | (defun push-charprops-change (change changes)
|
|---|
| 21 | (vector-push-extend change changes))
|
|---|
| 22 |
|
|---|
| 23 | ;;; Return the index of the charprops change that applies to
|
|---|
| 24 | ;;; charpos, or else NIL if the charpos has (implicit)
|
|---|
| 25 | ;;; default properties.
|
|---|
| 26 | (defun charprops-change-index-for-position (changes charpos)
|
|---|
| 27 | (do ((i 0 (1+ i))
|
|---|
| 28 | (i-1 nil i)
|
|---|
| 29 | (change nil))
|
|---|
| 30 | ((= i (length changes)) i-1)
|
|---|
| 31 | (setq change (aref changes i))
|
|---|
| 32 | (when (< charpos (charprops-change-index change))
|
|---|
| 33 | (return i-1))))
|
|---|
| 34 |
|
|---|
| 35 | ;;; Real programmers can write assembly in any language.
|
|---|
| 36 | (defun line-charprops-for-position (line charpos)
|
|---|
| 37 | "Return, as multiple values, the plist, and start position and end
|
|---|
| 38 | position over which the plist applies."
|
|---|
| 39 | (unless (and (>= charpos 0)
|
|---|
| 40 | (<= charpos (line-length line)))
|
|---|
| 41 | (error "index ~d out of range" charpos))
|
|---|
| 42 | (let* ((changes (line-charprops-changes line))
|
|---|
| 43 | (change nil)
|
|---|
| 44 | (prior-change nil)
|
|---|
| 45 | (start-pos 0)
|
|---|
| 46 | (end-pos 0))
|
|---|
| 47 | (dotimes (i (length changes) (values (and change
|
|---|
| 48 | (charprops-change-plist change))
|
|---|
| [12536] | 49 | start-pos (1+ (line-length line))))
|
|---|
| [12268] | 50 | (setq prior-change change)
|
|---|
| 51 | (setq change (aref changes i))
|
|---|
| 52 | (setq end-pos (charprops-change-index change))
|
|---|
| 53 | (when (< charpos (charprops-change-index change))
|
|---|
| 54 | (return (values (and prior-change (charprops-change-plist prior-change))
|
|---|
| 55 | start-pos end-pos)))
|
|---|
| 56 | (setq start-pos (charprops-change-index change)))))
|
|---|
| 57 |
|
|---|
| 58 | (defun squeeze-out-superseded-changes (changes idx)
|
|---|
| 59 | (let* ((base-change (aref changes idx)))
|
|---|
| 60 | (do* ((i (1+ idx) (1+ i))
|
|---|
| 61 | (change nil)
|
|---|
| 62 | (n 0))
|
|---|
| 63 | ((= i (length changes))
|
|---|
| 64 | ;;(format t "~&start1 = ~d start2 = ~d" (1+ idx) (+ n 1 idx))
|
|---|
| 65 | (replace changes changes :start1 (1+ idx) :start2 (+ n 1 idx))
|
|---|
| 66 | (decf (fill-pointer changes) n)
|
|---|
| 67 | changes)
|
|---|
| 68 | (setq change (aref changes i))
|
|---|
| 69 | (when (<= (charprops-change-index change)
|
|---|
| 70 | (charprops-change-index base-change))
|
|---|
| 71 | (setf (charprops-change-plist base-change) (charprops-change-plist change))
|
|---|
| 72 | (incf n)
|
|---|
| 73 | (setf (aref changes i) nil)))))
|
|---|
| 74 |
|
|---|
| 75 | ;;; Set the charprops of the specified LINE between positions START and
|
|---|
| 76 | ;;; END. If END is NIL, that means the end of the line. Note that this
|
|---|
| 77 | ;;; doesn't merge in properties: it replaces whatever is there.
|
|---|
| 78 | (defun set-line-charprops (line charprops &key (start 0) end &aux plist)
|
|---|
| 79 | (setq plist (charprops-as-plist charprops))
|
|---|
| 80 | (when (and end (= end (line-length line)))
|
|---|
| 81 | (setq end nil))
|
|---|
| 82 | (when (and (null plist) (= start 0) (null end))
|
|---|
| 83 | (setf (line-charprops-changes line) nil)
|
|---|
| 84 | (return-from set-line-charprops))
|
|---|
| 85 | (let* ((changes (line-charprops-changes line))
|
|---|
| 86 | (new-change (make-charprops-change start plist)))
|
|---|
| 87 | (if (null changes)
|
|---|
| 88 | (let ((new-changes (make-array 2 :adjustable t :fill-pointer 0)))
|
|---|
| 89 | (vector-push new-change new-changes)
|
|---|
| 90 | (when end
|
|---|
| 91 | (vector-push (make-charprops-change end nil) new-changes))
|
|---|
| 92 | (setf (line-charprops-changes line) new-changes)
|
|---|
| 93 | (line-charprops-changes line))
|
|---|
| 94 | ;; Put the new charprops change into the right place in the charprops
|
|---|
| 95 | ;; changes vector, making note of its position.
|
|---|
| 96 | (do* ((i 0 (1+ i))
|
|---|
| 97 | (change nil)
|
|---|
| 98 | (prior-change nil change))
|
|---|
| 99 | ((= i (length changes))
|
|---|
| 100 | (insert-charprops-change changes i new-change)
|
|---|
| 101 | (when end
|
|---|
| 102 | (let ((prior-plist (and prior-change
|
|---|
| 103 | (charprops-change-plist prior-change))))
|
|---|
| 104 | (insert-charprops-change changes (1+ i)
|
|---|
| 105 | (make-charprops-change end prior-plist)))))
|
|---|
| 106 | (setq change (aref changes i))
|
|---|
| 107 | (when (<= start (charprops-change-index change))
|
|---|
| 108 | (insert-charprops-change changes i new-change)
|
|---|
| 109 | (incf i)
|
|---|
| 110 | (if (null end)
|
|---|
| 111 | (setf (fill-pointer changes) i)
|
|---|
| 112 | (let ((prior-plist (and prior-change
|
|---|
| 113 | (charprops-change-plist prior-change))))
|
|---|
| 114 | (insert-charprops-change changes i (make-charprops-change end prior-plist))
|
|---|
| 115 | (squeeze-out-superseded-changes changes i)))
|
|---|
| 116 | (return))))))
|
|---|
| 117 |
|
|---|
| [12536] | 118 | (defun add-line-charprop-value (line name value &key (start 0) end)
|
|---|
| 119 | (let* ((changes (line-charprops-changes line))
|
|---|
| 120 | (start-idx (charprops-change-index-for-position changes start))
|
|---|
| 121 | (end-idx (charprops-change-index-for-position changes
|
|---|
| 122 | (or end
|
|---|
| 123 | (setq end (line-length line))))))
|
|---|
| 124 | (cond ((or (null changes)
|
|---|
| 125 | (and (null start-idx) (null end-idx)))
|
|---|
| 126 | ;; Either the line has no existing charprops, or we're within the
|
|---|
| 127 | ;; implicit run of default properties at the start of the line.
|
|---|
| 128 | ;; Just set the charprops over the relevant range and return.
|
|---|
| 129 | (set-line-charprops line (list name value) :start start :end end)
|
|---|
| 130 | (return-from add-line-charprop-value changes))
|
|---|
| 131 | ((null start-idx)
|
|---|
| 132 | ;; The starting position is in the implicit run of default
|
|---|
| 133 | ;; properties at the start of the line.
|
|---|
| 134 | (let ((new-change (make-charprops-change start (list name value))))
|
|---|
| 135 | (insert-charprops-change changes 0 new-change)
|
|---|
| 136 | (setq start-idx 0)
|
|---|
| 137 | (incf end-idx))
|
|---|
| 138 | (let ((end-change (aref changes end-idx)))
|
|---|
| 139 | (unless (= (charprops-change-index end-change) end)
|
|---|
| 140 | (let ((new-change (copy-charprops-change end-change)))
|
|---|
| 141 | (setf (charprops-change-index new-change) end)
|
|---|
| 142 | (insert-charprops-change changes (1+ end-idx) new-change)
|
|---|
| 143 | (incf end-idx)))))
|
|---|
| 144 | ((and start-idx end-idx)
|
|---|
| 145 | (let ((start-change (aref changes start-idx)))
|
|---|
| 146 | (unless (= (charprops-change-index start-change) start)
|
|---|
| 147 | (let ((new-change (copy-charprops-change start-change)))
|
|---|
| 148 | (setf (charprops-change-index new-change) start)
|
|---|
| 149 | (insert-charprops-change changes (1+ start-idx) new-change)
|
|---|
| 150 | (incf start-idx)
|
|---|
| 151 | (incf end-idx))))
|
|---|
| 152 | (let ((end-change (aref changes end-idx))
|
|---|
| 153 | (next-end-idx (charprops-change-index-for-position changes (1+ end))))
|
|---|
| 154 | ;; If end-idx and next-end-idx differ, then the end
|
|---|
| 155 | ;; position comes at the very end of a run, and we don't
|
|---|
| 156 | ;; need to split. We also don't need to split if end is
|
|---|
| 157 | ;; at the very end of the line.
|
|---|
| 158 | (when (and (= end-idx next-end-idx)
|
|---|
| 159 | (not (= end (line-length line))))
|
|---|
| 160 | (let ((new-change (copy-charprops-change end-change)))
|
|---|
| 161 | (setf (charprops-change-index new-change) end)
|
|---|
| 162 | (insert-charprops-change changes (1+ end-idx) new-change)))))
|
|---|
| 163 | (t (error "how did we get here?")))
|
|---|
| 164 | (loop for i from start-idx to end-idx
|
|---|
| 165 | as change = (aref changes i)
|
|---|
| 166 | do (if (null value)
|
|---|
| 167 | (remf (charprops-change-plist change) name)
|
|---|
| 168 | (setf (getf (charprops-change-plist change) name) value)))))
|
|---|
| 169 |
|
|---|
| 170 | (defun set-region-charprops (region charprops)
|
|---|
| 171 | (let* ((start (region-start region))
|
|---|
| 172 | (end (region-end region))
|
|---|
| 173 | (first-line (mark-line start))
|
|---|
| 174 | (last-line (mark-line end)))
|
|---|
| 175 | (cond ((eq first-line last-line)
|
|---|
| 176 | (set-line-charprops first-line charprops :start (mark-charpos start)
|
|---|
| 177 | :end (mark-charpos end))
|
|---|
| 178 | (coalesce-line-charprops first-line))
|
|---|
| 179 | (t
|
|---|
| 180 | (set-line-charprops first-line charprops :start (mark-charpos start))
|
|---|
| 181 | (do* ((line (line-next first-line) (line-next line)))
|
|---|
| 182 | ((eq line last-line)
|
|---|
| 183 | (set-line-charprops line charprops :end (mark-charpos end)))
|
|---|
| 184 | (set-line-charprops line charprops))))))
|
|---|
| 185 |
|
|---|
| [12268] | 186 | ;;; Returns two values: fresh charprops change vectors for the line's characters
|
|---|
| 187 | ;;; before and after charpos.
|
|---|
| 188 | (defun split-line-charprops (line charpos)
|
|---|
| [13130] | 189 | (let* ((changes (line-charprops-changes line))
|
|---|
| 190 | (nchanges (length changes)))
|
|---|
| 191 | (when (> nchanges 0)
|
|---|
| [12268] | 192 | (let ((left (make-array 2 :adjustable t :fill-pointer 0))
|
|---|
| 193 | (right (make-array 2 :adjustable t :fill-pointer 0))
|
|---|
| 194 | (pivot nil)
|
|---|
| 195 | (prior-change nil))
|
|---|
| 196 | (do* ((i 0 (1+ i))
|
|---|
| 197 | (change nil))
|
|---|
| 198 | ((or pivot
|
|---|
| [13130] | 199 | (= i nchanges))
|
|---|
| [12268] | 200 | (if (null pivot)
|
|---|
| 201 | ;; The last change extends to the end of line, so that will be the
|
|---|
| 202 | ;; charprops in effect at the beginning of the new line.
|
|---|
| 203 | (if (null (charprops-change-plist change))
|
|---|
| 204 | (setq right nil)
|
|---|
| 205 | (let* ((c (copy-charprops-change change)))
|
|---|
| 206 | (setf (charprops-change-index c) 0)
|
|---|
| 207 | (push-charprops-change c right)))
|
|---|
| 208 | ;; Some charprops changes remain. First, split the prior change
|
|---|
| 209 | ;; if necessary, and then pick up the rest of the shifts.
|
|---|
| 210 | (progn
|
|---|
| 211 | (when (and prior-change
|
|---|
| 212 | (> charpos (charprops-change-index prior-change)))
|
|---|
| 213 | ;; need to split change
|
|---|
| 214 | (let* ((c (copy-charprops-change prior-change)))
|
|---|
| 215 | (setf (charprops-change-index c) 0)
|
|---|
| 216 | (push-charprops-change c right)))
|
|---|
| [13130] | 217 | (loop for i from pivot below nchanges
|
|---|
| [12268] | 218 | as change = (aref changes i)
|
|---|
| 219 | do (decf (charprops-change-index change) charpos)
|
|---|
| 220 | (push-charprops-change (aref changes i) right))))
|
|---|
| 221 | (values left right pivot))
|
|---|
| 222 | (setq change (aref changes i))
|
|---|
| 223 | (if (< (charprops-change-index change) charpos)
|
|---|
| 224 | (progn
|
|---|
| 225 | (push-charprops-change change left)
|
|---|
| 226 | (setq prior-change change))
|
|---|
| 227 | (setq pivot i)))))))
|
|---|
| 228 |
|
|---|
| [12288] | 229 | (defun append-line-charprops (line changes)
|
|---|
| 230 | (let* ((left (line-charprops-changes line))
|
|---|
| 231 | (len (line-length line))
|
|---|
| 232 | (right changes))
|
|---|
| 233 | (cond ((and left right)
|
|---|
| [12536] | 234 | (loop for c across right
|
|---|
| 235 | for new-change = (copy-charprops-change c)
|
|---|
| 236 | do (incf (charprops-change-index new-change) len)
|
|---|
| 237 | (push-charprops-change new-change left)))
|
|---|
| [12288] | 238 | ((and (null left) right)
|
|---|
| [12536] | 239 | (setq left (copy-charprops-changes right))
|
|---|
| [12288] | 240 | (adjust-charprops-change-indexes left len)
|
|---|
| 241 | (setf (line-charprops-changes line) left))
|
|---|
| 242 | ((and left (null right))
|
|---|
| 243 | (push-charprops-change (make-charprops-change len nil) left)))
|
|---|
| 244 | left))
|
|---|
| 245 |
|
|---|
| [12268] | 246 | ;;; Append the charprops-changes from line2 onto line1, modifying their
|
|---|
| 247 | ;;; indexes appropriately.
|
|---|
| 248 | (defun join-line-charprops (line1 line2)
|
|---|
| 249 | (let* ((left (line-charprops-changes line1))
|
|---|
| 250 | (lidx (1- (length left)))
|
|---|
| 251 | (right (line-charprops-changes line2))
|
|---|
| 252 | (ridx 0)
|
|---|
| 253 | (line1-len (line-length line1)))
|
|---|
| 254 | (cond ((and left right)
|
|---|
| 255 | ;; If the last change on line1 and the first change on line2
|
|---|
| 256 | ;; represent the same properties, then omit line2's first
|
|---|
| 257 | ;; change.
|
|---|
| 258 | (let* ((lchange (aref left lidx))
|
|---|
| 259 | (lprops (charprops-change-plist lchange))
|
|---|
| 260 | (rchange (aref right ridx))
|
|---|
| 261 | (rprops (charprops-change-plist rchange)))
|
|---|
| 262 | (if (> 0 (charprops-change-index rchange))
|
|---|
| 263 | ;; There is an implicit run of default charprops at the
|
|---|
| 264 | ;; start of the line.
|
|---|
| 265 | (unless (null lprops)
|
|---|
| 266 | ;; The last change on line1 represents some non-default
|
|---|
| 267 | ;; set of charprops, so insert an explicit change to the
|
|---|
| 268 | ;; default set before copying over the rest.
|
|---|
| 269 | (push-charprops-change (make-charprops-change (1+ line1-len) nil)
|
|---|
| 270 | left))
|
|---|
| 271 | (when (charprops-equal lprops rprops)
|
|---|
| 272 | (incf ridx)))
|
|---|
| 273 | (do* ((i ridx (1+ i))
|
|---|
| 274 | (change nil))
|
|---|
| 275 | ((= i (length right)))
|
|---|
| 276 | (setq change (aref right i))
|
|---|
| 277 | (incf (charprops-change-index change) (1+ line1-len))
|
|---|
| 278 | (push-charprops-change change left))))
|
|---|
| 279 | ((and (null left) right)
|
|---|
| 280 | (adjust-charprops-change-indexes right line1-len)
|
|---|
| 281 | (setf (line-charprops-changes line1) right))
|
|---|
| 282 | ((and left (null right))
|
|---|
| 283 | (let* ((lchange (aref left lidx)))
|
|---|
| 284 | (unless (null (charprops-change-plist lchange))
|
|---|
| 285 | (push-charprops-change (make-charprops-change (1+ line1-len) nil)
|
|---|
| 286 | left))))
|
|---|
| 287 | ;; otherwise both nil, so don't need to do anything.
|
|---|
| 288 | )
|
|---|
| 289 | left))
|
|---|
| 290 |
|
|---|
| 291 | (defun copy-line-charprops (line &key (start 0) end)
|
|---|
| 292 | "Return a freshly-consed vector of charprops changes that applies to the
|
|---|
| 293 | characters in the interval [start, end) on the specified line. If the
|
|---|
| 294 | charprops in between start and end are the default charprops, return
|
|---|
| 295 | NIL."
|
|---|
| [12288] | 296 | (let ((changes (line-charprops-changes line)))
|
|---|
| 297 | ;; some early-out special cases
|
|---|
| [12268] | 298 | (cond ((null changes)
|
|---|
| [12288] | 299 | (return-from copy-line-charprops))
|
|---|
| [13429] | 300 | ((and (= start 0) (or (null end) (eql end (line-length line))))
|
|---|
| [12701] | 301 | (return-from copy-line-charprops (copy-charprops-changes changes))))
|
|---|
| [12288] | 302 | (unless end
|
|---|
| 303 | (setq end (line-length line)))
|
|---|
| [13711] | 304 | (when (eql start end)
|
|---|
| 305 | (return-from copy-line-charprops))
|
|---|
| [12288] | 306 | (let* ((new-changes (make-empty-charprops-changes))
|
|---|
| 307 | (start-idx (charprops-change-index-for-position changes start))
|
|---|
| 308 | (end-idx (charprops-change-index-for-position changes (1- end))))
|
|---|
| 309 | (if (eql start-idx end-idx)
|
|---|
| 310 | (if (null start-idx)
|
|---|
| 311 | (setq new-changes nil)
|
|---|
| 312 | (let* ((change (aref changes start-idx))
|
|---|
| 313 | (plist (charprops-change-plist change)))
|
|---|
| 314 | (if (null plist)
|
|---|
| 315 | (setq new-changes nil)
|
|---|
| 316 | (push-charprops-change (make-charprops-change start plist)
|
|---|
| 317 | new-changes))))
|
|---|
| 318 | (do ((i (or start-idx 0) (1+ i)))
|
|---|
| 319 | ((> i end-idx))
|
|---|
| 320 | (let* ((change (aref changes i))
|
|---|
| 321 | (index (charprops-change-index change))
|
|---|
| 322 | (plist (charprops-change-plist change)))
|
|---|
| 323 | (push-charprops-change (make-charprops-change
|
|---|
| 324 | (max 0 (- index start)) plist)
|
|---|
| 325 | new-changes))))
|
|---|
| 326 | new-changes)))
|
|---|
| [12268] | 327 |
|
|---|
| 328 | (defun delete-line-charprops (line &key (start 0) end)
|
|---|
| [12288] | 329 | (let ((changes (line-charprops-changes line)))
|
|---|
| 330 | ;; some early-out special cases
|
|---|
| [12268] | 331 | (cond ((null changes)
|
|---|
| 332 | (return-from delete-line-charprops))
|
|---|
| [12288] | 333 | ((and (= start 0) (null end))
|
|---|
| [12268] | 334 | (setf (line-charprops-changes line) nil)
|
|---|
| [12288] | 335 | (return-from delete-line-charprops)))
|
|---|
| 336 | (unless end
|
|---|
| 337 | (setq end (line-length line)))
|
|---|
| 338 | (assert (<= start end) (start end))
|
|---|
| 339 | (let* ((start-idx (charprops-change-index-for-position changes start))
|
|---|
| 340 | (end-idx (charprops-change-index-for-position changes (1- end))))
|
|---|
| 341 | (cond ((null start-idx)
|
|---|
| 342 | (if (null end-idx)
|
|---|
| 343 | (adjust-charprops-change-indexes changes (- start end) :start 0)
|
|---|
| 344 | (progn
|
|---|
| 345 | ;; delete changes before end-idx
|
|---|
| 346 | (replace changes changes :start1 0 :start2 end-idx)
|
|---|
| 347 | (decf (fill-pointer changes) end-idx)
|
|---|
| 348 | (setf (charprops-change-index (aref changes 0)) start)
|
|---|
| 349 | ;; move back start of subsequent changes, if there are any
|
|---|
| 350 | (when (> (length changes) 1)
|
|---|
| 351 | (adjust-charprops-change-indexes changes (- start end)
|
|---|
| 352 | :start 1)
|
|---|
| 353 | ;; if the change is now zero-length, remove it
|
|---|
| 354 | (when (= (charprops-change-index (aref changes 0))
|
|---|
| 355 | (charprops-change-index (aref changes 1)))
|
|---|
| 356 | (delete-charprops-change changes 0))))))
|
|---|
| 357 | ((eql start-idx end-idx)
|
|---|
| 358 | ;; The deletion takes place within the scope of a single
|
|---|
| 359 | ;; charprops run.
|
|---|
| 360 | ;; Move back start of subsequent changes, if there are any
|
|---|
| 361 | (when (> (length changes) (1+ start-idx))
|
|---|
| 362 | (adjust-charprops-change-indexes changes (- start end)
|
|---|
| 363 | :start (1+ start-idx))
|
|---|
| 364 | ;; if the change is now zero-length, remove it
|
|---|
| 365 | (when (= (charprops-change-index (aref changes start-idx))
|
|---|
| 366 | (charprops-change-index (aref changes (1+ start-idx))))
|
|---|
| 367 | (delete-charprops-change changes start-idx))))
|
|---|
| 368 | (t
|
|---|
| 369 | ;; Remove changes between start-idx and and end-idx.
|
|---|
| 370 | (replace changes changes :start1 (1+ start-idx)
|
|---|
| 371 | :start2 end-idx)
|
|---|
| 372 | (decf (fill-pointer changes) (- end-idx (1+ start-idx)))
|
|---|
| 373 | (setf (charprops-change-index (aref changes (1+ start-idx))) start)
|
|---|
| 374 | (when (> (length changes) (1+ start-idx))
|
|---|
| 375 | (adjust-charprops-change-indexes changes (- start end)
|
|---|
| 376 | :start (+ 2 start-idx))
|
|---|
| 377 | ;; if first change is now zero-length, remove it
|
|---|
| 378 | (when (= (charprops-change-index (aref changes start-idx))
|
|---|
| 379 | (charprops-change-index (aref changes (1+ start-idx))))
|
|---|
| 380 | (delete-charprops-change changes start-idx))))))
|
|---|
| 381 | (coalesce-line-charprops line)))
|
|---|
| [12268] | 382 |
|
|---|
| [12288] | 383 | ;;; Coalesce adjacent changes with CHARPROP-EQUAL plists.
|
|---|
| 384 | ;;; Maybe make this remove zero-length changes, too?
|
|---|
| 385 | (defun coalesce-line-charprops (line)
|
|---|
| 386 | (let ((changes (line-charprops-changes line)))
|
|---|
| 387 | (do* ((i 0 (1+ i))
|
|---|
| 388 | (change nil))
|
|---|
| 389 | ((>= i (length changes)))
|
|---|
| 390 | (setq change (aref changes i))
|
|---|
| 391 | (loop with j = (1+ i)
|
|---|
| 392 | while (and (< j (length changes))
|
|---|
| 393 | (charprops-equal (charprops-change-plist change)
|
|---|
| 394 | (charprops-change-plist (aref changes j))))
|
|---|
| 395 | do (delete-charprops-change changes j)))
|
|---|
| 396 | ;; Elide any changes with NIL plists at the start of the line.
|
|---|
| 397 | (loop
|
|---|
| 398 | while (and (> (length changes) 0)
|
|---|
| 399 | (null (charprops-change-plist (aref changes 0))))
|
|---|
| 400 | do (delete-charprops-change changes 0))
|
|---|
| 401 | (when (zerop (length changes))
|
|---|
| 402 | (setf (line-charprops-changes line) nil)))
|
|---|
| 403 | (line-charprops-changes line))
|
|---|
| 404 |
|
|---|
| [12268] | 405 | (defun adjust-charprops-change-indexes (changes delta &key (start 0))
|
|---|
| 406 | (do* ((i start (1+ i))
|
|---|
| 407 | (change nil))
|
|---|
| 408 | ((>= i (length changes))
|
|---|
| 409 | changes)
|
|---|
| 410 | (setq change (aref changes i))
|
|---|
| 411 | (incf (charprops-change-index change) delta)))
|
|---|
| 412 |
|
|---|
| 413 | ;;; Add delta to the starting index of all charprops changes after the one
|
|---|
| [12536] | 414 | ;;; containing start.
|
|---|
| 415 | (defun adjust-line-charprops (line delta &key (start 0))
|
|---|
| 416 | (let* ((changes (line-charprops-changes line))
|
|---|
| 417 | (start-idx (charprops-change-index-for-position changes start)))
|
|---|
| [12288] | 418 | (adjust-charprops-change-indexes changes delta :start (if start-idx
|
|---|
| 419 | (1+ start-idx)
|
|---|
| 420 | 0))))
|
|---|
| [12268] | 421 |
|
|---|
| [12536] | 422 | (defun apply-line-charprops (line changes start-pos end-pos)
|
|---|
| 423 | (cond ((null changes)
|
|---|
| 424 | (set-line-charprops line nil :start start-pos :end end-pos))
|
|---|
| 425 | (t
|
|---|
| 426 | (setq changes (copy-charprops-changes changes))
|
|---|
| 427 | (do* ((i 0 (1+ i))
|
|---|
| 428 | (change nil))
|
|---|
| 429 | ((= i (length changes)))
|
|---|
| 430 | (setq change (aref changes i))
|
|---|
| 431 | (set-line-charprops line (charprops-change-plist change)
|
|---|
| 432 | :start (+ (charprops-change-index change) start-pos)
|
|---|
| 433 | :end end-pos))
|
|---|
| 434 | (coalesce-line-charprops line)))
|
|---|
| 435 | (line-charprops-changes line))
|
|---|
| [12268] | 436 |
|
|---|
| 437 | (defvar *display-properties*
|
|---|
| 438 | '(:font-name
|
|---|
| 439 | :font-size
|
|---|
| 440 | :font-weight
|
|---|
| [12536] | 441 | :font-width
|
|---|
| [12268] | 442 | :font-slant
|
|---|
| 443 | :font-underline
|
|---|
| 444 | :font-color
|
|---|
| 445 | :background-color))
|
|---|
| 446 |
|
|---|
| [12536] | 447 | ;;; Setting and accessing charprops
|
|---|
| [12268] | 448 |
|
|---|
| 449 | (defun next-charprop-value (mark name &key view)
|
|---|
| 450 | (let ((props (next-charprops mark :view view)))
|
|---|
| 451 | (getf props name)))
|
|---|
| 452 |
|
|---|
| 453 | (defun previous-charprop-value (mark name &key view)
|
|---|
| 454 | (let ((props (previous-charprops mark :view view)))
|
|---|
| 455 | (getf props name)))
|
|---|
| 456 |
|
|---|
| 457 | (defun set-charprop-value (mark name value &key (count 1 count-supplied-p) end view)
|
|---|
| [12536] | 458 | (declare (ignore view))
|
|---|
| [12268] | 459 | (when (and count-supplied-p end)
|
|---|
| [12536] | 460 | (error "Cannot specify both :COUNT and :END"))
|
|---|
| 461 | (with-mark ((start-mark mark)
|
|---|
| 462 | (end-mark mark))
|
|---|
| 463 | (if end
|
|---|
| 464 | (move-mark end-mark end)
|
|---|
| 465 | (character-offset end-mark count))
|
|---|
| 466 | (let* ((start-line (mark-line start-mark))
|
|---|
| 467 | (start-charpos (mark-charpos start-mark))
|
|---|
| 468 | (end-line (mark-line end-mark))
|
|---|
| 469 | (end-charpos (mark-charpos end-mark)))
|
|---|
| 470 | (cond ((eq start-line end-line)
|
|---|
| 471 | (add-line-charprop-value start-line name value
|
|---|
| 472 | :start start-charpos
|
|---|
| 473 | :end end-charpos))
|
|---|
| 474 | (t
|
|---|
| 475 | (do* ((line start-line (line-next line))
|
|---|
| 476 | (start start-charpos 0))
|
|---|
| 477 | ((eq line end-line)
|
|---|
| 478 | (add-line-charprop-value end-line name value
|
|---|
| 479 | :start 0
|
|---|
| 480 | :end end-charpos))
|
|---|
| 481 | (add-line-charprop-value line name value :start start))))
|
|---|
| 482 | (let ((n (count-characters (region start-mark end-mark)))
|
|---|
| 483 | (buffer (line-%buffer start-line)))
|
|---|
| [12859] | 484 | (hemlock-ext:buffer-note-modification buffer mark n)))))
|
|---|
| [12268] | 485 |
|
|---|
| [12536] | 486 | (defun find-line-charprop-value (line name value &key (start 0) end)
|
|---|
| 487 | (unless end
|
|---|
| 488 | (setq end (line-length line)))
|
|---|
| 489 | (let* ((changes (line-charprops-changes line))
|
|---|
| 490 | (start-idx (or (charprops-change-index-for-position changes start) 0))
|
|---|
| 491 | (end-idx (or (charprops-change-index-for-position changes end) 0)))
|
|---|
| 492 | (when changes
|
|---|
| 493 | (loop for i from start-idx to end-idx
|
|---|
| 494 | as change = (aref changes i)
|
|---|
| 495 | as plist = (charprops-change-plist change)
|
|---|
| 496 | as found-value = (getf plist name)
|
|---|
| 497 | do (when (and found-value
|
|---|
| 498 | (charprop-equal found-value value))
|
|---|
| 499 | (return (max start (charprops-change-index change))))))))
|
|---|
| 500 |
|
|---|
| [12268] | 501 | (defun find-charprop-value (mark name value &key (count nil count-supplied-p)
|
|---|
| [12536] | 502 | end view from-end)
|
|---|
| 503 | (declare (ignore from-end view))
|
|---|
| 504 | (with-mark ((start-mark mark)
|
|---|
| 505 | (end-mark mark))
|
|---|
| 506 | (when (and count-supplied-p end)
|
|---|
| 507 | (error "Cannot specify both :COUNT and :END"))
|
|---|
| 508 | (let* ((buffer (line-buffer (mark-line mark))))
|
|---|
| 509 | (unless (bufferp buffer)
|
|---|
| 510 | (error "text must be in a buffer"))
|
|---|
| 511 | (if count-supplied-p
|
|---|
| 512 | (character-offset end-mark count)
|
|---|
| 513 | (move-mark end-mark (buffer-end-mark buffer)))
|
|---|
| 514 | (let* ((start-line (mark-line start-mark))
|
|---|
| 515 | (start-charpos (mark-charpos start-mark))
|
|---|
| 516 | (end-line (mark-line end-mark))
|
|---|
| 517 | (end-charpos (mark-charpos end-mark)))
|
|---|
| 518 | (do* ((line start-line (line-next line))
|
|---|
| 519 | (charpos start-charpos 0))
|
|---|
| 520 | ((eq line end-line)
|
|---|
| 521 | (let ((pos (find-line-charprop-value end-line name value
|
|---|
| 522 | :start charpos
|
|---|
| 523 | :end end-charpos)))
|
|---|
| 524 | (when pos
|
|---|
| 525 | (move-to-position mark pos end-line)
|
|---|
| 526 | mark)))
|
|---|
| 527 | (let ((pos (find-line-charprop-value line name value :start charpos)))
|
|---|
| 528 | (when pos
|
|---|
| 529 | (move-to-position mark pos line)
|
|---|
| 530 | (return mark))))))))
|
|---|
| [12268] | 531 |
|
|---|
| 532 | (defun filter-match (filter name)
|
|---|
| 533 | (cond ((functionp filter)
|
|---|
| 534 | (funcall filter name))
|
|---|
| 535 | ((eq filter :display)
|
|---|
| 536 | (member name *display-properties* :test #'eq))
|
|---|
| 537 | ((typep filter 'sequence)
|
|---|
| 538 | (member name filter))
|
|---|
| 539 | (t
|
|---|
| 540 | name)))
|
|---|
| 541 |
|
|---|
| 542 | (defun filter-charprops (filter charprops)
|
|---|
| 543 | (if (eq filter t)
|
|---|
| 544 | charprops
|
|---|
| 545 | (typecase charprops
|
|---|
| 546 | ((satisfies ccl::plistp) (loop for (k v) on charprops by #'cddr
|
|---|
| 547 | when (filter-match filter k)
|
|---|
| 548 | collect k and collect v))
|
|---|
| 549 | (hash-table (loop for k being the hash-keys of charprops using (hash-value v)
|
|---|
| 550 | when (filter-match filter k)
|
|---|
| 551 | collect k and collect v)))))
|
|---|
| 552 |
|
|---|
| 553 | (defun next-charprops (mark &key view (filter t))
|
|---|
| 554 | "Return the properties of the character after MARK."
|
|---|
| 555 | (declare (ignore view))
|
|---|
| 556 | (when (next-character mark)
|
|---|
| 557 | (let* ((props (line-charprops-for-position (mark-line mark) (mark-charpos mark))))
|
|---|
| 558 | (filter-charprops filter props))))
|
|---|
| 559 |
|
|---|
| 560 | (defun previous-charprops (mark &key view (filter t))
|
|---|
| 561 | "Return the properties of the character before MARK."
|
|---|
| 562 | (with-mark ((m mark))
|
|---|
| 563 | (when (mark-before m)
|
|---|
| 564 | (next-charprops m :view view :filter filter))))
|
|---|
| 565 |
|
|---|
| 566 | (defun set-charprops (mark charprops &key (count 1 count-supplied-p)
|
|---|
| [12804] | 567 | (end nil end-supplied-p) (filter (charprops-names charprops)))
|
|---|
| [12268] | 568 | (when (and count-supplied-p end-supplied-p)
|
|---|
| 569 | (error "Only one of count or end can be supplied."))
|
|---|
| [12536] | 570 | (setq charprops (charprops-as-plist charprops :filter filter))
|
|---|
| 571 | (with-mark ((start-mark mark)
|
|---|
| 572 | (end-mark mark))
|
|---|
| 573 | (if end
|
|---|
| 574 | (move-mark end-mark end)
|
|---|
| 575 | (character-offset end-mark count))
|
|---|
| [12804] | 576 | ;; lame.
|
|---|
| 577 | (loop for (k v) on charprops by #'cddr
|
|---|
| 578 | do (set-charprop-value start-mark k v :end end-mark))))
|
|---|
| [12268] | 579 |
|
|---|
| 580 | ;;; Return a list of charprops-change vectors that correspond to the lines
|
|---|
| [12536] | 581 | ;;; of text in the region defined by the paramaters.
|
|---|
| [12268] | 582 | (defun charprops-in-region (region-or-mark &key (count 1 count-supplied-p)
|
|---|
| 583 | end filter)
|
|---|
| 584 | (declare (ignore filter))
|
|---|
| 585 | (when (and count-supplied-p end)
|
|---|
| 586 | (error "Only one of count or end can be supplied."))
|
|---|
| 587 | (let (region result)
|
|---|
| 588 | (etypecase region-or-mark
|
|---|
| 589 | (mark (with-mark ((m region-or-mark))
|
|---|
| 590 | (when end
|
|---|
| 591 | (setq count (- end (mark-absolute-position m))))
|
|---|
| 592 | (character-offset m count)
|
|---|
| 593 | (setq region (region region-or-mark m))))
|
|---|
| [12536] | 594 | (region (when (or count-supplied-p end)
|
|---|
| 595 | (error "Can't specify count or end when passing in a region."))
|
|---|
| 596 | (setq region region-or-mark)))
|
|---|
| [12268] | 597 | (let* ((start (region-start region))
|
|---|
| 598 | (first-line (mark-line start))
|
|---|
| [12536] | 599 | (first-charpos (mark-charpos start))
|
|---|
| [12268] | 600 | (end (region-end region))
|
|---|
| [12536] | 601 | (last-line (mark-line end))
|
|---|
| 602 | (last-charpos (mark-charpos end)))
|
|---|
| 603 | (cond
|
|---|
| 604 | ((eq first-line last-line)
|
|---|
| 605 | (list (copy-line-charprops first-line :start first-charpos)))
|
|---|
| 606 | (t
|
|---|
| 607 | (push (copy-line-charprops first-line :start first-charpos) result)
|
|---|
| 608 | (do* ((line (line-next first-line) (line-next line))
|
|---|
| 609 | (m (copy-mark start) (line-start m line)))
|
|---|
| 610 | ((eq line last-line)
|
|---|
| 611 | (push (copy-line-charprops last-line :end last-charpos) result)
|
|---|
| 612 | (nreverse result))
|
|---|
| 613 | (push (copy-line-charprops line) result)))))))
|
|---|
| [12268] | 614 |
|
|---|
| 615 | (defun apply-charprops (mark charprops-range &key filter from-end)
|
|---|
| 616 | (declare (ignore from-end filter charprops-range mark)))
|
|---|
| 617 |
|
|---|
| [12536] | 618 | #|
|
|---|
| 619 | (let* ((start-line (mark-line mark))
|
|---|
| 620 | (start-charpos (mark-charpos))
|
|---|
| 621 | (nlines (length charprops-range))
|
|---|
| 622 | (first-changes (pop charprops-range)))
|
|---|
| 623 |
|
|---|
| 624 | ;; do possibly-partial first line
|
|---|
| 625 | (let ((left (split-line-charprops start-line start-charpos)))
|
|---|
| 626 | (setf (line-charprops start-line) left)
|
|---|
| 627 | (append-line-charprops start-line first-changes))
|
|---|
| 628 | ;; do some number of whole lines
|
|---|
| 629 | (do* ((line (line-next start-line) (line-next line))
|
|---|
| 630 | (previous-line start-line (line-next previous-line))
|
|---|
| 631 | (cc-list charprops-range (cdr charprops-range))
|
|---|
| 632 | (changes (car cc-list) (car cc-list)))
|
|---|
| 633 | ((or (null line) (endp cc-list)))
|
|---|
| 634 | (setf (line-charprops-changes line) (copy-charprops-changes changes)))
|
|---|
| 635 | ;; I don't know what to do about a partial last line. There's no
|
|---|
| 636 | ;; way that I can see to know whether the last charprops change vector
|
|---|
| 637 | ;; in the charprops-range list is to apply to an entire line or to end
|
|---|
| 638 | ;; at a particular charpos on that line. Maybe that information needs
|
|---|
| 639 | ;; to be stored as part of the charprops-range list. For example, if the
|
|---|
| 640 | ;; element of the charprops-range list is a non-null list, the list could
|
|---|
| 641 | ;; be (charprops-change-vector start-charpos end-charpos).
|
|---|
| 642 |
|
|---|
| 643 | (multiple-value-bind (left right)
|
|---|
| 644 | (split-line-charprops last-line last-charpos)
|
|---|
| 645 | (setf (line-charprops last-line) last-changes)
|
|---|
| 646 | (append-line-charprops last-line right)))
|
|---|
| 647 | |#
|
|---|
| 648 |
|
|---|
| [12268] | 649 | (defun find-charprops (mark charprops &key count end view filter from-end)
|
|---|
| 650 | (declare (ignore from-end filter view end count charprops mark)))
|
|---|
| 651 |
|
|---|
| 652 | (defun find-charprops-change (mark &key count end view filter from-end)
|
|---|
| 653 | (declare (ignore from-end filter view end count))
|
|---|
| 654 | (let* ((line (mark-line mark))
|
|---|
| 655 | (charpos (mark-charpos mark))
|
|---|
| 656 | (changes (line-charprops-changes line))
|
|---|
| 657 | (idx (charprops-change-index-for-position changes charpos)))
|
|---|
| 658 | (loop
|
|---|
| 659 | (incf idx)
|
|---|
| 660 | (if (= idx (length changes))
|
|---|
| 661 | (setf line (line-next line)
|
|---|
| 662 | charpos 0
|
|---|
| 663 | changes (line-charprops-changes line)
|
|---|
| 664 | idx (charprops-change-index-for-position changes charpos))
|
|---|
| 665 | (return (move-mark mark (charprops-change-index (aref changes idx))))))))
|
|---|
| 666 |
|
|---|
| 667 | (defun print-line-charprops (line &key (start 0) (end (hi:line-length line)))
|
|---|
| 668 | (let* ((string (hi:line-string line))
|
|---|
| 669 | (charprops-changes (hi::line-charprops-changes line)))
|
|---|
| 670 | (let ((index start)
|
|---|
| 671 | (plist nil)
|
|---|
| 672 | (x 0))
|
|---|
| 673 | (loop for change across charprops-changes
|
|---|
| 674 | do (let* ((next-index (charprops-change-index change))
|
|---|
| 675 | (next-plist (charprops-change-plist change))
|
|---|
| 676 | (end (min end next-index)))
|
|---|
| 677 | (when (and (>= index start)
|
|---|
| 678 | (< index end))
|
|---|
| 679 | (format t "~& ~d: [~d, ~d) ~s: ~s" x index end
|
|---|
| 680 | (subseq string index end) plist))
|
|---|
| 681 | (setq index next-index)
|
|---|
| 682 | (setq plist next-plist)
|
|---|
| 683 | (incf x)))
|
|---|
| 684 | ;; final part of line
|
|---|
| 685 | (format t "~& ~d: [~d, ~d) ~s: ~s" x index end
|
|---|
| 686 | (subseq string index end) plist))))
|
|---|
| 687 |
|
|---|
| 688 | (defun copy-charprops (charprops)
|
|---|
| 689 | (copy-list charprops))
|
|---|
| 690 |
|
|---|
| 691 |
|
|---|
| 692 | ;;; Utility functions
|
|---|
| 693 |
|
|---|
| 694 | (defun charprop-equal (value1 value2)
|
|---|
| 695 | (cond ((and (stringp value1) (stringp value2))
|
|---|
| 696 | (string= value1 value2))
|
|---|
| 697 | ((and (numberp value1) (numberp value2))
|
|---|
| 698 | (= value1 value2))
|
|---|
| 699 | (t
|
|---|
| 700 | (eql value1 value2))))
|
|---|
| 701 |
|
|---|
| 702 | (defun charprops-get (charprops name &key (filter t))
|
|---|
| 703 | (when (and name (filter-match filter name))
|
|---|
| 704 | (etypecase charprops
|
|---|
| 705 | ((satisfies ccl::plistp) (getf charprops name))
|
|---|
| 706 | (hash-table (gethash name charprops)))))
|
|---|
| 707 |
|
|---|
| 708 | (defun charprops-set (charprops name value)
|
|---|
| 709 | (etypecase charprops
|
|---|
| 710 | ((satisfies ccl::plistp) (setf (getf charprops name) value))
|
|---|
| 711 | (hash-table (setf (gethash name charprops) value)))
|
|---|
| 712 | charprops)
|
|---|
| 713 |
|
|---|
| 714 | (defun same-sets (s1 s2 &key (test #'eql))
|
|---|
| 715 | (and (subsetp s1 s2 :test test)
|
|---|
| 716 | (subsetp s2 s1 :test test)))
|
|---|
| 717 |
|
|---|
| [12536] | 718 | ;; I wonder if this will be a hot spot...
|
|---|
| [12268] | 719 | (defun charprops-equal (charprops1 charprops2 &key (filter t))
|
|---|
| 720 | (setq charprops1 (charprops-as-plist charprops1 :filter filter)
|
|---|
| 721 | charprops2 (charprops-as-plist charprops2 :filter filter))
|
|---|
| 722 | (let (keys1 values1 keys2 values2)
|
|---|
| 723 | (loop for (k1 v1) on charprops1 by #'cddr
|
|---|
| 724 | do (push k1 keys1)
|
|---|
| 725 | (push v1 values1))
|
|---|
| 726 | (loop for (k2 v2) on charprops2 by #'cddr
|
|---|
| 727 | do (push k2 keys2)
|
|---|
| 728 | (push v2 values2))
|
|---|
| 729 | (and (same-sets keys1 keys2)
|
|---|
| 730 | (same-sets values1 values2 :test #'charprop-equal))))
|
|---|
| 731 |
|
|---|
| 732 | (defun charprops-as-plist (charprops &key (filter t))
|
|---|
| 733 | (etypecase charprops
|
|---|
| 734 | ((satisfies ccl::plistp) (if (eq filter t)
|
|---|
| 735 | charprops
|
|---|
| 736 | (loop for (k v) on charprops by #'cddr
|
|---|
| 737 | when (filter-match filter k)
|
|---|
| 738 | collect k and collect v)))
|
|---|
| 739 | (hash-table (loop for k being the hash-keys of charprops using (hash-value v)
|
|---|
| 740 | when (filter-match filter k)
|
|---|
| 741 | collect k and collect v))))
|
|---|
| 742 |
|
|---|
| 743 | (defun charprops-as-hash (charprops &key (filter t))
|
|---|
| 744 | (etypecase charprops
|
|---|
| 745 | ((satisfies ccl::plistp) (let ((hash (make-hash-table)))
|
|---|
| 746 | (loop for (k v) on charprops by #'cddr
|
|---|
| 747 | when (filter-match filter k)
|
|---|
| 748 | do (setf (gethash k hash) v))
|
|---|
| 749 | hash))
|
|---|
| 750 | (hash-table (if (eq filter t)
|
|---|
| 751 | charprops
|
|---|
| 752 | (let ((hash (make-hash-table)))
|
|---|
| 753 | (maphash #'(lambda (k v)
|
|---|
| 754 | (when (filter-match filter k)
|
|---|
| 755 | (setf (gethash k hash) v)))
|
|---|
| 756 | charprops))))))
|
|---|
| 757 |
|
|---|
| 758 | (defun charprops-names (charprops &key (filter t))
|
|---|
| 759 | (etypecase charprops
|
|---|
| 760 | ((satisfies ccl::plistp) (loop for name in charprops by #'cddr
|
|---|
| 761 | when (filter-match filter name)
|
|---|
| 762 | collect name))
|
|---|
| 763 | (hash-table (loop for name being the hash-keys of charprops
|
|---|
| 764 | when (filter-match filter name)
|
|---|
| 765 | collect name))))
|
|---|
| 766 |
|
|---|
| 767 | ;;; From <AppKit/NSAttributedString.h>
|
|---|
| 768 | (defparameter *cocoa-attributes*
|
|---|
| [12536] | 769 | `((:ns-font . ,#&NSFontAttributeName)
|
|---|
| 770 | (:ns-paragraph-style . ,#&NSParagraphStyleAttributeName)
|
|---|
| 771 | (:ns-foreground-color . ,#&NSForegroundColorAttributeName)
|
|---|
| 772 | (:ns-underline-style . ,#&NSUnderlineStyleAttributeName)
|
|---|
| 773 | (:ns-superscript . ,#&NSSuperscriptAttributeName)
|
|---|
| 774 | (:ns-background-color . ,#&NSBackgroundColorAttributeName)
|
|---|
| 775 | (:ns-attachment . ,#&NSAttachmentAttributeName)
|
|---|
| 776 | (:ns-ligature . ,#&NSLigatureAttributeName)
|
|---|
| 777 | (:ns-baseline-offset . ,#&NSBaselineOffsetAttributeName)
|
|---|
| 778 | (:ns-kern . ,#&NSKernAttributeName)
|
|---|
| 779 | (:ns-link . ,#&NSLinkAttributeName)
|
|---|
| 780 | (:ns-stroke-width . ,#&NSStrokeWidthAttributeName)
|
|---|
| 781 | (:ns-stroke-color . ,#&NSStrokeColorAttributeName)
|
|---|
| 782 | (:ns-underline-color . ,#&NSUnderlineColorAttributeName)
|
|---|
| 783 | (:ns-strikethrough-style . ,#&NSStrikethroughStyleAttributeName)
|
|---|
| 784 | (:ns-strikethrough-color . ,#&NSStrikethroughColorAttributeName)
|
|---|
| 785 | (:ns-shadow . ,#&NSShadowAttributeName)
|
|---|
| 786 | (:ns-obliqueness . ,#&NSObliquenessAttributeName)
|
|---|
| 787 | (:ns-expansion . ,#&NSExpansionAttributeName)
|
|---|
| 788 | (:ns-cursor . ,#&NSCursorAttributeName)
|
|---|
| 789 | (:ns-tool-tip . ,#&NSToolTipAttributeName)
|
|---|
| [12484] | 790 | #-cocotron
|
|---|
| [12536] | 791 | (:ns-character-shape . ,#&NSCharacterShapeAttributeName)
|
|---|
| [12484] | 792 | #-cocotron
|
|---|
| [12536] | 793 | (:ns-glyph-info . ,#&NSGlyphInfoAttributeName)
|
|---|
| [12274] | 794 | ;;(:ns-marked-clause-segment . #&NSMarkedClauseSegmentAttributeName)
|
|---|
| 795 | ;;(:ns-spelling-state . #&NSSpellingStateAttributeName)
|
|---|
| 796 | ))
|
|---|
| [12268] | 797 |
|
|---|
