Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/sml-mode/sml-proc.el
ViewVC logotype

Diff of /sml/trunk/sml-mode/sml-proc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 39, Sat Mar 14 04:41:37 1998 UTC revision 300, Thu May 27 22:01:36 1999 UTC
# Line 372  Line 372 
372  (defvar sml-error-file nil)             ; file from which the last error came  (defvar sml-error-file nil)             ; file from which the last error came
373  (defvar sml-real-file nil)              ; used for finding source errors  (defvar sml-real-file nil)              ; used for finding source errors
374  (defvar sml-error-cursor nil)           ;   ditto  (defvar sml-error-cursor nil)           ;   ditto
 (defvar sml-error-barrier nil)          ;   ditto  
375    
376  (defun sml-proc-buffer ()  (defun sml-proc-buffer ()
377    "Returns the current ML process buffer,    "Returns the current ML process buffer,
# Line 489  Line 488 
488    
489    ;; For sequencing through error messages:    ;; For sequencing through error messages:
490    
491    (set (make-local-variable 'sml-error-cursor)    (set (make-local-variable 'sml-error-cursor) (point-max-marker))
492         (marker-position (point-max-marker)))    (set (make-local-variable 'sml-real-file) nil)
   (set (make-local-variable 'sml-error-barrier)  
        (marker-position (point-max-marker)))  
   (set (make-local-variable 'sml-real-file) (cons nil 0))  
493    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
494         inferior-sml-font-lock-defaults)         inferior-sml-font-lock-defaults)
495    
# Line 626  Line 622 
622           (comint-send-string (sml-proc) ";\n")))           (comint-send-string (sml-proc) ";\n")))
623    (if and-go (switch-to-sml nil)))    (if and-go (switch-to-sml nil)))
624    
625  ;; Update the buffer-local variables sml-real-file and sml-error-barrier  ;; Update the buffer-local variables sml-real-file
626  ;; in the process buffer:  ;; in the process buffer:
627    
628  (defun sml-update-barrier (file pos)  (defun sml-update-barrier (&optional file pos)
629    (let ((buf (current-buffer)))    (let ((buf (current-buffer)))
630      (unwind-protect      (unwind-protect
631          (let* ((proc (sml-proc))          (let* ((proc (sml-proc))
632                 (pmark (marker-position (process-mark proc))))                 (pmark (marker-position (process-mark proc))))
633            (set-buffer (process-buffer proc))            (set-buffer (process-buffer proc))
634            ;; update buffer local variables            ;; update buffer local variables
635            (setq sml-real-file (and file (cons file pos)))            (setq sml-real-file (and file (cons file pos))))
           (setq sml-error-barrier pmark))  
636        (set-buffer buf))))        (set-buffer buf))))
637    
638  ;; Update the buffer-local error-cursor in proc-buffer to be its  ;; Update the buffer-local error-cursor in proc-buffer to be its
# Line 650  Line 645 
645                 (pmark (marker-position (process-mark proc))))                 (pmark (marker-position (process-mark proc))))
646            (set-buffer proc-buffer)            (set-buffer proc-buffer)
647            ;; update buffer local variable            ;; update buffer local variable
648            (setq sml-error-cursor pmark))            (set-marker sml-error-cursor pmark))
649        (set-buffer buf))))        (set-buffer buf))))
650    
651  ;; This is quite bogus, so it isn't bound to a key by default.  ;; This is quite bogus, so it isn't bound to a key by default.
# Line 821  Line 816 
816        (cd dir))        (cd dir))
817      (setq sml-prev-l/c-dir/file (cons dir nil))))      (setq sml-prev-l/c-dir/file (cons dir nil))))
818    
819  (defun sml-send-command (cmd &optional dir)  (defun sml-send-command (cmd &optional dir print)
820    "Send string to ML process, display this string in ML's buffer"    "Send string to ML process, display this string in ML's buffer"
821    (if (sml-noproc) (save-excursion (run-sml t)))    (if (sml-noproc) (save-excursion (run-sml t)))
822    (let* ((my-dir (or dir (expand-file-name default-directory)))    (let* ((my-dir (or dir (expand-file-name default-directory)))
823           (cd-cmd (if my-dir           (cd-cmd (if my-dir (concat (format sml-cd-command my-dir) "; ") ""))
                      (concat (format sml-cd-command my-dir) "; ")  
                    ""))  
824           (buf (sml-proc-buffer))           (buf (sml-proc-buffer))
825             (win (get-buffer-window buf 'visible))
826           (proc (get-buffer-process buf))           (proc (get-buffer-process buf))
827           (string (concat cd-cmd cmd ";\n")))           (string (concat cd-cmd cmd ";\n")))
828      (save-some-buffers t)      (save-some-buffers t)
829      (save-excursion      (save-excursion
       (sml-update-cursor buf)  
830        (set-buffer buf)        (set-buffer buf)
831          (when win (select-window win))
832        (goto-char (point-max))        (goto-char (point-max))
833        (insert string)        (when print (insert string))
834        (if my-dir (cd my-dir))        (when my-dir (cd my-dir))
835        (set-marker (process-mark proc) (point))        (sml-update-cursor buf)
836        (process-send-string proc string))        (sml-update-barrier)
837          (set-marker (process-mark proc) (point-max))
838          (comint-send-string proc string))
839      (switch-to-sml t)))      (switch-to-sml t)))
840    
841  (defun sml-make (command)  (defun sml-make (command)
# Line 858  Line 854 
854      (while (and dir (not (file-exists-p (concat dir sml-make-file-name))))      (while (and dir (not (file-exists-p (concat dir sml-make-file-name))))
855        (let ((newdir (file-name-directory (directory-file-name dir))))        (let ((newdir (file-name-directory (directory-file-name dir))))
856          (setq dir (if (equal newdir dir) nil newdir))))          (setq dir (if (equal newdir dir) nil newdir))))
857      (sml-send-command command dir)))      (sml-send-command command dir t)))
858    
859  ;;; PARSING ERROR MESSAGES  ;;; PARSING ERROR MESSAGES
860    
# Line 910  Line 906 
906      ;; go to interaction buffer but don't raise it's frame      ;; go to interaction buffer but don't raise it's frame
907      (pop-to-buffer (sml-proc-buffer))      (pop-to-buffer (sml-proc-buffer))
908      ;; go to the last remembered error, and search for the next one.      ;; go to the last remembered error, and search for the next one.
909      (goto-char sml-error-cursor)      (goto-char (marker-position sml-error-cursor))
910      (if (not (re-search-forward sml-error-regexp (point-max) t))      (if (not (re-search-forward sml-error-regexp (point-max) t))
911          ;; no more errors -- move point to the sml prompt at the end          ;; no more errors -- move point to the sml prompt at the end
912          (progn          (progn
# Line 918  Line 914 
914            (if sml-window (select-window sml-window)) ;return there, perhaps            (if sml-window (select-window sml-window)) ;return there, perhaps
915            (message "No error message(s) found."))            (message "No error message(s) found."))
916        ;; error found: point is at end of last match; set the cursor posn.        ;; error found: point is at end of last match; set the cursor posn.
917        (setq sml-error-cursor (point))        (set-marker sml-error-cursor (point))
918        ;; move the SML window's text up to this line        ;; move the SML window's text up to this line
919        (set-window-start (get-buffer-window proc-buffer) (match-beginning 0))        (set-window-start (get-buffer-window proc-buffer) (match-beginning 0))
920        (let* ((pos)        (let* ((pos)
# Line 937  Line 933 
933              (sml-bottle "Sorry, can't locate errors on std_in.")              (sml-bottle "Sorry, can't locate errors on std_in.")
934            (if (string= file sml-temp-file)            (if (string= file sml-temp-file)
935                ;; errors found in tmp file; seek the real file                ;; errors found in tmp file; seek the real file
               (if (< (point) sml-error-barrier)  
                   ;; weird. user cleared *sml* and use'd the tmp file?  
                   (sml-bottle "Temp file error report is not current.")  
936                  (if (not (car sml-real-file))                  (if (not (car sml-real-file))
937                      ;; sent from a buffer w/o a file attached.                      ;; sent from a buffer w/o a file attached.
938                      ;; DEAL WITH THIS EVENTUALLY.                      ;; DEAL WITH THIS EVENTUALLY.
939                      (sml-bottle "No real file associated with the temp file.")                      (sml-bottle "No real file associated with the temp file.")
940                    ;; real file and error-barrier                    ;; real file and error-barrier
941                    (setq file (car sml-real-file))                    (setq file (car sml-real-file))
942                    (setq pos (cdr sml-real-file))))))                  (setq pos (cdr sml-real-file)))))
943          (if (not (file-readable-p file))          (if (not (file-readable-p file))
944              (sml-bottle (concat "Can't read " file))              (sml-bottle (concat "Can't read " file))
945            ;; instead of (find-file-other-window file) to lookup the file            ;; instead of (find-file-other-window file) to lookup the file

Legend:
Removed from v.39  
changed lines
  Added in v.300

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0