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 |
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)) |
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) |
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)) |