Function: url-truncate-url-for-viewing

url-truncate-url-for-viewing is an autoloaded and byte-compiled function defined in url-util.el.gz.

Signature

(url-truncate-url-for-viewing URL &optional WIDTH)

Documentation

Return a shortened version of URL that is WIDTH characters wide or less.

WIDTH defaults to the current frame width.

Source Code

;; Defined in /usr/src/emacs/lisp/url/url-util.el.gz
;;;###autoload
(defun url-truncate-url-for-viewing (url &optional width)
  "Return a shortened version of URL that is WIDTH characters wide or less.
WIDTH defaults to the current frame width."
  (let* ((fr-width (or width (frame-width)))
	 (str-width (length url))
	 (fname nil)
	 (modified 0)
	 (urlobj nil))
    ;; The first thing that can go are the search strings
    (if (and (>= str-width fr-width)
	     (string-match "\\?" url))
	(setq url (concat (substring url 0 (match-beginning 0)) "?...")
	      str-width (length url)))
    (if (< str-width fr-width)
	nil				; Hey, we are done!
      (setq urlobj (url-generic-parse-url url)
	    fname (url-filename urlobj)
	    fr-width (- fr-width 4))
      (while (and (>= str-width fr-width)
		  (string-match "/" fname))
	(setq fname (substring fname (match-end 0) nil)
	      modified (1+ modified))
	(setf (url-filename urlobj) fname)
	(setq url (url-recreate-url urlobj)
	      str-width (length url)))
      (if (> modified 1)
	  (setq fname (concat "/.../" fname))
	(setq fname (concat "/" fname)))
      (setf (url-filename urlobj) fname)
      (setq url (url-recreate-url urlobj)))
    url))