view etc/ledit.l @ 30411:41f228350eca

Got rid of all byte-compiler warnings on Emacs Load ada-xref.el before ada-prj.el, so that the Project menu is created when ada-prj tries to add to it. (ada-activate-keys-for-case): Suppress the characters that are not part of the Ada syntax. Better compatibility with else-mode (ada-adjust-case-interactive): When auto-casing is not active, correctly insert newlines (used to insert only ^M). Prevent the syntax table from being changed in case of an error (or '_' becomes part of a word and some commands are confused). Do nothing if ada-auto-case is nil. (ada-after-keyword-p): Ignore keywords that are also attributes (ada-batch-reformat): Update usage comment (ada-call-from-contextual-menu): New function (ada-case-read-exceptions): Reinitialize the casing exception list first to nil first, so that the casing exception file can be shared. (ada-check-defun-name): Handles "configure" keyword for gnatdist files. (ada-compile-goto-error): Fix regexp used to detect a file:line anywhere in the error message (ada-contextual-menu-last-point): New variable (ada-create-keymap): If the variable delete-key-deletes-forward is t on XEmacs, it means that DEL should delete one character forward. (ada-create-menu): Use :included instead of :visible for XEmacs. New submenu "Options". (ada-end-stmt-re): Correctly indent "select ... then abort" statements. (ada-fill-comment-paragraph): Correctly delete all leading '--' even if they don't match ada-fill-comment-prefix Fix handling of paragraphs on the first or last line of a file. (ada-format-paramlist): Fix handling of default parameter values. (ada-get-body-name): New function. (ada-get-current-indent): Optimized by searchling directly for an existing generic part or a statement outside of it. Handle ada-indent-align-comments when indenting comments Replaced some regexps by testing directly the next character. This results in a huge speedup on some files. New indentation scheme for renames statements. Stop looking for the 'while' or 'for' associated with a 'loop' at the first semicolon encountered. A "return" can also match an anonymous access subprogram declaration. (ada-get-indent-noindent): Ignore strings and comments when looking for the keywords "record" and "private". (ada-goto-matching-decl-start): When matching "if", make sure we are not in fact seeing "end if". Ignore "when" statements except when initial keyword was "begin". Fix handling of nested procedures. Add a recursive call to this function to skip over other 'end' statmts. Fix indentation for "when .. => begin" (ada-in-open-paren-p): Fix indentation for complex boolean expressions, where 'and then', 'or else' and parenthesis statements are mixed up. (ada-in-paramlist-p): Skip comments while searching for the beginning Fix handling of operator declarations. (ada-indent-align-comments): New variable (ada-indent-current): Change the syntax table only in the protected section, so that we are sure it is restored correctly. (ada-indent-on-previous-lines): Use ada-use-indent and ada-with-indent Correctly indent "select ... then" (ada-indent-region): Slight speedup. (ada-indent-renames): New variable. (ada-last-which-function-subprog, ada-last-which-function-line): New variables (ada-looking-at-semi-private): Correctly indent the 'private' keyword when it is the first word in a package declaration. (ada-loose-case-word): Stop searching if at the end of the buffer. (ada-loose-case-word, ada-capitalize-word): Recase the whole word even if point is not initially at the end of the word. (ada-matching-decl-start-re): Add "when". (ada-mode): Add support for abbrev-mode, outline-mode and which-func-mode Override the old find-file.el entry in ff-special-constructs since it is using the obsolete ada-spec-suffix variable (ada-no-auto-case): New function (ada-scan-paramlist): When parsing the argument type, accept spaces (as in "X 'Class", generated by Rational Rose). (ada-other-file-name): No longer loads the other file. (ada-popup-menu): Save and restore the current buffer and cursor position before and after displaying the menu. (ada-search-ignore-complex-boolean): New function. (ada-uncomment-region): Emacs21 already knows how to delete comments not starting in the first column. (ada-use-indent): New variable (ada-which-function): New function. (ada-with-indent): New variable (ada-xemacs): evaluate it at compile time too, so that ada-mode.el can be batch-compiled from the command line.

;;; -*- Mode: lisp -*-

; load in the c functions

(removeaddress '_signal)
(removeaddress '_switch_to_proc)
(removeaddress '_set_proc_str)

(cfasl "/src/mdc/ledit/leditcfns.o" '_switch_to_proc 'emacs)

(getaddress '_set_proc_str 'set_proc_str)

(declare (special *ledit-infile*               ; emacs->lisp tempfile
		  *ledit-outfile*              ; lisp->emacs tempfile
		  *ledit-ppfile*               ; pp->emacs tempfile
                  *ledit-lisztfile*            ; compiler input
                  *ledit-objfile*              ; compiler output
		  *ledit-initialized*)         ; flag
	 )

(setq *ledit-initialized* nil)

;;; INIT-LEDIT

(defun init-ledit ()
  (let ((user (getenv '|USER|)))		;USER must be uppercase
       (setq
	 *ledit-outfile* (concat "/tmp/" user ".l2") ; lisp -> emacs
	 *ledit-infile*  (concat "/tmp/" user ".l1") ; emacs -> lisp
	 *ledit-ppfile*  (concat "/tmp/" user ".l3") ; pp output to emacs.
	 *ledit-lisztfile*  (concat "/tmp/" user ".l4")
	 *ledit-objfile*  (concat "/tmp/" user ".o")
	 *ledit-initialized* t)))

;;; LEDIT
; if 1 arg, arg is taken as a tag name to pass to emacs.
; if 2 args, second arg is a keyword.  If 2nd arg is pp,
; pp is applied to first arg, and result is sent to emacs
; to put in a buffer called LEDIT (which is first erased.)

(defun ledit fexpr (args)
    (apply #'ledit* args))

;;; LEDIT*

(defun ledit* n
    (if (not *ledit-initialized*) (init-ledit))
    (ledit-output (listify n))
    (syscall 10. *ledit-infile*)        ; syscall 10 is "delete"
    (syscall 10. *ledit-lisztfile*)
    (emacs)
    (ledit-input)
    (syscall 10. *ledit-outfile*)
    (syscall 10. *ledit-ppfile*)
    t)

;;; LEDIT-OUTPUT
;;; Egad, what a mess!  Doesn't work for XEMACS yet.
;;; Here's an example from Mocklisp:
;;; -> (defun bar (nothing) (bar nothing))
;;; bar
;;; -> (ledit bar)
;;; should produce...
;;; (progn) (progn tag (setq tag "bar") (&goto-tag))
;;; and
;;; -> (ledit bar pp)
;;; should stuff this to emacs...
;;; (progn) (switch-to-buffer "LEDIT") (erase-buffer)
;;; (insert-file "/tmp/walter.l3") (lisp-mode)
;;; and this...
;;; (def bar
;;;   (lambda (x)
;;;    (bar nothing)))
;;; into *LEDIT*

(defun ledit-output (args)
  (if args
      (let ((ofile (outfile *ledit-outfile*)))
	   (format ofile "(progn)")             ; this is necessary.

	   (cond ((null (cdr args)) ; no keyword -> arg is a tag.
		  (format ofile "(progn tag (setq tag \"~A\"~
			         (&goto-tag))"
			         (car args)))
		 ((eq (cadr args) 'pp)       ; pp-> pp first arg to emacs
		      (apply 'pp `((|F| ,*ledit-ppfile*) ,(car args)))
		      (format ofile "(switch-to-buffer \"LEDIT\")~
				     (erase-buffer)")
		      (format ofile "(insert-file \"~A\")"
			             *ledit-ppfile*)
		      (format ofile "(lisp-mode)"))
	   
		 (t (format t "~&~A -- unknown option~%" (cdr args))))
	   (close ofile))))

;;; LISZT*
;;; Need this guy to do compile-input.
;;; Liszt returns 0 if all was well.
;;; Note that in ordinary use the user will have to get used to looking
;;; at "%Warning: ... Compiler declared *foo* special" messages, since
;;; you don't usually want to hunt around in your file, zap in the the
;;; declarations, then go back to what you were doing.
;;; Fortunately this doesn't cause the compiler to bomb.
;;; Some sleepless night I will think of a way to get around this.

(defun liszt* (&rest args)
   (apply #'liszt args))

;;; LEDIT-INPUT
;;; Although there are two cases here, in practice
;;; it is never the case that there is both input to be
;;; interpreted and input to be compiled.

(defun ledit-input ()
  (if (probef *ledit-lisztfile*)
      (cond ((getd #'liszt)
	     (format t ";Compiling LEDIT:")
	     (and (zerop (liszt* *ledit-lisztfile* '-o *ledit-objfile*))
		  (load *ledit-objfile*)))
	    (t (format t ";Can't compile LEDIT: No liszt.~%;Reading instead:")
	       (let ((ifile (infile *ledit-lisztfile*)))
		 (ledit-load ifile)
		 (close ifile)))))

  (if (probef *ledit-infile*)
      (let ((ifile (infile *ledit-infile*)))
	(format t ";Reading from LEDIT:~%")
	(ledit-load ifile)
	(close ifile))))

;;; LEDIT-LOAD
;;; A generally useful form of load

(defun ledit-load (ifile)
  (let ((eof-form (list 'eof-form)))
    (do ((form (read ifile eof-form) (read ifile eof-form)))
      ((eq form eof-form))
      (format t ";  ~A~%" (eval form)))))

(setsyntax #/ 'macro 'ledit)                  ; make ^E = (ledit)<return>

;; more robust version of the c function set_proc_str. Does argument checking.
;; set_proc_str sets the string that is stuffed to the tty after franz pauses
;; and the csh wakes up. It is usually "%emacs" or "%vemacs" or "%?emacs"
(defun set-proc-str (arg)
  (if (stringp arg)
    (set_proc_str arg)
    (if (symbolp arg)
      (set_proc_str (get-pname arg))
      (error arg " is illegal argument to set-proc-str"))))