Mercurial > hg > xemacs-beta

diff lisp/subr.el @ 851:e7ee5f8bde58

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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
line wrap: on
line diff
--- a/lisp/subr.el	Tue May 21 23:47:40 2002 +0000
+++ b/lisp/subr.el	Thu May 23 11:46:46 2002 +0000
@@ -580,8 +580,10 @@
       (setq idx (1+ idx) i (1+ i)))
     string))
 
-;; From FSF 21.1
-(defun truncate-string-to-width (str end-column &optional start-column padding)
+;; From FSF 21.1; ELLIPSES is XEmacs addition.
+
+(defun truncate-string-to-width (str end-column &optional start-column padding
+				     ellipses)
   "Truncate string STR to end at column END-COLUMN.
 The optional 3rd arg START-COLUMN, if non-nil, specifies
 the starting column; that means to return the characters occupying
@@ -594,7 +596,18 @@
 if column START-COLUMN appears in the middle of a character in STR.
 
 If PADDING is nil, no padding is added in these cases, so
-the resulting string may be narrower than END-COLUMN."
+the resulting string may be narrower than END-COLUMN.
+
+BUG: Currently assumes that the padding character is of width one.  You
+will get weird results if not.
+
+If ELLIPSES is non-nil, add ellipses (specified by ELLIPSES if a string,
+else `...') if STR extends past END-COLUMN.  The ellipses will be added in
+such a way that the total string occupies no more than END-COLUMN columns
+-- i.e. if the string goes past END-COLUMN, it will be truncated somewhere
+short of END-COLUMN so that, with the ellipses added (and padding, if the
+proper place to truncate the string would be in the middle of a character),
+the string occupies exactly END-COLUMN columns."
   (or start-column
       (setq start-column 0))
   (let ((len (length str))
@@ -602,6 +615,8 @@
 	(column 0)
 	(head-padding "") (tail-padding "")
 	ch last-column last-idx from-idx)
+
+    ;; find the index of START-COLUMN; bail out if end of string reached.
     (condition-case nil
 	(while (< column start-column)
 	  (setq ch (aref str idx)
@@ -609,12 +624,32 @@
 		idx (1+ idx)))
       (args-out-of-range (setq idx len)))
     (if (< column start-column)
-	(if padding (make-string end-column padding) "")
+	;; if string ends before START-COLUMN, return either a blank string
+	;; or a string entirely padded.
+	(if padding (make-string (- end-column start-column) padding) "")
       (if (and padding (> column start-column))
 	  (setq head-padding (make-string (- column start-column) padding)))
       (setq from-idx idx)
+      ;; If END-COLUMN is before START-COLUMN, then bail out.
       (if (< end-column column)
-	  (setq idx from-idx)
+	  (setq idx from-idx ellipses "")
+
+	;; handle ELLIPSES
+	(cond ((null ellipses) (setq ellipses ""))
+	      ((if (<= (string-width str) end-column)
+		   ;; string fits, no ellipses
+		   (setq ellipses "")))
+	      (t
+	       ;; else, insert default value and ...
+	       (or (stringp ellipses) (setq ellipses "..."))
+	       ;; ... take away the width of the ellipses from the
+	       ;; destination.  do all computations with new, shorter
+	       ;; width.  the padding computed will get us exactly up to
+	       ;; the shorted width, which is right -- it just gets added
+	       ;; to the right of the ellipses.
+	     (setq end-column (- end-column (string-width ellipses)))))
+
+	;; find the index of END-COLUMN; bail out if end of string reached.
 	(condition-case nil
 	    (while (< column end-column)
 	      (setq last-column column
@@ -623,28 +658,18 @@
 		    column (+ column (char-width ch))
 		    idx (1+ idx)))
 	  (args-out-of-range (setq idx len)))
+	;; if we went too far (stopped in middle of character), back up.
 	(if (> column end-column)
 	    (setq column last-column idx last-idx))
+	;; compute remaining padding
 	(if (and padding (< column end-column))
 	    (setq tail-padding (make-string (- end-column column) padding))))
+      ;; get substring ...
       (setq str (substring str from-idx idx))
+      ;; and construct result
       (if padding
-	  (concat head-padding str tail-padding)
-	str))))
-
-(defun truncate-string-with-continuation-dots (str end-column &optional
-						   dots-str)
-  "Truncate string STR to end at column END-COLUMN, adding dots if needed.
-The dots (normally `...', but can be controlled by DOTS-STR)' will be added
-in such a way that the total string occupies no more than END-COLUMN
-columns -- i.e. if the string goes past END-COLUMN, it will be truncated
-somewhere short of END-COLUMN so that, with the dots added, the string
-occupies END-COLUMN columns."
-  (if (<= (string-width str) end-column) str
-    (let* ((dots-str (or dots-str "..."))
-	   (dotswidth (string-width dots-str)))
-      (concat (truncate-string-to-width str (- end-column dotswidth))
-	      dots-str))))
+	  (concat head-padding str tail-padding ellipses)
+	(concat str ellipses)))))
 
 
 ;; alist/plist functions