Contribution to SES (resend)

[Vincent Belaïche]

Dear all,

I would like to make a contribution to SES, a user of which I am.

Here is the Change log which I propose:


--8<-------------coupez ici--------------début-------------->8---
2010-04-22  Vincent Belaïche  <address@hidden>

        * ses.el (ses-list): Addition of the ses-list macro in order to
        have more flexibility for range building. This also makes `ses+'
        kind of obsolete as `(apply 'ses+ (ses-range A1 A5))' can be
        replaced by `(apply '+ (ses-list A1 A5 !))' which is more
        universal as you could have anything instead of `+'.
--8<-------------coupez ici---------------fin--------------->8---

And here is a diff -c old new of ses.el:


--8<-------------coupez ici--------------début-------------->8---
*** ses.el.old  Wed Apr 21 21:34:40 2010
--- ses.el      Thu Apr 22 06:47:27 2010
***************
*** 141,146 ****
--- 141,147 ----
  (defconst ses-mode-edit-map
    (let ((keys '("\C-c\C-r"    ses-insert-range
                "\C-c\C-s"    ses-insert-ses-range
+               "\C-c\C-v"    ses-insert-ses-list
                [S-mouse-3]   ses-insert-range-click
                [C-S-mouse-3] ses-insert-ses-range-click
                "\M-\C-i"     lisp-complete-symbol))
***************
*** 1085,1091 ****
         ((ses-sym-rowcol cur)
        ;;Save this reference
        (add-to-list 'result-so-far cur))
!        ((eq (car-safe cur) 'ses-range)
        ;;All symbols in range are referenced
        (dolist (x (cdr (macroexpand cur)))
          (add-to-list 'result-so-far x)))
--- 1086,1092 ----
         ((ses-sym-rowcol cur)
        ;;Save this reference
        (add-to-list 'result-so-far cur))
!        ((memq (car-safe cur) '(ses-list ses-range))
        ;;All symbols in range are referenced
        (dolist (x (cdr (macroexpand cur)))
          (add-to-list 'result-so-far x)))
***************
*** 1144,1150 ****
            ;;implies 'delete.
            (unless ses-relocate-return
              (setq ses-relocate-return 'delete))))
!        ((eq (car-safe cur) 'ses-range)
          (setq cur (ses-relocate-range cur startrow startcol rowincr colincr))
          (if cur
              (push cur result)))
--- 1145,1151 ----
            ;;implies 'delete.
            (unless ses-relocate-return
              (setq ses-relocate-return 'delete))))
!        ((memq (car-safe cur) '(ses-list ses-range))
          (setq cur (ses-relocate-range cur startrow startcol rowincr colincr))
          (if cur
              (push cur result)))
***************
*** 1159,1175 ****
        (nreverse result))))
  
  (defun ses-relocate-range (range startrow startcol rowincr colincr)
!   "Relocate one RANGE, of the form '(ses-range min max).  Cells starting
! at (STARTROW,STARTCOL) are being shifted by (ROWINCR,COLINCR).  Result is the
! new range, or nil if the entire range is deleted.  If new rows are being added
! just beyond the end of a row range, or new columns just beyond a column range,
! the new rows/columns will be added to the range.  Sets `ses-relocate-return'
! if the range was altered."
    (let* ((minorig   (cadr range))
         (minrowcol (ses-sym-rowcol minorig))
         (min       (ses-relocate-symbol minorig minrowcol
                                         startrow startcol
                                         rowincr colincr))
         (maxorig   (nth 2 range))
         (maxrowcol (ses-sym-rowcol maxorig))
         (max       (ses-relocate-symbol maxorig maxrowcol
--- 1160,1179 ----
        (nreverse result))))
  
  (defun ses-relocate-range (range startrow startcol rowincr colincr)
!   "Relocate one RANGE, of the form '(ses-range min max) or
! '(ses-list min max ...).  Cells starting at (STARTROW,STARTCOL)
! are being shifted by (ROWINCR,COLINCR).  Result is the new range,
! or nil if the entire range is deleted.  If new rows are being
! added just beyond the end of a row range, or new columns just
! beyond a column range, the new rows/columns will be added to the
! range.  Sets `ses-relocate-return' if the range was altered."
    (let* ((minorig   (cadr range))
         (minrowcol (ses-sym-rowcol minorig))
         (min       (ses-relocate-symbol minorig minrowcol
                                         startrow startcol
                                         rowincr colincr))
+        (rest (cdddr range))
+        (fun (car range))
         (maxorig   (nth 2 range))
         (maxrowcol (ses-sym-rowcol maxorig))
         (max       (ses-relocate-symbol maxorig maxrowcol
***************
*** 1228,1234 ****
                 (funcall field (ses-sym-rowcol min))))
          ;;This range has changed size
          (setq ses-relocate-return 'range))
!       (list 'ses-range min max))))
  
  (defun ses-relocate-all (minrow mincol rowincr colincr)
    "Alter all cell values, symbols, formulas, and reference-lists to relocate
--- 1232,1238 ----
                 (funcall field (ses-sym-rowcol min))))
          ;;This range has changed size
          (setq ses-relocate-return 'range))
!       `( ,fun ,min ,max @,rest))))
  
  (defun ses-relocate-all (minrow mincol rowincr colincr)
    "Alter all cell values, symbols, formulas, and reference-lists to relocate
***************
*** 2823,2841 ****
                                            ,(cdr ses--curcell))))))
      (insert (substring (prin1-to-string (nreverse x)) 1 -1))))
  
! (defun ses-insert-ses-range ()
!   "Inserts \"(ses-range x y)\" in the minibuffer to represent the currently
! highlighted range in the spreadsheet."
!   (interactive "*")
    (let (x)
      (with-current-buffer (window-buffer minibuffer-scroll-window)
        (ses-command-hook)  ;For ses-coverage
        (ses-check-curcell 'needrange)
!       (setq x (format "(ses-range %S %S)"
                      (car ses--curcell)
                      (cdr ses--curcell))))
      (insert x)))
  
  (defun ses-insert-range-click (event)
    "Mouse version of `ses-insert-range'."
    (interactive "*e")
--- 2827,2859 ----
                                            ,(cdr ses--curcell))))))
      (insert (substring (prin1-to-string (nreverse x)) 1 -1))))
  
! (defun ses--insert-ses-range-or-ses-list (to-be-inserted)
!   "Insert \"(ses-range x y)\" or \"(ses-list x y)\" into the
!   minibuffer depending on TO-BE-INSERTED being equal to \"range\"
!   or to \"list\"."
    (let (x)
      (with-current-buffer (window-buffer minibuffer-scroll-window)
        (ses-command-hook)  ;For ses-coverage
        (ses-check-curcell 'needrange)
!       (setq x (format "(ses-%s %S %S)"
!                     to-be-inserted
                      (car ses--curcell)
                      (cdr ses--curcell))))
      (insert x)))
  
+ (defun ses-insert-ses-range ()
+   "Inserts \"(ses-range x y)\" in the minibuffer to represent the currently
+ highlighted range in the spreadsheet."
+   (interactive "*")
+   (ses--insert-ses-range-or-ses-list "range"))
+ 
+ (defun ses-insert-ses-list ()
+   "Inserts \"(ses-list x y)\" in the minibuffer to represent the currently
+ highlighted range in the spreadsheet."
+   (interactive "*")
+   (ses--insert-ses-range-or-ses-list "list"))
+ 
+ 
  (defun ses-insert-range-click (event)
    "Mouse version of `ses-insert-range'."
    (interactive "*e")
***************
*** 2890,2901 ****
    "Expands to a list of cell-symbols for the range.  The range automatically
  expands to include any new row or column inserted into its middle.  The SES
  library code specifically looks for the symbol `ses-range', so don't create an
! alias for this macro!"
    (let (result)
      (ses-dorange (cons from to)
        (push (ses-cell-symbol row col) result))
      (cons 'list result)))
  
  (defun ses-delete-blanks (&rest args)
    "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
    (let (result)
--- 2908,3030 ----
    "Expands to a list of cell-symbols for the range.  The range automatically
  expands to include any new row or column inserted into its middle.  The SES
  library code specifically looks for the symbol `ses-range', so don't create an
! alias for this macro!
! 
! Cells are listed in reverse order, that is to say from TO up to
! FROM, for instance `(ses-range A1 B2)' will produce (B2 B1 A2
! A1). This is important to know if you make a formula like `(apply
! '- (ses-range A1 A5))'."
    (let (result)
      (ses-dorange (cons from to)
        (push (ses-cell-symbol row col) result))
      (cons 'list result)))
  
+ (defun ses--clean-! (&rest x)
+   "Clean by delq list X from any occurrence of `nil' or `*skip*'"
+   (delq nil (delq '*skip* x)))
+ 
+ (defun ses--clean-!x (x y)
+   "Clean list X  by replacing by Y any occurrence of `nil' or `*skip*'.
+    This will change X by making setcar on its cons cells."
+   (let ((ret x) ret-elt)
+     (while ret
+       (setq ret-elt (car ret))
+       (when (memq ret-elt '(nil *skip*))
+       (setcar ret y))
+       (setq ret (cdr ret))))
+   x)
+ 
+ (defsubst ses--clean-!0 (&rest x) 
+   "Clean list X by replacing by 0  any occurrence of `nil' or `*skip*'.
+    This will change X by making setcar on its cons cells."
+   (ses--clean-!x x 0))
+ (defsubst ses--clean-!. (&rest x) 
+   "Clean list X by replacing by \"\"  any occurrence of `nil' or `*skip*'.
+    This will change X by making setcar on its cons cells."
+   (ses--clean-!x x ""))
+ 
+ (defmacro ses-list (from to &rest rest)
+   "Expands to a list of cell-symbols for the range groing from
+ FROM up to TO.  The range automatically expands to include any
+ new row or column inserted into its middle.  The SES library code
+ specifically looks for the symbol `ses-list', so don't create an
+ alias for this macro!
+ 
+ By passing in REST some flags one can configure the way the range
+ is read and how it is formatted. 
+ 
+ In the sequel we assume that cells A1, B1, A2 B2 have respective values
+ 1 2 3 and 4 for examplication.
+ 
+ A `>v' (default) `>^', `<v', `<^', `v>', `v<', `^>', `^<' flag
+ will configure the order of browsing through the range. This
+ way `(ses-list A1 B2 ^>)' will evaluate to `(1 3 2 4)',
+ while `(ses-list A1 B2 >^)' will evaluate to (3 4 1 2).
+ 
+ A `!' flag will remove all cells whose value is nil or `*skip*'
+ while `!0' will replace them by 0, and `!.' will replace them by
+ \"\".
+ 
+ A `*', `*1' or `*2' flag will vectorize the range in the sense of
+ Calc. See info node `(Calc) Top'. Flag `*' will output either a
+ vector or a matrix depending on the number of rows, `*1' will
+ flatten the result to a one row vector, and `*2' will make a
+ matrix whatever the number of rows. 
+ 
+ Warning: interaction with Calc is expermimental and may produce
+ confusing results if you are not aware of Calc data format. Use
+ `math-format-value' as a printer for Calc objects."
+   (let (result-row result (prev-row -1)
+                  reorient-x reorient-y transpose vectorize 
+                  (clean 'list))
+     (ses-dorange (cons from to)
+       (when (/= prev-row row)
+       (push result-row result)
+       (setq result-row nil))
+       (push (ses-cell-symbol row col) result-row)
+       (setq prev-row row))
+     (push result-row result)
+     (dolist (x rest)
+       (let ((s  (assq x `((>v setq transpose nil reorient-x nil reorient-y 
nil)
+                         (>^ setq transpose nil reorient-x nil reorient-y t) 
+                         (<^ setq transpose nil reorient-x t reorient-y t) 
+                         (<v setq transpose nil reorient-x t reorient-y nil)   
+                         (v> setq transpose t reorient-x nil reorient-y t)     
+                         (^> setq transpose t reorient-x nil reorient-y nil)   
+                         (^< setq transpose t reorient-x t reorient-y nil) 
+                         (v< setq transpose t reorient-x t reorient-y t)   
+                         (*  . #1=(setq vectorize x))
+                         (*2 . #1#)
+                         (*1 . #1#)
+                         (! setq clean 'ses--clean-!)
+                         (!0 setq clean 'ses--clean-!0)
+                         (!. setq clean 'ses--clean-!\.) ))))
+       (if s (eval (cdr s))
+         (error "Unexpected flag `%S' in ses-list" x))))
+ 
+     (if reorient-y 
+       (setcdr (last result 2) nil)
+       (setq result (cdr (nreverse result))))
+     (unless reorient-x
+       (setq result (mapcar 'nreverse result)))
+     (when transpose
+       (let ((ret (mapcar (lambda (x) (list x)) (pop result))) iter)
+       (while result
+         (setq iter ret)
+         (dolist (elt (pop result))
+           (setcar iter (cons elt (car iter)))
+           (setq iter (cdr iter))))
+       (setq result ret)))
+ 
+     (eval (cdr (assq vectorize
+                    '((nil cons clean (apply 'append result))
+                      (*1 . #2=(cons clean (cons (quote 'vec) (apply 'append 
result))))
+                      (*2 . #3=(cons clean (cons (quote 'vec) (mapcar (lambda 
(x) 
+                                                                        (cons  
clean (cons (quote 'vec) x)))
+                                                                      
result))))
+                      (* if (cdr result) #3# #2#)))))))
+ 
+ 
  (defun ses-delete-blanks (&rest args)
    "Return ARGS reversed, with the blank elements (nil and *skip*) removed."
    (let (result)
***************
*** 2932,2938 ****
      (cons 'list result)))
  
  ;;All standard formulas are safe
! (dolist (x '(ses-cell-value ses-range ses-delete-blanks ses+ ses-average
             ses-select))
    (put x 'side-effect-free t))
  
--- 3061,3067 ----
      (cons 'list result)))
  
  ;;All standard formulas are safe
! (dolist (x '(ses-cell-value ses-range ses-list ses-delete-blanks ses+ 
ses-average
             ses-select))
    (put x 'side-effect-free t))
  

--8<-------------coupez ici---------------fin--------------->8---


Very best regards,

   Vincent.