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

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

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

revision 1.16 by jpb, Fri Dec 31 03:30:46 2004 UTC revision 1.17 by jpb, Sun Jan 2 04:51:06 2005 UTC
# Line 660  Line 660 
660                                   (list '\? (list (car last)) '("$$"))))))))                                   (list '\? (list (car last)) '("$$"))))))))
661      part))      part))
662    
   
663  (defun calc-user-define-invocation ()  (defun calc-user-define-invocation ()
664    (interactive)    (interactive)
665    (or last-kbd-macro    (or last-kbd-macro
# Line 668  Line 667 
667    (setq calc-invocation-macro last-kbd-macro)    (setq calc-invocation-macro last-kbd-macro)
668    (message "Use `M-# Z' to invoke this macro"))    (message "Use `M-# Z' to invoke this macro"))
669    
670    (defun calc-user-define-edit ()
671  (defun calc-user-define-edit (prefix)    (interactive)  ; but no calc-wrapper!
   (interactive "P")  ; but no calc-wrapper!  
672    (message "Edit definition of command: z-")    (message "Edit definition of command: z-")
673    (let* ((key (read-char))    (let* ((key (read-char))
674           (def (or (assq key (calc-user-key-map))           (def (or (assq key (calc-user-key-map))
# Line 678  Line 676 
676                    (assq (downcase key) (calc-user-key-map))                    (assq (downcase key) (calc-user-key-map))
677                    (error "No command defined for that key")))                    (error "No command defined for that key")))
678           (cmd (cdr def)))           (cmd (cdr def)))
679      (if (symbolp cmd)      (when (symbolp cmd)
680          (setq cmd (symbol-function cmd)))        (setq cmdname (symbol-name cmd))
681          (setq cmd (symbol-function cmd)))
682      (cond ((or (stringp cmd)      (cond ((or (stringp cmd)
683                 (and (consp cmd)                 (and (consp cmd)
684                      (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))                      (eq (car-safe (nth 3 cmd)) 'calc-execute-kbd-macro)))
685             (if (and (>= (prefix-numeric-value prefix) 0)             (let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
686                      (fboundp 'edit-kbd-macro)                    (str (edmacro-format-keys mac t))
687                      (symbolp (cdr def))                    (macbeg))
688                      (eq major-mode 'calc-mode))               (calc-edit-mode
689                 (progn                (list 'calc-edit-macro-finish-edit cmdname (nth 3 (nth 3 cmd)))
690                   (if (and (< (window-width) (frame-width))                t "Calc Macro Edit Mode")
691                            calc-display-trail)               (goto-char (point-max))
692                       (let ((win (get-buffer-window (calc-trail-buffer))))               (insert "Original keys: " (elt (nth 1 (nth 3 cmd)) 0)  "\n" )
693                         (if win               (setq macbeg (point))
694                             (delete-window win))))               (insert str "\n")
695                   (edit-kbd-macro (cdr def) prefix nil               (calc-edit-format-macro-buffer)
696                                   (function               (calc-show-edit-buffer)
697                                    (lambda (x)               (goto-char (point-min))
698                                      (and calc-display-trail               (search-forward "Original")
699                                           (calc-wrapper               (forward-line 2)))
                                           (calc-trail-display 1 t)))))  
                                  (function  
                                   (lambda (cmd)  
                                     (if (stringp (symbol-function cmd))  
                                         (symbol-function cmd)  
                                       (let ((mac (nth 1 (nth 3 (symbol-function  
                                                                 cmd)))))  
                                         (if (vectorp mac)  
                                             (aref mac 1)  
                                           mac)))))  
                                  (function  
                                   (lambda (new cmd)  
                                     (if (stringp (symbol-function cmd))  
                                         (fset cmd new)  
                                       (let ((mac (cdr (nth 3 (symbol-function  
                                                               cmd)))))  
                                         (if (vectorp (car mac))  
                                             (progn  
                                               (aset (car mac) 0  
                                                     (key-description new))  
                                               (aset (car mac) 1 new))  
                                           (setcar mac new))))))))  
              (let ((keys (progn (and (fboundp 'edit-kbd-macro)  
                                      (edit-kbd-macro nil))  
                                 (fboundp 'edmacro-parse-keys))))  
                (calc-wrapper  
                 (calc-edit-mode (list 'calc-finish-macro-edit  
                                       (list 'quote def)  
                                       keys)  
                                 t)  
                 (if keys  
                     (let (top  
                           (fill-column 70)  
                           (fill-prefix nil))  
                       (insert "Notations: RET, SPC, TAB, DEL, LFD, NUL"  
                               ", C-xxx, M-xxx.\n\n")  
                       (setq top (point))  
                       (insert (if (stringp cmd)  
                                   (key-description cmd)  
                                 (if (vectorp (nth 1 (nth 3 cmd)))  
                                     (aref (nth 1 (nth 3 cmd)) 0)  
                                   (key-description (nth 1 (nth 3 cmd)))))  
                               "\n")  
                       (if (>= (prog2 (forward-char -1)  
                                      (current-column)  
                                      (forward-char 1))  
                               (frame-width))  
                           (fill-region top (point))))  
                   (insert "Press C-q to quote control characters like RET"  
                           " and TAB.\n"  
                           (if (stringp cmd)  
                               cmd  
                             (if (vectorp (nth 1 (nth 3 cmd)))  
                                 (aref (nth 1 (nth 3 cmd)) 1)  
                               (nth 1 (nth 3 cmd)))))))  
                (calc-show-edit-buffer)  
                (forward-line (if keys 2 1)))))  
700            (t (let* ((func (calc-stack-command-p cmd))            (t (let* ((func (calc-stack-command-p cmd))
701                      (defn (and func                      (defn (and func
702                                 (symbolp func)                                 (symbolp func)
# Line 770  Line 712 
712                       (calc-show-edit-buffer))                       (calc-show-edit-buffer))
713                   (error "That command's definition cannot be edited")))))))                   (error "That command's definition cannot be edited")))))))
714    
715  (defun calc-finish-macro-edit (def keys)  ;; Formatting the macro buffer
716    
717    (defun calc-edit-macro-repeats ()
718      (goto-char (point-min))
719      (while
720          (re-search-forward "^\\([0-9]+\\)\\*" nil t)
721        (setq num (string-to-int (match-string 1)))
722        (setq line (buffer-substring (point) (line-end-position)))
723        (goto-char (line-beginning-position))
724        (kill-line 1)
725        (while (> num 0)
726          (insert line "\n")
727          (setq num (1- num)))))
728    
729    (defun calc-edit-macro-adjust-buffer ()
730      (calc-edit-macro-repeats)
731      (goto-char (point-min))
732      (while (re-search-forward "^RET$" nil t)
733        (delete-char 1))
734      (goto-char (point-min))
735      (while (and (re-search-forward "^$" nil t)
736                  (not (= (point) (point-max))))
737        (delete-char 1)))
738    
739    (defun calc-edit-macro-command ()
740      "Return the command on the current line in a Calc macro editing buffer."
741      (let ((beg (line-beginning-position))
742            (end (save-excursion
743                   (if (search-forward ";;" (line-end-position) 1)
744                       (forward-char -2))
745                   (skip-chars-backward " \t")
746                   (point))))
747        (buffer-substring beg end)))
748    
749    (defun calc-edit-macro-command-type ()
750      "Return the type of command on the current line in a Calc macro editing buffer."
751      (let ((beg (save-excursion
752                   (if (search-forward ";;" (line-end-position) t)
753                       (progn
754                         (skip-chars-forward " \t")
755                         (point)))))
756            (end (save-excursion
757                   (goto-char (line-end-position))
758                   (skip-chars-backward " \t")
759                   (point))))
760        (if beg
761            (buffer-substring beg end)
762          "")))
763    
764    (defun calc-edit-macro-combine-alg-ent ()
765      "Put an entire algebraic entry on a single line."
766      (let ((line (calc-edit-macro-command))
767            (type (calc-edit-macro-command-type))
768            curline
769            match)
770        (goto-char (line-beginning-position))
771        (kill-line 1)
772        (setq curline (calc-edit-macro-command))
773        (while (and curline
774                    (not (string-equal "RET" curline))
775                    (not (setq match (string-match "<return>" curline))))
776          (setq line (concat line curline))
777          (kill-line 1)
778          (setq curline (calc-edit-macro-command)))
779        (when match
780          (kill-line 1)
781          (setq line (concat line (substring curline 0 match))))
782        (setq line (replace-regexp-in-string "SPC" " SPC "
783                      (replace-regexp-in-string " " "" line)))
784        (insert line "\t\t\t")
785        (if (> (current-column) 24)
786            (delete-char -1))
787        (insert ";; " type "\n")
788        (if match
789            (insert "RET\t\t\t;; calc-enter\n"))))
790    
791    (defun calc-edit-macro-combine-ext-command ()
792      "Put an entire extended command on a single line."
793      (let ((cmdbeg (calc-edit-macro-command))
794            (line "")
795            (type (calc-edit-macro-command-type))
796            curline
797            match)
798        (goto-char (line-beginning-position))
799        (kill-line 1)
800        (setq curline (calc-edit-macro-command))
801        (while (and curline
802                    (not (string-equal "RET" curline))
803                    (not (setq match (string-match "<return>" curline))))
804          (setq line (concat line curline))
805          (kill-line 1)
806          (setq curline (calc-edit-macro-command)))
807        (when match
808          (kill-line 1)
809          (setq line (concat line (substring curline 0 match))))
810        (setq line (replace-regexp-in-string " " "" line))
811        (insert cmdbeg " " line "\t\t\t")
812        (if (> (current-column) 24)
813            (delete-char -1))
814        (insert ";; " type "\n")
815        (if match
816            (insert "RET\t\t\t;; calc-enter\n"))))
817    
818    (defun calc-edit-macro-combine-var-name ()
819      "Put an entire variable name on a single line."
820      (let ((line (calc-edit-macro-command))
821            curline
822            match)
823        (goto-char (line-beginning-position))
824        (kill-line 1)
825        (if (string-equal line "1")
826              (insert line "\t\t\t;; calc quick variable\n")
827          (setq curline (calc-edit-macro-command))
828          (while (and curline
829                      (not (string-equal "RET" curline))
830                      (not (setq match (string-match "<return>" curline))))
831            (setq line (concat line curline))
832            (kill-line 1)
833            (setq curline (calc-edit-macro-command)))
834          (when match
835            (kill-line 1)
836            (setq line (concat line (substring curline 0 match))))
837          (setq line (replace-regexp-in-string " " "" line))
838          (insert line "\t\t\t")
839          (if (> (current-column) 24)
840              (delete-char -1))
841          (insert ";; calc variable\n")
842          (if match
843              (insert "RET\t\t\t;; calc-enter\n")))))
844    
845    (defun calc-edit-macro-combine-digits ()
846      "Put an entire sequence of digits on a single line."
847      (let ((line (calc-edit-macro-command))
848            curline)
849        (goto-char (line-beginning-position))
850        (kill-line 1)
851        (while (string-equal (calc-edit-macro-command-type) "calcDigit-start")
852          (setq line (concat line (calc-edit-macro-command)))
853          (kill-line 1))
854        (insert line "\t\t\t")
855        (if (> (current-column) 24)
856            (delete-char -1))
857        (insert ";; calc digits\n")))
858    
859    (defun calc-edit-format-macro-buffer ()
860      "Rewrite the Calc macro editing buffer."
861      (calc-edit-macro-adjust-buffer)
862      (goto-char (point-min))
863      (search-forward "Original keys:")
864    (forward-line 1)    (forward-line 1)
865    (if (and keys (looking-at "\n")) (forward-line 1))    (insert "\n")
866    (let* ((true-str (buffer-substring (point) (point-max)))    (skip-chars-forward " \t\n")
867           (str true-str))    (let ((type (calc-edit-macro-command-type)))
868      (if keys (setq str (edmacro-parse-keys str)))      (while (not (string-equal type ""))
869      (if (symbolp (cdr def))        (cond
870          (if (stringp (symbol-function (cdr def)))         ((or
871              (fset (cdr def) str)           (string-equal type "calc-algebraic-entry")
872            (let ((mac (cdr (nth 3 (symbol-function (cdr def))))))           (string-equal type "calc-auto-algebraic-entry"))
873              (if (vectorp (car mac))          (calc-edit-macro-combine-alg-ent))
874                  (progn         ((string-equal type "calc-execute-extended-command")
875                    (aset (car mac) 0 (if keys true-str (key-description str)))          (calc-edit-macro-combine-ext-command))
876                    (aset (car mac) 1 str))         ((string-equal type "calcDigit-start")
877                (setcar mac str))))          (calc-edit-macro-combine-digits))
878        (setcdr def str))))         ((or
879             (string-equal type "calc-store")
880             (string-equal type "calc-store-into")
881             (string-equal type "calc-store-neg")
882             (string-equal type "calc-store-plus")
883             (string-equal type "calc-store-minus")
884             (string-equal type "calc-store-div")
885             (string-equal type "calc-store-times")
886             (string-equal type "calc-store-power")
887             (string-equal type "calc-store-concat")
888             (string-equal type "calc-store-inv")
889             (string-equal type "calc-store-dec")
890             (string-equal type "calc-store-incr")
891             (string-equal type "calc-store-exchange")
892             (string-equal type "calc-unstore")
893             (string-equal type "calc-recall")
894             (string-equal type "calc-let")
895             (string-equal type "calc-permanent-variable"))
896            (forward-line 1)
897            (calc-edit-macro-combine-var-name))
898           ((or
899             (string-equal type "calc-copy-variable")
900             (string-equal type "calc-declare-variable"))
901            (forward-line 1)
902            (calc-edit-macro-combine-var-name)
903            (calc-edit-macro-combine-var-name))
904           (t (forward-line 1)))
905          (setq type (calc-edit-macro-command-type))))
906      (goto-char (point-min)))
907    
908    ;; Finish editing the macro
909    
910    (defun calc-edit-macro-pre-finish-edit ()
911      (goto-char (point-min))
912      (while (re-search-forward "\\(^\\| \\)RET\\($\\|\t\\| \\)" nil t)
913        (search-backward "RET")
914        (delete-char 3)
915        (insert "<return>")))
916    
917    (defun calc-edit-macro-finish-edit (cmdname key)
918      "Finish editing a Calc macro.
919    Redefine the corresponding command."
920      (interactive)
921      (let ((cmd (intern cmdname)))
922        (calc-edit-macro-pre-finish-edit)
923        (goto-char (point-max))
924        (re-search-backward "^Original keys:")
925        (forward-line 1)
926        (let* ((str (buffer-substring (point) (point-max)))
927               (mac (edmacro-parse-keys str t)))
928          (if (= (length mac) 0)
929              (fmakunbound cmd)
930            (fset cmd
931                  (list 'lambda '(arg)
932                        '(interactive "P")
933                        (list 'calc-execute-kbd-macro
934                              (vector (key-description mac)
935                                      mac)
936                              'arg key)))))))
937    
938  (defun calc-finish-formula-edit (func)  (defun calc-finish-formula-edit (func)
939    (let ((buf (current-buffer))    (let ((buf (current-buffer))

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

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