interfaces/emacs/misc/bookmode.el

   1 ;;;;;;;;;;;;;;;;;; bookmode.el ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;; bookmode for emacs for interacting with various programs such as
   3 ;;; maxima, dfplot, xplot, shells, octave, maple Regions of text can be
   4 ;;; made sensitive, and clicking on these regions can run commands which
   5 ;;; will then possibly modify the buffer or bring up a display or bring
   6 ;;; in other files.  The input for the commands is edited, killed yanked
   7 ;;; etc, as if this were a normal buffer.  It also allows hypertext
   8 ;;; links, using the push-file ;;; Copyright William F. Schelter
   9 ;;;
  10 ;; This file is part of GNU Emacs and is covered by the Gnu GPL:
  11 ;;
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 1, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;; The following is a "simple shell" much like the one in version 18
  28 ;; of emacs.   Unfortunately cmint breaks most code which tries to use
  29 ;; the shell mode, and is rather complex.
  30 ;;
  31 (require 'sshell)
  32 ;;
  33 ;; Bugfix, default.el also contains this line.
  34 (setq auto-mode-alist (cons '( "\\.bk$" . book-mode) auto-mode-alist))
  35 ;;
  36
  37 (defvar book-faces nil)
  38 (defvar book-face-default-background "pink")
  39 (defvar book-face-default-foreground "white")
  40 (defvar under-x-windows (eq (framep (selected-frame)) 'x))
  41
  42 (defun def-book-face (name eval-fun &optional copy-face bg fg)
  43   (make-face name)
  44   (put name 'book-eval-fun eval-fun)
  45   (or (member name book-faces)
  46       (setq book-faces (cons name book-faces)))
  47   (if copy-face (copy-face copy-face name))
  48   (cond ((and
  49           (eq (framep (selected-frame)) 'x)
  50           (x-display-color-p))
  51          (set-face-background name (or bg book-face-default-background))
  52          (set-face-foreground name (or fg book-face-default-foreground)))
  53         ((or bg fg) (invert-face name))))
  54
  55
  56 (def-book-face 'book-result nil 'bold "blue" "white")
  57 (def-book-face 'book-modified-result nil 'default "pink" "white")
  58 (def-book-face 'book-mouse-face nil 'underline "black" "white")
  59 (def-book-face 'book-mouse-face nil 'underline "white" "blue")
  60 (def-book-face 'book-mouse-face nil 'underline "white" "blue")
  61
  62 (defun show-saved-properties (&optional pos)
  63   "Show properties at point which will be saved"
  64   (interactive "d")
  65   (let ((lis saved-properties) tem (ans "Props: "))
  66     (while lis
  67       (cond ((setq tem (get-text-property pos (car (car lis))))
  68              (setq ans (format "%s (%s %s)" ans (car (car lis)) tem))))
  69       (setq lis (cdr lis)))
  70   (message "%s" ans)
  71   ans
  72   ))
  73
  74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75 ;;;; set up menu bar on top, to allow popping file.
  76
  77 (defvar bookmode-menu-bar-book-menu (make-sparse-keymap "Book"))
  78
  79 (define-key bookmode-menu-bar-book-menu [kill-emacs] '("Exit No Saving!" . kill-emacs))
  80 (define-key bookmode-menu-bar-book-menu [exit-emacs] '("Exit Emacs" . book-save-buffers-kill-emacs))
  81
  82
  83
  84 (define-key bookmode-menu-bar-book-menu [separator-xx]  '("--"))
  85 (define-key bookmode-menu-bar-book-menu [bk-hardcopy] '("Print" . bk-hardcopy))
  86 (define-key bookmode-menu-bar-book-menu [save-in-home] '("Save to Home" . save-in-home))
  87 (define-key bookmode-menu-bar-book-menu [pop-find-file] '("Back" . pop-find-file))
  88
  89 (put 'pop-find-file 'menu-enable 'find-file-pushed)
  90
  91
  92
  93
  94
  95 (define-key menu-bar-file-menu [pop-find-file] '("Back to previous file" . pop-find-file))
  96
  97 (defun book-save-buffers-kill-emacs ()
  98   (interactive)
  99   (offer-to-save-books)
 100   (kill-emacs))
 101
 102 ;;;
 103
 104
 105 (defvar book-mode-map nil "Keymap for book mode" )
 106 (defvar properties-to-save '(face book-command-arg read-only))
 107 (defun book-mode ()
 108  "
 109 Book mode provides commands for making certain regions sensitive
 110 and putting commands on these regions.
 111
 112 The special keys or clicks in this mode are
 113 \\<book-mode-map>
 114 \\{book-mode-map}
 115
 116 Use \\[book-eval] or equivalently \\[book-mouse-eval] to run a command
 117 associated to a region.  Such regions are distinguished by a different
 118 face:  underlining, inverse video or a different font depending on
 119 the screen capabilities.   Some such commands modify a result field
 120 which is further in the buffer.   You may modify the command field
 121 to try different parameters etc, and then reexecute.
 122
 123 \\[show-saved-properties] shows what commands are associated to
 124 the current point.
 125
 126 Creating book files:
 127 ===================
 128 After bringing in a new file in book mode (possibly by using
 129 find file for a file with the .bk suffix, after making sure
 130 bookmode.el has been loaded),
 131  use \\[book-mark-for-shell-eval] to make a region sensitive
 132  for \\[book-mouse-eval].  This would also prompt for the shell
 133  command you wish to run when that region is clicked on,
 134  use \\[book-mark-for-maxima-eval] to mark a region for evaluation
 135  by maxima  or
 136  use \\[book-mark-for-maple-eval] to mark a region for evaluation
 137  by maple.
 138
 139 To mark a region with other faces such as dfplot-eval use
 140 \\[set-face-region].
 141
 142 If you edit a book-mode file without bringing it in bookmode, or
 143 in another editor, you may edit the fields up to the end of the initial
 144 s expression (i.e. up to the \page character), in order to change the filenames
 145 or other material.   You may not edit the material after that \page, however
 146 since the numbering scheme for tracking regions starts at that point, and
 147 so editing after it would mean all offsets would likely be incorrect.
 148
 149 "
 150   (interactive)
 151   (cond (buffer-read-only
 152          (toggle-read-only 0)
 153          (auto-save-mode 0)))
 154   (make-local-variable 'write-region-annotate-functions)
 155   (or (member 'book-write-region-annotate write-region-annotate-functions)
 156       (setq write-region-annotate-functions
 157             (cons 'book-write-region-annotate
 158                   write-region-annotate-functions)))
 159   (setq under-x-windows (eq (framep (selected-frame)) 'x))
 160   (setq major-mode 'book-mode)
 161   (setq mode-name "Book")
 162   (or (boundp 'saved-properties)
 163       (setq saved-properties
 164             '((face) (book-command-arg) (read-only) )))
 165   (let ((lis book-faces) f)
 166         (while lis
 167           (setq f (car lis))(setq lis (cdr lis))
 168           (cond ((eq (framep (selected-frame)) 'x)
 169                  (cond ((get f 'book-eval-fun)
 170                         (or (face-differs-from-default-p f)
 171                             (copy-face 'bold-italic f))
 172                         (or (face-differs-from-default-p f)
 173                             (set-face-underline-p f t)))
 174                        (t
 175                         (or (face-differs-from-default-p f)
 176                             (copy-face 'bold f))))))
 177           (or (face-differs-from-default-p f)
 178               (invert-face f))))
 179   (if book-mode-map
 180     nil
 181   (setq book-mode-map (make-keymap))
 182   (let ((i ?\ ))
 183     (while (<= i ?~)
 184       (define-key book-mode-map (make-string 1 i) 'book-self-insert)
 185       (setq i (+ i 1))))
 186   (define-key book-mode-map "\C-d" 'book-delete-char)
 187
 188   (define-key book-mode-map [mouse-3] 'book-mouse-eval)
 189   (define-key book-mode-map [double-down-mouse-1] 'book-mouse-eval)
 190   (define-key book-mode-map [double-mouse-1] 'book-mouse-eval)
 191
 192
 193   (define-key book-mode-map "\C-cm" 'book-mark-for-maxima-eval)
 194   (define-key book-mode-map "\C-cu" 'book-unmark-all)
 195   (define-key book-mode-map "\C-cr" 'book-insert-sample-result)
 196   (define-key book-mode-map "\C-cs" 'book-mark-for-shell-eval)
 197   (define-key book-mode-map "\C-cl" 'book-mark-for-elisp-eval)
 198
 199   (define-key book-mode-map "\C-cf" 'set-face-region)
 200
 201   ;; hack
 202   (define-key book-mode-map "\C-cp" 'book-mark-for-maple-eval)
 203   (define-key book-mode-map "\C-cg" 'book-mark-for-gp-eval)
 204   (define-key book-mode-map "\C-c\C-cs" 'book-mark-for-Splus-eval)
 205   (define-key book-mode-map "\C-c\C-cr" 'book-mark-read-only)
 206   (define-key book-mode-map "\C-ca" 'book-mark-for-mma-eval)
 207   ;;
 208
 209   (define-key book-mode-map "\C-ce" 'book-eval)
 210   (define-key book-mode-map "\C-c?" 'show-saved-properties)
 211   (define-key book-mode-map [menu-bar book] (cons "Book" bookmode-menu-bar-book-menu))
 212    )
 213   (use-local-map book-mode-map)
 214   ;; 30 xterminals beep randomly can really be anoying!
 215  ;  (setq visible-bell t)
 216   (setq trim-versions-without-asking t)
 217   )
 218
 219 ;;;
 220 ;;; hack. It is extremely easy to get clicked twice on
 221 ;;; an expression. This little hack record down the time
 222 ;;; of the last mouse-eval and ignore the current click if
 223 ;;; it is less than  time-between-mouse-evals  apart, the
 224 ;;;; default is 3 seconds.
 225 ;;;;
 226
 227 ;; I have removed this!   For 2 days i thought the mode was broken,
 228 ;; because it was doing nothing when I clicked... I guess I click too fast!
 229 ;; I have added a message to reinforce the idea that something is happening
 230 ;; when you click, to prevent double clicking..
 231 ;(defvar last-mouse-eval-time 0 "time of the last mouse-eval")
 232 ;(defvar time-between-mouse-evals 3)
 233
 234 ;(defun book-mouse-eval (click)
 235 ;  "\\<book-mode-map>Follow a node reference near point.
 236 ;At end of the node's text, moves to the next node, or up if none."
 237 ;  (interactive "e")
 238 ;  (message "%s:%d" (car click)
 239 ;        (- (nth 1 (current-time)) last-mouse-eval-time))
 240 ;  (cond ((member (car click) '(double-mouse-1 mouse-3))
 241 ;        (let* ((start (event-start click))
 242 ;               (window (car start))
 243 ;               (pos (car (cdr start))))
 244 ;          (select-window window)
 245 ;          (goto-char pos))
 246 ;        (let (time)
 247 ;          (setq time (nth 1 (current-time)))
 248 ;          (cond ((> (abs (- time last-mouse-eval-time))
 249 ;                    time-between-mouse-evals)
 250 ;                 (setq last-mouse-eval-time time)
 251 ;                 (book-eval))
 252 ;                (t (message "you click too fast for mzou")))))))
 253
 254 (defun book-mouse-eval (click)
 255   "\\<book-mode-map>Follow a node reference near point.
 256 At end of the node's text, moves to the next node, or up if none."
 257   (interactive "e")
 258 ;  (message "%s" click)
 259   (cond ((member (car click) '(double-mouse-1 mouse-3))
 260          (let* ((start (event-start click))
 261                 (window (car start))
 262                 (pos (car (cdr start))))
 263            (select-window window)
 264            (goto-char pos))
 265          (book-eval))))
 266
 267
 268 (defun count-expr (ch string)
 269   (let ((n 0) (beg -1))
 270     (while (setq beg (string-match ch string (+ beg 1)))
 271       (setq n (+ n 1)))
 272     n))
 273
 274 (defun book-result-next (pos)
 275   "If next face change after pos is to book-result, return point"
 276   (let ((p (next-single-property-change pos 'face)))
 277     (and p (member (get-text-property p 'face) '(book-result
 278                                                  book-modified-result
 279                                                  ))
 280          p)))
 281
 282 (defun book-eval ()
 283   "Try to eval the current expression as delimited by the special
 284 characters"
 285   (interactive)
 286   (let* ((type (get-text-property (point) 'face))
 287          (eval-fun (get type 'book-eval-fun))
 288          )
 289     (or eval-fun (error "No book-eval-fun for type %s" type))
 290     (message "Using %s" eval-fun)
 291     (save-excursion
 292       (let* ((beg (or (previous-single-property-change (point) 'face) 1))
 293              (end (or (next-single-property-change (point) 'face)
 294                       (point-max)))
 295              (result (funcall eval-fun beg end type )))
 296         (cond (result
 297                (save-excursion
 298                  (goto-char end)
 299                    (let ((p (book-result-next end)))
 300                      (or p
 301                          (error "No place to put result: %s" result))
 302                    (setq result (maxima-trim-result result))
 303                    (goto-char p)
 304                    (delete-region p (next-single-property-change p 'face))
 305                    (cond ((and (string-match "\n" result)
 306                                (not  (equal (current-column) 0)))
 307                           (insert "\n")))
 308                    (insert result)
 309                    (put-text-property p (point)  'face 'book-result)))))))) )
 310
 311 (defun book-insert-sample-result()
 312   "Insert a place holder for a result from previous expression"
 313   (interactive)
 314   (let ((beg (point)) ans)
 315     (insert   "RESULT ")
 316     (put-text-property beg (- (point) 1) 'face 'book-modified-result)
 317     (show-saved-properties beg)
 318     ))
 319
 320 ;;;
 321 ;;;  hack.
 322 ;;;
 323 (defun book-unmark-all (&optional remove-all pos)
 324   (interactive "P\nd")
 325   " Remove marks on regions that contains the current point. If a numeric
 326     argument is given, it removes the read-only property also"
 327   (let ((inhibit-read-only remove-all))
 328     (book-unmark-expr pos)))
 329
 330 ;;;
 331 ;;;
 332 (defun book-unmark-expr (&optional pos)
 333   (interactive "d")
 334   "Remove special marks on regions that contain the current point.
 335    cannot remove the read-only property though. Use book-unmark-all
 336    to remove the read-only property"
 337   (let ((lis saved-properties) prop
 338         (inhibit-read-only t))
 339     (while lis
 340       (setq prop (car (car lis))) (setq lis (cdr lis))
 341       (if (get-text-property pos prop )
 342           (remove-text-properties
 343            (or (previous-single-property-change pos prop)
 344                (point-min))
 345            (or (next-single-property-change pos prop)
 346                (point-max))
 347            (list prop) ) ))))
 348
 349 (defun add-to-buffer (buf str)
 350   (save-excursion
 351     (set-buffer buf)
 352     (goto-char (point-max))
 353     (insert str)))
 354
 355 (defun alter-face-at (p value)
 356   (let ((beg (previous-single-property-change (+ p 1) 'face))
 357         (end (next-single-property-change p 'face)))
 358     ;(message "%s" (list p beg end))
 359     (put-text-property beg (or end (point-max)) 'face value)
 360     ))
 361
 362 (defun book-self-insert (&optional arg)
 363   "Change a result font to indicate the corresponding command was altered."
 364   (interactive "p")
 365   (maybe-change-result-field)
 366    (self-insert-command arg))
 367
 368 (defun maybe-change-result-field ()
 369   (let* ((p (point))
 370          (prop (and (> p 1) (get-text-property (- p 1) 'face))))
 371     (cond ((get prop 'insert)
 372            (setq p (book-result-next (next-single-property-change
 373                                       (- p 1) 'face)))
 374            (and p
 375                 (alter-face-at p 'book-modified-result))))))
 376
 377 (defun book-delete-char (n &optional killflag)
 378   (interactive "p\nP")
 379   (maybe-change-result-field)
 380   (delete-char n killflag))
 381
 382
 383
 384 ;;;;;;;;; buffer property saving for a file.
 385
 386 (defun buffer-properties-prop (min max prop)
 387   "Go thru buffer finding changes in value of PROP text property, and
 388 return a list of beg1 end1 value1 beg2 end2 value2 ...  for text
 389 values of PROP"
 390
 391   ;;
 392   ;; Bug fix, the original version does work when the the char
 393   ;; at MIN or MAX have some special marks.   7-24-95, mzou
 394   ;;
 395   ;; should write a better version!
 396   ;;
 397   (let ((p min) beg end beginning ans alist val tem)
 398     ;; check to see if MIN has non-nil mark
 399     (and p (setq beginning (get-text-property p prop)))
 400     (while (and p (or (setq beg (next-single-property-change  p prop))
 401                       beginning))   ; the whole buffer may be marked
 402                                     ; read-only.
 403                                     ;
 404       (cond (beginning              ; if there are marks at MIN
 405              (setq beg min)         ; save it first.
 406              (setq beginning nil))) ;
 407       (or (number-or-marker-p beg)  ; there are cases when beg is nil,
 408           (setq beg max))           ; and it broke there. ???
 409       (cond ((>= beg max)           ;
 410              (setq beg max)))       ; if called on a region ...
 411
 412       (setq end (next-single-property-change beg prop))
 413       (or (number-or-marker-p end)  ;
 414           (setq end max))           ; bug fix
 415
 416       (cond ((>= end max)
 417              (setq end max)
 418              (setq p nil))
 419             ((get-text-property end prop)
 420              (setq p (- end 1)))
 421             (t (setq p end)))
 422       (cond ( (setq val (get-text-property beg prop)) ; save non-nil only
 423               (or (setq tem (assoc val ans))
 424                   (setq ans (cons (setq tem (list val)) ans)))
 425               (setq tem (nconc tem (list beg end)))))
 426       )
 427     ans))
 428
 429
 430 (or (member 'install-props-after-insert-file after-insert-file-functions)
 431        (setq after-insert-file-functions
 432             (cons 'install-props-after-insert-file
 433                   after-insert-file-functions)))
 434
 435 (defvar install-props-magic "\x06\x01\x19\x16\x05\n"
 436   "A regexp such that (looking-at install-props-magic) is t
 437 and  going (match-end 0) will move us to the beginning of the
 438 saved-properties list to install.  The saved-properties list is
 439 followed by a new page character, and then the regular text of the
 440 file")
 441
 442 (defun install-props-after-insert-file (n)
 443     (cond
 444      ((looking-at install-props-magic)
 445       (install-props-after-insert-file1 n))
 446      (t n)))
 447
 448 ;;;
 449 ;;; hack, insert mouse-face property on theose regions
 450 ;;; which are suppose to be executed when a click event
 451 ;;; happens on them.  These regions are marked with one
 452 ;;; of the following faces.
 453 ;;;
 454 (setq put-mouse-face-on-them nil)
 455 (defvar put-mouse-face-on-them
 456   (list 'book-shell-eval 'book-elisp-eval 'dfplot-eval
 457         'maxima-eval-insert 'maxima-eval 'octave-eval
 458         'xplot-eval 'shell-eval-region 'maple-eval
 459         'gp-eval 'Splus-eval 'book-shell-eval-insert
 460         'maple-eval-insert 'gp-eval-insert 'mma-eval
 461         'mma-eval-insert 'Splus-eval-insert))
 462 ;;;
 463 ;;;
 464 (defun install-props-after-insert-file1 (n)
 465   (let* (val (pt (point)) (mod (buffer-modified-p)))
 466     (goto-char (match-end 0))
 467     (let ((saved-properties (read (current-buffer)))
 468           (end (point)))
 469       (or (looking-at "\f") (error "bad props"))
 470       (forward-char 1)                  ;past new page mark.
 471       (delete-region pt (point))
 472       (let ((lis saved-properties)
 473             prop x values)
 474         (while lis
 475           (setq x (car lis))
 476           (setq lis (cdr lis))
 477           (setq prop (car x))
 478           (setq values (cdr x))
 479           (while values
 480             (setq x (car values))
 481             (setq values (cdr values))
 482             (setq val (car x))
 483             (setq x (cdr x))
 484             (while x
 485               (put-text-property (car x) (nth 1 x)  prop val)
 486               ;;
 487               ;; hack
 488               (cond ( (member val put-mouse-face-on-them )
 489                       (put-text-property (car x) (nth 1 x)
 490                                          'mouse-face 'book-mouse-face)))
 491               ;;
 492               (setq x (nthcdr 2 x))))
 493           ))
 494       (or mod (set-buffer-modified-p nil))
 495       (- n (- end pt))
 496       )))
 497
 498
 499
 500
 501 ;; unfortunately format truncates at newlines...
 502 ;; format "%s%S\f" install-props-magic ans
 503 (defun book-write-region-annotate (beg end)
 504   (save-excursion
 505     (let (ans prop (lis properties-to-save) vals string)
 506       (while lis
 507         (setq prop (car lis)) (setq lis (cdr lis))
 508         (setq vals  (buffer-properties-prop beg end prop))
 509         (cond (vals
 510                (setq ans (cons (cons prop vals)
 511
 512                                ans))))
 513         )
 514       (cond (ans
 515              (setq ans (nreverse ans))
 516              (let ((buf (generate-new-buffer " saving")))
 517                (set-buffer buf)
 518                (insert install-props-magic)
 519                (prin1 ans buf)
 520                (insert "\f")
 521                (setq string (buffer-substring (point-min) (point-max)))
 522                (kill-buffer buf)))
 523             (t  (setq string (format "%s%S\f" install-props-magic ans ))))
 524       (list (cons 1 string)))))
 525
 526
 527 (defun set-face-region (&optional face)
 528   "Make the current region have FACE, eg dfplot-eval, octave-eval"
 529   (interactive)
 530   (or face (setq face (completing-read "Face: "
 531                                        (apply 'vector (face-list)))))
 532   (cond ((stringp face) (setq face (intern face))))
 533   (put-text-property (region-beginning) (region-end) 'face face)
 534   (put-text-property (region-beginning)
 535                      (region-end)
 536                      'mouse-face 'book-mouse-face)
 537   )
 538
 539 ;;;;;;;; code for evaluation of general form in shell ;;;
 540 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 541
 542 (def-book-face 'book-shell-eval 'book-shell-eval 'bold "YellowGreen" "black")
 543 (def-book-face 'book-elisp-eval 'book-elisp-eval 'bold  "YellowGreen" "red2")
 544 (def-book-face 'book-elisp-eval 'book-elisp-eval 'bold  "White" "red2")
 545
 546 (defvar book-command-arg-history nil)
 547
 548 (defun book-mark-for-shell-eval (&optional do-insert beg end com1)
 549   "Mark the region for evaluation by shell.  You must quote spaces
 550   with control-q, because of the completion mechanism.  If a numeric
 551   argument is set then the next <Result> place will get the output
 552   from running the shell command.  If 'insert' mode is specified then
 553   the emacs will wait until the command completes, whereas otherwise
 554   it will run in the background."
 555
 556   (interactive "P\nr")
 557   (let ((com (or
 558               com1 (get-text-property beg 'book-command-arg)))
 559         (table
 560          (buffer-properties-prop (point-min) (point-max) 'book-command-arg)))
 561     (book-unmark-expr beg)
 562     (put-text-property beg end 'face
 563                        (if do-insert 'book-shell-eval-insert 'book-shell-eval
 564                            ))
 565     (put-text-property beg
 566                        end
 567                        'book-command-arg
 568                        (or com1
 569                            (completing-read "Shell Command: " table nil nil
 570                                             com  'book-command-arg-history
 571                                             )))
 572     (or (not do-insert) (maybe-add-result-field end))
 573     ))
 574
 575 (defun maybe-add-result-field (end)
 576   (or
 577    (not book-maxima-auto-result-insert)
 578       (book-result-next end)
 579       (save-excursion (goto-char end)
 580                       (insert
 581                        (nth (random (length book-maxima-auto-result-insert))
 582                             book-maxima-auto-result-insert))
 583                       (book-insert-sample-result))))
 584
 585
 586 (defun book-mark-for-elisp-eval (&optional beg end com1)
 587   "Mark for elisp eval.   You must quote spaces with control-q, because
 588    of the completion mechanism."
 589   (interactive "r")
 590   (let ((com (or com1 (get-text-property beg
 591                                          'book-command-arg)))
 592         (table (buffer-properties-prop (point-min) (point-max)
 593                                        'book-command-arg))
 594         )
 595     (book-unmark-expr beg)
 596     (put-text-property beg
 597                        end
 598                        'face 'book-elisp-eval)
 599     (put-text-property beg
 600                        end
 601                        'mouse-face 'book-mouse-face)
 602     (put-text-property beg
 603                        end
 604                        'book-command-arg
 605                        (or com1
 606                            (completing-read "Elisp Command: " table nil nil
 607                                             com  'book-command-arg-history
 608                                             )))))
 609 (defun book-elisp-eval (beg end type &optional command)
 610   (let ((com (or command (get-text-property beg 'book-command-arg))))
 611     (eval (read com)))
 612   nil)
 613
 614 ;;;
 615 ;;; mark a region to be read-only. This is primarily for
 616 ;;; buttons in the buffer. (don't want students  midify them)
 617 ;;;  7-24-95, mzou
 618 ;;;
 619 (defun book-mark-read-only (&optional beg end)
 620   "Mark the current region read-only. To remove read-only property,
 621     use the function book-unmark-expr"
 622   (interactive "r")
 623   (put-text-property beg end 'read-only t)
 624   (message "region [%d %d] marked read-only" beg end))
 625 ;;;
 626 ;;;
 627
 628 (defvar find-file-pushed nil "List of file positions from find-file-pushed")
 629 (defun push-find-file (name &optional string)
 630   "Follow a link to FILENAME optionally searching for STRING in the file"
 631   (interactive)
 632   (setq  find-file-pushed
 633          (cons (make-marker )  find-file-pushed))
 634   (set-marker (car find-file-pushed) (point) (current-buffer))
 635   (find-file name)
 636   (cond (string
 637          (let ((at (point)))
 638            (goto-char (point-min))
 639            (or (search-forward string nil t)
 640                (goto-char at)))))
 641   )
 642 (defun pop-find-file ()
 643   "If you have followed a link, return back to where you were"
 644   (interactive)
 645   (cond (find-file-pushed
 646          (let ((at (car find-file-pushed)))
 647            (switch-to-buffer (marker-buffer at))
 648            (goto-char at)
 649            (setq find-file-pushed (cdr find-file-pushed))
 650            (set-marker at nil))))
 651   nil)
 652
 653 ;;;;;;;;;;;Postscript insertion stuff;;;;;;;;;;;;;;
 654 (def-book-face 'book-postscript-insert 'book-postscript-insert-eval nil
 655   "beige" "black")
 656 (defvar book-faces-that-make-postscript '((dfplot-eval "~/dfplot.ps")
 657                                           (xplot-eval "~/zplot.ps")
 658                                           (maxima-eval "~/maxout.ps")
 659                                           (octave-eval "~/gnuplot.ps")
 660                                           (maxima-eval-insert "~/maxout.ps")
 661                                           ))
 662
 663
 664 (defun book-postscript-insert-eval (beg end type)
 665   (let* ((com (get-text-property beg 'book-command-arg))
 666          (p (previous-single-property-change beg 'face))
 667          (tem (and p (assoc (get-text-property (- p 1) 'face)
 668                             book-faces-that-make-postscript)))
 669          (menu
 670                 (list
 671                  "Do What1?"
 672                  (list "Insert Named Postscript File" 'book-set-postscript-value
 673                        beg end)
 674                  (and (car com)
 675                       (list
 676                        "View Current Postscript" 'book-view-postscript   (car com)))
 677                  (and tem
 678                       (list (concat "Set Postscript to "(nth 1 tem))
 679                             'book-set-postscript-value beg end (nth 1 tem)))
 680
 681                   (and tem
 682                        (list (concat "View "(nth 1 tem))
 683                              'call-process  "ghostview" nil nil nil
 684                              (expand-file-name(nth 1 tem))
 685                              ))
 686                   (list "Cancel")
 687                   )))
 688
 689     (setq menu (delete nil menu))
 690     (setq com (x-popup-menu t (list "Do whate? " menu)))
 691     (message "%s" com)
 692     (eval com)
 693     nil
 694     ))
 695
 696 (defun book-view-postscript (string)
 697   (let ((buf (get-buffer-create "ps view")))
 698     (set-buffer buf)
 699     (erase-buffer)
 700     (insert string)
 701     (call-process-region (point-min) (point-max) "sh" t
 702                          0 ; means dont wait.
 703                          nil "-c"
 704                          ;; construct command to pass to the shell.
 705                          (concat
 706                           (cond ((looking-at "%PS") "")
 707                                 (t "gzip -dc | "))
 708                           "ghostview -")
 709
 710         )))
 711
 712 (defun book-set-postscript-value ( beg end &optional file)
 713   (interactive "r")
 714   "Put the postscript FILE as a file to insert for current region"
 715   (or file (setq file (read-file-name "Postscript file: " )))
 716   (let* ((date           (nth 5 (file-attributes file)))
 717          (buf (generate-new-buffer "pszip"))
 718          string)
 719     (save-excursion
 720       (set-buffer buf)
 721       (insert-file-contents file nil)
 722       (call-process-region  (point-min)(point-max) "gzip" t buf nil "-c")
 723       (setq string (buffer-substring (point-min) (point-max)))
 724       (kill-buffer buf))
 725     (put-text-property beg end 'book-command-arg
 726                        (list string date))))
 727
 728 ;;;;;;;;;;end postscript insert stuff;;;;;;;;;;
 729
 730 (defvar book-shell-program nil
 731  "Program to use for shell for executing commands given to book-shell-eval
 732 `sh' will be used if none is supplied")
 733
 734 (defun book-start-process (name buffer program &rest prog-args)
 735   "Start a program in a subprocess.  Return the process object for it.
 736 Args are NAME BUFFER PROGRAM &rest PROGRAM-ARGS
 737 NAME is name for process.  It is modified if necessary to make it unique.
 738 BUFFER is the buffer or (buffer-name) to associate with the process.
 739 "
 740   (let ((proc (apply 'start-process name buffer program prog-args))
 741         (i 0)
 742         result
 743         tem
 744         buf)
 745     (put-process-prop proc 'last-output "")
 746     (setq buf (get-buffer buffer))
 747     (set-marker (process-mark proc)
 748                 (if buf (save-excursion (set-buffer buf) (point-max)) 1)
 749                 (set-process-buffer proc (or buf (get-buffer-create buffer))))
 750     (put-process-prop proc 'started nil)
 751     (set-process-filter proc 'book-process-filter)
 752     (while (< i 10)
 753       (cond ((get-process-prop proc 'started)
 754              (setq i 11)
 755              (setq result proc))
 756             (t (setq i (+ i 1))
 757                (sleep-for 1))))
 758     (or result (error "could not start process %s" name))
 759     result))
 760
 761
 762 (defun book-shell-eval (beg end type &optional command)
 763   (let* (res
 764          (com (or command (get-text-property beg 'book-command-arg)))
 765          (sh (or book-shell-program
 766                                        "/bin/sh"))
 767          (proc (start-process "*book-shell-output*" "*book-out*"
 768                                    sh
 769                                    "-s"
 770                                    ))
 771          (buf (process-buffer proc))
 772          (marker (process-mark proc))
 773          (at-end "<AT fayve END>")
 774          )
 775     (let ((i 10))
 776       (while (> i 0)
 777         (cond ((setq beg (marker-position marker))
 778                (setq i -1)))
 779         (setq i (- i 1))
 780         (sit-for 0 400)
 781         ))
 782     (or beg (error "problem starting process ?"))
 783     (cond (com
 784            (message "executing in %s: %s" sh com)
 785            (process-send-string proc
 786                                 (concat com
 787                                         ";echo '" at-end
 788                                         "'\nexit\nexit\n\x04\nn"))
 789            ))
 790     (cond ((eq type 'book-shell-eval-insert)
 791            ;; must grab the result...
 792            (while (equal (process-status proc) 'run)
 793              (sleep-for  1))
 794            (save-excursion
 795              (set-buffer buf)
 796              (goto-char beg)
 797              (cond ((search-forward at-end nil t)
 798                     (message "..done")
 799                     (buffer-substring beg (- (point) (length at-end) 1)))
 800                    (t (error "did not terminate normally")))))
 801           (t nil))))
 802
 803 (def-book-face 'book-shell-eval-insert 'book-shell-eval
 804       'underline "YellowGreen" "black")
 805 (put 'book-shell-eval-insert 'insert t)
 806
 807 (defun dfplot-eval (beg end type)
 808   "Call dfplot on a region and send output to ~/dfplot.ps"
 809
 810   (let* ((default-directory "~/")
 811          (proc (book-start-process "*book-dfplot-output*" "*book-out*"
 812                              "dfplot")))
 813     (let ((com  (concat (buffer-substring beg end)
 814                         " ;\n plot ; \n set output 'dfplot.ps' ;\n "
 815                         " replot \n\n quit \n"))
 816           )
 817       (message "executing %s" com)
 818       (process-send-string proc com))))
 819
 820 (def-book-face  'dfplot-eval 'dfplot-eval 'underline "yellow2"  "black")
 821
 822 ;;;;;;;; code for maxima evaluation.;;;;;;;;;;;;;
 823 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 824
 825 ;; make maxima-eval-insert face do insertion of result
 826
 827 (def-book-face 'maxima-eval-insert 'maxima-eval 'underline "yellow" "black" )
 828
 829 (put 'maxima-eval-insert 'insert t)
 830
 831 (def-book-face 'maxima-eval 'maxima-eval 'underline "yellow" "black" )
 832
 833 (defvar maxima-eval nil)
 834
 835 (defun book-mark-for-maxima-eval (eval-only beg end)
 836   "Mark the current region to be evaluated by maxima and
 837 substituted in the next book result region.   If a
 838 numeric arg is supplied, dont wait for the evaluation nor
 839 insert the result.  The variable book-maxima-auto-result-insert
 840 affects whether a sample result is inserted.
 841 "
 842   (interactive "P\nr")
 843   (put-text-property beg
 844                      end
 845                      'face (if eval-only 'maxima-eval 'maxima-eval-insert))
 846   (put-text-property beg
 847                      end
 848                      'mouse-face 'book-mouse-face)
 849   (or eval-only
 850       (not book-maxima-auto-result-insert)
 851       (book-result-next end)
 852       (save-excursion (goto-char end)
 853                       (insert
 854                        (nth (random (length book-maxima-auto-result-insert))
 855                             book-maxima-auto-result-insert))
 856                       (book-insert-sample-result)))
 857   (show-saved-properties beg)
 858   )
 859
 860 (defun m1 (&optional eval-only )
 861   (interactive "P")
 862   (let (beg end)
 863   (save-excursion
 864     (progn (re-search-forward "[ \n\t]" nil t) (setq end (- (point) 1))))
 865   (save-excursion
 866     (progn (re-search-backward "[ \n\t]" nil t) (setq beg (+ 1 (point)))))
 867   (book-mark-for-maxima-eval eval-only beg end)))
 868
 869 (defvar book-maxima-auto-result-insert '(" yields " " evaluates to "
 870                                          " returns " " produces " " gives " )
 871   "If not nil a sample result field will be inserted after the
 872 maxima expression.   It should be a list of strings which will
 873 be used at random between the form to eval and the `result'")
 874
 875 (defvar book-maxima-ready-for-input nil)
 876
 877
 878 (defun add-to-process-buffer (proc str)
 879 ;  (setq me proc)
 880   (let (moving (buf (current-buffer)))
 881     (unwind-protect
 882         (progn
 883           (set-buffer (process-buffer proc))
 884           (setq moving (= (point) (process-mark proc)))
 885           (save-excursion
 886             (goto-char (process-mark proc))
 887             (insert str)
 888             (set-marker (process-mark proc) (point)))
 889           (if moving (goto-char (process-mark proc))))
 890       (set-buffer buf))))
 891 (defun get-process-prop (proc prop)
 892   (if (processp proc) (setq proc (intern (process-name proc))))
 893   (get proc prop))
 894
 895 (defun put-process-prop (proc prop val)
 896   (if (processp proc) (setq proc (intern (process-name proc))))
 897   (put proc prop val))
 898
 899 (defvar last-maxima-result nil)
 900 (defvar book-result nil)
 901
 902 (defun book-maxima-process-filter ( proc str)
 903   (let (tem )
 904     (book-process-filter proc str)
 905     (put-process-prop proc 'last-output
 906                       (concat (get-process-prop proc 'last-output)
 907                               str))
 908     (cond ((setq tem (string-match "(C[0-9]+)[ ]*$"
 909                                    (get-process-prop proc 'last-output)))
 910            (setq book-maxima-ready-for-input t)
 911            (setq last-maxima-result
 912                  (substring (get-process-prop proc 'last-output)  0 tem ))
 913            (put-process-prop proc 'last-output "")
 914            )
 915           ((string-match ">>$" str)
 916            (process-send-string proc ":t\n")
 917            (message "had error")
 918            (setq book-result "<had-error>"))
 919           )))
 920
 921
 922 (defun book-process-filter ( proc str)
 923   (add-to-process-buffer proc str)
 924   (put-process-prop proc 'started t)
 925   )
 926
 927 (defun maxima-restart ()
 928   (setq maxima-eval nil)
 929   (if (get-buffer "*maxima-eval*")
 930       (kill-buffer (get-buffer "*maxima-eval*") )))
 931
 932 (defun book-maxima-interrupt ()
 933   "Interrupt the *maxima-eval* process running for book mode"
 934   (interactive)
 935   (cond (maxima-eval
 936          (interrupt-process maxima-eval))
 937         (t (error "*maxima-eval* process not found"))))
 938
 939 (defun maxima-eval (beg end type)
 940   "Evaluate the region returning a result"
 941   (let (tem (process (get-process  "*maxima-eval*")))
 942     (cond ((not  (and maxima-eval
 943                       (setq process (get-buffer-process maxima-eval))))
 944            (cond ((and under-x-windows x-display-name
 945                        (not (getenv "DISPLAY")))
 946                   (setq process-environment
 947                         (cons (concat "DISPLAY=" x-display-name)
 948                               process-environment))))
 949            (let ((default-directory "~/"))
 950              (setq maxima-eval (make-sshell "maxima-eval" "maxima" )))
 951            (setq process (get-buffer-process  maxima-eval))
 952            (set-process-filter process 'book-maxima-process-filter)
 953            ))
 954     (let ((com (buffer-substring beg end)))
 955       (or (string-match  "[;$][ \t\n]*$" com)
 956           (setq com (concat com ";" )))
 957       (setq com (concat com "\n"))
 958       (while (not book-maxima-ready-for-input)
 959         (message "waiting till maxima ready for input..")
 960         (process-send-string process "\n")
 961         (sleep-for 1))
 962       (message  "sending command :%s " com )
 963       (setq last-maxima-result nil)
 964       (process-send-string process com))
 965     (cond ((equal type 'maxima-eval-insert)
 966            (while (not last-maxima-result)
 967              (message "waiting for result...")
 968              (sleep-for 1))
 969            (message "done")
 970            (setq tem (maxima-trim-result last-maxima-result))
 971            (setq last-maxima-result nil)
 972            tem))))
 973
 974 (defun maxima-trim-result (x)
 975   (let (tem)
 976     (cond ((equal 1 (count-expr "\n" x))
 977            (cond ((string-match "(D[0-9]+)" x)
 978                   (setq x (substring x (match-end 0)))))
 979            (cond ((setq tem (string-match "\n$" x))
 980                   (setq x (substring x 0 tem))))
 981            (cond ((not (string-match "\n" x))
 982                   (cond ((string-match "[ \t]+" x)
 983                          (setq x (substring x (match-end 0)))))))
 984            x)
 985           (t (cond ((setq tem (string-match "(D[0-9]+)" x))
 986                     (while (< tem (match-end 0))
 987                       (aset x tem ? )
 988                       (setq tem (+ tem 1)))))
 989              x))))
 990 ;;;;;;;; end code for maxima evaluation.
 991
 992 ;; for octave eval
 993 (defun octave-eval (beg end type)
 994   "Call octave on a region and send output to ~/octave.ps"
 995
 996   (let* ((default-directory "~/")
 997          (proc (book-start-process "*book-octave-output*" "*book-out*"
 998                              "octave")))
 999     (let ((com  (concat
1000             "gnuplot_binary='tk_gnuplot1';\n"
1001             "set title 'Plot for " (user-real-login-name)  " on "
1002                 (current-time-string) "';\n"
1003                  (buffer-substring beg end)
1004                         "\n quit;\n"
1005                         )))
1006       (message "executing %s" com)
1007       (process-send-string proc com))))
1008
1009 (def-book-face 'octave-eval 'octave-eval 'underline "yellow3" "black")
1010 ;; end octave
1011
1012
1013 ;; xplot
1014 (defun xplot-eval (beg end type)
1015   "Call xplot on a region and send output to ~/xplot.ps"
1016
1017   (let* ((default-directory "~/")
1018          (proc (book-start-process "*book-xplot-output*" "*book-out*"
1019                              "xplot")))
1020     (let ((com  (concat (buffer-substring beg end)
1021                         "\n plot \n  quit ; \n quit;\n\n")))
1022       (message "executing %s"  com)
1023       (process-send-string proc com))))
1024
1025 (def-book-face 'xplot-eval 'xplot-eval 'underline "yellow3" "black")
1026 ;; end xplot
1027
1028 (provide 'bookmode)
1029
1030 ;;;
1031 ;;; additions from mzou adopting maxima to maple, and
1032 ;;; cours- name stuff.
1033 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1034 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1035 ;;;
1036 ;;  mkdir ~/course-name if not already there
1037 ;;    copy the master file into it. These are
1038 ;;    done by the shell script find_course,
1039 ;;    push-find-file ~/course-name/master.bk
1040 ;;    set the global variable course-name (???)
1041 ;;
1042 (defvar course-name nil)
1043 (defvar project-name nil)
1044 (defvar start-time nil)
1045
1046
1047
1048 (defun select-course (name)
1049    "Make a directory ~/name and copy the master file into it"
1050  (setq course-name  name)
1051  (push-find-file (concat name "/master.bk")))
1052 ; (call-process "select_course" nil nil nil name)
1053 ; (push-find-file (concat (getenv "HOME") "/" name "/master.bk"))
1054 ; (setq start-time (current-time-string))
1055 ; (message (concat (getenv "HOME") "/" name "/master.bk")))
1056
1057
1058
1059 ;;
1060 ;;
1061 ;;  copy the project file into ~/course-name/ and
1062 ;;  push-find-file the-proj-file.
1063 ;;
1064 (defun select-project (name)
1065    "Select a project. Copy the proj-file into the right place"
1066    (setq project-name name)
1067    (push-find-file name))
1068
1069 ;;;
1070 ;;;  convert buffer to latex and print a hardcopy
1071 ;;;  if possible. have to write to a tmp-file in ~/
1072 ;;;  because the usr may not have the permission to
1073 ;;;  save the current buffer.
1074 ;;;
1075 (defun bk-hardcopy ( )
1076   "print out a nice hardcopy of the current buffer"
1077   (interactive)
1078   (let ((tmp-file) (old-back make-backup-files))
1079     (setq tmp-file (concat (getenv "HOME") "/pj_.bk"))
1080     (setq make-backup-files nil)
1081     (write-file tmp-file)
1082     (setq make-backup-files old-back)
1083     (start-process "printbk" nil "printbk" tmp-file )
1084     ;(call-process "printbk"  nil nil tmp-file "&")
1085     )
1086   nil)
1087 ;;;
1088 ;;; eval the shell command in region
1089 ;;;
1090 (def-book-face 'shell-eval-region 'shell-eval-region
1091   'bold "yellow2" "blue")
1092 (defun shell-eval-region (beg end type)
1093   "Exec the shell command in region"
1094   (let* ((default-directory "~/")
1095          (proc (book-start-process "*book-shell-output*" "*book-out*"
1096                              "sh")))
1097     (let ((com  (concat (buffer-substring beg end)
1098                         "\n exit \n")))
1099       (message "executing %s" com)
1100       (process-send-string proc com))))
1101 ;;;
1102 ;;;  A may be useful function.
1103 ;;;
1104 (defun turnin-project ( )
1105   "Turn in the current project"
1106   (save-buffer)
1107   (let ( project-file )
1108     (setq project-file (concat (getenv "HOME") "/"
1109                                 course-name "/"
1110                                 project-name))
1111     (call-process "turnin_project" nil nil nil
1112                   course-name project-file
1113                   start-time (current-time-string) ) ))
1114
1115 (defun offer-to-save-books ()
1116   (let ((tem  (buffer-list))
1117         vars b)
1118     (while tem
1119       (setq b (car tem))
1120       (setq tem (cdr tem))
1121       (setq vars (buffer-local-variables b))
1122       (cond ((and
1123               (buffer-modified-p b)
1124               (eq (cdr (assoc 'major-mode vars)) 'book-mode)
1125               (y-or-n-p  (format "Save changes to %s as %s ?"
1126                          (buffer-name b)
1127                          (get-home-directory-name
1128                           (buffer-file-name b)))
1129                          ))
1130              (save-excursion (set-buffer b)
1131                              (save-in-home)))))))
1132
1133 (defun get-home-directory-name (name)
1134   (let ((p (file-name-nondirectory name))
1135         (dir "~/"))
1136     (cond ((string-match "/books/\\|/courses/" name)
1137            (setq f (substring name (match-beginning 0)))
1138            (setq dir (concat "~" (file-name-directory f)))
1139            (concat dir p))
1140           (t name))))
1141
1142 (defun save-in-home ()
1143   (interactive "")
1144   (let* ((name (buffer-file-name (current-buffer)))
1145          (new (get-home-directory-name name))
1146          (default-directory default-directory ))
1147     (make-directory (file-name-directory new) t)
1148     (write-file new)))
1149
1150
1151 ;;;
1152 ;;;
1153 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1154 ;;;;;;;;;;; code for maple evaluation.;;;;;;;;;;;;;
1155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1156 ;;
1157 ;; make maple-eval-insert face do insertion of result
1158 ;;
1159 (def-book-face 'maple-eval-insert 'maple-eval
1160   'underline "Greenyellow" "black" )
1161
1162 (put 'maple-eval-insert 'insert t)
1163
1164 (def-book-face 'maple-eval 'maple-eval 'underline "Greenyellow" "black" )
1165
1166 (defvar maple-eval nil)
1167
1168 (defun book-mark-for-maple-eval (eval-only beg end)
1169   "Mark the current region to be evaluated by maple and
1170 substituted in the next book result region.   If a
1171 numeric arg is supplied, dont wait for the evaluation nor
1172 insert the result.  The variable book-maxima-auto-result-insert
1173 affects whether a sample result is inserted.
1174 "
1175   (interactive "P\nr")
1176   (put-text-property beg
1177                      end
1178                      'face (if eval-only 'maple-eval 'maple-eval-insert))
1179   (put-text-property beg
1180                      end
1181                      'mouse-face 'book-mouse-face)
1182   (or eval-only
1183       (not book-maxima-auto-result-insert)
1184       (book-result-next end)
1185       (save-excursion (goto-char end)
1186                       (insert
1187                        (nth (random (length book-maxima-auto-result-insert))
1188                             book-maxima-auto-result-insert))
1189                       (book-insert-sample-result)))
1190   (show-saved-properties beg)
1191   )
1192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1193 (defvar book-maple-ready-for-input nil)
1194 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1195 (defvar last-maple-result nil)
1196 (defun book-maple-process-filter ( proc str)
1197   (let (tem )
1198     (book-process-filter proc str)
1199     (put-process-prop proc 'last-output
1200                       (concat (get-process-prop proc 'last-output)
1201                               str))
1202
1203     (cond ((setq tem (string-match ";#z#"  ;;; terminating symbol
1204                                    (get-process-prop proc 'last-output)))
1205            (cond ((setq tem
1206                         (string-match "^>>[ ]*$" ;;; the prompt
1207                                       (get-process-prop proc 'last-output)))
1208                   (setq book-maple-ready-for-input t)
1209                   (setq last-maple-result (get-process-prop proc 'last-output))
1210                   (put-process-prop proc 'last-output ">> "))
1211                  )
1212           )
1213     )))
1214 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1215 (defun maple-restart ()
1216   (setq maple-eval nil)
1217   (if (get-buffer "*maple-eval*")
1218       (kill-buffer (get-buffer "*maple-eval*") )))
1219
1220 (defun book-maple-interrupt ()
1221   "Interrupt the *maple-eval* process running for book mode"
1222   (interactive)
1223   (cond (maple-eval
1224            (interrupt-process maple-eval))
1225         (t (error "*maple-eval* process not found"))))
1226
1227 (defun maple-eval (beg end type)
1228   "Evaluate the region returning a result"
1229   (let (tem (process (get-process  "*maple-eval*")))
1230     (cond ((not  (and maple-eval
1231                       (setq process (get-buffer-process maple-eval))))
1232            (cond ((and under-x-windows x-display-name
1233                        (not (getenv "DISPLAY")))
1234                   (setq process-environment
1235                         (cons (concat "DISPLAY=" x-display-name)
1236                               process-environment))))
1237            (let ((default-directory "~/"))
1238              (setq maple-eval (make-sshell "maple-eval" "maple52" )))
1239            (setq process (get-buffer-process  maple-eval))
1240            (set-process-filter process 'book-maple-process-filter)
1241            (process-send-string process
1242            "interface(echo=0,plotdevice=x11,prompt=`>> `,screenwidth=80);gc(0);")
1243            )
1244           )
1245     (let ((com (buffer-substring beg end)))
1246       (setq com (concat com ";#z#\n"))
1247       (while (not book-maple-ready-for-input)
1248         (message "waiting till maple ready for input..")
1249         (process-send-string process ";#z#\n")
1250         (sleep-for 1))
1251       (message  "sending command :%s " com )
1252       (setq last-maple-result nil)
1253       (process-send-string process com)
1254       )
1255     (cond ((equal type 'maple-eval-insert)
1256            (while (not last-maple-result)
1257              (message "waiting for result...")
1258              (sleep-for 1)
1259              )
1260            (message "done")
1261            (setq tem (maple-trim-result  last-maple-result))
1262            (setq last-maple-result nil)
1263            tem))))
1264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1265 (defun maple-trim-result (str)
1266   (let ( (tem) (x) (bgn 0) (end -1) (tstr) (ll) )
1267     (setq x "") (setq tstr "")
1268     (setq ll (length str))
1269     ;;
1270     ;; str contains mixed inputs and outputs, with inputs
1271     ;; matchs "^>>[^\n]*". Strip out all inpus. Also, maple
1272     ;; insert an extra "\n" at both the beginning and the end
1273     ;; of its outputs (except for error mesg)
1274     ;;
1275     (while (setq end (string-match "^>>[^\n]*" str (+ end 1)))
1276       (or (< end bgn)
1277           (setq x (concat  x (substring str bgn end))))
1278       (setq tem (+ (match-end 0) 1))
1279       (if  (> ll tem)
1280           (setq tstr (substring str tem (+ tem 1))))
1281       ( cond  ( (string-equal tstr "\n")
1282                 (setq bgn  (+ tem 1)))
1283               (t (setq bgn tem)))
1284       )
1285     ;;
1286     ;; if there is output at all, x is at least of length 2
1287     ;; including a trailling \n\n (yes 2 of them).
1288     ;; Strip one \n out.
1289     ;;
1290     (if (< (length x) 2)
1291         (setq x "OK")
1292       (setq x (substring x 0 (- (length x ) 1))))
1293     ;;
1294     ;; from maxima-trim-result. Strip out spaces if
1295     ;; output fits in one line.
1296     ;;
1297     (cond ((equal 1 (count-expr "\n" x))
1298            (cond ((setq tem (string-match "\n$" x))
1299                   (setq x (substring x 0 tem))))
1300            (cond ((not (string-match "\n" x))
1301                   (cond ((string-match "[ \t]+" x)
1302                          (setq x (substring x (match-end 0)))))))
1303            x)
1304           (t x))))
1305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1306 ;;;;;;;;;;; code for gp evaluation.;;;;;;;;;;;;;
1307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1308 ;;
1309 ;; make maple-eval-insert face do insertion of result
1310 ;;
1311 (def-book-face 'gp-eval-insert 'gp-eval 'underline "chartreuse" "black" )
1312
1313 (put 'gp-eval-insert 'insert t)
1314
1315 (def-book-face 'gp-eval 'gp-eval 'underline "chartreuse" "black" )
1316
1317 (defvar gp-eval nil)
1318
1319 (defun book-mark-for-gp-eval (eval-only beg end)
1320   "Mark the current region to be evaluated by gp and
1321 substituted in the next book result region.   If a
1322 numeric arg is supplied, dont wait for the evaluation nor
1323 insert the result.  The variable book-maxima-auto-result-insert
1324 affects whether a sample result is inserted.
1325 "
1326   (interactive "P\nr")
1327   (put-text-property beg
1328                      end
1329                      'face (if eval-only 'gp-eval 'gp-eval-insert))
1330   (put-text-property beg
1331                      end
1332                      'mouse-face 'book-mouse-face)
1333   (or eval-only
1334       (not book-maxima-auto-result-insert)
1335       (book-result-next end)
1336       (save-excursion (goto-char end)
1337                       (insert
1338                        (nth (random (length book-maxima-auto-result-insert))
1339                             book-maxima-auto-result-insert))
1340                       (book-insert-sample-result)))
1341   (show-saved-properties beg)
1342   )
1343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1344
1345 (defvar book-gp-ready-for-input nil)
1346 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1347 (defvar last-gp-result nil)
1348 (defun book-gp-process-filter ( proc str)
1349   (let (tem )
1350     (book-process-filter proc str)
1351     (put-process-prop proc 'last-output
1352                       (concat (get-process-prop proc 'last-output)
1353                               str))
1354     (cond ((setq tem (string-match "\?[ ]*$"
1355                                    (get-process-prop proc 'last-output)))
1356            (setq book-gp-ready-for-input t)
1357            (setq last-gp-result
1358                  (substring (get-process-prop proc 'last-output)  0 tem ))
1359            (put-process-prop proc 'last-output "")
1360            )
1361           )))
1362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1363 (defun gp-restart ()
1364   (setq gp-eval nil)
1365   (if (get-buffer "*gp-eval*")
1366       (kill-buffer (get-buffer "*gp-eval*") )))
1367
1368 (defun book-gp-interrupt ()
1369   "Interrupt the *gp-eval* process running for book mode"
1370   (interactive)
1371   (cond (gp-eval
1372          (interrupt-process gp-eval))
1373         (t (error "*gp-eval* process not found"))))
1374
1375 (defun gp-eval (beg end type)
1376   "Evaluate the region returning a result"
1377   (let (tem (process (get-process  "*gp-eval*")))
1378     (cond ((not  (and gp-eval
1379                       (setq process (get-buffer-process gp-eval))))
1380            (cond ((and under-x-windows x-display-name
1381                        (not (getenv "DISPLAY")))
1382                   (setq process-environment
1383                         (cons (concat "DISPLAY=" x-display-name)
1384                               process-environment))))
1385            (let ((default-directory "~/"))
1386              (setq gp-eval (make-sshell "gp-eval" "gp" )))
1387            (setq process (get-buffer-process  gp-eval))
1388            (set-process-filter process 'book-gp-process-filter)
1389            (process-send-string process  "\n")
1390            )
1391           )
1392     (let ((com (buffer-substring beg end)))
1393       (setq com (concat com "\n"))
1394       (while (not book-gp-ready-for-input)
1395         (message "waiting till gp ready for input..")
1396         (process-send-string process "\n")
1397         (sleep-for 1))
1398       (message  "sending command :%s " com )
1399
1400       (setq last-gp-result nil)
1401       (process-send-string process com)
1402       )
1403     (cond ((equal type 'gp-eval-insert)
1404            (while (not last-gp-result)
1405              (message "waiting for result...")
1406              (sleep-for 1)
1407              )
1408            (message "done")
1409            (setq tem (gp-trim-result  last-gp-result))
1410            (setq last-gp-result nil)
1411            tem))))
1412
1413 (defun gp-trim-result (x)
1414   (let (tem)
1415     (cond ((equal 0 (count-expr "\n" x))
1416            (setq x "OK")
1417            x)
1418           ((equal 1 (count-expr "\n" x))
1419            (cond ((string-match "%[0-9]+[ ]=" x)
1420                   (setq x (substring x (match-end 0)))))
1421            (cond ((setq tem (string-match "\n$" x))
1422                   (setq x (substring x 0 tem))))
1423            x)
1424           (t (cond ((setq tem (string-match "%[0-9]+[ ]=" x))
1425                     (while (< tem (match-end 0))
1426                       (aset x tem ? )
1427                       (setq tem (+ tem 1)))))
1428              x)) ))
1429 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1430 ;;;;;;;;;;; code for Splus evaluation.;;;;;;;;;;;
1431 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1432 ;;
1433 ;; make Splus-eval-insert face do insertion of result
1434 ;;
1435 (def-book-face  'Splus-eval-insert 'Splus-eval 'underline "LimeGreen" "black" )
1436
1437 (put 'Splus-eval-insert 'insert t)
1438
1439 (def-book-face 'Splus-eval 'Splus-eval 'underline "LimeGreen" "black" )
1440
1441 (defvar Splus-eval nil)
1442
1443 (defun book-mark-for-Splus-eval (eval-only beg end)
1444   "Mark the current region to be evaluated by Splus and
1445 substituted in the next book result region.   If a
1446 numeric arg is supplied, dont wait for the evaluation nor
1447 insert the result.  The variable book-maxima-auto-result-insert
1448 affects whether a sample result is inserted.
1449 "
1450   (interactive "P\nr")
1451   (put-text-property beg
1452                      end
1453                      'face (if eval-only 'Splus-eval 'Splus-eval-insert))
1454   (put-text-property beg
1455                      end
1456                      'mouse-face 'book-mouse-face)
1457   (or eval-only
1458       (not book-maxima-auto-result-insert)
1459       (book-result-next end)
1460       (save-excursion (goto-char end)
1461                       (insert
1462                        (nth (random (length book-maxima-auto-result-insert))
1463                             book-maxima-auto-result-insert))
1464                       (book-insert-sample-result)))
1465   (show-saved-properties beg)
1466   )
1467 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1468 (defvar book-Splus-ready-for-input nil)
1469 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1470 (defvar last-Splus-result nil)
1471 (defun book-Splus-process-filter ( proc str)
1472   (let (tem )
1473     (book-process-filter proc str)
1474     (put-process-prop proc 'last-output
1475                       (concat (get-process-prop proc 'last-output)
1476                               str))
1477     (cond ((setq tem (string-match ">[ ]*$"
1478                                    (get-process-prop proc 'last-output)))
1479            (setq book-Splus-ready-for-input t)
1480            (setq last-Splus-result
1481                  (substring (get-process-prop proc 'last-output)  0 tem ))
1482            (put-process-prop proc 'last-output "")
1483            )
1484           )))
1485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1486 (defun Splus-restart ()
1487   (setq Splus-eval nil)
1488   (if (get-buffer "*Splus-eval*")
1489       (kill-buffer (get-buffer "*Splus-eval*") )))
1490
1491 (defun book-Splus-interrupt ()
1492   "Interrupt the *Splus-eval* process running for book mode"
1493   (interactive)
1494   (cond (Splus-eval
1495          (interrupt-process Splus-eval))
1496         (t (error "*Splus-eval* process not found"))))
1497
1498 (defun Splus-eval (beg end type)
1499   "Evaluate the region returning a result"
1500   (let (tem (process (get-process  "*Splus-eval*")))
1501     (cond ((not  (and Splus-eval
1502                       (setq process (get-buffer-process Splus-eval))))
1503            (cond ((and under-x-windows x-display-name
1504                        (not (getenv "DISPLAY")))
1505                   (setq process-environment
1506                         (cons (concat "DISPLAY=" x-display-name)
1507                               process-environment))))
1508            (let ((default-directory "~/"))
1509              (setq Splus-eval (make-sshell "Splus-eval" "Splus" )))
1510            (setq process (get-buffer-process  Splus-eval))
1511            (set-process-filter process 'book-Splus-process-filter)
1512            (process-send-string process  "\n")
1513            )
1514           )
1515     (let ((com (buffer-substring beg end)))
1516       (setq com (concat com "\n"))
1517       (while (not book-Splus-ready-for-input)
1518         (message "waiting till Splus ready for input..")
1519         (process-send-string process "\n")
1520         (sleep-for 1))
1521       (message  "sending command :%s " com )
1522
1523       (setq last-Splus-result nil)
1524       (process-send-string process com)
1525       )
1526     (cond ((equal type 'Splus-eval-insert)
1527            (while (not last-Splus-result)
1528              (message "waiting for result...")
1529              (sleep-for 1)
1530              )
1531            (message "done")
1532            (setq tem (Splus-trim-result  last-Splus-result))
1533            (setq last-Splus-result nil)
1534            tem))))
1535
1536 (defun Splus-trim-result (x)
1537   (let (tem)
1538     (cond ((equal 0 (count-expr "\n" x))
1539            (setq x "OK")
1540            x)
1541            ((equal 1 (count-expr "\n" x))
1542            (cond ((string-match "\[[0-9]+\]" x)
1543                   (setq x (substring x (match-end 0)))))
1544            (cond ((setq tem (string-match "\n$" x))
1545                   (setq x (substring x 0 tem))))
1546            (cond ((not (string-match "\n" x))
1547                   (cond ((string-match "[ \t]+" x)
1548                          (setq x (substring x (match-end 0)))))))
1549            x)
1550           (t x))))
1551
1552 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1553 ;;;;;;;;;;; code for Mathematica evaluation.;;;;;;;;;;;
1554 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1555 ;;
1556 ;; make mma-eval-insert face do insertion of result
1557 ;;
1558 (def-book-face  'mma-eval-insert 'mma-eval 'underline "yellow3" "black" )
1559 (put 'mma-eval-insert 'insert t)
1560 (def-book-face 'mma-eval 'mma-eval 'underline "yellow3" "black" )
1561 (defvar mma-eval nil)
1562
1563 (defun book-mark-for-mma-eval (eval-only beg end)
1564   "Mark the current region to be evaluated by Mathematica and
1565 substituted in the next book result region.   If a
1566 numeric arg is supplied, dont wait for the evaluation nor
1567 insert the result.  The variable book-maxima-auto-result-insert
1568 affects whether a sample result is inserted.
1569 "
1570   (interactive "P\nr")
1571   (put-text-property beg
1572                      end
1573                      'face (if eval-only 'mma-eval 'mma-eval-insert))
1574   (put-text-property beg
1575                      end
1576                      'mouse-face 'book-mouse-face)
1577   (or eval-only
1578       (not book-maxima-auto-result-insert)
1579       (book-result-next end)
1580       (save-excursion (goto-char end)
1581                       (insert
1582                        (nth (random (length book-maxima-auto-result-insert))
1583                             book-maxima-auto-result-insert))
1584                       (book-insert-sample-result)))
1585   (show-saved-properties beg)
1586   )
1587 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1588 (defvar book-mma-ready-for-input nil)
1589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1590 (defvar last-mma-result nil)
1591 (defun book-mma-process-filter ( proc str)
1592   (let (tem )
1593     (book-process-filter proc str)
1594     (put-process-prop proc 'last-output
1595                       (concat (get-process-prop proc 'last-output)
1596                               str))
1597     (cond ((setq tem (string-match "In\[[0-9]+\]:=[ ]*$"
1598                                    (get-process-prop proc 'last-output)))
1599            (setq book-mma-ready-for-input t)
1600            (setq last-mma-result
1601                  (substring (get-process-prop proc 'last-output)  0 tem ))
1602            (put-process-prop proc 'last-output "")
1603            )
1604           )))
1605 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1606 (defun mma-restart ()
1607   (setq mma-eval nil)
1608   (if (get-buffer "*mma-eval*")
1609       (kill-buffer (get-buffer "*mma-eval*") )))
1610
1611 (defun book-mma-interrupt ()
1612   "Interrupt the *mma-eval* process running for book mode"
1613   (interactive)
1614   (cond (mma-eval
1615          (interrupt-process mma-eval))
1616         (t (error "*mma-eval* process not found"))))
1617
1618 (defun mma-eval (beg end type)
1619   "Evaluate the region returning a result"
1620   (let (tem (process (get-process  "*mma-eval*")))
1621     (cond ((not  (and mma-eval
1622                       (setq process (get-buffer-process mma-eval))))
1623            (cond ((and under-x-windows x-display-name
1624                        (not (getenv "DISPLAY")))
1625                   (setq process-environment
1626                         (cons (concat "DISPLAY=" x-display-name)
1627                               process-environment))))
1628            (let ((default-directory "~/"))
1629              (setq mma-eval (make-sshell "mma-eval" "math" )))
1630            (setq process (get-buffer-process  mma-eval))
1631            (set-process-filter process 'book-mma-process-filter)
1632            (process-send-string process  "\n")
1633            )
1634           )
1635     (let ((com (buffer-substring beg end)))
1636       (setq com (concat com "\n"))
1637       (while (not book-mma-ready-for-input)
1638         (message "waiting till Mathematica ready for input..")
1639         (process-send-string process "\n")
1640         (sleep-for 1))
1641       (message  "sending command :%s " com )
1642
1643       (setq last-mma-result nil)
1644       (process-send-string process com)
1645       )
1646     (cond ((equal type 'mma-eval-insert)
1647            (while (not last-mma-result)
1648              (message "waiting for result...")
1649              (sleep-for 1)
1650              )
1651            (message "done")
1652            (setq tem (mma-trim-result  last-mma-result))
1653            (setq last-mma-result nil)
1654            tem))))
1655 ;;;;
1656 (defun mma-trim-result (str)
1657   (let ( (tem) (x) )
1658     (setq x str)
1659     ;;
1660     ;; if there is output at all, x is at least of length 2
1661     ;; including a trailling \n\n.
1662     ;; Strip the beginning \n and one ending \n out.
1663     ;;
1664     (if (< (length x) 2)
1665         (setq x "OK")
1666       (cond ((string-match "Out\[[0-9]+\]=" x)
1667              (setq x (substring x 1 (- (length x ) 1))))))
1668     ;;
1669     (cond ((equal 1 (count-expr "\n" x))
1670            (cond ((string-match "Out\[[0-9]+\]=[ ]+" x)
1671                   (setq x (substring x (match-end 0)))))
1672            (cond ((setq tem (string-match "\n$" x))
1673                   (setq x (substring x 0 tem))))
1674            x)
1675           (t (cond ((setq tem (string-match "Out\[[0-9]+\]=[ ]" x))
1676                     (while (< tem (match-end 0))
1677                       (aset x tem ? )
1678                       (setq tem (+ tem 1)))))
1679              x))))
1680 ;;;
1681 (provide 'bookmode)
1682
1683 ;;; Local Variables: ***
1684 ;;; version-control: t ***
1685 ;;; End: ***
1686