Return to ring.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi

Annotation of 43BSDReno/contrib/emacs-18.55/dist-1.3/fi/ring.el, revision 1.1

1.1     ! root        1: ;;
        !             2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca.
        !             3: ;;
        !             4: ;; The software, data and information contained herein are the property 
        !             5: ;; of Franz, Inc.  
        !             6: ;;
        !             7: ;; This file (or any derivation of it) may be distributed without 
        !             8: ;; further permission from Franz Inc. as long as:
        !             9: ;;
        !            10: ;;     * it is not part of a product for sale,
        !            11: ;;     * no charge is made for the distribution, other than a tape
        !            12: ;;       fee, and
        !            13: ;;     * all copyright notices and this notice are preserved.
        !            14: ;;
        !            15: ;; If you have any comments or questions on this interface, please feel
        !            16: ;; free to contact Franz Inc. at
        !            17: ;;     Franz Inc.
        !            18: ;;     Attn: Kevin Layer
        !            19: ;;     1995 University Ave
        !            20: ;;     Suite 275
        !            21: ;;     Berkeley, CA 94704
        !            22: ;;     (415) 548-3600
        !            23: ;; or
        !            24: ;;     emacs-info%[email protected]
        !            25: ;;     ucbvax!franz!emacs-info
        !            26: ;;
        !            27: 
        !            28: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
        !            29: ;;
        !            30: ;; This file is derived from part of GNU Emacs.
        !            31: ;;
        !            32: ;; GNU Emacs is distributed in the hope that it will be useful,
        !            33: ;; but WITHOUT ANY WARRANTY.  No author or distributor
        !            34: ;; accepts responsibility to anyone for the consequences of using it
        !            35: ;; or for whether it serves any particular purpose or works at all,
        !            36: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
        !            37: ;; License for full details.
        !            38: ;;
        !            39: ;; Everyone is granted permission to copy, modify and redistribute
        !            40: ;; GNU Emacs, but only under the conditions described in the
        !            41: ;; GNU Emacs General Public License.   A copy of this license is
        !            42: ;; supposed to have been given to you along with GNU Emacs so you
        !            43: ;; can know your rights and responsibilities.  It should be in a
        !            44: ;; file named COPYING.  Among other things, the copyright notice
        !            45: ;; and this notice must be preserved on all copies.
        !            46: 
        !            47: ;; $Header: ring.el,v 1.8 88/07/15 18:32:33 layer Exp $
        !            48: 
        !            49: ;; This code is very similar to the kill-ring implementation
        !            50: ;; and implements the fi::subprocess input ring.  Each fi::subprocess buffer
        !            51: ;; has its own input ring.
        !            52: 
        !            53: (defvar fi:default-input-ring-max 50
        !            54:   "*The default maximum length to which an input ring is allowed to grow.")
        !            55: 
        !            56: (defvar fi::input-ring nil
        !            57:   "A list of previous input to a subprocess.")
        !            58: 
        !            59: (defvar fi::input-ring-max fi:default-input-ring-max
        !            60:   "Maximum length of input ring before oldest elements are thrown away.")
        !            61: 
        !            62: (defvar fi::input-ring-yank-pointer nil
        !            63:   "The tail of the input ring whose car is the last thing yanked.")
        !            64: 
        !            65: (defvar fi::last-input-search-string ""
        !            66:   "Last input search string in each fi::subprocess buffer.")
        !            67: 
        !            68: (defvar fi::last-command-was-successful-search nil
        !            69:   "Switch to indicate that last command was a successful input re-search.")
        !            70: 
        !            71: (defun fi::input-append (string before-p)
        !            72:   (setq fi::last-command-was-successful-search nil)
        !            73:   (setcar fi::input-ring
        !            74:          (if before-p
        !            75:              (concat string (car fi::input-ring))
        !            76:              (concat (car fi::input-ring) string))))
        !            77: 
        !            78: (defun fi::input-region (beg end)
        !            79:   "Delete text between point and mark and save in input ring.
        !            80: This is the primitive for programs to kill text into the input ring.
        !            81: Supply two arguments, character numbers indicating the stretch of text to
        !            82: be killed.  If the previous command was also a kill command, the text
        !            83: killed this time appends to the text killed last time to make one entry in
        !            84: the subprocess input ring." 
        !            85:   (interactive "*r")
        !            86:   (setq fi::last-command-was-successful-search nil)
        !            87:   (fi::input-ring-save beg end)
        !            88:   (delete-region beg end))
        !            89: 
        !            90: (defun fi::input-ring-save (beg end)
        !            91:   "Save the region on the subprocess input ring but don't kill it."
        !            92:   (interactive "r")
        !            93:   (setq fi::last-command-was-successful-search nil)
        !            94:   (if (eq last-command 'fi::input-region)
        !            95:       (fi::input-append (buffer-substring beg end) (< end beg))
        !            96:     (setq fi::input-ring (cons (buffer-substring beg end) fi::input-ring))
        !            97:     (if (> (length fi::input-ring) fi::input-ring-max)
        !            98:        (setcdr (nthcdr (1- fi::input-ring-max) fi::input-ring) nil)))
        !            99:   (setq this-command 'fi::input-region)
        !           100:   (setq fi::input-ring-yank-pointer fi::input-ring))
        !           101: 
        !           102: (defun fi::rotate-yank-input-pointer (arg)
        !           103:   "Rotate the yanking point in the fi::subprocess input ring."
        !           104:   (interactive "p")
        !           105:   (setq fi::last-command-was-successful-search nil)
        !           106:   (let ((ring-length (length fi::input-ring))
        !           107:        (yank-ring-length (length fi::input-ring-yank-pointer)))
        !           108:     (cond
        !           109:      ((zerop ring-length)
        !           110:       (error "Fi::subprocess input ring is empty."))
        !           111:      ((< arg 0)
        !           112:       (setq arg (- ring-length (% (- arg) ring-length)))
        !           113:       (setq fi::input-ring-yank-pointer
        !           114:            (nthcdr (% (+ arg (- ring-length yank-ring-length)) ring-length)
        !           115:                    fi::input-ring)))
        !           116:      (t
        !           117:       (setq fi::input-ring-yank-pointer
        !           118:            (nthcdr (% (+ arg (- ring-length yank-ring-length)) ring-length)
        !           119:                    fi::input-ring))))))
        !           120: 
        !           121: (defun fi:pop-input (&optional arg)
        !           122:   "Yank previous text from input ring.  Cycle through input ring with each
        !           123: successive invocation."
        !           124:   (interactive "*p")
        !           125:   (setq fi::last-command-was-successful-search nil)
        !           126:   (if (not (memq last-command '(fi::yank-input
        !           127:                                fi:re-search-backward-input
        !           128:                                fi:re-search-forward-input)))
        !           129:       (progn
        !           130:        (fi::yank-input arg)
        !           131:        (setq this-command 'fi::yank-input))
        !           132:       (progn
        !           133:        (setq this-command 'fi::yank-input)
        !           134:        (let ((before (< (point) (mark))))
        !           135:             (delete-region (point) (mark))
        !           136:             (fi::rotate-yank-input-pointer arg)
        !           137:             (set-mark (point))
        !           138:             (insert (car fi::input-ring-yank-pointer))
        !           139:             (if before (exchange-point-and-mark))))))
        !           140: 
        !           141: (defun fi:push-input (&optional arg)
        !           142:   "Yank next text from input ring.  Cycle through input ring in reverse
        !           143: order with each successive invocation."
        !           144:   (interactive "*p")
        !           145:   (setq fi::last-command-was-successful-search nil)
        !           146:   (if (not (memq last-command '(fi::yank-input
        !           147:                                fi:re-search-backward-input
        !           148:                                fi:re-search-forward-input)))
        !           149:       (progn
        !           150:        (fi::yank-input (- (1- arg)))
        !           151:        (setq this-command 'fi::yank-input))
        !           152:       (progn
        !           153:        (setq this-command 'fi::yank-input)
        !           154:        (let ((before (< (point) (mark))))
        !           155:             (delete-region (point) (mark))
        !           156:             (fi::rotate-yank-input-pointer (- arg))
        !           157:             (set-mark (point))
        !           158:             (insert (car fi::input-ring-yank-pointer))
        !           159:             (if before (exchange-point-and-mark))))))
        !           160: 
        !           161: (defun fi::yank-input (&optional arg)
        !           162:   "Reinsert the last fi::subprocess input text.
        !           163: More precisely, reinsert the input text most recently killed OR yanked.
        !           164: With just C-U as argument, same but put point in front (and mark at end).
        !           165: With argument n, reinsert the nth most recent input text.
        !           166: See also the command fi::yank-input-pop."
        !           167:   (interactive "*P")
        !           168:   (setq fi::last-command-was-successful-search nil)
        !           169:   (fi::rotate-yank-input-pointer (if (listp arg) 0
        !           170:                                 (if (eq arg '-) -1
        !           171:                                     (1- arg))))
        !           172:   (set-mark (point))
        !           173:   (insert (car fi::input-ring-yank-pointer))
        !           174:   (if (consp arg)
        !           175:       (exchange-point-and-mark)))
        !           176: 
        !           177: (defun fi:list-input-ring (arg &optional reflect)
        !           178:   "Display contents of input ring, starting at arg.  The list is displayed
        !           179: in reverse order if called from a program and the optional second parameter
        !           180: is non-nil."
        !           181:   (interactive "p")
        !           182:   (let* ((input-ring-for-list fi::input-ring)
        !           183:         (input-ring-max-for-list fi::input-ring-max)
        !           184:         (input-ring-yank-pointer-for-list fi::input-ring-yank-pointer)
        !           185:         (ring-length (length fi::input-ring))
        !           186:         (yank-ring-length (length fi::input-ring-yank-pointer))
        !           187:         (loops ring-length)
        !           188:         nth
        !           189:         first
        !           190:         count)
        !           191:        (if (zerop ring-length) (error "Input ring is empty."))
        !           192:        ;; We rely on (error) to exit from this function. [HW]
        !           193:        (if reflect
        !           194:          (if (= arg 1)
        !           195:            (setq arg -1)
        !           196:            (setq arg (1- arg))))
        !           197:        (cond
        !           198:         ((< arg 0)
        !           199:          (setq arg (- ring-length (% (- arg) ring-length)))
        !           200:          (setq count (1+ arg))
        !           201:          (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length)))
        !           202:         ((= arg 0)
        !           203:          (setq count 1)
        !           204:          (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length)))
        !           205:         (t
        !           206:          (setq count arg)
        !           207:          (setq arg (1- arg))
        !           208:          (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length))))
        !           209:        (setq first nth)
        !           210:        (with-output-to-temp-buffer
        !           211:          "*Input Ring*"
        !           212:          (save-excursion
        !           213:            (set-buffer standard-output)
        !           214:            (let ((lastcdr (nthcdr nth input-ring-for-list)))
        !           215:                 ; GNU Emacs really needs better looping constructs. [HW]
        !           216:                 (while
        !           217:                   (not (cond
        !           218:                         ((= loops 0)
        !           219:                          t)
        !           220:                         ((and (= nth (1- ring-length)) (not reflect))
        !           221:                          (setq nth 0)
        !           222:                          nil)
        !           223:                         ((and (= nth 0) reflect)
        !           224:                          (setq nth (1- ring-length))
        !           225:                          nil)
        !           226:                         (t
        !           227:                          (setq nth (if reflect (1- nth) (1+ nth)))
        !           228:                          nil)))
        !           229:                   (insert (int-to-string count) " " (car lastcdr) "\n")
        !           230:                   (setq lastcdr (nthcdr nth input-ring-for-list))
        !           231:                   (setq count (if reflect (1- count) (1+ count)))
        !           232:                   (setq loops (1- loops))
        !           233:                   (cond
        !           234:                    ((> count ring-length)
        !           235:                     (setq count 1))
        !           236:                    ((< count 1)
        !           237:                     (setq count ring-length)))))))))
        !           238: 
        !           239: (defun fi::re-search-input-ring (regexp direction)
        !           240:   "Look for input text that contains string regexp.
        !           241: Set fi::input-ring-yank-pointer to text."
        !           242:   (let* ((ring-length (length fi::input-ring))
        !           243:         (yank-ring-length (length fi::input-ring-yank-pointer))
        !           244:         (nth (- ring-length yank-ring-length))
        !           245:         (loops ring-length)
        !           246:         (return-value nil)
        !           247:         (lastcdr (nthcdr nth fi::input-ring)))
        !           248:     (if (zerop ring-length) (error "Input ring is empty."))
        !           249:     ;; We rely on (error) to exit from this function. [HW]
        !           250:     (while
        !           251:       (not
        !           252:        (cond
        !           253:        ((= loops 0)
        !           254:         t)
        !           255:        ((string-match regexp (car lastcdr) nil)
        !           256:         (setq fi::input-ring-yank-pointer lastcdr)
        !           257:         (setq return-value t))
        !           258:        ((and (= nth (1- ring-length)) (>= direction 0))
        !           259:         (setq nth 0)
        !           260:         nil)
        !           261:        ((and (= nth 0) (< direction 0))
        !           262:         (setq nth (1- ring-length))
        !           263:         nil)
        !           264:        (t
        !           265:         (setq nth (if (< direction 0) (1- nth) (1+ nth)))
        !           266:         nil)))
        !           267:       (setq lastcdr (nthcdr nth fi::input-ring))
        !           268:       (setq loops (1- loops)))
        !           269:     (if return-value (setq fi::last-input-search-string regexp))
        !           270:     return-value))
        !           271: 
        !           272: (defun fi:re-search-backward-input (arg regexp)
        !           273:   "Search in input ring for text that contains regexp and yank."
        !           274:   (interactive "*p\nsRE search input backward: ")
        !           275:   (if (string= regexp "") (setq regexp fi::last-input-search-string))
        !           276:   (if fi::last-command-was-successful-search
        !           277:       (fi::rotate-yank-input-pointer 1))
        !           278:   (setq fi::last-command-was-successful-search nil)
        !           279:   (if (let ((found t))
        !           280:           (while (and (> arg 0) found)
        !           281:                  (setq found (fi::re-search-input-ring regexp 1))
        !           282:                  (setq arg (1- arg))
        !           283:                  (if (and (> arg 0) found)
        !           284:                      (fi::rotate-yank-input-pointer 1)))
        !           285:           found)
        !           286:       (progn
        !           287:        (fi::yank-input-at-pointer)
        !           288:        (setq this-command 'fi:re-search-backward-input)
        !           289:        (setq fi::last-command-was-successful-search t))
        !           290:       (message "Matching string not found in input ring.")))
        !           291: 
        !           292: (defun fi:re-search-forward-input (arg regexp)
        !           293:   "Search in input ring for text that contains regexp and yank."
        !           294:   (interactive "*p\nsRE search input forward: ")
        !           295:   (if fi::last-command-was-successful-search
        !           296:       (fi::rotate-yank-input-pointer -1))
        !           297:   (setq fi::last-command-was-successful-search nil)
        !           298:   (if (string= regexp "") (setq regexp fi::last-input-search-string))
        !           299:   (if (let ((found t))
        !           300:           (while (and (> arg 0) found)
        !           301:                  (setq found (fi::re-search-input-ring regexp -1))
        !           302:                  (setq arg (1- arg))
        !           303:                  (if (and (> arg 0) found)
        !           304:                      (fi::rotate-yank-input-pointer -1)))
        !           305:           found)
        !           306:       (progn
        !           307:        (fi::yank-input-at-pointer)
        !           308:        (setq this-command 'fi:re-search-backward-input)
        !           309:        (setq fi::last-command-was-successful-search t))
        !           310:       (message "Matching string not found in input ring.")))
        !           311: 
        !           312: (defun fi::yank-input-at-pointer ()
        !           313:   "Yank input at current input ring pointer.
        !           314: Used internally by fi:re-search-backward-input and fi:re-search-forward-input."
        !           315:   ;; This business of last-command does not work here since the
        !           316:   ;; `last command' was self-insert-command because of the prompt
        !           317:   ;; for a regular expression by (fi:re-search-forward-input) and
        !           318:   ;; (fi:re-search-backward-input).
        !           319:   (delete-region (process-mark (get-buffer-process (current-buffer))) (point))
        !           320:   (set-mark (point))
        !           321:   (insert (car fi::input-ring-yank-pointer)))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.