mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-29 19:48:19 +00:00
Code Issues Releases Activity

Fix ring extension code in ring.el, and tweak comint-input-ring handling.

Browse Source 
* lisp/emacs-lisp/ring.el (ring-extend): New function.
(ring-insert+extend): Extend the ring correctly.

* lisp/comint.el (comint-read-input-ring)
(comint-add-to-input-history): Grow comint-input-ring lazily.

Fixes: debbugs:11019
This commit is contained in:
Chong Yidong 2012-03-15 16:00:43 +08:00
parent 663b16775f
commit 3f2eafd1fb
3 changed files with 57 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lisp/ChangeLog
View File

@ -1,3 +1,11 @@
2012-03-15 Chong Yidong <cyd@gnu.org>
* emacs-lisp/ring.el (ring-extend): New function.
(ring-insert+extend): Extend the ring correctly (Bug#11019).
* comint.el (comint-read-input-ring)
(comint-add-to-input-history): Grow comint-input-ring lazily.
2012-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/perl-mode.el (perl-syntax-propertize-special-constructs):

49
lisp/comint.el
View File

@ -922,15 +922,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(t
(let* ((file comint-input-ring-file-name)
(count 0)
(size comint-input-ring-size)
(ring (make-ring size)))
;; Some users set HISTSIZE or `comint-input-ring-size'
;; to huge numbers. Don't allocate a huge ring right
;; away; there might not be that much history.
(ring-size (min 1500 comint-input-ring-size))
(ring (make-ring ring-size)))
(with-temp-buffer
(insert-file-contents file)
;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(let (start end history)
(while (and (< count size)
(while (and (< count comint-input-ring-size)
(re-search-backward comint-input-ring-separator
nil t)
(setq end (match-beginning 0)))
@ -941,15 +944,18 @@ See also `comint-input-ignoredups' and `comint-write-input-ring'."
(point-min)))
(setq history (buffer-substring start end))
(goto-char start)
(if (and (not (string-match comint-input-history-ignore
history))
(or (null comint-input-ignoredups)
(ring-empty-p ring)
(not (string-equal (ring-ref ring 0)
history))))
(progn
(ring-insert-at-beginning ring history)
(setq count (1+ count)))))))
(when (and (not (string-match comint-input-history-ignore
history))
(or (null comint-input-ignoredups)
(ring-empty-p ring)
(not (string-equal (ring-ref ring 0)
history))))
(when (= count ring-size)
(ring-extend ring (min (- comint-input-ring-size ring-size)
ring-size))
(setq ring-size (ring-size ring)))
(ring-insert-at-beginning ring history)
(setq count (1+ count))))))
(setq comint-input-ring ring
comint-input-ring-index nil)))))
@ -1691,13 +1697,18 @@ Argument 0 is the command name."
(defun comint-add-to-input-history (cmd)
"Add CMD to the input history.
Ignore duplicates if `comint-input-ignoredups' is non-nil."
(if (and (funcall comint-input-filter cmd)
(or (null comint-input-ignoredups)
(not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring)
(not (string-equal (ring-ref comint-input-ring 0)
cmd))))
(ring-insert comint-input-ring cmd)))
(when (and (funcall comint-input-filter cmd)
(or (null comint-input-ignoredups)
(not (ring-p comint-input-ring))
(ring-empty-p comint-input-ring)
(not (string-equal (ring-ref comint-input-ring 0) cmd))))
;; If `comint-input-ring' is full, maybe grow it.
(let ((size (ring-size comint-input-ring)))
(and (= size (ring-length comint-input-ring))
(< size comint-input-ring-size)
(ring-extend comint-input-ring
(min size (- comint-input-ring-size size)))))
(ring-insert comint-input-ring cmd)))
(defun comint-send-input (&optional no-newline artificial)
"Send input to process.

33
lisp/emacs-lisp/ring.el
View File

@ -185,26 +185,31 @@ Raise error if ITEM is not in the RING."
(unless curr-index (error "Item is not in the ring: `%s'" item))
(ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
(defun ring-extend (ring x)
"Increase the size of RING by X."
(when (and (integerp x) (> x 0))
(let* ((hd (car ring))
(length (ring-length ring))
(size (ring-size ring))
(old-vec (cddr ring))
(new-vec (make-vector (+ size x) nil)))
(setcdr ring (cons length new-vec))
;; If the ring is wrapped, the existing elements must be written
;; out in the right order.
(dotimes (j length)
(aset new-vec j (aref old-vec (mod (+ hd j) size))))
(setcar ring 0))))
(defun ring-insert+extend (ring item &optional grow-p)
"Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
Insert onto ring RING the item ITEM, as the newest (last) item.
If the ring is full, behavior depends on GROW-P:
If GROW-P is non-nil, enlarge the ring to accommodate the new item.
If GROW-P is nil, dump the oldest item to make room for the new."
(let* ((vec (cddr ring))
(veclen (length vec))
(hd (car ring))
(ringlen (ring-length ring)))
(prog1
(cond ((and grow-p (= ringlen veclen)) ; Full ring. Enlarge it.
(setq veclen (1+ veclen))
(setcdr ring (cons (setq ringlen (1+ ringlen))
(setq vec (vconcat vec (vector item)))))
(setcar ring hd))
(t (aset vec (mod (+ hd ringlen) veclen) item)))
(if (= ringlen veclen)
(setcar ring (ring-plus1 hd veclen))
(setcar (cdr ring) (1+ ringlen))))))
(and grow-p
(= (ring-length ring) (ring-size ring))
(ring-extend ring 1))
(ring-insert ring item))
(defun ring-remove+insert+extend (ring item &optional grow-p)
"`ring-remove' ITEM from RING, then `ring-insert+extend' it.