From: Chong Yidong Date: Thu, 15 Mar 2012 08:00:43 +0000 (+0800) Subject: Fix ring extension code in ring.el, and tweak comint-input-ring handling. X-Git-Tag: emacs-pretest-24.0.05~85^2~22 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3f2eafd1fbb706a8774a61b4b633d5f4e24b9cc1;p=emacs.git Fix ring extension code in ring.el, and tweak comint-input-ring handling. * 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 --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f19d5e8ab79..427d7d87979 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2012-03-15 Chong Yidong + + * 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 * progmodes/perl-mode.el (perl-syntax-propertize-special-constructs): diff --git a/lisp/comint.el b/lisp/comint.el index 4c2229f2f83..9306bf8dbb2 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -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. diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index 4b07de523c3..cee6a43df86 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -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.