home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / multi-line.el < prev    next >
Encoding:
Text File  |  1990-07-22  |  3.4 KB  |  102 lines
  1. ;From ark1!uakari.primate.wisc.edu!brutus.cs.uiuc.edu!caesar.cs.montana.edu!ogicse!ucsd!ucsdhub!hp-sdd!hplabs!hpfcso!jka Fri Dec 15 12:39:47 1989
  2. ;Article 1067 of comp.emacs:
  3. ;Path: ark1!uakari.primate.wisc.edu!brutus.cs.uiuc.edu!caesar.cs.montana.edu!ogicse!ucsd!ucsdhub!hp-sdd!hplabs!hpfcso!jka
  4. ;>From jka@hpfcso.HP.COM (Jay Adams)
  5. ;Newsgroups: comp.emacs
  6. ;Subject: Re: Grow and shrink minibuffer window as minibuffer grows and shrinks
  7. ;Message-ID: <8970006@hpfcso.HP.COM>
  8. ;Date: 14 Dec 89 18:06:47 GMT
  9. ;References: <8912140405.AA00554@moose.crd.Ge.Com>
  10. ;Organization: Hewlett-Packard, Fort Collins, CO, USA
  11. ;Lines: 87
  12. ;
  13. ;
  14. ;As it turns out, I was working along similar lines not too long ago.
  15. ;Here is what I came up with.  multi-line-message and
  16. ;multi-line-read-from-minibuffer could be replacements for the standard
  17. ;emacs functions message and read-from-minibuffer.
  18. ;multi-line-read-from-minibuffer, however, uses recursive-edit to read
  19. ;the input string.  The real read-from-minibuffer does some kind of
  20. ;magic to read the input string.  
  21. ;
  22. ;This code is not copyrighted in any way so feel free to mass-produce
  23. ;it, claim it as your own work, sell it for some exorbitant price, and
  24. ;make a small fortune.
  25. ;
  26. ;- Jay
  27.  
  28.  
  29. (defun multi-line-message (string)
  30.   "Sort of like message 'cept STRING can be many lines."
  31.   (let ((index 0)
  32.     (lines (lines-in-string string)))
  33.     (if (= lines 1)
  34.     (message str)
  35.       (let (start
  36.         end
  37.         (old-window (selected-window)))
  38.     (unwind-protect
  39.         (progn
  40.           (select-window (minibuffer-window))
  41.           (enlarge-window (1- lines))
  42.           (setq start (point))
  43.           (insert string)
  44.           (setq end (point))
  45.           (select-window old-window)
  46.           (sit-for 33554431))
  47.       (select-window (minibuffer-window))
  48.       (enlarge-window (- 1 lines))
  49.       (delete-region start end)
  50.       (select-window old-window))))))
  51.  
  52. (defun lines-in-string (s width)
  53.   (let ((index 0)
  54.     (last 0)
  55.     (lines 1))
  56.     (while (string-match "\n" s index)
  57.       (if (>= (- (match-beginning 0) last) (1- width))
  58.       (setq lines (1+ lines)))
  59.       (setq lines (1+ lines)
  60.         last  index
  61.         index (match-end 0)))
  62.     (if (>= (- (length s) index) (1- width))
  63.     (setq lines (1+ lines)))
  64.     lines))
  65.  
  66. (defun multi-line-read-from-minibuffer (prompt &optional initial keymap read)
  67.   "Read a string from the minibuffer, prompting with string PROMPT.
  68. If optional second arg INITIAL-CONTENTS is non-nil, it is a string
  69.   to be inserted into the minibuffer before reading input.
  70. Third arg KEYMAP is a keymap to use whilst reading; the default is
  71.   minibuffer-local-map.
  72. If fourth arg READ is non-nil, then interpret the result as a lisp object
  73.   and return that object  (ie  (car (read-from-string <input-string>)))"
  74.   (or initial (setq initial ""))
  75.   (or keymap (setq keymap minibuffer-local-map))
  76.   (save-window-excursion
  77.     (select-window (minibuffer-window))
  78.     (let ((start (point))
  79.       input-begin
  80.       (scroll-step 1)
  81.       (lines (+ -1
  82.             (lines-in-string prompt (window-width))
  83.             (lines-in-string initial (window-width))))
  84.       result)
  85.       (unwind-protect
  86.       (progn
  87.         (enlarge-window (1- lines))
  88.         (insert "*")
  89.         (insert prompt)
  90.         (setq input-begin (point))
  91.         (insert initial)
  92.         (use-local-map keymap)
  93.         (recursive-edit)
  94.         (setq result (buffer-substring input-begin (point-max))))
  95.     (enlarge-window (- 1 lines))
  96.     (delete-region start (point-max)))
  97.       (if read
  98.       (car (read-from-string result))
  99.     result))))
  100.  
  101.  
  102.