home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 9 / FreshFishVol9-CD2.bin / bbs / gnu / calc-2.02c-src.lha / calc-2.02c / calc-maint.el < prev    next >
Encoding:
Text File  |  1994-12-20  |  15.5 KB  |  468 lines
  1. ;; Calculator for GNU Emacs, maintenance routines
  2. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;; Written by Dave Gillespie, daveg@synaptics.com.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23.  
  24.  
  25. (defun calc-compile ()
  26.   "Compile all parts of Calc.
  27. Unix usage:
  28.      emacs -batch -l calc-maint -f calc-compile"
  29.   (interactive)
  30.   (if (equal (user-full-name) "David Gillespie")
  31.       (load "~/lisp/newbytecomp"))
  32.   (setq byte-compile-verbose t)
  33.   (if noninteractive
  34.       (let ((old-message (symbol-function 'message))
  35.         (old-write-region (symbol-function 'write-region))
  36.         (comp-was-func nil)
  37.         (comp-len 0))
  38.     (unwind-protect
  39.         (progn
  40.           (fset 'message (symbol-function 'calc-compile-message))
  41.           (fset 'write-region (symbol-function 'calc-compile-write-region))
  42.           (calc-do-compile))
  43.       (fset 'message old-message)
  44.       (fset 'write-region old-write-region)))
  45.     (calc-do-compile))
  46. )
  47.  
  48. (defun calc-do-compile ()
  49.   (let ((make-backup-files nil)
  50.     (changed-rules nil)
  51.     (changed-units nil)
  52.     (message-bug (string-match "^18.\\([0-4][0-9]\\|5[0-6]\\)"
  53.                    emacs-version)))
  54.     (setq max-lisp-eval-depth (max 400 max-lisp-eval-depth))
  55.     (setq byte-compile-warnings nil)
  56.  
  57.     ;; Make sure we're in the right directory.
  58.     (find-file "calc.el")
  59.     (if (= (buffer-size) 0)
  60.     (error "This command must be used in the Calc source directory."))
  61.  
  62.     ;; Make sure current directory is in load-path.
  63.     (setq load-path (cons default-directory load-path))
  64.     (load "calc-macs.el" nil t t)
  65.     (provide 'calc)
  66.     (provide 'calc-ext)
  67.  
  68.     ;; Compile all the source files.
  69.     (let ((files (append
  70.           '("calc.el" "calc-ext.el")
  71.           (sort (directory-files
  72.              default-directory nil
  73.              "\\`\\(calc-.[^x].*\\|macedit\\)\\.el\\'")
  74.             'string<))))
  75.       (while files
  76.     (if (file-newer-than-file-p (car files) (concat (car files) "c"))
  77.         (progn
  78.           (if (string-match "calc-rules" (car files))
  79.           (setq changed-rules t))
  80.           (if (string-match "calc-units" (car files))
  81.           (setq changed-units t))
  82.           (or message-bug (message ""))
  83.           (byte-compile-file (car files)))
  84.       (message "File %s is up to date." (car files)))
  85.     (if (string-match "calc\\(-ext\\)?.el" (car files))
  86.         (load (concat (car files) "c") nil t t))
  87.     (setq files (cdr files))))
  88.  
  89.     (if (or changed-units changed-rules)
  90.     (condition-case err
  91.         (progn
  92.  
  93.           ;; Pre-build the units table.
  94.           (if (and changed-units
  95.                (not (string-match "Lucid" emacs-version)))
  96.           (progn
  97.             (or message-bug (message ""))
  98.             (save-excursion
  99.               (calc-create-buffer)
  100.               (math-build-units-table))
  101.             (find-file "calc-units.elc")
  102.             (goto-char (point-max))
  103.             (insert "\n(setq math-units-table '"
  104.                 (prin1-to-string math-units-table)
  105.                 ")\n")
  106.             (save-buffer)))
  107.  
  108.           ;; Pre-build rewrite rules for j D, j M, etc.
  109.           (if (and changed-rules (not (string-match "^19" emacs-version)))
  110.           (let ((rules nil))
  111.             (or message-bug (message ""))
  112.             (find-file "calc-rules.elc")
  113.             (goto-char (point-min))
  114.             (while (re-search-forward "defun calc-\\([A-Za-z]*Rules\\)"
  115.                           nil t)
  116.               (setq rules (cons (buffer-substring (match-beginning 1)
  117.                               (match-end 1))
  118.                     rules)))
  119.             (goto-char (point-min))
  120.             (re-search-forward "\n(defun calc-[A-Za-z]*Rules")
  121.             (beginning-of-line)
  122.             (delete-region (point) (point-max))
  123.             (mapcar (function
  124.                  (lambda (v)
  125.                    (let* ((vv (intern (concat "var-" v)))
  126.                       (val (save-excursion
  127.                          (calc-create-buffer)
  128.                          (calc-var-value vv))))
  129.                  (insert "\n(defun calc-" v " () '"
  130.                      (prin1-to-string val) ")\n"))))
  131.                 (sort rules 'string<))
  132.             (save-buffer))))
  133.       (error (message "Unable to pre-build tables %s" err))))
  134.     (message "Done.  Don't forget to install with \"make public\" or \"make private\"."))
  135. )
  136.  
  137. (defun calc-compile-message (fmt &rest args)
  138.   (cond ((and (= (length args) 2)
  139.           (stringp (car args))
  140.           (string-match ".elc?\\'" (car args))
  141.           (symbolp (nth 1 args)))
  142.      (let ((name (symbol-name (nth 1 args))))
  143.        (princ (if comp-was-func ", " "  "))
  144.        (if (and comp-was-func (eq (string-match comp-was-func name) 0))
  145.            (setq name (substring name (1- (length comp-was-func))))
  146.          (setq comp-was-func (if (string-match "\\`[a-zA-Z]+-" name)
  147.                      (substring name 0 (match-end 0))
  148.                    " ")))
  149.        (if (> (+ comp-len (length name)) 75)
  150.            (progn
  151.          (princ "\n  ")
  152.          (setq comp-len 0)))
  153.        (princ name)
  154.        (send-string-to-terminal "")  ; cause an fflush(stdout)
  155.        (setq comp-len (+ comp-len 2 (length name)))))
  156.     ((and (setq comp-was-func nil
  157.             comp-len 0)
  158.           (= (length args) 1)
  159.           (stringp (car args))
  160.           (string-match ".elc?\\'" (car args)))
  161.      (or (string-match "Saving file %s..." fmt)
  162.          (funcall old-message fmt (file-name-nondirectory (car args)))))
  163.     ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\.$" fmt)
  164.      (send-string-to-terminal (apply 'format fmt args)))
  165.     ((string-match "\\(Preparing\\|Building\\).*\\.\\.\\. *done$" fmt)
  166.      (send-string-to-terminal "done\n"))
  167.     (t (apply old-message fmt args)))
  168. )
  169.  
  170. (defun calc-compile-write-region (start end filename &optional append visit)
  171.   (if (eq visit t)
  172.       (set-buffer-auto-saved))
  173.   (if (and (string-match "\\.elc" filename)
  174.        (= start (point-min))
  175.        (= end (point-max)))
  176.       (save-excursion
  177.     (goto-char (point-min))
  178.     (if (search-forward "\n(require (quote calc-macs))\n" nil t)
  179.         (replace-match ""))
  180.     (setq end (point-max))))
  181.   (funcall old-write-region start end filename append 'quietly)
  182.   (message "Wrote %s" filename)
  183.   nil
  184. )
  185.  
  186.  
  187.  
  188. (defun calc-split-tutorial (&optional force)
  189.   (interactive "P")
  190.   (calc-split-manual force 1))
  191.  
  192.  
  193. (defun calc-split-reference (&optional force)
  194.   (interactive "P")
  195.   (calc-split-manual force 2))
  196.  
  197.  
  198. (defun calc-split-manual (&optional force part)
  199.   "Split the Calc manual into separate Tutorial and Reference manuals.
  200. Use this if your TeX installation is too small-minded to handle
  201. calc.texinfo all at once.
  202. Usage:  C-x C-f calc.texinfo RET
  203.         M-x calc-split-manual RET"
  204.   (interactive "P")
  205.   (or (let ((case-fold-search t))
  206.     (string-match "calc\\.texinfo" (buffer-name)))
  207.       force
  208.       (error "This command should be used in the calc.texinfo buffer."))
  209.   (let ((srcbuf (current-buffer))
  210.     tutpos refpos endpos (maxpos (point-max)))
  211.     (goto-char 1)
  212.     (search-forward "@c [tutorial]")
  213.     (beginning-of-line)
  214.     (setq tutpos (point))
  215.     (search-forward "@c [reference]")
  216.     (beginning-of-line)
  217.     (setq refpos (point))
  218.     (search-forward "@c [end]")
  219.     (beginning-of-line)
  220.     (setq endpos (point))
  221.     (or (eq part 2)
  222.     (progn
  223.       (find-file "calctut.tex")
  224.       (erase-buffer)
  225.       (insert-buffer-substring srcbuf 1 refpos)
  226.       (insert-buffer-substring srcbuf endpos maxpos)
  227.       (calc-split-volume "I" "ref" "Tutorial" "Reference")
  228.       (save-buffer)))
  229.     (or (eq part 1)
  230.     (progn
  231.       (find-file "calcref.tex")
  232.       (erase-buffer)
  233.       (insert-buffer-substring srcbuf 1 tutpos)
  234.       (insert "\n@tex\n\\global\\advance\\chapno by 1\n@end tex\n")
  235.       (insert-buffer-substring srcbuf refpos maxpos)
  236.       (calc-split-volume "II" "tut" "Reference" "Tutorial")
  237.       (save-buffer)))
  238.     (switch-to-buffer srcbuf)
  239.     (goto-char 1))
  240.   (message (cond ((eq part 1) "Wrote file calctut.tex")
  241.          ((eq part 2) "Wrote file calcref.tex")
  242.          (t "Wrote files calctut.tex and calcref.tex")))
  243. )
  244.  
  245. (defun calc-split-volume (number fix name other-name)
  246.   (goto-char 1)
  247.   (search-forward "@c [title]\n")
  248.   (search-forward "Manual")
  249.   (delete-backward-char 6)
  250.   (insert name)
  251.   (search-forward "@c [volume]\n")
  252.   (insert "@sp 1\n@center Volume " number ": " name "\n")
  253.   (let ((pat (format "@c \\[fix-%s \\(.*\\)\\]\n" fix)))
  254.     (while (re-search-forward pat nil t)
  255.       (let ((topic (buffer-substring (match-beginning 1) (match-end 1))))
  256.     (re-search-forward "@\\(p?xref\\){[^}]*}")
  257.     (let ((cmd (buffer-substring (match-beginning 1) (match-end 1))))
  258.       (delete-region (match-beginning 0) (match-end 0))
  259.       (insert (if (equal cmd "pxref") "see" "See")
  260.           " ``" topic "'' in @emph{the Calc "
  261.           other-name "}")))))
  262.   (goto-char 1)
  263.   (while (search-forward "@c [when-split]\n" nil t)
  264.     (while (looking-at "@c ")
  265.       (delete-char 3)
  266.       (forward-line 1)))
  267.   (goto-char 1)
  268.   (while (search-forward "@c [not-split]\n" nil t)
  269.     (while (not (looking-at "@c"))
  270.       (insert "@c ")
  271.       (forward-line 1)))
  272. )
  273.  
  274.  
  275. (defun calc-inline-summary ()
  276.   "Make a special \"calcsum.tex\" file to be used with main manual."
  277.   (calc-split-summary nil t)
  278. )
  279.  
  280. (defun calc-split-summary (&optional force in-line)
  281.   "Make a special \"calcsum.tex\" file with just the Calc summary."
  282.   (interactive "P")
  283.   (or (let ((case-fold-search t))
  284.     (string-match "calc\\.texinfo" (buffer-name)))
  285.       force
  286.       (error "This command should be used in the calc.texinfo buffer."))
  287.   (let ((srcbuf (current-buffer))
  288.     begpos sumpos endpos midpos)
  289.     (goto-char 1)
  290.     (search-forward "{Calc Manual}")
  291.     (backward-char 1)
  292.     (delete-backward-char 6)
  293.     (insert "Summary")
  294.     (search-forward "@c [begin]")
  295.     (beginning-of-line)
  296.     (setq begpos (point))
  297.     (search-forward "@c [summary]")
  298.     (beginning-of-line)
  299.     (setq sumpos (point))
  300.     (search-forward "@c [end-summary]")
  301.     (beginning-of-line)
  302.     (setq endpos (point))
  303.     (find-file "calcsum.tex")
  304.     (erase-buffer)
  305.     (insert-buffer-substring srcbuf 1 begpos)
  306.     (insert "@tex\n"
  307.         "\\global\\advance\\appendixno2\n"
  308.         "\\gdef\\xref#1.{See ``#1.''}\n")
  309.     (setq midpos (point))
  310.     (insert "@end tex\n")
  311.     (insert-buffer-substring srcbuf sumpos endpos)
  312.     (insert "@bye\n")
  313.     (goto-char 1)
  314.     (if (search-forward "{. a b c" nil t)
  315.     (replace-match "{... a b c"))
  316.     (goto-char 1)
  317.     (if in-line
  318.     (let ((buf (current-buffer))
  319.           (page nil))
  320.       (find-file "calc.aux")
  321.       (if (> (buffer-size) 0)
  322.           (progn
  323.         (goto-char 1)
  324.         (re-search-forward "{Summary-pg}{\\([0-9]+\\)}")
  325.         (setq page (string-to-int (buffer-substring (match-beginning 1)
  326.                                 (match-end 1))))))
  327.       (switch-to-buffer buf)
  328.       (if page
  329.           (progn
  330.         (message "Adjusting starting page number to %d" page)
  331.         (goto-char midpos)
  332.         (insert (format "\\global\\pageno=%d\n" page)))
  333.         (message "Unable to find page number from calc.aux")))
  334.       (if (search-forward "@c smallbook" nil t)
  335.       (progn   ; activate "smallbook" format for compactness
  336.         (beginning-of-line)
  337.         (forward-char 1)
  338.         (delete-char 2))))
  339.     (let ((buf (current-buffer)))
  340.       (find-file "calc.ky")
  341.       (if (> (buffer-size) 0)
  342.       (let ((ibuf (current-buffer)))
  343.         (message "Mixing in page numbers from Key Index (calc.ky)")
  344.         (switch-to-buffer buf)
  345.         (goto-char 1)
  346.         (search-forward "notes at the end")
  347.         (insert "; the number in italics is\n"
  348.             "the page number where the command is described")
  349.         (while (re-search-forward
  350.             "@r{.*@: *\\([^ ]\\(.*[^ ]\\)?\\) *@:.*@:.*@:\\(.*\\)@:.*}"
  351.             nil t)
  352.           (let ((key (buffer-substring (match-beginning 1) (match-end 1)))
  353.             (pos (match-beginning 3))
  354.             num)
  355.         (set-buffer ibuf)
  356.         (goto-char 1)
  357.         (let ((p '( ( "I H " . "H I " )  ; oops!
  358.                 ( "@@ ' \"" . "@@" ) ( "h m s" . "@@" )
  359.                 ( "\\\\" . "{\\tt\\indexbackslash }" )
  360.                 ( "_" . "{\\_}" )
  361.                 ( "\\^" . "{\\tt\\hat}" )
  362.                 ( "<" . "{\\tt\\less}" )
  363.                 ( ">" . "{\\tt\\gtr}" )
  364.                 ( "\"" ) ( "@{" ) ( "@}" )
  365.                 ( "~" ) ( "|" ) ( "@@" )
  366.                 ( "\\+" . "{\\tt\\char43}" )
  367.                 ( "# l" . "# L" )
  368.                 ( "I f I" . "f I" ) ( "I f Q" . "f Q" )
  369.                 ( "V &" . "&" ) ( "C-u " . "" ) ))
  370.               (case-fold-search nil))
  371.           (while p
  372.             (if (string-match (car (car p)) key)
  373.             (setq key (concat (substring key 0 (match-beginning 0))
  374.                       (or (cdr (car p))
  375.                           (format "{\\tt\\char'%03o}"
  376.                               (aref key (1- (match-end
  377.                                      0)))))
  378.                       (substring key (match-end 0)))))
  379.             (setq p (cdr p)))
  380.           (setq num (and (search-forward (format "\\entry {%s}{" key)
  381.                          nil t)
  382.                  (looking-at "[0-9]+")
  383.                  (buffer-substring (point) (match-end 0)))))
  384.         (set-buffer buf)
  385.         (goto-char pos)
  386.         (insert "@pgref{" (or num "") "}")))
  387.         (goto-char midpos)
  388.         (insert "\\gdef\\pgref#1{\\hbox to 2em{\\indsl\\hss#1}\\ \\ }\n"))
  389.     (message
  390.      "Unable to find Key Index (calc.ky); no page numbers inserted"))
  391.       (switch-to-buffer buf))
  392.     (save-buffer))
  393.   (message "Wrote file calcsum.tex")
  394. )
  395.  
  396.  
  397.  
  398. (defun calc-public-autoloads ()
  399.   "Modify the public \"default\" file to contain the necessary autoload and
  400. global-set-key commands for Calc."
  401.   (interactive)
  402.   (let ((home default-directory)
  403.     (p load-path)
  404.     instbuf name)
  405.     (while (and p
  406.         (not (file-exists-p
  407.               (setq name (expand-file-name "default" (car p)))))
  408.         (not (file-exists-p
  409.               (setq name (expand-file-name "default.el" (car p))))))
  410.       (setq p (cdr p)))
  411.     (or p (error "Unable to find \"default\" file.  Create one and try again."))
  412.     (find-file name)
  413.     (if buffer-read-only (error "No write permission for \"%s\"" buffer-file-name))
  414.     (goto-char (point-max))
  415.     (calc-add-autoloads home "calc-public-autoloads"))
  416. )
  417.  
  418. (defun calc-private-autoloads ()
  419.   "Modify the user's \".emacs\" file to contain the necessary autoload and
  420. global-set-key commands for Calc."
  421.   (interactive)
  422.   (let ((home default-directory))
  423.     (find-file "~/.emacs")
  424.     (goto-char (point-max))
  425.     (calc-add-autoloads home "calc-private-autoloads"))
  426. )
  427.  
  428. (defun calc-add-autoloads (home cmd)
  429.   (barf-if-buffer-read-only)
  430.   (let (top)
  431.     (if (and (re-search-backward ";;; Commands added by calc-.*-autoloads"
  432.                  nil t)
  433.          (setq top (point))
  434.          (search-forward ";;; End of Calc autoloads" nil t))
  435.     (progn
  436.       (forward-line 1)
  437.       (message "(Removing previous autoloads)")
  438.       (delete-region top (point)))
  439.       (insert "\n\n")
  440.       (backward-char 1)))
  441.   (insert ";;; Commands added by " cmd " on "
  442.       (current-time-string) ".
  443. \(autoload 'calc-dispatch       \"calc\" \"Calculator Options\" t)
  444. \(autoload 'full-calc           \"calc\" \"Full-screen Calculator\" t)
  445. \(autoload 'full-calc-keypad       \"calc\" \"Full-screen X Calculator\" t)
  446. \(autoload 'calc-eval           \"calc\" \"Use Calculator from Lisp\")
  447. \(autoload 'defmath           \"calc\" nil t t)
  448. \(autoload 'calc               \"calc\" \"Calculator Mode\" t)
  449. \(autoload 'quick-calc           \"calc\" \"Quick Calculator\" t)
  450. \(autoload 'calc-keypad           \"calc\" \"X windows Calculator\" t)
  451. \(autoload 'calc-embedded       \"calc\" \"Use Calc inside any buffer\" t)
  452. \(autoload 'calc-embedded-activate  \"calc\" \"Activate =>'s in buffer\" t)
  453. \(autoload 'calc-grab-region       \"calc\" \"Grab region of Calc data\" t)
  454. \(autoload 'calc-grab-rectangle       \"calc\" \"Grab rectangle of data\" t)
  455. \(autoload 'edit-kbd-macro       \"macedit\" \"Edit Keyboard Macro\" t)
  456. \(autoload 'edit-last-kbd-macro       \"macedit\" \"Edit Keyboard Macro\" t)
  457. \(autoload 'read-kbd-macro       \"macedit\" \"Read Keyboard Macro\" t)
  458. \(setq load-path (append load-path (list \"gnu:lib/emacs/site-lisp\")))
  459. \(global-set-key \"\\e#\" 'calc-dispatch)
  460. ;;; End of Calc autoloads.\n")
  461.   (let ((trim-versions-without-asking t))
  462.     (save-buffer))
  463. )
  464.  
  465.  
  466.  
  467. ;;; End.
  468.