Mercurial > hg > xemacs-beta
comparison lisp/subr.el @ 851:e7ee5f8bde58
[xemacs-hg @ 2002-05-23 11:46:08 by ben]
fix for raymond toy's crash, alloca crashes, some recover-session improvements
files.el: Recover-session improvements: Only show session files where some
files can actually be recovered, and show in chronological order.
subr.el, menubar-items.el: As promised to rms, the functionality in
truncate-string-with-continuation-dots has been merged into
truncate-string-to-width. Change callers in menubar-items.el.
select.el: Document some of these funs better. Fix problem where we were
doing own-clipboard twice.
Makefile.in.in: Add alloca.o. Ensure that alloca.s doesn't compile into alloca.o,
but allocax.o (not that it's currently used or anything.)
EmacsFrame.c, abbrev.c, alloc.c, alloca.c, callint.c, callproc.c, config.h.in, device-msw.c, device-x.c, dired.c, doc.c, editfns.c, emacs.c, emodules.c, eval.c, event-Xt.c, event-msw.c, event-stream.c, file-coding.c, fileio.c, filelock.c, fns.c, glyphs-gtk.c, glyphs-msw.c, glyphs-x.c, gui-x.c, input-method-xlib.c, intl-win32.c, lisp.h, lread.c, menubar-gtk.c, menubar-msw.c, menubar.c, mule-wnnfns.c, nt.c, objects-msw.c, process-nt.c, realpath.c, redisplay-gtk.c, redisplay-output.c, redisplay-x.c, redisplay.c, search.c, select-msw.c, sysdep.c, syswindows.h, text.c, text.h, ui-byhand.c: Fix Raymond Toy's crash. Repeat to self: 2^21 - 1 is NOT the
same as (2 << 21) - 1.
Fix crashes due to excessive alloca(). replace alloca() with
ALLOCA(), which calls the C alloca() [which uses xmalloc()]
when the size is too big. Insert in various places calls to
try to flush the C alloca() stored info if there is any.
Add MALLOC_OR_ALLOCA(), for places that expect to be alloca()ing
large blocks. This xmalloc()s when too large and records an
unwind-protect to free -- relying on the caller to unbind_to()
elsewhere in the function. Use it in concat().
Use MALLOC instead of ALLOCA in select-msw.c.
xemacs.mak: Add alloca.o.
author | ben |
---|---|
date | Thu, 23 May 2002 11:46:46 +0000 |
parents | a634e3b7acc8 |
children | 79c6ff3eef26 |
comparison
equal
deleted
inserted
replaced
850:f915ad7befaf | 851:e7ee5f8bde58 |
---|---|
578 (while (and (< i len) (< idx string-len)) | 578 (while (and (< i len) (< idx string-len)) |
579 (aset string idx (aref str i)) | 579 (aset string idx (aref str i)) |
580 (setq idx (1+ idx) i (1+ i))) | 580 (setq idx (1+ idx) i (1+ i))) |
581 string)) | 581 string)) |
582 | 582 |
583 ;; From FSF 21.1 | 583 ;; From FSF 21.1; ELLIPSES is XEmacs addition. |
584 (defun truncate-string-to-width (str end-column &optional start-column padding) | 584 |
585 (defun truncate-string-to-width (str end-column &optional start-column padding | |
586 ellipses) | |
585 "Truncate string STR to end at column END-COLUMN. | 587 "Truncate string STR to end at column END-COLUMN. |
586 The optional 3rd arg START-COLUMN, if non-nil, specifies | 588 The optional 3rd arg START-COLUMN, if non-nil, specifies |
587 the starting column; that means to return the characters occupying | 589 the starting column; that means to return the characters occupying |
588 columns START-COLUMN ... END-COLUMN of STR. | 590 columns START-COLUMN ... END-COLUMN of STR. |
589 | 591 |
592 or if END-COLUMN comes in the middle of a character in STR. | 594 or if END-COLUMN comes in the middle of a character in STR. |
593 PADDING is also added at the beginning of the result | 595 PADDING is also added at the beginning of the result |
594 if column START-COLUMN appears in the middle of a character in STR. | 596 if column START-COLUMN appears in the middle of a character in STR. |
595 | 597 |
596 If PADDING is nil, no padding is added in these cases, so | 598 If PADDING is nil, no padding is added in these cases, so |
597 the resulting string may be narrower than END-COLUMN." | 599 the resulting string may be narrower than END-COLUMN. |
600 | |
601 BUG: Currently assumes that the padding character is of width one. You | |
602 will get weird results if not. | |
603 | |
604 If ELLIPSES is non-nil, add ellipses (specified by ELLIPSES if a string, | |
605 else `...') if STR extends past END-COLUMN. The ellipses will be added in | |
606 such a way that the total string occupies no more than END-COLUMN columns | |
607 -- i.e. if the string goes past END-COLUMN, it will be truncated somewhere | |
608 short of END-COLUMN so that, with the ellipses added (and padding, if the | |
609 proper place to truncate the string would be in the middle of a character), | |
610 the string occupies exactly END-COLUMN columns." | |
598 (or start-column | 611 (or start-column |
599 (setq start-column 0)) | 612 (setq start-column 0)) |
600 (let ((len (length str)) | 613 (let ((len (length str)) |
601 (idx 0) | 614 (idx 0) |
602 (column 0) | 615 (column 0) |
603 (head-padding "") (tail-padding "") | 616 (head-padding "") (tail-padding "") |
604 ch last-column last-idx from-idx) | 617 ch last-column last-idx from-idx) |
618 | |
619 ;; find the index of START-COLUMN; bail out if end of string reached. | |
605 (condition-case nil | 620 (condition-case nil |
606 (while (< column start-column) | 621 (while (< column start-column) |
607 (setq ch (aref str idx) | 622 (setq ch (aref str idx) |
608 column (+ column (char-width ch)) | 623 column (+ column (char-width ch)) |
609 idx (1+ idx))) | 624 idx (1+ idx))) |
610 (args-out-of-range (setq idx len))) | 625 (args-out-of-range (setq idx len))) |
611 (if (< column start-column) | 626 (if (< column start-column) |
612 (if padding (make-string end-column padding) "") | 627 ;; if string ends before START-COLUMN, return either a blank string |
628 ;; or a string entirely padded. | |
629 (if padding (make-string (- end-column start-column) padding) "") | |
613 (if (and padding (> column start-column)) | 630 (if (and padding (> column start-column)) |
614 (setq head-padding (make-string (- column start-column) padding))) | 631 (setq head-padding (make-string (- column start-column) padding))) |
615 (setq from-idx idx) | 632 (setq from-idx idx) |
633 ;; If END-COLUMN is before START-COLUMN, then bail out. | |
616 (if (< end-column column) | 634 (if (< end-column column) |
617 (setq idx from-idx) | 635 (setq idx from-idx ellipses "") |
636 | |
637 ;; handle ELLIPSES | |
638 (cond ((null ellipses) (setq ellipses "")) | |
639 ((if (<= (string-width str) end-column) | |
640 ;; string fits, no ellipses | |
641 (setq ellipses ""))) | |
642 (t | |
643 ;; else, insert default value and ... | |
644 (or (stringp ellipses) (setq ellipses "...")) | |
645 ;; ... take away the width of the ellipses from the | |
646 ;; destination. do all computations with new, shorter | |
647 ;; width. the padding computed will get us exactly up to | |
648 ;; the shorted width, which is right -- it just gets added | |
649 ;; to the right of the ellipses. | |
650 (setq end-column (- end-column (string-width ellipses))))) | |
651 | |
652 ;; find the index of END-COLUMN; bail out if end of string reached. | |
618 (condition-case nil | 653 (condition-case nil |
619 (while (< column end-column) | 654 (while (< column end-column) |
620 (setq last-column column | 655 (setq last-column column |
621 last-idx idx | 656 last-idx idx |
622 ch (aref str idx) | 657 ch (aref str idx) |
623 column (+ column (char-width ch)) | 658 column (+ column (char-width ch)) |
624 idx (1+ idx))) | 659 idx (1+ idx))) |
625 (args-out-of-range (setq idx len))) | 660 (args-out-of-range (setq idx len))) |
661 ;; if we went too far (stopped in middle of character), back up. | |
626 (if (> column end-column) | 662 (if (> column end-column) |
627 (setq column last-column idx last-idx)) | 663 (setq column last-column idx last-idx)) |
664 ;; compute remaining padding | |
628 (if (and padding (< column end-column)) | 665 (if (and padding (< column end-column)) |
629 (setq tail-padding (make-string (- end-column column) padding)))) | 666 (setq tail-padding (make-string (- end-column column) padding)))) |
667 ;; get substring ... | |
630 (setq str (substring str from-idx idx)) | 668 (setq str (substring str from-idx idx)) |
669 ;; and construct result | |
631 (if padding | 670 (if padding |
632 (concat head-padding str tail-padding) | 671 (concat head-padding str tail-padding ellipses) |
633 str)))) | 672 (concat str ellipses))))) |
634 | |
635 (defun truncate-string-with-continuation-dots (str end-column &optional | |
636 dots-str) | |
637 "Truncate string STR to end at column END-COLUMN, adding dots if needed. | |
638 The dots (normally `...', but can be controlled by DOTS-STR)' will be added | |
639 in such a way that the total string occupies no more than END-COLUMN | |
640 columns -- i.e. if the string goes past END-COLUMN, it will be truncated | |
641 somewhere short of END-COLUMN so that, with the dots added, the string | |
642 occupies END-COLUMN columns." | |
643 (if (<= (string-width str) end-column) str | |
644 (let* ((dots-str (or dots-str "...")) | |
645 (dotswidth (string-width dots-str))) | |
646 (concat (truncate-string-to-width str (- end-column dotswidth)) | |
647 dots-str)))) | |
648 | 673 |
649 | 674 |
650 ;; alist/plist functions | 675 ;; alist/plist functions |
651 (defun plist-to-alist (plist) | 676 (defun plist-to-alist (plist) |
652 "Convert property list PLIST into the equivalent association-list form. | 677 "Convert property list PLIST into the equivalent association-list form. |