Contribution to SES (resend)

["Vincent Belaïche" <vincent.b.1@hotmail.fr>]

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  <vincentb1@users.sourceforge.net>

	* 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.