From xemacs-m  Wed Mar 12 08:58:05 1997
Received: from gwa.ericsson.com (gwa.ericsson.com [198.215.127.2])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id IAA11003
	for <xemacs-beta@xemacs.org>; Wed, 12 Mar 1997 08:58:04 -0600 (CST)
Received: from mr2.exu.ericsson.se (mr2.exu.ericsson.com [138.85.147.12]) by gwa.ericsson.com (8.8.2/8.8.2) with ESMTP id IAA19744; Wed, 12 Mar 1997 08:57:33 -0600 (CST)
Received: from screamer.rtp.ericsson.se (screamer.rtp.ericsson.se [147.117.133.13]) by mr2.exu.ericsson.se (8.7.1/NAHUB-MR1.1) with SMTP id IAA15651; Wed, 12 Mar 1997 08:57:31 -0600 (CST)
Received: from rcur (rcur18.rtp.ericsson.se [147.117.133.138]) by screamer.rtp.ericsson.se (8.6.12/8.6.4) with ESMTP id JAA23246; Wed, 12 Mar 1997 09:57:30 -0500
To: XEmacs Mailing List <xemacs-beta@xemacs.org>
cc: ILISP Discussion <ilisp@naggum.no>
Subject: Small patch for ilisp package handling
Mime-Version: 1.0 (generated by tm-edit 7.105)
Content-Type: multipart/mixed;
 boundary="Multipart_Wed_Mar_12_09:57:27_1997-1"
Content-Transfer-Encoding: 7bit
Date: Wed, 12 Mar 1997 09:57:30 -0500
Message-ID: <11873.858178650@rtp.ericsson.se>
From: Raymond Toy <toy@rtp.ericsson.se>

--Multipart_Wed_Mar_12_09:57:27_1997-1
Content-Type: text/plain; charset=US-ASCII


Here is a small patch for ilisp that enhances the package handling in
ilisp.  Ilisp currently just finds the first in-package statement in
the file and sets the package of the current buffer to be that.
Often, this is not the correct package.  This patch tells ilisp to
parse a mode line like

;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER -*-

and use the package given in the line.  If no package is given here,
the original method is used.

Ray

The patch is actually small:  one new function and a few lines changed
in another, but it got reindented.


--Multipart_Wed_Mar_12_09:57:27_1997-1
Content-Type: application/octet-stream
Content-Disposition: attachment; filename="patch"
Content-Transfer-Encoding: 7bit

*** /home/unix/toy/apps/XEmacs/lib/xemacs-20.1-b6/lisp/ilisp/ilisp-snd.el	Wed Dec 18 17:42:44 1996
--- rlt-ilisp-snd.el	Tue Mar 11 17:01:54 1997
***************
*** 68,112 ****
  			     ":" buffer-package)))
  	   buffer-package))))
  
  (defun lisp-buffer-package-internal (search-from-start)
    "Returns the package of the buffer.  If SEARCH-FROM-START is T then
  will search from the beginning of the buffer, otherwise will search
  backwards from current point."
!   (setq mode-line-process 'ilisp-status)
!   (let* ((lisp-buffer-package t)
! 	 (case-fold-search t)
! 	 (regexp (ilisp-value 'ilisp-package-regexp t))
! 	 (spec
! 	  (if regexp
! 	      (save-excursion
! 		(if (or (and search-from-start
! 			     (goto-char (point-min))
! 			     (re-search-forward regexp nil t))
! 			(re-search-backward regexp nil t))
! 		    (buffer-substring (match-beginning 0)
! 				      (progn 
! 					(goto-char (match-beginning 0))
! 					(forward-sexp)
! 					(point)))))))
! 	 (str  (format (ilisp-value 'ilisp-package-command) spec))
! 	 (package
! 	  (if spec
! 	      (ilisp-send 
! 	       str
! 	       "Finding buffer package"
! 	       'pkg))))
!     (if (ilisp-value 'comint-errorp t)
! 	(progn
! 	  (lisp-display-output package)
! 	  (error "No package"))
! 	(if (and package 
! 		 ;; There was a bug here, used to have the second *
! 		 ;; outside of the parens.
! 		 (string-match "[ \n\t:\"]*\\([^ \n\t\"]*\\)" package))
! 	    (setq package
! 		  (substring package
! 			     (match-beginning 1) (match-end 1)))))
!     package))
  
  ;;;
  (defun package-lisp ()
--- 68,144 ----
  			     ":" buffer-package)))
  	   buffer-package))))
  
+ (defun parse-attribute-list (&optional buffer)
+   "Find the attribute list in the given buffer (or current buffer, if
+ none) and return an alist of attribute/value pairs.  The attributes
+ are (lowercase) symbols, but the values are strings."
+   (let ((buf (or buffer (current-buffer)))
+ 	attrib-alist end)
+     (save-excursion
+       (set-buffer buf)
+       (goto-char (point-min))
+       (end-of-line)
+       (setq end (point))
+       (goto-char (point-min))
+       (when (search-forward "-*-" end t)
+ 	;; We found something interesting
+ 	(while (re-search-forward "\\s-*\\(\\sw+\\):\\s-*\\([a-zA-Z0-9-]+\\);?" end t)
+ 	  ;; Got a key word and value
+ 	  (push (cons (intern
+ 		       (downcase (buffer-substring (match-beginning 1)
+ 						 (match-end 1))))
+ 		      (buffer-substring (match-beginning 2)
+ 					(match-end 2)))
+ 		attrib-alist)))
+       (nreverse attrib-alist))))
+ 	
+     
+ 
+ 
  (defun lisp-buffer-package-internal (search-from-start)
    "Returns the package of the buffer.  If SEARCH-FROM-START is T then
  will search from the beginning of the buffer, otherwise will search
  backwards from current point."
!   (let* ((file-parsed-attributes (parse-attribute-list))
! 	 (pkg (and file-parsed-attributes (assoc 'package file-parsed-attributes))))
!     (if pkg
! 	(cdr pkg)
!       (progn
! 	(setq mode-line-process 'ilisp-status)
! 	(let* ((lisp-buffer-package t)
! 	       (case-fold-search t)
! 	       (regexp (ilisp-value 'ilisp-package-regexp t))
! 	       (spec
! 		(if regexp
! 		    (save-excursion
! 		      (if (or (and search-from-start
! 				   (goto-char (point-min))
! 				   (re-search-forward regexp nil t))
! 			      (re-search-backward regexp nil t))
! 			  (buffer-substring (match-beginning 0)
! 					    (progn 
! 					      (goto-char (match-beginning 0))
! 					      (forward-sexp)
! 					      (point)))))))
! 	       (str  (format (ilisp-value 'ilisp-package-command) spec))
! 	       (package
! 		(if spec
! 		    (ilisp-send 
! 		     str
! 		     "Finding buffer package"
! 		     'pkg))))
! 	  (if (ilisp-value 'comint-errorp t)
! 	      (progn
! 		(lisp-display-output package)
! 		(error "No package"))
! 	    (if (and package 
! 		     ;; There was a bug here, used to have the second *
! 		     ;; outside of the parens.
! 		     (string-match "[ \n\t:\"]*\\([^ \n\t\"]*\\)" package))
! 		(setq package
! 		      (substring package
! 				 (match-beginning 1) (match-end 1)))))
! 	  package)))))
  
  ;;;
  (defun package-lisp ()

--Multipart_Wed_Mar_12_09:57:27_1997-1--

