X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/dedffa6a6bdfbfe6bb1257579734bc4467ebc7bc..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/pcvs-util.el diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 06a0758348..a4eda95e23 100644 --- a/lisp/pcvs-util.el +++ b/lisp/pcvs-util.el @@ -1,11 +1,10 @@ -;;; pcvs-util.el --- Utitlity functions for pcl-cvs +;;; pcvs-util.el --- utility functions for PCL-CVS -*- byte-compile-dynamic: t -*- -;; Copyright (C) 1998-2000 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2001, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier ;; Keywords: pcl-cvs -;; Version: $Name: $ -;; Revision: $Id: pcvs-util.el,v 1.1 2000/08/05 19:33:53 gerd Exp gerd $ ;; This file is part of GNU Emacs. @@ -33,7 +32,7 @@ ;;;; ;;;; list processing -;;;l +;;;; (defsubst cvs-car (x) (if (consp x) (car x) x)) (defalias 'cvs-cdr 'cdr-safe) @@ -50,7 +49,6 @@ (let ((zs ys)) (dolist (x xs zs) (unless (member x ys) (push x zs))))) - (defun cvs-map (-cvs-map-f &rest -cvs-map-ls) (unless (cvs-every 'null -cvs-map-ls) @@ -78,14 +76,14 @@ the other elements. The ordering among elements is maintained." (if (funcall p x) (push x car) (push x cdr))) (cons (nreverse car) (nreverse cdr)))) -;;;; -;;;; frame, window, buffer handling -;;;; +;;; +;;; frame, window, buffer handling +;;; (defun cvs-pop-to-buffer-same-frame (buf) "Pop to BUF like `pop-to-buffer' but staying on the same frame. If `pop-to-buffer' would have opened a new frame, this function would -try to split the a new window instead." +try to split a new window instead." (let ((pop-up-windows (or pop-up-windows pop-up-frames)) (pop-up-frames nil)) (or (let ((buf (get-buffer-window buf))) (and buf (select-window buf))) @@ -106,8 +104,12 @@ BUF is assumed to be a temporary buffer used from the buffer MAINBUF." (condition-case () (delete-window win) (error (iconify-frame (window-frame win)))) - (if (and mainbuf (get-buffer-window mainbuf)) - (delete-window win))))) +;;; (if (and mainbuf (get-buffer-window mainbuf)) +;;; ;; FIXME: if the buffer popped into a pre-existing window, +;;; ;; we don't want to delete that window. +;;; t ;;(delete-window win) +;;; ) + ))) (with-current-buffer buf (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) (not (window-dedicated-p (selected-window)))) @@ -116,7 +118,7 @@ BUF is assumed to be a temporary buffer used from the buffer MAINBUF." (let ((mainwin (or (get-buffer-window mainbuf) (get-buffer-window mainbuf 'visible)))) (when mainwin (select-window mainwin)))))) - + (defun cvs-get-buffer-create (name &optional noreuse) "Create a buffer NAME unless such a buffer already exists. If the NAME looks like an absolute file name, the buffer will be created @@ -138,29 +140,48 @@ If NOREUSE is non-nil, always return a new buffer." ;;;; string processing ;;;; +(defun cvs-insert-strings (strings) + "Insert a list of STRINGS into the current buffer. +Uses columns to keep the listing readable but compact." + (when (consp strings) + (let* ((length (apply 'max (mapcar 'length strings))) + (wwidth (1- (window-width))) + (columns (min + ;; At least 2 columns; at least 2 spaces between columns. + (max 2 (/ wwidth (+ 2 length))) + ;; Don't allocate more columns than we can fill. + ;; Windows can't show less than 3 lines anyway. + (max 1 (/ (length strings) 2)))) + (colwidth (/ wwidth columns))) + ;; Use tab-width rather than indent-to. + (setq tab-width colwidth) + ;; The insertion should be "sensible" no matter what choices were made. + (dolist (str strings) + (unless (bolp) (insert " \t")) + (when (< wwidth (+ (max colwidth (length str)) (current-column))) + (delete-char -2) (insert "\n")) + (insert str))))) + + (defun cvs-file-to-string (file &optional oneline args) "Read the content of FILE and return it as a string. If ONELINE is t, only the first line (no \\n) will be returned. If ARGS is non-nil, the file will be executed with ARGS as its arguments. If ARGS is not a list, no argument will be passed." - (with-temp-buffer - (condition-case nil - (progn - (if args - (apply 'call-process - file nil t nil (when (listp args) args)) - (insert-file-contents file)) - (buffer-substring (point-min) - (if oneline - (progn (goto-char (point-min)) (end-of-line) (point)) - (point-max)))) - (file-error nil)))) + (condition-case nil + (with-temp-buffer + (if args + (apply 'call-process + file nil t nil (when (listp args) args)) + (insert-file-contents file)) + (goto-char (point-min)) + (buffer-substring (point) + (if oneline (line-end-position) (point-max)))) + (file-error nil))) (defun cvs-string-prefix-p (str1 str2) "Tell whether STR1 is a prefix of STR2." - (let ((length1 (length str1))) - (and (>= (length str2) length1) - (string= str1 (substring str2 0 length1))))) + (eq t (compare-strings str2 nil (length str1) str1 nil nil))) ;; (string->strings (strings->string X)) == X (defun cvs-strings->string (strings &optional separator) @@ -188,11 +209,12 @@ The SEPARATOR regexp defaults to \"\\s-+\"." (append (unless (eq i 0) (split-string (substring string 0 i) sep)) (let ((rfs (read-from-string string i))) (cons (car rfs) - (cvs-string->strings (substring string (cdr rfs)) sep))))))) + (cvs-string->strings (substring string (cdr rfs)) + sep))))))) -;;;; +;;;; ;;;; file names -;;;; +;;;; (defsubst cvs-expand-dir-name (d) (file-name-as-directory (expand-file-name d))) @@ -232,9 +254,9 @@ The SEPARATOR regexp defaults to \"\\s-+\"." initval hist-sym)) (t initval))))) -;;;; +;;;; ;;;; Flags handling -;;;; +;;;; (defstruct (cvs-flags (:constructor nil) @@ -279,7 +301,7 @@ If it is \\[universal-argument] \\[universal-argument], behave just ;; sanity check (unless (< (abs numarg) (length defaults)) - (error "There is no %sth default." (abs numarg))) + (error "There is no %sth default" (abs numarg))) (if permstr (let* ((prompt (format "%s%s: " desc permstr)) @@ -294,9 +316,9 @@ If it is \\[universal-argument] \\[universal-argument], behave just "Set SYM's INDEX'th setting to VALUE." (setf (nth index (cvs-flags-defaults (symbol-value sym))) value)) -;;;; +;;;; ;;;; Prefix keys -;;;; +;;;; (defconst cvs-prefix-number 10) @@ -306,9 +328,9 @@ If it is \\[universal-argument] \\[universal-argument], behave just &optional qtypedesc hist-sym) (let ((cps (cvs-prefix-sym sym))) `(progn - (defvar ,sym nil ,(cons (or docstring "") " + (defvar ,sym nil ,(concat (or docstring "") " See `cvs-prefix-set' for further description of the behavior.")) - (defconst ,cps + (defvar ,cps (let ((defaults ,defaults)) ;; sanity ensurance (unless (>= (length defaults) cvs-prefix-number) @@ -331,7 +353,7 @@ If ARG is negative (or \\[universal-argument] which corresponds to negative 0), it queries the user and sets the -ARG'th default. If ARG is greater than 9 (or \\[universal-argument] \\[universal-argument]), the (ARG mod 10)'th prefix is made persistent. -If ARG is NIL toggle the PREFIX's value between its 0th default and NIL +If ARG is nil toggle the PREFIX's value between its 0th default and nil and reset the persistence." (let* ((prefix (symbol-value (cvs-prefix-sym sym))) (numarg (if (integerp arg) arg 0)) @@ -369,4 +391,5 @@ and reset it unless READ-ONLY is non-nil." (provide 'pcvs-util) -;;; pcl-cvs-util.el ends here +;; arch-tag: 3b2588bb-2ae3-4f1f-bf5b-dea91b1f8a59 +;;; pcvs-util.el ends here