[climacs-devel] latest progress

[Luigi Panzeri]

Robert Strandh <strandh at labri.fr> writes:

> Do not hesitate taking on even minor tasks such as fixing a bug or
> adding documentation strings.  And please add your favorite Emacs
> command that is currently missing from Climacs, but please let us know
> (by mailing to this list) what you are working on in that case. 
>

Hi,

i am lookig at climacs, which i consider a nice project. I wrote for
fun a little function for the buffer library that implements the
dabbrev-expand function (plus two utility function), commonly
keybinded with M-/ on emacs (one of my favourite command for writing
texts)

It tries to expand the current word in one that is found in the
buffer. It works incrementally, using a closure and avoid duplicated
expansion.

It is not a beautiful code imho, but it works well. I don not have a
lot of real experience with cl programming, so i have many doubts
about design and style.

I ll try to change it, but i ll be happy if you look at it and point
me what could be wrong.

(in-package :climacs-buffer)

;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Dynamic Abbrev
;;; Simple implementation
;;;;;;;;;;;;;;;;;;;;;;;;;

(defun previous-word (mark)
  "Return a freshly allocated sequence, that is word before the mark"
  (region-to-sequence
   (loop for i downfrom (1- (offset mark))
      until (zerop i)
      while (constituentp (buffer-object (buffer mark) (1- i)))
      finally (return i))
   mark))

(defun buffer-search-word-backward (buffer offset word &key (test #'eql))
  "return the largest offset of BUFFER <= (- OFFSET (length WORD))
containing WORD as a word or NIL if no such offset exists"
  (loop for i downfrom (- offset (length word)) to 0
	when (and (or (zerop i) (whitespacep (buffer-object buffer (1- i))))
	      (buffer-looking-at buffer i word :test test))
	  return i
	finally (return nil)))

(let ((last-match-off nil)
      (matches nil)
      (cur-search nil))
  (defun dabbrev-expand (mark)
    "Expand word, dynamically. Expands to the most recent,
preceding word for which it is a prefix. Move mark and insert text."
    (flet ((sequence-equal (s1 s2)
	     (not (mismatch s1 s2))))
      (let ((word (previous-word mark))
	    (buffer (buffer mark)))
	(unless (and last-match-off    ;; restart search
		     (member word matches :test #'sequence-equal)
		     (search cur-search word)
		     (zerop (search cur-search word)))
	  (setf cur-search word 
		matches nil
		last-match-off (offset mark)))
	(backward-delete-word mark)
	(let* ((new-match-off (buffer-search-word-backward
			       buffer last-match-off cur-search :test #'eql))
	       (new-match
		(if new-match-off
		    (buffer-sequence buffer new-match-off 
				     (loop for i 
					upfrom new-match-off
					while (constituentp 
					       (buffer-object buffer i))
					finally (return i)))
		    cur-search)))
	  (setf last-match-off new-match-off)
	  (insert-sequence mark new-match)
	  (if (and new-match-off
		   (member new-match matches :test #'sequence-equal))
	      (dabbrev-expand mark)
	      (pushnew new-match matches :test #'sequence-equal)))))))

(in-package :climacs-gui)

(define-named-command com-dabbrev-expand ()
  (dabbrev-expand (point (win *application-frame*))))

(global-set-key '(#\/ :meta) 'com-dabbrev-expand)


-- 
Luigi Panzeri