xemacs-beta: lisp/ilisp/ilisp-ext.el comparison

comparison lisp/ilisp/ilisp-ext.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

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;; -*- Mode: Emacs-Lisp -*-
+;;; ilisp-ext.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.
+;;; Lisp mode extensions from the ILISP package.
+;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
+;;; This file may become part of GNU Emacs.
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY.  No author or distributor
+;;; accepts responsibility to anyone for the consequences of using it
+;;; or for whether it serves any particular purpose or works at all,
+;;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;;; License for full details.
+;;; Everyone is granted permission to copy, modify and redistribute
+;;; GNU Emacs, but only under the conditions described in the
+;;; GNU Emacs General Public License.   A copy of this license is
+;;; supposed to have been given to you along with GNU Emacs so you
+;;; can know your rights and responsibilities.  It should be in a
+;;; file named COPYING.  Among other things, the copyright notice
+;;; and this notice must be preserved on all copies.
+;;; When loaded this file adds new functionality to emacs lisp mode
+;;; and lisp mode.
+;;;
+;;; Default bindings:
+;;;
+;;; M-x find-unbalanced-lisp find unbalanced parens in the current
+;;; buffer.  With a prefix in the current region.
+;;;
+;;; ] Close all open parentheses back to the start of the containing
+;;; sexp, or to a previous left bracket which will be converted to a
+;;; left paren.
+;;;
+;;; M-q Reindent comments or strings in paragraph chunks or reindent
+;;; the containing sexp.
+;;;
+;;; M-x comment-region-lisp inserts prefix copies of the comment-start
+;;; character before lines in the region and the comment-end character
+;;; at the end of each line.  If called with a negative prefix, that
+;;; many copies are removed.
+;;;
+;;; C-M-r repositions the first line of the current defun to the top
+;;; of the current window.
+;;;
+;;; C-M-l switches the current window to the previously seen buffer.
+;;;
+;;; EXAMPLE .emacs:
+;;;
+;;; (setq ilisp-ext-load-hook
+;;;   '(lambda () (define-key global-map "\C-\M-l" 'previous-buffer-lisp)))
+;;; (require 'ilisp-ext)
+;;;%Syntax
+;;; This makes it so that .'s are treated as normal characters so that
+;;; 3.141 gets treated as a single lisp token.  This does cause dotted
+;;; pairs to be treated weird though.
+(modify-syntax-entry ?. "_" lisp-mode-syntax-table)
+;;; Brackets match
+(modify-syntax-entry ?\[ "(]" lisp-mode-syntax-table)
+(modify-syntax-entry ?\] ")[" lisp-mode-syntax-table)
+;;;%Superbrackets
+(defun close-all-lisp (arg)
+"Unless you are in a string, insert right parentheses as necessary
+to balance unmatched left parentheses back to the start of the current
+defun or to a previous left bracket which is then replaced with a left
+parentheses.  If there are too many right parentheses, remove them
+unless there is text after the extra right parentheses.  If called
+with a prefix, the entire expression will be closed and all open left
+brackets will be replaced with left parentheses."
+(interactive "P")
+(let* ((point (point))
+	 (begin (lisp-defun-begin))
+	 (end (lisp-end-defun-text))
+	 inserted
+	 (closed nil))
+(goto-char point)
+(if (or (car (cdr (cdr (lisp-in-string begin end))))
+	    (save-excursion (beginning-of-line)
+			    (looking-at "[ \t]*;")))
+	(insert "]")
+	(if (= begin end)
+	    (error "No sexp to close.")
+	    (save-restriction
+	      (narrow-to-region begin end)
+	      (if (< point begin)
+		  (setq point begin)
+		  (if (> point end)
+		      (setq point end)))
+	      ;; Add parens at point until either the defun is closed, or we
+	      ;; hit a square bracket.
+	      (goto-char point)
+	      (insert ?\))		;So we have an sexp
+	      (while (progn
+		       (setq inserted (point))
+		       (condition-case ()
+			   (progn (backward-sexp)
+				  (or arg
+				      (not (eq (char-after (point)) ?\[))))
+			 (error (setq closed t) nil)))
+		;; With an arg replace all left brackets
+		(if (and arg (= (char-after (point)) ?\[))
+		    (progn
+		      (delete-char 1)
+		      (insert ?\()
+		      (backward-char)))
+		(forward-sexp)
+		(insert ?\)))
+	      (if (< (point) point)
+		  ;; We are at a left bracket
+		  (let ((left (point)))
+		    (delete-char 1)
+		    (insert ?\()
+		    (backward-char)
+		    (forward-sexp))
+		  ;; There was not an open left bracket so close at end
+		  (delete-region point inserted)
+		  (goto-char begin)
+		  (if (condition-case () (progn
+					   (forward-sexp)
+					   (<= (point) end))
+			(error nil))
+		      ;; Delete extra right parens
+		      (let ((point (point)))
+			(skip-chars-forward " \t)\n")
+			(if (or (bolp) (eobp))
+			    (progn
+			      (skip-chars-backward " \t\n")
+			      (delete-region point (point)))
+			    (error
+			     "There is text after the last right parentheses.")))
+		      ;; Insert parens at end changing any left brackets
+		      (goto-char end)
+		      (while
+			  (progn
+			    (insert ?\))
+			    (save-excursion
+			      (condition-case ()
+				  (progn (backward-sexp)
+					 (if (= (char-after (point)) ?\[)
+					     (progn
+					       (delete-char 1)
+					       (insert ?\()
+					       (backward-char)))
+					 (> (point) begin))
+				(error (delete-backward-char 1)
+				       nil))))))))))))
+;;;%Reindentation
+;;;
+(defun reindent-lisp ()
+"Indents code depending partially on context (comments or strings).
+If in a comment, indent the comment paragraph bounded by
+non-comments, blank lines or empty comment lines.  If in a string,
+indent the paragraph bounded by string delimiters or blank lines.
+Otherwise go to the containing defun, close it and reindent the code
+block."
+(interactive)
+(let ((region (lisp-in-string))
+	(comment (concat "[ \t]*" comment-start "+[ \t]*")))
+(set-marker lisp-fill-marker (point))
+(back-to-indentation)
+(cond (region
+	   (or (= (char-after (point)) ?\")
+	       (and (< (point) (car region)) (goto-char (car region)))
+	       (re-search-backward "^$" (car region) 'end))
+	   (let ((begin (point))
+		 (end (car (cdr region)))
+		 (fill-prefix nil))
+	     (forward-char)
+	     (re-search-forward "^$" end 'end)
+	     (if (= (point) end)
+		 (progn (skip-chars-forward "^\n")
+			(if (not (eobp)) (forward-char))))
+	     (fill-region-as-paragraph begin (point))))
+	  ((looking-at comment)
+	   (let ((fill-prefix
+		  (buffer-substring
+		   (progn (beginning-of-line) (point))
+		   (match-end 0))))
+	     (while (and (not (bobp)) (lisp-in-comment comment))
+	       (forward-line -1))
+	     (if (not (bobp)) (forward-line 1))
+	     (let ((begin (point)))
+	       (while (and (lisp-in-comment comment) (not (eobp)))
+		 (replace-match fill-prefix)
+		 (forward-line 1))
+	       (if (not (eobp))
+		   (progn (forward-line -1)
+			  (end-of-line)
+			  (forward-char 1)))
+	       (fill-region-as-paragraph begin (point)))))
+	  (t
+	   (goto-char lisp-fill-marker)
+	   (close-all-lisp 1)
+	   (lisp-defun-begin)
+	   (indent-sexp-ilisp)))
+(goto-char lisp-fill-marker)
+(set-marker lisp-fill-marker nil)
+(message "Done")))
+;;;%Comment region
+(defun comment-region-lisp (start end prefix)
+"If prefix is positive, insert prefix copies of comment-start at the
+start and comment-end at the end of each line in region.  If prefix is
+negative, remove all comment-start and comment-end strings from the
+region."
+(interactive "r\np")
+(save-excursion
+(goto-char end)
+(if (and (not (= start end)) (bolp)) (setq end (1- end)))
+(goto-char end)
+(beginning-of-line)
+(set-marker ilisp-comment-marker (point))
+(untabify start end)
+(goto-char start)
+(beginning-of-line)
+(let* ((count 1)
+	   (comment comment-start)
+	   (comment-end (if (not (equal comment-end "")) comment-end)))
+(if (> prefix 0)
+	  (progn
+	    (while (< count prefix)
+	      (setq comment (concat comment-start comment)
+		    count (1+ count)))
+	    (while (<= (point) ilisp-comment-marker)
+	      (beginning-of-line)
+	      (insert comment)
+	      (if comment-end (progn (end-of-line) (insert comment-end)))
+	      (forward-line 1)))
+	  (setq comment (concat comment "+"))
+	  (while (<= (point) ilisp-comment-marker)
+	    (back-to-indentation)
+	    (if (looking-at comment) (replace-match ""))
+	    (if comment-end
+		(progn
+		  (re-search-backward comment-end)
+		  (replace-match "")))
+	    (forward-line 1)))
+(set-marker ilisp-comment-marker nil))))
+;;;%Movement
+;;; beginning-of-defun-lisp and end-of-defun-lisp are overloaded by ilisp.el
+(defun beginning-of-defun-lisp (&optional stay)
+"Go to the next left paren that starts at the left margin."
+(interactive)
+(beginning-of-defun))
+;;;
+(defun end-of-defun-lisp ()
+"Go to the next left paren that starts at the left margin."
+(interactive)
+(let ((point (point)))
+(beginning-of-line)
+(re-search-forward "^[ \t\n]*[^; \t\n]" nil t)
+(back-to-indentation)
+(if (not (bolp)) (beginning-of-defun-lisp t))
+(lisp-end-defun-text t)
+(if (= point (point))		;Already at end so move to next end
+	(lisp-skip (point-max))
+	(if (not (or (eobp)
+		     (= (char-after (point)) ?\n)))
+	    (lisp-end-defun-text t)))))
+;;;%%Reposition-window
+(defun count-screen-lines-lisp (start end)
+"Return the number of screen lines between start and end."
+(save-excursion
+(save-restriction
+(narrow-to-region start end)
+(goto-char (point-min))
+(vertical-motion (- (point-max) (point-min))))))
+;;;
+(defun count-screen-lines-signed-lisp (start end)
+"Return number of screen lines between START and END; returns a negative
+number if END precedes START."
+(interactive "r")
+(let ((lines (count-screen-lines-lisp start end)))
+(if (< start end) lines (- lines))))
+;;; This was written by Michael D. Ernst
+(defun reposition-window-lisp (&optional arg)
+"Make the current definition and/or comment visible, move it to the
+top of the window, or toggle the visibility of comments that precede
+it.  Leaves point unchanged unless supplied with prefix ARG.  If the
+definition is fully onscreen, it is moved to the top of the window.
+If it is partly offscreen, the window is scrolled to get the
+definition \(or as much as will fit) onscreen, unless point is in a
+comment which is also partly offscreen, in which case the scrolling
+attempts to get as much of the comment onscreen as possible.
+Initially reposition-window attempts to make both the definition and
+preceding comments visible.  Further invocations toggle the visibility
+of the comment lines.  If ARG is non-nil, point may move in order to
+make the whole defun visible \(if only part could otherwise be made
+so), to make the defun line visible \(if point is in code and it could
+not be made so, or if only comments, including the first comment line,
+are visible), or to make the first comment line visible \(if point is
+in a comment)."
+(interactive "P")
+(let* ((here (point))
+	 ;; change this name once I've gotten rid of references to ht.
+	 ;; this is actually the number of the last screen line
+	 (ht (- (window-height (selected-window)) 2))
+	 (line (count-screen-lines-lisp (window-start) (point)))
+	 (comment-height
+	  ;; The max deals with the case of cursor between defuns.
+	  (max 0
+	       (count-screen-lines-signed-lisp
+		;; the beginning of the preceding comment
+		(save-excursion
+		  (if (not (and (bolp) (eq (char-after (point)) ?\()))
+		      (beginning-of-defun-lisp))
+		  (beginning-of-defun-lisp)
+		  (end-of-defun-lisp)
+		  ;; Skip whitespace, newlines, and form feeds.
+		  (re-search-forward "[^\\s \n\014]")
+		  (backward-char 1)
+		  (point))
+		here)))
+	 (defun-height
+	     (count-screen-lines-signed-lisp
+	      (save-excursion
+	       (end-of-defun-lisp)	;associate comment with next defun
+	       (beginning-of-defun-lisp)
+	       (point))
+	      here))
+	 ;; This must be positive, so don't use the signed version.
+	 (defun-depth
+	     (count-screen-lines-lisp
+	      here
+	      (save-excursion (end-of-defun-lisp) (point))))
+	 (defun-line-onscreen-p
+	     (and (<= defun-height line) (<= (- line defun-height) ht))))
+(cond ((or (= comment-height line)
+	       (and (= line ht)
+		    (> comment-height line)
+		    ;; if defun line offscreen, we should be in case 4
+		    defun-line-onscreen-p))
+	   ;; Either first comment line is at top of screen or (point at
+	   ;; bottom of screen, defun line onscreen, and first comment line
+	   ;; off top of screen).  That is, it looks like we just did
+	   ;; recenter-definition, trying to fit as much of the comment
+	   ;; onscreen as possible.  Put defun line at top of screen; that
+	   ;; is, show as much code, and as few comments, as possible.
+	   (if (and arg (> defun-depth (1+ ht)))
+	       ;; Can't fit whole defun onscreen without moving point.
+	       (progn (end-of-defun-lisp) (beginning-of-defun-lisp)
+		      (recenter 0))
+	       (recenter (max defun-height 0))))
+	  ((or (= defun-height line)
+	       (= line 0)
+	       (and (< line comment-height)
+		    (< defun-height 0)))
+	   ;; Defun line or cursor at top of screen, OR cursor in comment
+	   ;; whose first line is offscreen.
+	   ;; Avoid moving definition up even if defun runs offscreen;
+	   ;; we care more about getting the comment onscreen.
+	   (cond ((= line ht)
+		  ;; cursor on last screen line (and so in a comment)
+		  (if arg (progn (end-of-defun-lisp)
+				 (beginning-of-defun-lisp)))
+		  (recenter 0))
+		 ;; This condition, copied from case 4, may not be quite right
+		 ((and arg (< ht comment-height))
+		  ;; Can't get first comment line onscreen.
+		  ;; Go there and try again.
+		  (forward-line (- comment-height))
+		  (beginning-of-line)
+		  ;; was (reposition-window)
+		  (recenter 0))
+		 (t
+		  (recenter (min ht comment-height))))
+	   ;; (recenter (min ht comment-height))
+	   )
+	  ((and (> (+ line defun-depth -1) ht)
+		defun-line-onscreen-p)
+	   ;; Defun runs off the bottom of the screen and the defun
+	   ;; line is onscreen.  Move the defun up.
+	   (recenter (max 0 (1+ (- ht defun-depth)) defun-height)))
+	  (t
+	   ;; If on the bottom line and comment start is offscreen
+	   ;; then just move all comments offscreen, or at least as
+	   ;; far as they'll go.  Try to get as much of the comments
+	   ;; onscreen as possible.
+	   (if (and arg (< ht comment-height))
+	       ;; Can't get defun line onscreen; go there and try again.
+	       (progn (forward-line (- defun-height))
+		      (beginning-of-line)
+		      (reposition-window-lisp))
+	       (recenter (min ht comment-height)))))))
+;;;
+(defun previous-buffer-lisp (n)
+"Switch to Nth previously selected buffer.  N defaults to the number
+of windows plus 1.  That is, no argument switches to the most recently
+selected buffer that is not visible.  If N is 1, repeated calls will
+cycle through all buffers; -1 cycles the other way.  If N is greater
+than 1, the first N buffers on the buffer list are rotated."
+(interactive "P")
+(if (not n)
+(switch-to-buffer nil)
+(let ((buffer-list (buffer-list)))
+	(setq n (prefix-numeric-value n))
+	(cond ((= n 1)
+	       (bury-buffer (current-buffer))
+	       (setq n 2))
+	      ((< n 0)
+	       (setq buffer-list (nreverse buffer-list)
+		     n (- n)))
+	      (t nil))
+	(while (and (> n 1) buffer-list)
+	  (setq n (1- n)
+		buffer-list (cdr buffer-list))
+	  (while (eq (elt (buffer-name (car buffer-list)) 0) ? )
+	    (setq buffer-list (cdr buffer-list))))
+	(if buffer-list
+	    (switch-to-buffer (car buffer-list))
+	    (error "There aren't that many buffers")))))
+;;;%Bindings
+(define-key emacs-lisp-mode-map "\M-q"    'reindent-lisp)
+(define-key emacs-lisp-mode-map "\M-\C-a" 'beginning-of-defun-lisp)
+(define-key emacs-lisp-mode-map "\M-\C-e" 'end-of-defun-lisp)
+(define-key emacs-lisp-mode-map "\C-\M-r" 'reposition-window-lisp)
+(define-key emacs-lisp-mode-map "]"       'close-all-lisp)
+(define-key lisp-mode-map       "\M-q"    'reindent-lisp)
+(define-key lisp-mode-map       "\C-\M-r" 'reposition-window-lisp)
+(define-key lisp-mode-map       "]"       'close-all-lisp)
+(define-key global-map          "\M-\C-l" 'previous-buffer-lisp)
+;;;
+(run-hooks 'ilisp-ext-load-hook)
+(provide 'ilisp-ext)

Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ilisp-ext.el @ 0:376386a54a3c r19-14