diff options
| author | Stefan Monnier | 2012-12-06 15:16:38 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2012-12-06 15:16:38 -0500 |
| commit | 1812c7246ef5ab9256adffd4d2b5eabeb16757d1 (patch) | |
| tree | 07a8b57ef571382e510dae62b255938534e99049 | |
| parent | 24fc9480399b2d018e8d85f34e9c5d8c327ce3bf (diff) | |
| download | emacs-1812c7246ef5ab9256adffd4d2b5eabeb16757d1.tar.gz emacs-1812c7246ef5ab9256adffd4d2b5eabeb16757d1.zip | |
* lisp/ses.el: Use advice-add/remove.
(ses--advice-copy-region-as-kill, ses--advice-yank): New functions.
(copy-region-as-kill, yank): Use advice-add.
(ses-unload-function): Use advice-remove.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/ses.el | 24 |
2 files changed, 20 insertions, 11 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 58b7e443798..41c535dc889 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * ses.el: Use advice-add/remove. | ||
| 4 | (ses--advice-copy-region-as-kill, ses--advice-yank): New functions. | ||
| 5 | (copy-region-as-kill, yank): Use advice-add. | ||
| 6 | (ses-unload-function): Use advice-remove. | ||
| 7 | |||
| 1 | 2012-12-06 Jonas Bernoulli <jonas@bernoul.li> | 8 | 2012-12-06 Jonas Bernoulli <jonas@bernoul.li> |
| 2 | 9 | ||
| 3 | * button.el: Make them work in header-lines (bug#12817). | 10 | * button.el: Make them work in header-lines (bug#12817). |
diff --git a/lisp/ses.el b/lisp/ses.el index a0b69232e19..80260185942 100644 --- a/lisp/ses.el +++ b/lisp/ses.el | |||
| @@ -2718,8 +2718,9 @@ inserts a new row if at bottom of print area. Repeat COUNT times." | |||
| 2718 | ;; Cut and paste, import and export | 2718 | ;; Cut and paste, import and export |
| 2719 | ;;---------------------------------------------------------------------------- | 2719 | ;;---------------------------------------------------------------------------- |
| 2720 | 2720 | ||
| 2721 | (defadvice copy-region-as-kill (around ses-copy-region-as-kill | 2721 | (defun ses--advice-copy-region-as-kill (crak-fun beg end &rest args) |
| 2722 | activate preactivate) | 2722 | ;; FIXME: Why doesn't it make sense to copy read-only or |
| 2723 | ;; intangible attributes? They're removed upon yank! | ||
| 2723 | "It doesn't make sense to copy read-only or intangible attributes into the | 2724 | "It doesn't make sense to copy read-only or intangible attributes into the |
| 2724 | kill ring. It probably doesn't make sense to copy keymap properties. | 2725 | kill ring. It probably doesn't make sense to copy keymap properties. |
| 2725 | We'll assume copying front-sticky properties doesn't make sense, either. | 2726 | We'll assume copying front-sticky properties doesn't make sense, either. |
| @@ -2730,14 +2731,15 @@ hard to override how mouse-1 works." | |||
| 2730 | (let ((temp beg)) | 2731 | (let ((temp beg)) |
| 2731 | (setq beg end | 2732 | (setq beg end |
| 2732 | end temp))) | 2733 | end temp))) |
| 2733 | (if (not (and (eq major-mode 'ses-mode) | 2734 | (if (not (and (derived-mode-p 'ses-mode) |
| 2734 | (eq (get-text-property beg 'read-only) 'ses) | 2735 | (eq (get-text-property beg 'read-only) 'ses) |
| 2735 | (eq (get-text-property (1- end) 'read-only) 'ses))) | 2736 | (eq (get-text-property (1- end) 'read-only) 'ses))) |
| 2736 | ad-do-it ; Normal copy-region-as-kill. | 2737 | (apply crak-fun beg end args) ; Normal copy-region-as-kill. |
| 2737 | (kill-new (ses-copy-region beg end)) | 2738 | (kill-new (ses-copy-region beg end)) |
| 2738 | (if transient-mark-mode | 2739 | (if transient-mark-mode |
| 2739 | (setq deactivate-mark t)) | 2740 | (setq deactivate-mark t)) |
| 2740 | nil)) | 2741 | nil)) |
| 2742 | (advice-add 'copy-region-as-kill :around #'ses--advice-copy-region-as-kill) | ||
| 2741 | 2743 | ||
| 2742 | (defun ses-copy-region (beg end) | 2744 | (defun ses-copy-region (beg end) |
| 2743 | "Treat the region as rectangular. Convert the intangible attributes to | 2745 | "Treat the region as rectangular. Convert the intangible attributes to |
| @@ -2801,7 +2803,7 @@ We clear the killed cells instead of deleting them." | |||
| 2801 | (ses-clear-cell row col)) | 2803 | (ses-clear-cell row col)) |
| 2802 | (ses-jump (car ses--curcell))) | 2804 | (ses-jump (car ses--curcell))) |
| 2803 | 2805 | ||
| 2804 | (defadvice yank (around ses-yank activate preactivate) | 2806 | (defun ses--advice-yank (yank-fun &optional arg &rest args) |
| 2805 | "In SES mode, the yanked text is inserted as cells. | 2807 | "In SES mode, the yanked text is inserted as cells. |
| 2806 | 2808 | ||
| 2807 | If the text contains 'ses attributes (meaning it went to the kill-ring from a | 2809 | If the text contains 'ses attributes (meaning it went to the kill-ring from a |
| @@ -2819,9 +2821,9 @@ When inserting formulas, the text is treated as a string constant if it doesn't | |||
| 2819 | make sense as a sexp or would otherwise be considered a symbol. Use 'sym to | 2821 | make sense as a sexp or would otherwise be considered a symbol. Use 'sym to |
| 2820 | explicitly insert a symbol, or use the C-u prefix to treat all unmarked words | 2822 | explicitly insert a symbol, or use the C-u prefix to treat all unmarked words |
| 2821 | as symbols." | 2823 | as symbols." |
| 2822 | (if (not (and (eq major-mode 'ses-mode) | 2824 | (if (not (and (derived-mode-p 'ses-mode) |
| 2823 | (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) | 2825 | (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) |
| 2824 | ad-do-it ; Normal non-SES yank. | 2826 | (apply yank-fun arg args) ; Normal non-SES yank. |
| 2825 | (ses-check-curcell 'end) | 2827 | (ses-check-curcell 'end) |
| 2826 | (push-mark (point)) | 2828 | (push-mark (point)) |
| 2827 | (let ((text (current-kill (cond | 2829 | (let ((text (current-kill (cond |
| @@ -2839,6 +2841,7 @@ as symbols." | |||
| 2839 | arg))) | 2841 | arg))) |
| 2840 | (if (consp arg) | 2842 | (if (consp arg) |
| 2841 | (exchange-point-and-mark)))) | 2843 | (exchange-point-and-mark)))) |
| 2844 | (advice-add 'yank :around #'ses--advice-yank) | ||
| 2842 | 2845 | ||
| 2843 | (defun ses-yank-pop (arg) | 2846 | (defun ses-yank-pop (arg) |
| 2844 | "Replace just-yanked stretch of killed text with a different stretch. | 2847 | "Replace just-yanked stretch of killed text with a different stretch. |
| @@ -3586,10 +3589,9 @@ current column and continues until the next nonblank column." | |||
| 3586 | 3589 | ||
| 3587 | (defun ses-unload-function () | 3590 | (defun ses-unload-function () |
| 3588 | "Unload the Simple Emacs Spreadsheet." | 3591 | "Unload the Simple Emacs Spreadsheet." |
| 3589 | (dolist (fun '(copy-region-as-kill yank)) | 3592 | (advice-remove 'yank #'ses--advice-yank) |
| 3590 | (ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun)))) | 3593 | (advice-remove 'copy-region-as-kill #'ses--advice-copy-region-as-kill) |
| 3591 | (ad-update fun)) | 3594 | ;; Continue standard unloading. |
| 3592 | ;; continue standard unloading | ||
| 3593 | nil) | 3595 | nil) |
| 3594 | 3596 | ||
| 3595 | (provide 'ses) | 3597 | (provide 'ses) |