X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/5b467bf4e2787e3290280cadbae9e915df88dacd..a2b7dcc77da2403959f1b7c22614eb01c7f6b878:/lisp/pcvs-util.el diff --git a/lisp/pcvs-util.el b/lisp/pcvs-util.el index 9763fd8256..cb18fc83d5 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, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. -;; Author: Stefan Monnier +;; Author: Stefan Monnier ;; Keywords: pcl-cvs -;; Version: $Name: $ -;; Revision: $Id: pcl-cvs-util.el,v 1.26 2000/03/05 21:32:21 monnier Exp $ ;; This file is part of GNU Emacs. @@ -21,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -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,41 +140,61 @@ 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) "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). This tries to quote the strings to avoid ambiguity such that (cvs-string->strings (cvs-strings->string strs)) == strs -Only some SEPARATOR will work properly." +Only some SEPARATORs will work properly." (let ((sep (or separator " "))) (mapconcat (lambda (str) (if (string-match "[\\\"]" str) - (concat "\"" (replace-regexps-in-string "[\\\"]" "\\\\\\&" str) "\"") + (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") str)) strings sep))) @@ -184,24 +206,16 @@ It understands elisp style quoting within STRING such that The SEPARATOR regexp defaults to \"\\s-+\"." (let ((sep (or separator "\\s-+")) (i (string-match "[\"]" string))) - (if (null i) (split-string string sep) ; no quoting: easy - (append (unless (eq i 0) (split-string (substring string 0 i) sep)) + (if (null i) (split-string string sep t) ; no quoting: easy + (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) (let ((rfs (read-from-string string i))) (cons (car rfs) - (cvs-string->strings (substring string (cdr rfs)) sep))))))) - - -(defun cvs-string-fill (str n &optional filling truncate) - "Add FILLING (defaults to the space char) to STR to reach size N. -If STR is longer than N, truncate if TRUNCATE is set, else don't do anything." - (let ((l (length str))) - (if (> l n) - (if truncate (substring str 0 n) str) - (concat str (make-string (- n l) (or filling ? )))))) - -;;;; + (cvs-string->strings (substring string (cdr rfs)) + sep))))))) + +;;;; ;;;; file names -;;;; +;;;; (defsubst cvs-expand-dir-name (d) (file-name-as-directory (expand-file-name d))) @@ -241,9 +255,9 @@ If STR is longer than N, truncate if TRUNCATE is set, else don't do anything." initval hist-sym)) (t initval))))) -;;;; +;;;; ;;;; Flags handling -;;;; +;;;; (defstruct (cvs-flags (:constructor nil) @@ -264,7 +278,7 @@ If STR is longer than N, truncate if TRUNCATE is set, else don't do anything." (defun cvs-flags-query (sym &optional desc arg) "Query flags based on SYM. -Optional argument DESC will be used for the prompt +Optional argument DESC will be used for the prompt. If ARG (or a prefix argument) is nil, just use the 0th default. If it is a non-negative integer, use the corresponding default. If it is a negative integer query for a new value of the corresponding @@ -288,7 +302,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)) @@ -303,9 +317,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) @@ -315,15 +329,15 @@ 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) (setq defaults (append defaults (make-list (1- cvs-prefix-number) - (first defaults))))) + (nth 0 defaults))))) (-cvs-flags-make ,desc defaults ,qtypedesc ,hist-sym)))))) (defun cvs-prefix-make-local (sym) @@ -340,11 +354,12 @@ 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)) - (defs (cvs-flags-defaults prefix))) + ;; (defs (cvs-flags-defaults prefix)) + ) ;; set persistence if requested (when (> (prefix-numeric-value arg) 9) @@ -356,7 +371,7 @@ If ARG is NIL toggle the PREFIX's value between its 0th default and NIL (cond ((null arg) (setf (cvs-flags-persist prefix) nil) - (unless (symbol-value sym) (first (cvs-flags-defaults prefix)))) + (unless (symbol-value sym) (nth 0 (cvs-flags-defaults prefix)))) ((or (consp arg) (< numarg 0)) (setf (nth (- numarg) (cvs-flags-defaults prefix)) @@ -369,7 +384,7 @@ If ARG is NIL toggle the PREFIX's value between its 0th default and NIL (defun cvs-prefix-get (sym &optional read-only) "Return the current value of the prefix SYM. -and reset it unless READ-ONLY is non-nil." +And reset it unless READ-ONLY is non-nil." (prog1 (symbol-value sym) (unless (or read-only (cvs-flags-persist (symbol-value (cvs-prefix-sym sym)))) @@ -378,4 +393,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