cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-utl.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-utl.el --
   4 ;;; ILISP misc tools.
   5 ;;;
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ilisp-utl.el,v 1.3 2001-07-02 09:40:49 youngs Exp $
  13
  14 (defun lisp-show-send (string)
  15   "Show STRING in the *ilisp-send* buffer."
  16   (save-excursion
  17     (if (ilisp-buffer)
  18         (set-buffer "*ilisp-send*")
  19         (error "You must start an inferior LISP with run-ilisp."))
  20     (erase-buffer)
  21     (insert string)
  22     string))
  23
  24
  25 ;;;
  26 (defun lisp-slashify (string)
  27   "Put string in the *ilisp-send* buffer, backslashifying troublesome chars.
  28 I.e. put backslashes before quotes and backslashes and return the resulting
  29 string."
  30   (save-excursion
  31     (lisp-show-send string)
  32     (set-buffer "*ilisp-send*")
  33     (goto-char (point-min))
  34     (while (search-forward "\\" nil t)
  35       (delete-char -1)
  36       (insert "\\\\"))
  37     (goto-char (point-min))
  38     (while (search-forward "\"" nil t)
  39       (backward-char)
  40       (insert ?\\)
  41       (forward-char))
  42     (buffer-substring (point-min) (point-max))))
  43
  44
  45 ;;;%%String
  46 (defun lisp-prefix-p (s1 s2)
  47   "Returns t if S1 is a prefix of S2.
  48 It considers all non alphanumerics as word delimiters."
  49   (let ((len1 (length s1)))
  50     (and (<= len1 (length s2))
  51          (let ((start 0)
  52                (start2 0)
  53                end
  54                (match t))
  55            (while
  56                (if (setq end (string-match "[^a-zA-Z0-9]" s1 start))
  57                    ;; Found delimiter
  58                    (if (string= (substring s1 start end)
  59                         (substring s2 start2 (+ start2 (- end start))))
  60                        ;; Words are the same
  61                        (progn (setq start (match-end 0))
  62                               (if (string-match
  63                                    (regexp-quote (substring s1 end start))
  64                                    s2 start2)
  65                                   (setq start2 (match-end 0)) ;OK
  66                                 (setq match nil))) ;Can't find delimiter
  67                      (setq match nil))  ;Words don't match
  68                  nil))                  ;Ran out of delimiters in s1
  69            (and match
  70                 (string= (substring s1 start len1)
  71                  (substring s2 start2 (+ start2 (- len1 start)))))))))
  72
  73
  74 ;;;
  75 (defun lisp-last-line (string)
  76   "Return the last line of STRING with everything else."
  77   (let* ((position 0))
  78     (while (string-match "\\(\n+\\)[^\n]" string position)
  79       (setq position (match-end 1)))
  80     (cons (substring string position)
  81           (substring string 0 position))))
  82
  83
  84 ;;;%%File
  85 ;;;
  86 (defun lisp-file-extension (file extension)
  87   "Return FILE with new EXTENSION."
  88   (concat (substring file 0 (string-match ".[^.]*$" file))
  89           "." extension))
  90
  91 (defun ilisp-directory (file &optional dirs)
  92   "Return the directory of DIRS that FILE is found in.
  93 By default 'load-path' is used for the directories."
  94   (let* ((dirs (or dirs (cons "" load-path)))
  95          (dir (car dirs)))
  96     (while (and dir (not (file-exists-p (expand-file-name file dir))))
  97       (setq dirs (cdr dirs)
  98             dir (car dirs)))
  99     dir))
 100
 101
 102 ;;; ilisp-update-status --
 103 ;;;
 104 ;;; Notes:
 105 ;;;
 106 ;;; 19970412 Marco Antoniotti
 107 ;;; Changed in order to propagate the status change in the
 108 ;;; underlying process to the menu.
 109 ;;;
 110 ;;; 19990806 Martin Atzmueller
 111 ;;; Added test for FEATUREP ILISP-EASY-MENU.
 112
 113 (defun ilisp-update-status (status)
 114   "Update process STATUS of the whole ILISP system.
 115 It updates the STATUS of the current buffer and let all lisp mode
 116 buffers know as well.  Also, do some 'exterior' things like make sure
 117 that the menubar is in a consistent state."
 118   (setq ilisp-status (if lisp-show-status (format " :%s" status)))
 119   (when (and (not (member +ilisp-emacs-version-id+
 120                           '(xemacs lucid-19 lucid-19-new)))
 121              (not (featurep 'ilisp-easy-menu)))
 122     (ilisp-update-menu status))
 123   (comint-update-status status))
 124
 125 ;;; end of file -- ilisp-utl.el --