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-mode/trunk/sml-proc.el
ViewVC logotype

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

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

revision 1472, Sun Apr 4 07:17:07 2004 UTC revision 1478, Wed Apr 21 22:46:05 2004 UTC
# Line 1  Line 1 
1  ;;; sml-proc.el --- Comint based interaction mode for Standard ML.  ;;; sml-proc.el --- Comint based interaction mode for Standard ML.
2    
 ;; Copyright (C) 1989       Lars Bo Nielsen  
 ;; Copyright (C) 1994-1997  Matthew J. Morley  
3  ;; Copyright (C) 1999,2000,03,04  Stefan Monnier  ;; Copyright (C) 1999,2000,03,04  Stefan Monnier
4    ;; Copyright (C) 1994-1997  Matthew J. Morley
5    ;; Copyright (C) 1989       Lars Bo Nielsen
6    
7  ;; $Revision$  ;; $Revision$
8  ;; $Date$  ;; $Date$
# Line 207  Line 207 
207    :type '(regexp))    :type '(regexp))
208    
209  (defvar sml-error-regexp-alist  (defvar sml-error-regexp-alist
210    '(;; Poly/ML messages    `( ;; Poly/ML messages
211      ("\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)      ("\\(Error\\|Warning:\\) in '\\(.+\\)', line \\([0-9]+\\)" 2 3)
212      ;; Moscow ML      ;; Moscow ML
213      ("File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)      ("File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?, characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
214        ,@(if (not (fboundp 'compilation-fake-loc))
215      ;; SML/NJ:  the file-pattern is anchored to avoid      ;; SML/NJ:  the file-pattern is anchored to avoid
216      ;; pathological behavior with very long lines.      ;; pathological behavior with very long lines.
217              '(
218      ("^[-= ]*\\(.*[^\n)]\\)\\( (.*)\\)?:\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warning\\): .*" 1 sml-make-error 3 4 6 7)      ("^[-= ]*\\(.*[^\n)]\\)\\( (.*)\\)?:\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warning\\): .*" 1 sml-make-error 3 4 6 7)
     ;; SML/NJ's exceptions:  see above.  
219      ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7))      ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 sml-make-error 3 4 6 7))
220            '(("^[-= ]*\\(.*[^\n)]\\)\\( (.*)\\)?:\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)? \\(Error\\|Warnin\\(g\\)\\): .*" 1 (3 . 6) (4 . 7) (9))
221              ;; SML/NJ's exceptions:  see above.
222              ("^ +\\(raised at: \\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2 (3 . 6) (4 . 7)))))
223    "Alist that specifies how to match errors in compiler output.    "Alist that specifies how to match errors in compiler output.
224  See `compilation-error-regexp-alist' for a description of the format.")  See `compilation-error-regexp-alist' for a description of the format.")
225    
# Line 449  Line 453 
453    (if (= start end)    (if (= start end)
454        (message "The region is zero (ignored)")        (message "The region is zero (ignored)")
455      (let* ((buf (sml-proc-buffer))      (let* ((buf (sml-proc-buffer))
            (file (buffer-file-name))  
456             (marker (copy-marker start))             (marker (copy-marker start))
457             (tmp (make-temp-file "sml")))             (tmp (make-temp-file "sml")))
458        (write-region start end tmp nil 'silently)        (write-region start end tmp nil 'silently)
# Line 502  Line 505 
505    (interactive)    (interactive)
506    (sml-send-function t))    (sml-send-function t))
507    
 ;;; H A C K   A T T A C K !   X E M A C S   V E R S U S   E M A C S  
   
 (defun sml-drag-region (event)  
   "Highlight the text the mouse is dragged over, and send it to ML.  
 This must be bound to a button-down mouse EVENT, currently \\[sml-drag-region].  
   
 If you drag the mouse (ie, keep the mouse button depressed) the  
 program text sent to the complier is delimited by where you started  
 dragging the mouse, and where you release the mouse button.  
   
 If you only click the mouse, the program text sent to the compiler is  
 delimited by the current position of point and the place where you  
 click the mouse.  
   
 In either event, the values of both point and mark are left  
 undisturbed once this operation is completed."  
   (interactive "e")  
   (let ((mark-ring)                     ;BAD: selection start gets cons'd  
         (pmark (point)))                ;where point is now  
     (if (fboundp 'mouse-track-default)  
         ;; Assume this is XEmacs, otherwise assume its Emacs  
         (save-excursion  
           (let ((zmacs-regions))  
             (set-marker (mark-marker) nil)  
             (mouse-track-default event)  
             (if (not (region-exists-p)) (push-mark pmark nil t))  
             (call-interactively 'sml-send-region)))  
       ;; Emacs: making this buffer-local ought to happen in sml-mode  
       (make-local-variable 'transient-mark-mode)  
       (save-excursion  
         (let ((transient-mark-mode 1))  
           (mouse-drag-region event)  
           (if (not mark-active) (push-mark pmark nil t))  
           (call-interactively 'sml-send-region))))))  
   
   
508  ;;; LOADING AND IMPORTING SOURCE FILES:  ;;; LOADING AND IMPORTING SOURCE FILES:
509    
510  (defvar sml-prev-dir/file nil  (defvar sml-prev-dir/file nil
# Line 653  Line 620 
620  (defvar sml-endof-error-alist nil)  (defvar sml-endof-error-alist nil)
621    
622  (defun sml-update-cursor ()  (defun sml-update-cursor ()
623    ;; update buffer local variable    ;; Update buffer local variable.
624    (set-marker sml-error-cursor (1- (process-mark (sml-proc))))    (set-marker sml-error-cursor (1- (process-mark (sml-proc))))
625    (setq sml-endof-error-alist nil)    (setq sml-endof-error-alist nil)
626    (compilation-forget-errors)    (compilation-forget-errors)
627      (if (fboundp 'compilation-fake-loc)
628          (compilation-fake-loc (cdr sml-temp-file) (car sml-temp-file)))
629    (if (markerp compilation-parsing-end)    (if (markerp compilation-parsing-end)
630        (set-marker compilation-parsing-end sml-error-cursor)        (set-marker compilation-parsing-end sml-error-cursor)
631      (setq compilation-parsing-end sml-error-cursor)))      (setq compilation-parsing-end sml-error-cursor)))
# Line 696  Line 665 
665        ;; taken from compile.el        ;; taken from compile.el
666        (list err filename linenum column))))        (list err filename linenum column))))
667    
668    (unless (fboundp 'compilation-fake-loc)
669  (defadvice compilation-goto-locus (after sml-endof-error activate)  (defadvice compilation-goto-locus (after sml-endof-error activate)
670    (let* ((next-error (ad-get-arg 0))    (let* ((next-error (ad-get-arg 0))
671           (err (car next-error))           (err (car next-error))
# Line 711  Line 681 
681            (forward-char coldiff))            (forward-char coldiff))
682          (sml-error-overlay nil pos (point))          (sml-error-overlay nil pos (point))
683          (push-mark nil t (not sml-error-overlay))          (push-mark nil t (not sml-error-overlay))
684          (goto-char pos)))))          (goto-char pos))))))
685    
686  (defun sml-error-overlay (undo &optional beg end)  (defun sml-error-overlay (undo &optional beg end)
687    "Move `sml-error-overlay' to the text region in the current buffer.    "Move `sml-error-overlay' to the text region in the current buffer.
# Line 736  Line 706 
706              (end (or end (region-end))))              (end (or end (region-end))))
707          (move-overlay sml-error-overlay beg end (current-buffer))))))          (move-overlay sml-error-overlay beg end (current-buffer))))))
708    
 ;;; H A C K   A T T A C K !   X E M A C S   /   E M A C S   K E Y S  
   
 ;;(define-key sml-mode-map [(meta shift down-mouse-1)] 'sml-drag-region)  
   
709  (provide 'sml-proc)  (provide 'sml-proc)
710    
711  ;;; sml-proc.el ends here  ;;; sml-proc.el ends here

Legend:
Removed from v.1472  
changed lines
  Added in v.1478

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