/[emacs]/emacs/lisp/calc/calc-units.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-units.el

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

revision 1.15 by jpb, Sat Apr 9 18:59:36 2005 UTC revision 1.16 by jpb, Fri May 20 22:37:14 2005 UTC
# Line 555  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 555  Entries are (SYMBOL EXPR DOC-STRING TEMP
555             (save-excursion             (save-excursion
556               (goto-char (point-min))               (goto-char (point-min))
557               (if (looking-at "Calculator Units Table")               (if (looking-at "Calculator Units Table")
558                   (let ((buffer-read-only nil))                   (let ((inhibit-read-only t))
559                     (insert "(Obsolete) "))))))))                     (insert "(Obsolete) "))))))))
560    
561  (defun calc-get-unit-definition (uname)  (defun calc-get-unit-definition (uname)
# Line 1310  Entries are (SYMBOL EXPR DOC-STRING TEMP Line 1310  Entries are (SYMBOL EXPR DOC-STRING TEMP
1310          (save-excursion          (save-excursion
1311            (message "Formatting units table...")            (message "Formatting units table...")
1312            (set-buffer buf)            (set-buffer buf)
1313            (setq buffer-read-only nil)            (let ((inhibit-read-only t))
1314            (erase-buffer)              (erase-buffer)
1315            (insert "Calculator Units Table:\n\n")              (insert "Calculator Units Table:\n\n")
1316            (insert "Unit    Type  Definition                  Description\n\n")              (insert "Unit    Type  Definition                  Description\n\n")
1317            (while uptr              (while uptr
1318              (setq u (car uptr)                (setq u (car uptr)
1319                    name (nth 2 u))                      name (nth 2 u))
1320              (when (eq (car u) 'm)                (when (eq (car u) 'm)
1321                (setq std t))                  (setq std t))
1322              (setq shadowed (and std (assq (car u) math-additional-units)))                (setq shadowed (and std (assq (car u) math-additional-units)))
1323              (when (and name                (when (and name
1324                         (> (length name) 1)                           (> (length name) 1)
1325                         (eq (aref name 0) ?\*))                           (eq (aref name 0) ?\*))
1326                (unless (eq uptr math-units-table)                  (unless (eq uptr math-units-table)
1327                  (insert "\n"))                    (insert "\n"))
1328                (setq name (substring name 1)))                  (setq name (substring name 1)))
1329              (insert " ")                (insert " ")
1330              (and shadowed (insert "("))                (and shadowed (insert "("))
1331              (insert (symbol-name (car u)))                (insert (symbol-name (car u)))
1332              (and shadowed (insert ")"))                (and shadowed (insert ")"))
1333              (if (nth 3 u)                (if (nth 3 u)
1334                  (progn                    (progn
1335                    (indent-to 10)                      (indent-to 10)
1336                    (insert (symbol-name (nth 3 u))))                      (insert (symbol-name (nth 3 u))))
1337                (or std                  (or std
1338                    (progn                      (progn
1339                      (indent-to 10)                        (indent-to 10)
1340                      (insert "U"))))                        (insert "U"))))
1341              (indent-to 14)                (indent-to 14)
1342              (and shadowed (insert "("))                (and shadowed (insert "("))
1343              (if (nth 1 u)                (if (nth 1 u)
1344                  (insert (math-format-value (nth 1 u) 80))                    (insert (math-format-value (nth 1 u) 80))
1345                (insert (symbol-name (car u))))                  (insert (symbol-name (car u))))
1346              (and shadowed (insert ")"))                (and shadowed (insert ")"))
1347              (indent-to 41)                (indent-to 41)
1348              (insert " ")                (insert " ")
1349              (when name                (when name
1350                (insert name))                  (insert name))
1351              (if shadowed                (if shadowed
1352                  (insert " (redefined above)")                    (insert " (redefined above)")
1353                (unless (nth 1 u)                  (unless (nth 1 u)
1354                  (insert " (base unit)")))                    (insert " (base unit)")))
1355              (insert "\n")                (insert "\n")
1356              (setq uptr (cdr uptr)))                (setq uptr (cdr uptr)))
1357            (insert "\n\nUnit Prefix Table:\n\n")              (insert "\n\nUnit Prefix Table:\n\n")
1358            (setq uptr math-unit-prefixes)              (setq uptr math-unit-prefixes)
1359            (while uptr              (while uptr
1360              (setq u (car uptr))                (setq u (car uptr))
1361              (insert " " (char-to-string (car u)))                (insert " " (char-to-string (car u)))
1362              (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))                (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))
1363                  (insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))                    (insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))
1364                          "   ")                            "   ")
1365                (insert "     "))                  (insert "     "))
1366              (insert "10^" (int-to-string (nth 2 (nth 1 u))))                (insert "10^" (int-to-string (nth 2 (nth 1 u))))
1367              (indent-to 15)                (indent-to 15)
1368              (insert "   " (nth 2 u) "\n")                (insert "   " (nth 2 u) "\n")
1369              (while (eq (car (car (setq uptr (cdr uptr)))) 0)))                (while (eq (car (car (setq uptr (cdr uptr)))) 0)))
1370            (insert "\n")              (insert "\n"))
1371            (setq buffer-read-only t)            (view-mode)
1372            (message "Formatting units table...done"))            (message "Formatting units table...done"))
1373          (setq math-units-table-buffer-valid t)          (setq math-units-table-buffer-valid t)
1374          (let ((oldbuf (current-buffer)))          (let ((oldbuf (current-buffer)))

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.16

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26