Mercurial > hg > xemacs-beta
diff lisp/ilisp/ilisp-low.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | b82b59fe008d |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ilisp/ilisp-low.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,137 @@ +;;; -*- Mode: Emacs-Lisp -*- + +;;; ilisp-low.el -- + +;;; This file is part of ILISP. +;;; Version: 5.7 +;;; +;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell +;;; 1993, 1994 Ivan Vasquez +;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker +;;; +;;; Other authors' names for which this Copyright notice also holds +;;; may appear later in this file. +;;; +;;; Send mail to 'ilisp-request@lehman.com' to be included in the +;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP +;;; mailing list were bugs and improvements are discussed. +;;; +;;; ILISP is freely redistributable under the terms found in the file +;;; COPYING. + + + +;;; +;;; ILISP low level interface functions Lisp <-> Emacs +;;; +;;; + + + +;;;%Lisp mode extensions +;;;%%Sexps +(defun lisp-previous-sexp (&optional prefix) + "Return the previous sexp. If PREFIX is T, then prefix like ' or #' +are allowed." + (save-excursion + (condition-case () + (progn + (if (and (memq major-mode ilisp-modes) + (= (point) + (process-mark (get-buffer-process (current-buffer))))) + nil + (if (not + (or (eobp) (memq (char-after (point)) '(? ?\) ?\n ?\t)))) + (forward-sexp)) + (skip-chars-backward " \t\n") + (let ((point (point))) + (backward-sexp) + (skip-chars-backward "^ \t\n(\",") + (if (not prefix) (skip-chars-forward "#'")) + (buffer-substring (point) point)))) + (error nil)))) + +;;; +(defun lisp-def-name (&optional namep) + "Return the name of a definition assuming that you are at the start +of the sexp. If the form starts with DEF, the form start and the next +symbol will be returned. Optional NAMEP will return only the name without the defining symbol." + (let ((case-fold-search t)) + (if (looking-at + ;; (( \( (def*) (( \( (setf)) | \(?)) | \(?) (symbol) + ;; 12 3 3 45 6 65 42 1 7 7 + ;;0011\(22 def* 22 32 43\(54 setf54 43 \(?32 11 00 60 60 + "\\(\\((\\(def[^ \t\n]*\\)[ \t\n]+\\(\\((\\(setf\\)[ \t\n]+\\)\\|(?\\)\\)\\|(?\\)\\([^ \t\n)]*\\)") + (let ((symbol (buffer-substring (match-beginning 7) (match-end 7)))) + (if (match-end 6) + (concat (if (not namep) + (concat + (buffer-substring (match-beginning 3) (match-end 3)) + " ")) + "(" + (buffer-substring (match-beginning 6) (match-end 6)) + " " symbol ")") + (if (match-end 3) + (concat (if (not namep) + (concat + (buffer-substring (match-beginning 3) + (match-end 3)) + " ")) + symbol) + symbol)))))) + + +;;; +(defun lisp-minus-prefix () + "Set current-prefix-arg to its absolute value if numeric and return +T if it is a negative." + (if current-prefix-arg + (if (symbolp current-prefix-arg) + (progn (setq current-prefix-arg nil) t) + (if (< (setq current-prefix-arg + (prefix-numeric-value current-prefix-arg)) + 0) + (progn + (setq current-prefix-arg (- current-prefix-arg)) t))))) + + + +;;;%%Defuns +(defun lisp-defun-region-and-name () + "Return the region of the current defun and the name starting it." + (save-excursion + (let ((end (lisp-defun-end)) + (begin (lisp-defun-begin))) + (list begin end (lisp-def-name))))) + +;;; +(defun lisp-region-name (start end) + "Return a name for the region from START to END." + (save-excursion + (goto-char start) + (if (re-search-forward "^[ \t]*[^;\n]" end t) + (forward-char -1)) + (setq start (point)) + (goto-char end) + (re-search-backward "^[ \t]*[^;\n]" start 'move) + (end-of-line) + (skip-chars-backward " \t") + (setq end (min (point) end)) + (goto-char start) + (let ((from + (if (= (char-after (point)) ?\() + (lisp-def-name) + (buffer-substring (point) + (progn (forward-sexp) (point)))))) + (goto-char end) + (if (= (char-after (1- (point))) ?\)) + (progn + (backward-sexp) + (if (= (point) start) + from + (concat "from " from " to " (lisp-def-name)))) + (concat "from " from " to " + (buffer-substring (save-excursion + (backward-sexp) + (point)) + (1- (point))))))))