| [7540] | 1 | ;;; -*- Package: Hemlock -*-
|
|---|
| 2 | ;;;
|
|---|
| [16688] | 3 | ;;; Copyright 2007 Clozure Associates
|
|---|
| [7540] | 4 | ;;;
|
|---|
| [16688] | 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|---|
| 6 | ;;; you may not use this file except in compliance with the License.
|
|---|
| 7 | ;;; You may obtain a copy of the License at
|
|---|
| 8 | ;;;
|
|---|
| 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0
|
|---|
| 10 | ;;;
|
|---|
| 11 | ;;; Unless required by applicable law or agreed to in writing, software
|
|---|
| 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|---|
| 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|---|
| 14 | ;;; See the License for the specific language governing permissions and
|
|---|
| 15 | ;;; limitations under the License.
|
|---|
| 16 |
|
|---|
| [7540] | 17 | ;;; Dynamic symbol completion
|
|---|
| 18 | ;;; gz@clozure.com
|
|---|
| 19 | ;;;
|
|---|
| 20 | ;;; This uses wordchar attributes set up in completion.lisp, but otherwise is unrelated.
|
|---|
| 21 |
|
|---|
| 22 | (in-package :hemlock)
|
|---|
| 23 |
|
|---|
| 24 | ;; Context maintained so repeated M-/'s can walk through all available abbreviations
|
|---|
| 25 |
|
|---|
| 26 | (defstruct (dabbrev-context (:conc-name "DABBREV."))
|
|---|
| 27 | ;; The buffer this context belongs to
|
|---|
| 28 | (buffer nil)
|
|---|
| 29 | ;; The last expansion
|
|---|
| 30 | (expansion nil)
|
|---|
| 31 | ;; The thing that was expanded. This is usually a prefix of expansion, but it might
|
|---|
| 32 | ;; be initials (i.e. abbrev = mvb, expansion = multiple-value-bind).
|
|---|
| 33 | (abbrev "" :type simple-string)
|
|---|
| 34 | ;; The package prefix if any, including the ending colon(s).
|
|---|
| 35 | (prefix nil)
|
|---|
| 36 | ;; The position of the end of the expansion
|
|---|
| 37 | (end-mark nil)
|
|---|
| 38 | ;; buffer-signature as of the time the expansion was inserted.
|
|---|
| 39 | (signature nil)
|
|---|
| 40 | ;; list of expansions already tried and rejected
|
|---|
| 41 | (seen ())
|
|---|
| 42 | ;; List of places to try next
|
|---|
| 43 | (state-path '(:before-point :after-point :other-buffers :this-package :other-packages))
|
|---|
| 44 | ;; Sequence of sources to go thru before changing state
|
|---|
| 45 | (sources '(:last-used))
|
|---|
| 46 | ;; a sequence of expansions to go thru before changing source
|
|---|
| 47 | (seq (make-array 10 :fill-pointer 0 :adjustable t)))
|
|---|
| 48 |
|
|---|
| 49 | (defun symbol-completion-buffer-hook (buffer)
|
|---|
| 50 | (defhvar "DAbbrev Context"
|
|---|
| 51 | "Internal variable for cycling through symbol completions"
|
|---|
| 52 | :buffer buffer
|
|---|
| 53 | :value nil)
|
|---|
| 54 | (defhvar "DAbbrev Cache"
|
|---|
| 55 | "Internal variable for caching symbols in buffer"
|
|---|
| 56 | :buffer buffer
|
|---|
| 57 | ;; Cons of buffer sig and a vector of all symbols in buffer as of the time
|
|---|
| 58 | ;; of the buffer sig.
|
|---|
| 59 | :value (cons nil nil))
|
|---|
| 60 | )
|
|---|
| 61 |
|
|---|
| 62 | (add-hook make-buffer-hook #'symbol-completion-buffer-hook)
|
|---|
| 63 |
|
|---|
| 64 | ;; Global table of all abbrevs expanded in this session, and the last value they expanded to.
|
|---|
| 65 | (defvar *dabbrevs* (make-hash-table :test #'equalp))
|
|---|
| 66 |
|
|---|
| 67 | (defun dabbrev-package (context)
|
|---|
| 68 | (or (dabbrev-package-for-prefix (dabbrev.prefix context))
|
|---|
| 69 | ;; TODO: look for in-package form preceeding point...
|
|---|
| 70 | (buffer-package (dabbrev.buffer context))))
|
|---|
| 71 |
|
|---|
| 72 | (defun dabbrev-external-symbol-p (context)
|
|---|
| 73 | ;; True if explicitly looking for an external symbol.
|
|---|
| 74 | (let* ((prefix (dabbrev.prefix context))
|
|---|
| 75 | (prefix-len (length prefix)))
|
|---|
| 76 | (or (eql prefix-len 1)
|
|---|
| 77 | (and (>= prefix-len 2)
|
|---|
| 78 | (not (eql (aref prefix (- prefix-len 2)) #\:))))))
|
|---|
| 79 |
|
|---|
| 80 | (defun dabbrev-package-for-prefix (prefix)
|
|---|
| 81 | (when prefix
|
|---|
| 82 | (let* ((prefix-len (length prefix)))
|
|---|
| 83 | (if (eql prefix-len 1)
|
|---|
| 84 | ccl::*keyword-package*
|
|---|
| 85 | (find-package (subseq prefix 0 (if (eql (aref prefix (- prefix-len 2)) #\:)
|
|---|
| 86 | (- prefix-len 2)
|
|---|
| 87 | (- prefix-len 1))))))))
|
|---|
| 88 |
|
|---|
| 89 |
|
|---|
| 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 91 | ;; State machine support:
|
|---|
| 92 |
|
|---|
| 93 | (defun dabbrev-next-expansion (context)
|
|---|
| 94 | (cond ((> (length (dabbrev.seq context)) 0)
|
|---|
| 95 | (let* ((exp (vector-pop (dabbrev.seq context))))
|
|---|
| 96 | (if (find exp (dabbrev.seen context) :test #'string=)
|
|---|
| 97 | (dabbrev-next-expansion context)
|
|---|
| 98 | exp)))
|
|---|
| 99 | ((dabbrev.sources context)
|
|---|
| 100 | (dabbrev-collect-expansions (pop (dabbrev.sources context)) context)
|
|---|
| 101 | (dabbrev-next-expansion context))
|
|---|
| 102 | ((dabbrev.state-path context)
|
|---|
| 103 | (setf (dabbrev.sources context)
|
|---|
| 104 | (dabbrev-sources-in (pop (dabbrev.state-path context)) context))
|
|---|
| 105 | (dabbrev-next-expansion context))
|
|---|
| 106 | (t nil)))
|
|---|
| 107 |
|
|---|
| 108 |
|
|---|
| 109 | ;; dabbrev-sources-in: maps state -> sources
|
|---|
| 110 |
|
|---|
| 111 | (defmethod dabbrev-sources-in ((state t) context)
|
|---|
| 112 | (declare (ignore context))
|
|---|
| 113 | (list state))
|
|---|
| 114 |
|
|---|
| 115 | (defmethod dabbrev-sources-in ((state (eql :other-buffers)) context)
|
|---|
| [8428] | 116 | (let* ((buffers (mapcar #'hemlock-view-buffer (hemlock-ext:all-hemlock-views))))
|
|---|
| [7540] | 117 | ;; Remove duplicates, always keeping the first occurance (frontmost window)
|
|---|
| 118 | (loop for blist on buffers do (setf (cdr blist) (delete (car blist) (cdr blist))))
|
|---|
| 119 | (delete (dabbrev.buffer context) buffers)))
|
|---|
| 120 |
|
|---|
| 121 | (defmethod dabbrev-sources-in ((state (eql :other-packages)) context)
|
|---|
| 122 | (let* ((all (copy-list (list-all-packages)))
|
|---|
| 123 | (this-package (dabbrev-package context))
|
|---|
| 124 | (keyword-package ccl::*keyword-package*))
|
|---|
| 125 | (setq all (delete this-package all))
|
|---|
| 126 | (unless (eq this-package keyword-package)
|
|---|
| 127 | (setq all (nconc (delete keyword-package all) (list keyword-package))))
|
|---|
| 128 | all))
|
|---|
| 129 |
|
|---|
| 130 | ;; dabbrev-collect-expansion: maps source -> expansions
|
|---|
| 131 | ;; Note that in general these methods don't bother to check for dabbrev.seen
|
|---|
| 132 | ;; or duplicates, even though they could, because there is no reason to spend
|
|---|
| 133 | ;; time up front on checking expansions we might never get to.
|
|---|
| 134 |
|
|---|
| 135 | (defun dabbrev-match-p (context exp)
|
|---|
| 136 | (let* ((abbrev (dabbrev.abbrev context))
|
|---|
| 137 | (abbrev-len (length abbrev)))
|
|---|
| 138 | (or (and (< abbrev-len (length exp))
|
|---|
| 139 | (string-equal abbrev exp :end1 abbrev-len :end2 abbrev-len))
|
|---|
| 140 | ;; Check for initials.
|
|---|
| 141 | (loop
|
|---|
| 142 | for char across abbrev
|
|---|
| 143 | for pos = 0 then (and (setq pos (position-if-not #'alphanumericp exp :start pos))
|
|---|
| 144 | (position-if #'alphanumericp exp :start (1+ pos)))
|
|---|
| 145 | always (and pos (char-equal char (aref exp pos)))))))
|
|---|
| 146 |
|
|---|
| 147 | (defmethod dabbrev-collect-expansions ((source (eql :last-used)) context)
|
|---|
| 148 | (let* ((abbrev (dabbrev.abbrev context))
|
|---|
| 149 | (prefix (dabbrev.prefix context))
|
|---|
| 150 | (abbrev-len (length abbrev))
|
|---|
| 151 | (prefix-len (length prefix))
|
|---|
| 152 | (string (concatenate 'string abbrev prefix)))
|
|---|
| 153 | (loop
|
|---|
| 154 | for end from (+ abbrev-len prefix-len) downto prefix-len
|
|---|
| 155 | for key = string then (subseq string 0 end)
|
|---|
| 156 | as exp = (gethash key *dabbrevs*)
|
|---|
| 157 | when (and exp (dabbrev-match-p context exp))
|
|---|
| 158 | do (return (vector-push-extend exp (dabbrev.seq context))))))
|
|---|
| 159 |
|
|---|
| 160 | (defmethod dabbrev-collect-expansions ((buffer buffer) context)
|
|---|
| 161 | ;; TODO: need to take prefix into account - give preferences to things
|
|---|
| 162 | ;; matching prefix. For now, ignore the prefix-only case here since can't
|
|---|
| 163 | ;; do anything useful.
|
|---|
| 164 | (unless (equal (dabbrev.abbrev context) "")
|
|---|
| 165 | (let* ((vec (dabbrev-symbols-in-buffer buffer))
|
|---|
| 166 | (seq (dabbrev.seq context)))
|
|---|
| 167 | (loop
|
|---|
| 168 | for exp across vec
|
|---|
| 169 | when (dabbrev-match-p context exp)
|
|---|
| 170 | do (vector-push-extend exp seq))
|
|---|
| 171 | seq)))
|
|---|
| 172 |
|
|---|
| 173 | ;; TODO: have a background process that does this. (Since the architecture doesn't allow locking
|
|---|
| 174 | ;; against buffer changes, might need to do ignore-errors and just bludgeon through, checking
|
|---|
| 175 | ;; for sig changes at end. Or perhaps could use the modification hook, if that's reliable)
|
|---|
| 176 | (defun dabbrev-symbols-in-buffer (buffer)
|
|---|
| 177 | (let* ((cache (variable-value 'dabbrev-cache :buffer buffer)))
|
|---|
| 178 | (unless (and cache (eql (car cache) (buffer-signature buffer)))
|
|---|
| 179 | (let* ((hi::*current-buffer* buffer)
|
|---|
| 180 | (start-mark (buffer-start-mark buffer))
|
|---|
| 181 | (symbols (make-array 100 :adjustable t :fill-pointer 0)))
|
|---|
| 182 | (with-mark ((word-start start-mark)
|
|---|
| 183 | (word-end start-mark))
|
|---|
| 184 | (loop
|
|---|
| 185 | (unless (find-attribute word-end :completion-wordchar) (return))
|
|---|
| 186 | (move-mark word-start word-end)
|
|---|
| 187 | (unless (find-not-attribute word-end :completion-wordchar)
|
|---|
| 188 | (buffer-end word-end))
|
|---|
| 189 | (let* ((word (region-to-string (region word-start word-end))))
|
|---|
| 190 | (unless (find word symbols :test #'equal)
|
|---|
| 191 | (vector-push-extend word symbols)))))
|
|---|
| 192 | (setf (variable-value 'dabbrev-cache :buffer buffer)
|
|---|
| 193 | (setq cache (cons (buffer-signature buffer) (coerce symbols 'simple-vector))))))
|
|---|
| 194 | (cdr cache)))
|
|---|
| 195 |
|
|---|
| 196 | (defun dabbrev-next-in-buffer (mark temp-mark temp-string)
|
|---|
| 197 | ;; Leaves temp-mark at start and point-mark at end of next symbol
|
|---|
| 198 | (when (find-attribute mark :completion-wordchar)
|
|---|
| 199 | (move-mark temp-mark mark)
|
|---|
| 200 | (unless (find-not-attribute mark :completion-wordchar)
|
|---|
| 201 | (buffer-end mark))
|
|---|
| 202 | (region-to-string (region temp-mark mark) temp-string)))
|
|---|
| 203 |
|
|---|
| 204 | (defun dabbrev-prev-in-buffer (mark temp-mark temp-string)
|
|---|
| 205 | (when (reverse-find-attribute mark :completion-wordchar)
|
|---|
| 206 | (move-mark temp-mark mark)
|
|---|
| 207 | (unless (reverse-find-not-attribute mark :completion-wordchar)
|
|---|
| 208 | (buffer-start mark))
|
|---|
| 209 | (region-to-string (region mark temp-mark) temp-string)))
|
|---|
| 210 |
|
|---|
| 211 | (defmethod dabbrev-collect-expansions ((source (eql :before-point)) context)
|
|---|
| 212 | (dabbrev-collect-expansions-1 source context))
|
|---|
| 213 |
|
|---|
| 214 | (defmethod dabbrev-collect-expansions ((source (eql :after-point)) context)
|
|---|
| 215 | (dabbrev-collect-expansions-1 source context))
|
|---|
| 216 |
|
|---|
| 217 | (defun dabbrev-collect-expansions-1 (direction context)
|
|---|
| 218 | (let* ((buffer (dabbrev.buffer context))
|
|---|
| 219 | (point (buffer-point buffer))
|
|---|
| 220 | (abbrev (dabbrev.abbrev context))
|
|---|
| 221 | (abbrev-len (length abbrev))
|
|---|
| 222 | (seq (dabbrev.seq context))
|
|---|
| 223 | (temp-string (make-string 30)))
|
|---|
| 224 | ;; TODO: need to take prefix into account - give preferences to things
|
|---|
| 225 | ;; matching prefix. For now, ignore the prefix-only case here since can't
|
|---|
| 226 | ;; do anything useful.
|
|---|
| 227 | (when (eql abbrev-len 0)
|
|---|
| 228 | (return-from dabbrev-collect-expansions-1))
|
|---|
| 229 | (with-mark ((mark point) (temp-mark point))
|
|---|
| 230 | (when (eq direction :before-point) (character-offset mark (- abbrev-len)))
|
|---|
| 231 | (loop
|
|---|
| 232 | (multiple-value-bind (word word-len)
|
|---|
| 233 | (if (eq direction :before-point)
|
|---|
| 234 | (dabbrev-prev-in-buffer mark temp-mark temp-string)
|
|---|
| 235 | (dabbrev-next-in-buffer mark temp-mark temp-string))
|
|---|
| 236 | (unless word (return))
|
|---|
| 237 | (when (and (< abbrev-len word-len)
|
|---|
| 238 | (string-equal word abbrev :end1 abbrev-len :end2 abbrev-len))
|
|---|
| 239 | (let* ((word (subseq word 0 word-len)))
|
|---|
| 240 | (unless (find word seq :test #'equal)
|
|---|
| 241 | (vector-push-extend word seq)))))))
|
|---|
| 242 | (nreverse seq)))
|
|---|
| 243 |
|
|---|
| 244 | (defmethod dabbrev-collect-expansions ((source (eql :this-package)) context)
|
|---|
| 245 | (let* ((pkg (dabbrev-package context))
|
|---|
| 246 | (seq (dabbrev.seq context)))
|
|---|
| 247 | (when pkg
|
|---|
| 248 | (when (dabbrev.prefix context)
|
|---|
| 249 | (if (or (dabbrev-external-symbol-p context)
|
|---|
| 250 | (eq pkg ccl::*keyword-package*))
|
|---|
| 251 | (do-external-symbols (sym pkg)
|
|---|
| 252 | (when (and (not (find sym seq :test #'eq))
|
|---|
| 253 | (dabbrev-match-p context (symbol-name sym)))
|
|---|
| 254 | (vector-push-extend sym seq)))
|
|---|
| 255 | (ccl::do-present-symbols (sym pkg)
|
|---|
| 256 | (when (and (not (find sym seq :test #'eq))
|
|---|
| 257 | (dabbrev-match-p context (symbol-name sym)))
|
|---|
| 258 | (vector-push-extend sym seq)))))
|
|---|
| 259 | (unless (eq pkg ccl::*keyword-package*)
|
|---|
| 260 | (do-symbols (sym pkg)
|
|---|
| 261 | (when (and (not (find sym seq :test #'eq))
|
|---|
| 262 | (dabbrev-match-p context (symbol-name sym)))
|
|---|
| 263 | (vector-push-extend sym seq))))
|
|---|
| [8774] | 264 | (setq seq
|
|---|
| 265 | (stable-sort seq #'(lambda (s1 s2)
|
|---|
| 266 | (and (or (boundp s1) (fboundp s1))
|
|---|
| 267 | (not (or (boundp s2) (fboundp s2)))))))
|
|---|
| [7540] | 268 | ;; Now convert to strings - and downcase for inserting in buffer.
|
|---|
| 269 | (dotimes (i (length seq))
|
|---|
| 270 | (setf (aref seq i) (string-downcase (symbol-name (aref seq i))))))
|
|---|
| 271 | seq))
|
|---|
| 272 |
|
|---|
| 273 | (defmethod dabbrev-collect-expansions ((pkg package) context)
|
|---|
| 274 | ;; For random packages, only need to do present symbols, since imported ones will be
|
|---|
| 275 | ;; shown in their own package.
|
|---|
| 276 | (let* ((seq (dabbrev.seq context)))
|
|---|
| 277 | (ccl::do-present-symbols (sym pkg)
|
|---|
| 278 | (let* ((name (symbol-name sym)))
|
|---|
| 279 | (when (dabbrev-match-p context name)
|
|---|
| 280 | (vector-push-extend (string-downcase name) seq))))
|
|---|
| 281 | seq))
|
|---|
| 282 |
|
|---|
| 283 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 284 | ;;
|
|---|
| 285 | ;; the command
|
|---|
| 286 |
|
|---|
| 287 |
|
|---|
| 288 | (defcommand "Expand Dynamic Abbreviation" (p)
|
|---|
| 289 | "Treats the symbol before point as an abbreviation and expands it.
|
|---|
| 290 | It checks the following in order until a suitable expansion is found:
|
|---|
| 291 | - last accepted expansion for this abbreviation, if any
|
|---|
| 292 | - symbols in current buffer before point
|
|---|
| 293 | - symbols in current buffer after point
|
|---|
| 294 | - symbols in all other editor windows, front to back
|
|---|
| 295 | - symbols visible in the current package, fbound/bound symbols first
|
|---|
| 296 | - symbols in all other packages (in no particular order)
|
|---|
| 297 |
|
|---|
| 298 | If called repeatedly from the same position, replaces the previous expansion
|
|---|
| 299 | with the next possible one.
|
|---|
| 300 |
|
|---|
| 301 | A symbol is a suitable expansion for an abbreviation if the abbreviation is
|
|---|
| 302 | a proper prefix of the symbol, or the abbreviation consists of the initials
|
|---|
| 303 | of the individual words within the symbol (e.g. mvb => multiple-value-bind).
|
|---|
| 304 | "
|
|---|
| 305 | (declare (ignore p))
|
|---|
| 306 | (let* ((buffer (current-buffer))
|
|---|
| 307 | (point (buffer-point buffer))
|
|---|
| 308 | (context (dabbrev-command-init buffer))
|
|---|
| 309 | (abbrev (dabbrev.abbrev context))
|
|---|
| 310 | (abbrev-len (length abbrev))
|
|---|
| 311 | (expansion (dabbrev-next-expansion context))
|
|---|
| 312 | (expansion-len (length expansion)))
|
|---|
| 313 | (when (null expansion)
|
|---|
| [11674] | 314 | (editor-error "No~:[ more~;~] expansions for ~s"
|
|---|
| [7540] | 315 | (null (dabbrev.expansion context))
|
|---|
| 316 | abbrev))
|
|---|
| 317 | (push expansion (dabbrev.seen context))
|
|---|
| 318 | (setf (dabbrev.expansion context) expansion)
|
|---|
| 319 | (setf (gethash abbrev *dabbrevs*) expansion)
|
|---|
| 320 | (if (and (>= expansion-len abbrev-len)
|
|---|
| 321 | (string= abbrev expansion :end2 abbrev-len))
|
|---|
| 322 | (insert-string point (subseq expansion abbrev-len))
|
|---|
| 323 | (progn
|
|---|
| 324 | (delete-characters point (- abbrev-len))
|
|---|
| 325 | (insert-string point expansion)))
|
|---|
| 326 | (move-mark (dabbrev.end-mark context) point)
|
|---|
| 327 | (setf (dabbrev.signature context) (buffer-signature buffer))))
|
|---|
| 328 |
|
|---|
| 329 | #+gz ;; This tests the generation of completion candidates
|
|---|
| 330 | ;; (time(hemlock::test-completions (cadr hi::*buffer-list*) "dabbrev"))
|
|---|
| 331 | (defun test-completions (buffer abbrev)
|
|---|
| 332 | (let* ((hi::*current-buffer* buffer)
|
|---|
| 333 | (point (buffer-point buffer))
|
|---|
| 334 | (context (make-dabbrev-context
|
|---|
| 335 | :buffer buffer
|
|---|
| 336 | :abbrev abbrev
|
|---|
| 337 | ;; Can use a temp mark (i.e. the kind that doesn't automatically
|
|---|
| 338 | ;; update) because we only use it while buffer is unmodified.
|
|---|
| 339 | :end-mark (copy-mark point :temporary))))
|
|---|
| 340 | (loop as expansion = (dabbrev-next-expansion context) while expansion
|
|---|
| 341 | do (push expansion (dabbrev.seen context))
|
|---|
| 342 | do (setf (dabbrev.expansion context) expansion)
|
|---|
| 343 | do (setf (gethash abbrev *dabbrevs*) expansion))
|
|---|
| 344 | (dabbrev.seen context)))
|
|---|
| 345 |
|
|---|
| 346 | ;; Reinitialize context to either restart or cycle to next completion.
|
|---|
| 347 | ;; In the latter case, undoes the last completion in the buffer.
|
|---|
| 348 | (defun dabbrev-command-init (buffer)
|
|---|
| 349 | (let* ((point (buffer-point buffer))
|
|---|
| 350 | (context (variable-value 'dabbrev-context :buffer buffer)))
|
|---|
| 351 | (if (and context
|
|---|
| 352 | ;; If buffer not modified since last time
|
|---|
| 353 | (eql (dabbrev.signature context) (buffer-signature buffer))
|
|---|
| 354 | ;; and cursor not moved elsewhere
|
|---|
| 355 | (mark= (dabbrev.end-mark context) point))
|
|---|
| 356 | ;; This means rejected previous attempt, get rid of it.
|
|---|
| 357 | (let* ((abbrev (dabbrev.abbrev context))
|
|---|
| 358 | (abbrev-len (length abbrev))
|
|---|
| 359 | (expansion (dabbrev.expansion context))
|
|---|
| 360 | (expansion-len (length expansion)))
|
|---|
| 361 | ;; Sanity check, because I don't totally trust buffer-signature ...
|
|---|
| 362 | (with-mark ((mark point))
|
|---|
| 363 | (assert (and (character-offset mark (- (length expansion)))
|
|---|
| 364 | (equal (region-to-string (region mark point)) expansion))
|
|---|
| 365 | () "Bug! Buffer changed unexpectedly"))
|
|---|
| 366 | (if (and (>= expansion-len abbrev-len)
|
|---|
| 367 | (string= abbrev expansion :end2 abbrev-len))
|
|---|
| 368 | (delete-characters point (- abbrev-len expansion-len))
|
|---|
| 369 | (progn
|
|---|
| 370 | (delete-characters point (- expansion-len))
|
|---|
| 371 | (insert-string point abbrev))))
|
|---|
| 372 | ;; Else starting a new attempt, create a new context
|
|---|
| 373 | (let* ((mark (copy-mark point :temporary)))
|
|---|
| 374 | (multiple-value-bind (abbrev prefix) (dabbrev-get-abbrev mark point)
|
|---|
| 375 | (when (and (equal abbrev "") (equal prefix ""))
|
|---|
| 376 | (editor-error "Nothing to expand"))
|
|---|
| 377 | (setq context (make-dabbrev-context
|
|---|
| 378 | :buffer buffer
|
|---|
| 379 | :abbrev abbrev
|
|---|
| 380 | :prefix prefix
|
|---|
| 381 | ;; Can use a temp mark (i.e. the kind that doesn't automatically
|
|---|
| 382 | ;; update) because we only use it while buffer is unmodified.
|
|---|
| 383 | :end-mark mark)))
|
|---|
| 384 | (setf (variable-value 'dabbrev-context :buffer buffer) context)))
|
|---|
| 385 | (move-mark (dabbrev.end-mark context) point)
|
|---|
| 386 | context))
|
|---|
| 387 |
|
|---|
| 388 | (defun dabbrev-get-abbrev (mark point)
|
|---|
| 389 | (declare (values abbrev package-prefix))
|
|---|
| 390 | (move-mark mark point)
|
|---|
| 391 | (unless (reverse-find-not-attribute mark :completion-wordchar)
|
|---|
| 392 | (buffer-start mark))
|
|---|
| 393 | (values (region-to-string (region mark point))
|
|---|
| 394 | (when (eql (previous-character mark) #\:)
|
|---|
| 395 | (with-mark ((temp mark))
|
|---|
| 396 | (character-offset temp -1)
|
|---|
| 397 | (when (eql (previous-character temp) #\:)
|
|---|
| 398 | (character-offset temp -1))
|
|---|
| 399 | (unless (reverse-find-not-attribute temp :completion-wordchar)
|
|---|
| 400 | (buffer-start temp))
|
|---|
| 401 | (region-to-string (region temp mark))))))
|
|---|
| 402 |
|
|---|
| 403 |
|
|---|
