From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: Request: ses.el Turn accessors into defsubst Date: Wed, 01 Aug 2012 16:30:34 -0400 Message-ID: References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: dough.gmane.org 1343853049 27960 80.91.229.3 (1 Aug 2012 20:30:49 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Wed, 1 Aug 2012 20:30:49 +0000 (UTC) Cc: Jonathan Yavner , emacs-devel@gnu.org To: "T.V. Raman" Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Aug 01 22:30:49 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SwfZB-0004aS-2Z for ged-emacs-devel@m.gmane.org; Wed, 01 Aug 2012 22:30:49 +0200 Original-Received: from localhost ([::1]:36345 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SwfZA-0007L8-CJ for ged-emacs-devel@m.gmane.org; Wed, 01 Aug 2012 16:30:48 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:52085) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SwfZ5-0007Aa-Cc for emacs-devel@gnu.org; Wed, 01 Aug 2012 16:30:45 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SwfZ2-0002Oo-F2 for emacs-devel@gnu.org; Wed, 01 Aug 2012 16:30:43 -0400 Original-Received: from pruche.dit.umontreal.ca ([132.204.246.22]:42634) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SwfZ2-0002OX-AN for emacs-devel@gnu.org; Wed, 01 Aug 2012 16:30:40 -0400 Original-Received: from fmsmemgm.homelinux.net (lechon.iro.umontreal.ca [132.204.27.242]) by pruche.dit.umontreal.ca (8.14.1/8.14.1) with ESMTP id q71KUZtY009151; Wed, 1 Aug 2012 16:30:36 -0400 Original-Received: by fmsmemgm.homelinux.net (Postfix, from userid 20848) id A189CAE2A6; Wed, 1 Aug 2012 16:30:34 -0400 (EDT) In-Reply-To: (T. V. Raman's message of "Tue, 31 Jul 2012 08:42:25 -0700") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1.50 (gnu/linux) X-NAI-Spam-Flag: NO X-NAI-Spam-Threshold: 5 X-NAI-Spam-Score: 0 X-NAI-Spam-Rules: 1 Rules triggered RV4297=0 X-NAI-Spam-Version: 2.2.0.9309 : core <4297> : streams <793237> : uri <1181206> X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 132.204.246.22 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152092 Archived-At: > At present, ses.el defines its all its internal accessors as > macros -- could we please have them changed to use defsubst? Fine by me. I have some local changes which do that and a few more things, but I haven't cleaned it up and some of the changes are probably not appropriate. It might be a good starting point for someone to extract the defstruct part. Stefan Using submit branch file:///home/monnier/src/emacs/bzr/trunk/ =3D=3D=3D modified file 'lisp/ses.el' --- lisp/ses.el 2012-07-22 21:14:12 +0000 +++ lisp/ses.el 2012-07-24 23:57:58 +0000 @@ -25,8 +25,18 @@ =20 ;;; To-do list: =20 +;; * M-w should deactivate the mark. +;; * offer some way to use absolute cell addressing. +;; * Maybe some way to copy a reference to a cell's formula rather than the +;; formula itself. ;; * split (catch 'cycle ...) call back into one or more functions ;; * Use $ or =E2=80=A6 for truncated fields +;; * M-t to transpose 2 columns. +;; * M-d should kill the cell under point. +;; * C-t to transpose 2 rows. +;; * C-k and M-k should be ses-kill-row and ses-kill-column. +;; * C-o should insert the row below point rather than above. +;; * rows inserted with C-o should inherit formulas from surrounding rows. ;; * Add command to make a range of columns be temporarily invisible. ;; * Allow paste of one cell to a range of cells -- copy formula to each. ;; * Do something about control characters & octal codes in cell print @@ -345,22 +355,30 @@ =20 (defmacro ses-get-cell (row col) "Return the cell structure that stores information about cell (ROW,COL)." + (declare (debug t)) `(aref (aref ses--cells ,row) ,col)) =20 -;; We might want to use defstruct here, but cells are explicitly used as -;; arrays in ses-set-cell, so we'd need to fix this first. --Stef -(defsubst ses-make-cell (&optional symbol formula printer references - property-list) - (vector symbol formula printer references property-list)) +(cl-defstruct (ses-cell + (:constructor nil) + (:constructor ses-make-cell + (&optional symbol formula printer references)) + (:copier nil) + ;; This is treated as an 4-elem array in various places. + ;; Mostly in ses-set-cell. + (:type vector) ;Not named. + (:conc-name ses-cell--)) + symbol formula printer references) =20 (defmacro ses-cell-symbol (row &optional col) "From a CELL or a pair (ROW,COL), get the symbol that names the local-va= riable holding its value. (0,0) =3D> A1." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) + (declare (debug t)) + `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row))) (put 'ses-cell-symbol 'safe-function t) =20 (defmacro ses-cell-formula (row &optional col) "From a CELL or a pair (ROW,COL), get the function that computes its val= ue." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 1)) + (declare (debug t)) + `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row))) =20 (defmacro ses-cell-formula-aset (cell formula) "From a CELL set the function that computes its value." @@ -368,12 +386,14 @@ =20 (defmacro ses-cell-printer (row &optional col) "From a CELL or a pair (ROW,COL), get the function that prints its value= ." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 2)) + (declare (debug t)) + `(ses-cell--printer ,(if col `(ses-get-cell ,row ,col) row))) =20 (defmacro ses-cell-references (row &optional col) "From a CELL or a pair (ROW,COL), get the list of symbols for cells whose functions refer to its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 3)) + (declare (debug t)) + `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row))) =20 (defmacro ses-cell-references-aset (cell references) "From a CELL set the list REFERENCES of symbols for cells the @@ -500,19 +520,23 @@ =20 (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." + (declare (debug t)) `(symbol-value (ses-cell-symbol ,row ,col))) =20 (defmacro ses-col-width (col) "Return the width for column COL." + (declare (debug t)) `(aref ses--col-widths ,col)) =20 (defmacro ses-col-printer (col) "Return the default printer for column COL." + (declare (debug t)) `(aref ses--col-printers ,col)) =20 (defmacro ses-sym-rowcol (sym) "From a cell-symbol SYM, gets the cons (row . col). A1 =3D> (0 . 0). Result is nil if SYM is not a symbol that names a cell." + (declare (debug t)) `(and (symbolp ,sym) (get ,sym 'ses-cell))) =20 (defmacro ses-cell (sym value formula printer references) @@ -536,6 +560,28 @@ (set sym value) sym) =20 +(defmacro ses-c (sym formula &optional references value printer) + "Load a cell SYM from the spreadsheet file. Does not recompute VALUE fr= om +FORMULA, does not reprint using PRINTER, does not check REFERENCES. This = is a +macro to prevent propagate-on-load viruses. Safety-checking for FORMULA a= nd +PRINTER are deferred until first use." + (unless value (setq value formula)) + (let ((rowcol (ses-sym-rowcol sym))) + (ses-formula-record formula) + (ses-printer-record printer) + (or (atom formula) + (eq safe-functions t) + (setq formula `(ses-safe-formula ,formula))) + (or (not printer) + (stringp printer) + (eq safe-functions t) + (setq printer `(ses-safe-printer ,printer))) + (aset (aref ses--cells (car rowcol)) + (cdr rowcol) + (ses-make-cell sym formula printer references))) + (set sym value) + sym) + (defmacro ses-column-widths (widths) "Load the vector of column widths from the spreadsheet file. This is a macro to prevent propagate-on-load viruses." @@ -604,9 +650,11 @@ (defmacro 1value (form) "For code-coverage testing, indicate that FORM is expected to always have the same value." + (declare (debug t)) form) (defmacro noreturn (form) "For code-coverage testing, indicate that FORM will always signal an err= or." + (declare (debug t)) form) =20 =20 @@ -745,21 +793,23 @@ ;; The cells ;;------------------------------------------------------------------------= ---- =20 -(defun ses-set-cell (row col field val) - "Install VAL as the contents for field FIELD (named by a quoted symbol) = of -cell (ROW,COL). This is undoable. The cell's data will be updated through -`post-command-hook'." - (let ((cell (ses-get-cell row col)) - (elt (plist-get '(value t symbol 0 formula 1 printer 2 references 3) - field)) - change) +(defmacro ses-set-cell (row col field val) + "Install VAL as the contents for field FIELD of cell (ROW,COL). +FIELD is a quoted symbol. This is undoable. +The cell's data will be updated through `post-command-hook'." + (declare (debug t)) + (let ((elt (plist-get '(value t symbol 0 formula 1 printer 2 references= 3) + (eval field)))) (or elt (signal 'args-out-of-range nil)) - (setq change (if (eq elt t) - (ses-set-with-undo (ses-cell-symbol cell) val) - (ses-aset-with-undo cell elt val))) + `(let* ((row ,row) + (col ,col) + (val ,val) + (cell (ses-get-cell row col)) + (change ,(if (eq elt t) + `(ses-set-with-undo (ses-cell-symbol cell) val) + `(ses-aset-with-undo cell ,elt val)))) (if change - (add-to-list 'ses--deferred-write (cons row col)))) - nil) ; Make coverage-tester happy. + (add-to-list 'ses--deferred-write (cons row col)))))) =20 (defun ses-cell-set-formula (row col formula) "Store a new formula for (ROW . COL) and enqueue the cell for @@ -1124,7 +1174,8 @@ ((< len width) ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) - text (if (eq ses-call-printer-return t) + text (if (or (stringp value) + (eq ses-call-printer-return t)) (concat text len) (concat len text)))) ((> len width) @@ -1331,8 +1382,9 @@ "Write cells in `ses--deferred-write' from local variables to data area. Newlines in the data are escaped." (let* ((inhibit-read-only t) + (standard-output (current-buffer)) (print-escape-newlines t) - rowcol row col cell sym formula printer text) + rowcol row col cell sym formula printer) (setq ses-start-time (float-time)) (with-temp-message " " (save-excursion @@ -1350,27 +1402,26 @@ (setq formula (cadr formula))) (if (eq (car-safe printer) 'ses-safe-printer) (setq printer (cadr printer))) - ;; This is noticeably faster than (format "%S %S %S %S %S") - (setq text (concat "(ses-cell " - (symbol-name sym) - " " - (prin1-to-string (symbol-value sym)) - " " - (prin1-to-string formula) - " " - (prin1-to-string printer) - " " - (if (atom (ses-cell-references cell)) - "nil" - (concat "(" - (mapconcat 'symbol-name - (ses-cell-references cell) - " ") - ")")) - ")")) (ses-goto-data row col) (delete-region (point) (line-end-position)) - (insert text))) + ;; This is noticably faster than (format "%S %S %S %S %S") + (insert "(ses-c ") + (prin1 sym) + (insert " ") + (prin1 formula) + (let ((refs (ses-cell-references cell)) + (val (symbol-value sym))) + (if (eq val formula) (setq val nil)) + (when (or refs val printer) + (insert " ") + (prin1 refs) + (when (or val printer) + (insert " ") + (prin1 val) + (when printer + (insert " ") + (prin1 printer))))) + (insert ")"))) (message " ")))) =20 =20 @@ -1405,6 +1456,8 @@ )) result-so-far) =20 +(defalias 'ses-absolute 'identity) + (defsubst ses-relocate-symbol (sym rowcol startrow startcol rowincr colinc= r) "Relocate one symbol SYM, which corresponds to ROWCOL (a cons of ROW and COL). Cells starting at (STARTROW,STARTCOL) are being shifted @@ -1457,7 +1510,7 @@ (setq cur (ses-relocate-range cur startrow startcol rowincr colincr)) (if cur (push cur result))) - ((or (atom cur) (eq (car cur) 'quote)) + ((or (atom cur) (eq (car cur) 'quote) (eq (car cur) 'ses-absolute)) ;; Constants pass through unchanged. (push cur result)) (t @@ -1677,6 +1730,7 @@ (defun ses-aset-with-undo (array idx newval) "Like `aset', but undoable. Result is t if element has changed." + ;; BEWARE: This is also used on ses-cell elements, assuming they're arra= ys. (unless (equal (aref array idx) newval) (push `(apply ses-aset-with-undo ,array ,idx ,(aref array idx)) buffer-undo-list) @@ -1737,7 +1791,7 @@ (let* ((x (read (current-buffer))) (sym (car-safe (cdr-safe x)))) (or (and (looking-at "\n") - (eq (car-safe x) 'ses-cell) + (memq (car-safe x) '(ses-cell ses-c)) (ses-create-cell-variable sym row col)) (error "Cell-def error")) (eval x))) @@ -1874,7 +1928,8 @@ ;; calculation). indent-tabs-mode nil) (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) - (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) + ;; This makes revert impossible if the buffer is read-only. + ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) (setq header-line-format '(:eval (progn (when (/=3D (window-hscroll) ses--header-hscroll) @@ -2258,16 +2313,23 @@ (barf-if-buffer-read-only) (list (car rowcol) (cdr rowcol) + (if (equal initial "\"") + (progn + (if (not (stringp curval)) (setq curval nil)) + (read-string (if curval + (format "String Cell %s (default %s): " + ses--curcell curval) + (format "String Cell %s: " ses--curcell)) + nil 'ses-read-string-history curval)) (read-from-minibuffer (format "Cell %s: " ses--curcell) - (cons (if (equal initial "\"") "\"\"" - (if (equal initial "(") "()" initial)) 2) + (cons (if (equal initial "(") "()" initial) 2) ses-mode-edit-map t ; Convert to Lisp object. 'ses-read-cell-history (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) (cadr curval) - curval)))))) + curval))))))) (when (ses-edit-cell row col newval) (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) @@ -2891,9 +2953,9 @@ ;; Invalid sexp --- leave it as a string. (setq val (substring text from to))) ((and (car val) (symbolp (car val))) - (if (consp arg) - (setq val (list 'quote (car val))) ; Keep symbol. - (setq val (substring text from to)))) ; Treat symbol as text. + (setq val (if (consp arg) + (list 'quote (car val)) ; Keep symbol. + (substring text from to)))) ; Treat symbol as text. (t (setq val (car val)))) (let ((row (car rowcol)) @@ -3437,7 +3499,7 @@ "Return ARGS reversed, with the blank elements (nil and *skip*) removed." (let (result) (dolist (cur args) - (unless (memq cur '(nil *skip*)) + (unless (memq cur '(nil *skip* *error*)) (push cur result))) result)) =20 @@ -3470,7 +3532,7 @@ =20 ;;All standard formulas are safe (dolist (x '(ses-cell-value ses-range ses-delete-blanks ses+ ses-average - ses-select)) + ses-select ses-absolute)) (put x 'side-effect-free t)) =20 =20