modules/ml-string.cc

   1 #include "ml-string.h"
   2 #include "ml.h"
   3 #include "mlenv.h"
   4 #include "motorenv.h"
   5 #include "motoroutput.h"
   6 #include "util_const.h"
   7 #include "util_check.h"
   8 #include "util_random.h"
   9 #include "util_string.h"
  10 #include "util_wsplitter.h"
  11 #include "expr.h"
  12 #include "utf8.h"
  13 #include "utf16.h"
  14 #include "ustring.h"
  15 #include <vector>
  16 #include <boost/ptr_container/ptr_vector.hpp>
  17 #include <exception>
  18 #include <stdlib.h>
  19
  20 /*DOC:
  21 ==string function==
  22
  23 */
  24 /*DOC:
  25 ===concat===
  26  (concat STRING...) -> STRING
  27 パラメータの文字列を連結して一つの文字列を返す。
  28
  29 */
  30 //#AFUNC        concat  ml_concat
  31 //#WIKIFUNC     concat
  32 MNode*  ml_concat (MNode* cell, MlEnv* mlenv) {
  33     MNode*  arg = cell->cdr ();
  34     AutoDelete<ustring>  a1;
  35
  36     a1 = new ustring;
  37     a1 ()->reserve (256);
  38
  39     while (arg) {
  40         a1 ()->append (eval_str (arg->car (), mlenv));
  41         nextNode (arg);
  42     }
  43     return newMNode_str (a1.release ());
  44 }
  45
  46 /*DOC:
  47 ===megabyte===
  48  (megabyte NUMBER) -> STRING
  49
  50 */
  51 //#AFUNC        megabyte        ml_megabyte
  52 //#WIKIFUNC     megabyte
  53 MNode*  ml_megabyte (MNode* cell, MlEnv* mlenv) {
  54     MNode*  arg = cell->cdr ();
  55     double  val;
  56     ustring  u;
  57
  58     if (! arg)
  59         throw (uErrorWrongNumber);
  60
  61     val = eval_double (arg->car (), mlenv);
  62     nextNode (arg);
  63     if (arg)
  64         throw (uErrorWrongNumber);
  65
  66     if (val < 900) {
  67         u = to_ustring (val);
  68         return newMNode_str (new ustring (u));
  69     }
  70     val = floor (val / 1024. * 10.) / 10.;
  71     if (val < 900) {
  72         u = to_ustring (val);
  73         u.append (CharConst ("K"));
  74         return newMNode_str (new ustring (u));
  75     }
  76     val = floor (val / 1024. * 10. ) / 10.;
  77     if (val < 900) {
  78         u = to_ustring (val);
  79         u.append (CharConst ("M"));
  80         return newMNode_str (new ustring (u));
  81     }
  82     val = floor (val / 1024. * 10.) / 10.;
  83     if (val < 900) {
  84         u = to_ustring (val);
  85         u.append (CharConst ("G"));
  86         return newMNode_str (new ustring (u));
  87     }
  88     val = floor (val / 1024. * 10.) / 10.;
  89     if (val < 900) {
  90         u = to_ustring (val);
  91         u.append (CharConst ("T"));
  92         return newMNode_str (new ustring (u));
  93     }
  94     val = floor (val / 1024. * 10.) / 10.;
  95     u = to_ustring (val);
  96     u.append (CharConst ("P"));
  97     return newMNode_str (new ustring (u));
  98 }
  99
 100 /*DOC:
 101 ===c3===
 102  (c3 INTEGER) -> STRING
 103
 104 */
 105 //#AFUNC        c3      ml_c3
 106 //#WIKIFUNC     c3
 107 MNode*  ml_c3 (MNode* cell, MlEnv* mlenv) {
 108     MNode*  arg = cell->cdr ();
 109     ustring  u;
 110
 111     if (! arg)
 112         throw (uErrorWrongNumber);
 113
 114     u = eval_str (arg->car (), mlenv);
 115     nextNode (arg);
 116     if (arg)
 117         throw (uErrorWrongNumber);
 118
 119     return newMNode_str (new ustring (c3 (u)));
 120 }
 121
 122 /*DOC:
 123 ===regexp-match===
 124  (regexp-match REGEX TEXT [#i | :i BOOL]) -> BOOL
 125
 126 */
 127 //#AFUNC        regexp-match    ml_regexp_match
 128 //#WIKIFUNC     regexp-match
 129 MNode*  ml_regexp_match (MNode* cell, MlEnv* mlenv) {
 130     MNode*  arg = cell->cdr ();
 131     ustring  reg;
 132     ustring  text;
 133     boost::wregex::flag_type  f = boost::regex_constants::normal;
 134     bool  ans;
 135     std::vector<MNode*>  params;
 136     std::vector<MNode*>  keywords;
 137     static paramList  kwlist[] = {
 138         {CharConst ("i"), true},
 139         {NULL, 0, 0}
 140     };
 141
 142     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 143     reg = eval_str (params[0], mlenv);
 144     text = eval_str (params[1], mlenv);
 145     if (eval_bool (keywords[0], mlenv))
 146         f |= boost::regex_constants::icase;
 147
 148     ans = wsearch_env (mlenv, text, reg, f);
 149
 150     return newMNode_bool (ans);
 151 }
 152
 153 /*DOC:
 154 ===match-string===
 155  (match-string NUM) -> STRING
 156
 157 */
 158 //#AFUNC        match-string    ml_match_string
 159 //#WIKIFUNC     match-string
 160 MNode*  ml_match_string (MNode* cell, MlEnv* mlenv) {
 161     MNode*  arg = cell->cdr ();
 162     int  n;
 163     MNode*  ans = NULL;
 164
 165     if (! arg)
 166         throw (uErrorWrongNumber);
 167     n = eval_int (arg->car (), mlenv);
 168     nextNode (arg);
 169     if (arg)
 170         throw (uErrorWrongNumber);
 171
 172     if (0 <= n && n < mlenv->regmatch.size ()) {
 173         ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[n].first, mlenv->regmatch[n].second))));
 174     }
 175
 176     return ans;
 177 }
 178
 179 /*DOC:
 180 ===prematch===
 181  (prematch) -> STRING
 182
 183 */
 184 //#AFUNC        prematch        ml_prematch
 185 //#WIKIFUNC     prematch
 186 MNode*  ml_prematch (MNode* cell, MlEnv* mlenv) {
 187     MNode*  arg = cell->cdr ();
 188     MNode*  ans = NULL;
 189     std::wstring::const_iterator  b = mlenv->regtext.begin ();
 190
 191     if (arg)
 192         throw (uErrorWrongNumber);
 193
 194     ans = newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regmatch[0].first))));
 195
 196     return ans;
 197 }
 198
 199 /*DOC:
 200 ===postmatch===
 201  (postmatch) -> STRING
 202
 203 */
 204 //#AFUNC        postmatch       ml_postmatch
 205 //#WIKIFUNC     postmatch
 206 MNode*  ml_postmatch (MNode* cell, MlEnv* mlenv) {
 207     MNode*  arg = cell->cdr ();
 208     MNode*  ans = NULL;
 209     std::wstring::const_iterator  e = mlenv->regtext.end ();
 210
 211     if (arg)
 212         throw (uErrorWrongNumber);
 213
 214     ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[0].second, e))));
 215
 216     return ans;
 217 }
 218
 219 /*DOC:
 220 ===string-filter===
 221  (string-filter REGEX STRING [#i | :i BOOL] [:max NUM]) -> STRING
 222
 223 */
 224 //#AFUNC        string-filter   ml_string_filter
 225 //#WIKIFUNC     string-filter
 226 MNode*  ml_string_filter (MNode* cell, MlEnv* mlenv) {
 227     MNode*  arg = cell->cdr ();
 228     ustring  reg;
 229     ustring  t;
 230     boost::wregex::flag_type  f = boost::regex_constants::normal;
 231     size_t  max = 0;
 232     std::vector<MNode*>  params;
 233     std::vector<MNode*>  keywords;
 234     static paramList  kwlist[] = {
 235         {CharConst ("i"), true},
 236         {CharConst ("max"), false},
 237         {NULL, 0, 0}
 238     };
 239
 240     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 241     reg = eval_str (params[0], mlenv);
 242     t = eval_str (params[1], mlenv);
 243     if (eval_bool (keywords[0], mlenv))
 244         f |= boost::regex_constants::icase;
 245     if (eval_bool (keywords[1], mlenv)) {
 246         max = eval_int (keywords[1], mlenv);
 247         if (max < 0)
 248             max = 0;
 249     }
 250
 251     if (wsearch_env (mlenv, t, reg, f)) {
 252         ustring  ans = wtou (std::wstring (mlenv->regmatch[0].first, mlenv->regmatch[0].second));
 253         if (max > 0) {
 254             substring (ans, 0, max, true, ans);
 255         }
 256         return newMNode_str (new ustring (ans));
 257     } else {
 258         return NULL;            // unmatched
 259     }
 260 }
 261
 262 /*DOC:
 263 ===regexp-replace===
 264  (regexp-replace REGEX TO_TEXT TEXT [#i | :i BOOL] [#g | #global | :g BOOL | :global BOOL]) -> TEXT
 265
 266 */
 267 //#AFUNC        regexp-replace  ml_regexp_replace
 268 //#WIKIFUNC     regexp-replace
 269 MNode*  ml_regexp_replace (MNode* cell, MlEnv* mlenv) {
 270     MNode*  arg = cell->cdr ();
 271     ustring  reg;
 272     ustring  to;
 273     ustring  text;
 274     boost::wregex::flag_type  f = boost::regex_constants::normal;
 275     boost::match_flag_type  mf = boost::regex_constants::match_default;
 276     bool  fglobal = false;
 277     ustring  ans;
 278     std::vector<MNode*>  params;
 279     std::vector<MNode*>  keywords;
 280     static paramList  kwlist[] = {
 281         {CharConst ("i"), true},
 282         {CharConst ("g"), true},
 283         {CharConst ("global"), true},
 284         {NULL, 0, 0}
 285     };
 286
 287     setParams (arg, 3, &params, kwlist, &keywords, NULL);
 288     reg = eval_str (params[0], mlenv);
 289     to = eval_str (params[1], mlenv);
 290     text = eval_str (params[2], mlenv);
 291     if (eval_bool (keywords[0], mlenv))
 292         f |= boost::regex_constants::icase;
 293     if (eval_bool (keywords[1], mlenv))
 294         fglobal = true;
 295     if (eval_bool (keywords[2], mlenv))
 296         fglobal = true;
 297
 298     if (! fglobal)
 299         mf |= boost::regex_constants::format_first_only;
 300     ans = wreplace (text, reg, to, f, mf);
 301
 302     return newMNode_str (new ustring (ans));
 303 }
 304
 305 /*DOC:
 306 ===regexp-split===
 307  (regexp-split REGEX STRING [#i | :i BOOL]) -> (PREMATCH_STRING POSTMATCH_STRING)
 308
 309 */
 310 //#AFUNC        regexp-split    ml_regexp_split
 311 //#WIKIFUNC     regexp-split
 312 MNode*  ml_regexp_split (MNode* cell, MlEnv* mlenv) {
 313     MNode*  arg = cell->cdr ();
 314     ustring  reg;
 315     ustring  text;
 316     boost::wregex::flag_type  f = boost::regex_constants::normal;
 317     MNodeList  ans;
 318     std::vector<MNode*>  params;
 319     std::vector<MNode*>  keywords;
 320     static paramList  kwlist[] = {
 321         {CharConst ("i"), true},
 322         {NULL, 0, 0}
 323     };
 324
 325     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 326     reg = eval_str (params[0], mlenv);
 327     text = eval_str (params[1], mlenv);
 328     if (eval_bool (keywords[0], mlenv))
 329         f |= boost::regex_constants::icase;
 330
 331     if (wsearch_env (mlenv, text, reg, f)) {
 332         std::wstring::const_iterator  b = mlenv->regtext.begin ();
 333         std::wstring::const_iterator  e = mlenv->regtext.end ();
 334         ans.append (newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regmatch[0].first)))));
 335         ans.append (newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[0].second, e)))));
 336     } else {
 337         ans.append (newMNode_str (new ustring (text)));
 338         ans.append (NULL);
 339     }
 340
 341     return ans.release ();
 342 }
 343
 344 /*DOC:
 345 ===split===
 346  (split REGEX STRING) -> STRING_LIST
 347
 348 */
 349 //#AFUNC        split   ml_split
 350 //#WIKIFUNC     split
 351 MNode*  ml_split (MNode* cell, MlEnv* mlenv) {
 352     MNode*  arg = cell->cdr ();
 353     ustring  reg;
 354     ustring  t;
 355     MNodeList  ans;
 356
 357     if (! arg)
 358         throw (uErrorWrongNumber);
 359
 360     reg = eval_str (arg->car (), mlenv);
 361     nextNodeNonNil (arg);
 362     t = eval_str (arg->car (), mlenv);
 363     nextNode (arg);
 364
 365     if (arg)
 366         throw (uErrorWrongNumber);
 367
 368     try {
 369         std::wstring  wt = utow (t);
 370         std::wstring  wreg = utow (reg);
 371         boost::wregex  wre (wreg);
 372         WSplitter  sp (wt, wre);
 373         size_t  m = wt.length () + 1;
 374
 375         while (sp.next ()) {
 376             ans.append (newMNode_str (new ustring (sp.cur ())));
 377             m --;
 378             if (m == 0)
 379                 throw (uErrorRegexp);
 380         }
 381     } catch (boost::regex_error& err) {
 382         throw (uErrorRegexp);
 383     }
 384     return ans.release ();
 385 }
 386
 387 /*DOC:
 388 ===string-join===
 389  (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
 390
 391 */
 392 //#AFUNC        string-join     ml_string_join
 393 //#WIKIFUNC     string-join
 394 MNode*  ml_string_join (MNode* cell, MlEnv* mlenv) {
 395     MNode*  arg = cell->cdr ();
 396     ustring  sep;
 397     MNodePtr  val;
 398     ustring  var;
 399     ustring  u;
 400     ustring  ans;
 401     int  i, n, c;
 402     MNode*  v;
 403
 404     if (! arg)
 405         throw (uErrorWrongNumber);
 406
 407     sep = eval_str (arg->car (), mlenv);
 408     nextNodeNonNil (arg);
 409     c = 0;
 410     while (arg) {
 411         val = eval (arg->car (), mlenv);
 412         nextNode (arg);
 413
 414         if (val ()) {
 415             if (val ()->isSym ()) {
 416                 var = val ()->to_string ();
 417                 checkAry (var, var);
 418                 n = mlenv->getArySize (var);
 419                 for (i = 1; i <= n; i ++) {
 420                     if (c == 0)
 421                         c ++;
 422                     else
 423                         ans.append (sep);
 424                     v = mlenv->getAry (var, i);
 425                     if (v)
 426                         ans.append (v->to_string ());
 427                 }
 428             } else if (val ()->isCons ()) {
 429                 MNode*  a = val ();
 430                 for (; a && a->isCons (); a = a->cdr ()) {
 431                     if (c == 0)
 432                         c ++;
 433                     else
 434                         ans.append (sep);
 435                     if (! isNil (a->car ()))
 436                         ans.append (a->car ()->to_string ());
 437                 }
 438             } else {
 439                 var = val ()->to_string ();
 440                 if (c == 0)
 441                     c ++;
 442                 else
 443                     ans.append (sep);
 444                 ans.append (var);
 445             }
 446         }
 447     }
 448     return newMNode_str (new ustring (ans));
 449 }
 450
 451 /*DOC:
 452 ===password-match===
 453  (password-match PASSWORD CRYPT) -> BOOL
 454
 455 */
 456 //#AFUNC        password-match  ml_password_match
 457 //#WIKIFUNC     password-match
 458 MNode*  ml_password_match (MNode* cell, MlEnv* mlenv) {
 459     MNode*  arg = cell->cdr ();
 460     ustring  pass;
 461     ustring  cpass;
 462
 463     if (! arg)
 464         throw (uErrorWrongNumber);
 465     pass = eval_str (arg->car (), mlenv);
 466     nextNodeNonNil (arg);
 467     cpass = eval_str (arg->car (), mlenv);
 468     nextNode (arg);
 469     if (arg)
 470         throw (uErrorWrongNumber);
 471
 472     return newMNode_bool (passMatch (pass, cpass));
 473 }
 474
 475 /*DOC:
 476 ===password-crypt===
 477  (password-crypt PASSWORD) -> STRING
 478
 479 */
 480 //#AFUNC        password-crypt  ml_password_crypt
 481 //#WIKIFUNC     password-crypt
 482 MNode*  ml_password_crypt (MNode* cell, MlEnv* mlenv) {
 483     MNode*  arg = cell->cdr ();
 484     ustring  pass;
 485
 486     if (! arg)
 487         throw (uErrorWrongNumber);
 488     pass = eval_str (arg->car (), mlenv);
 489     nextNode (arg);
 490     if (arg)
 491         throw (uErrorWrongNumber);
 492
 493     return newMNode_str (new ustring (passCrypt (pass)));
 494 }
 495
 496 /*DOC:
 497 ===substring===
 498  (substring STR INDEX LENGTH) -> STRING
 499  (substring STR INDEX) -> STRING
 500
 501 */
 502 //#AFUNC        substring       ml_substring
 503 //#WIKIFUNC     substring
 504 MNode*  ml_substring (MNode* cell, MlEnv* mlenv) {
 505     MNode*  arg = cell->cdr ();
 506     ustring  str;
 507     size_t  index;
 508     size_t  length;
 509     int  mode;
 510     ustring  ans;
 511
 512     if (! arg)
 513         throw (uErrorWrongNumber);
 514     str = eval_str (arg->car (), mlenv);
 515     nextNodeNonNil (arg);
 516     index = eval_int (arg->car (), mlenv);
 517     nextNode (arg);
 518     if (arg) {
 519         mode = 3;
 520         length = eval_int (arg->car (), mlenv);
 521         nextNode (arg);
 522     } else {
 523         mode = 2;
 524     }
 525     if (arg)
 526         throw (uErrorWrongNumber);
 527
 528     substring (str, index, length, mode == 3, ans);
 529     return newMNode_str (new ustring (ans));
 530 }
 531
 532 /*DOC:
 533 ===length===
 534  (length STRING) -> NUMBER
 535
 536 */
 537 //#AFUNC        length  ml_length
 538 //#WIKIFUNC     length
 539 MNode*  ml_length (MNode* cell, MlEnv* mlenv) {
 540     MNode*  arg = cell->cdr ();
 541     ustring  str;
 542     size_t  ans;
 543
 544     if (! arg)
 545         throw (uErrorWrongNumber);
 546     str = eval_str (arg->car (), mlenv);
 547     nextNode (arg);
 548     if (arg)
 549         throw (uErrorWrongNumber);
 550
 551     ans = strLength (str);
 552     return newMNode_num (ans);
 553 }
 554
 555 /*DOC:
 556 ===pad0===
 557  (pad0 NUMBER STRING) -> STRING
 558  (pad0 NUMBER STRING_LIST) -> STRING_LIST
 559  (pad0 NUMBER_LIST STRING_LIST) -> STRING_LIST
 560
 561 */
 562 //#AFUNC        pad0    ml_pad0
 563 //#WIKIFUNC     pad0
 564 MNode*  ml_pad0 (MNode* cell, MlEnv* mlenv) {
 565     MNode*  arg = cell->cdr ();
 566     MNodePtr  num;
 567     MNodePtr  val;
 568     int  n;
 569     MNode*  np;
 570     MNode*  vp;
 571     MNodeList  ans;
 572
 573     if (! arg)
 574         throw (uErrorWrongNumber);
 575     num = np = eval (arg->car (), mlenv);
 576     nextNodeNonNil (arg);
 577     val = vp = eval (arg->car (), mlenv);
 578     nextNode (arg);
 579     if (arg)
 580         throw (uErrorWrongNumber);
 581
 582     n = 0;
 583     if (vp) {
 584         if (vp->isCons ()) {
 585             while (vp) {
 586                 if (np) {
 587                     if (np->isCons ()) {
 588                         n = to_int (np->car ());
 589                         np = np->cdr ();
 590                     } else {
 591                         n = to_int (np);
 592                     }
 593                 }
 594                 ans.append (newMNode_str (new ustring (zeroPad (n, to_string (vp->car ())))));
 595                 vp = vp->cdr ();
 596                 if (vp && ! vp->isCons ())
 597                     vp = NULL;
 598             }
 599             return ans.release ();
 600         } else {
 601             if (np) {
 602                 if (np->isCons ())
 603                     n = to_int (np->car ());
 604                 else
 605                     n = to_int (np);
 606             }
 607             return newMNode_str (new ustring (zeroPad (n, to_string (vp))));
 608         }
 609     }
 610
 611     return NULL;
 612 }
 613
 614 /*DOC:
 615 ===ellipsis===
 616  (ellipsis NUM STRING) -> STRING
 617
 618 */
 619 //#AFUNC        ellipsis        ml_ellipsis
 620 //#WIKIFUNC     ellipsis
 621 MNode*  ml_ellipsis (MNode* cell, MlEnv* mlenv) {
 622     MNode*  arg = cell->cdr ();
 623     int  num;
 624     ustring  str;
 625
 626     if (! arg)
 627         throw (uErrorWrongNumber);
 628     num = eval_int (arg->car (), mlenv);
 629     nextNodeNonNil (arg);
 630     str = eval_str (arg->car (), mlenv);
 631     nextNode (arg);
 632     if (arg)
 633         throw (uErrorWrongNumber);
 634
 635     str = ellipsis (str, num);
 636     return newMNode_str (new ustring (str));
 637 }
 638
 639 /*DOC:
 640 ===string-format===
 641  (string-format FORMAT LIST-OF-ARGS) -> STRING
 642  (string-format FORMAT ARGS...) -> STRING
 643
 644 |h:format|h:sample|h:note|
 645 |${''NUM''}|${1}||
 646 |${''NUM'':hex:''NUM''}|${1:hex:4}||
 647 |${''NUM'':HEX:''NUM''}|${1:HEX:4}||
 648 |${''NUM'':int:''NUM''}|${1:int:5}||
 649 |${''NUM'':int:''NUM'':c}|${1:int:5:c}||
 650 |${''NUM'':int:''NUM'':comma}|${1:int:5:comma}||
 651 |${''NUM'':int:''NUM'':clip}|${1:int:5:clip}||
 652 |${''NUM'':int:''NUM'':0}|${1:int:5:0}||
 653 |${''NUM'':float:''NUM'':''NUM''}|${1:float:4:3}||
 654 |${''NUM'':string:''NUM''}|${1:string:20}||
 655 |${''NUM'':string:''NUM'':right}|${1:string:20:right}||
 656 |${''NUM'':month}|${1:month}|Jan, Feb,...|
 657 |${''NUM'':Month}|${1:Month}|January, February,...|
 658 |${''NUM'':week}|${1:week}|Sun, Mon,...|
 659 |${''NUM'':Week}|${1:Week}|Sunday, Monday,...|
 660
 661 */
 662 //#AFUNC        string-format   ml_string_format
 663 //#WIKIFUNC     string-format
 664 MNode*  ml_string_format (MNode* cell, MlEnv* mlenv) {
 665     MNode*  arg = cell->cdr ();
 666     ustring  format;
 667     boost::ptr_vector<MNodePtr>  par;
 668     MNode*  a;
 669
 670     if (! arg)
 671         throw (uErrorWrongNumber);
 672     format = eval_str (arg->car (), mlenv);
 673     nextNode (arg);
 674     while (arg) {
 675         a = eval (arg->car (), mlenv);
 676         if (a && a->isCons ()) {
 677             MNodePtr  h;
 678             h = a;
 679             while (a) {
 680                 par.push_back (new MNodePtr);
 681                 par.back () = a->car ();
 682                 nextNode (a);
 683             }
 684         } else {
 685             par.push_back (new MNodePtr);
 686             par.back () = a;
 687         }
 688         nextNode (arg);
 689     }
 690
 691     return newMNode_str (new ustring (formatString (format, par)));
 692 }
 693
 694 /*DOC:
 695 ===random-key===
 696  (random-key) -> STRING
 697
 698 */
 699 //#AFUNC        random-key      ml_random_key
 700 //#WIKIFUNC     random-key
 701 MNode*  ml_random_key (MNode* cell, MlEnv* mlenv) {
 702     MNode*  arg = cell->cdr ();
 703
 704     if (arg)
 705         throw (uErrorWrongNumber);
 706
 707     return newMNode_str (new ustring (randomKey ()));
 708 }
 709
 710 /*DOC:
 711 ===date-format, gmdate-format===
 712  (date-format FORMAT INTEGER) -> STRING
 713  (gmdate-format FORMAT INTEGER) -> STRING
 714
 715  ${Y:4}, ${Y:2}
 716  ${M:2}, ${M}
 717  ${D:2}, ${D}
 718  ${h:2}, ${h}
 719  ${m:2}, ${m}
 720  ${s:2}, ${s}
 721  ${W}, ${w}
 722
 723 */
 724 //#AFUNC        date-format     ml_date_format
 725 //#WIKIFUNC     date-format
 726 MNode*  ml_date_format (MNode* cell, MlEnv* mlenv) {
 727     MNode*  arg = cell->cdr ();
 728     ustring  format;
 729     time_t  tm;
 730     struct tm  tmv;
 731
 732     if (! arg)
 733         throw (uErrorWrongNumber);
 734     format = eval_str (arg->car (), mlenv);
 735     nextNodeNonNil (arg);
 736     tm = eval_int (arg->car (), mlenv);
 737     nextNode (arg);
 738     if (arg)
 739         throw (uErrorWrongNumber);
 740
 741     localtime_r (&tm, &tmv);
 742     return newMNode_str (new ustring (formatDateString (format, tmv)));
 743 }
 744
 745 //#AFUNC        gmdate-format   ml_gmdate_format
 746 //#WIKIFUNC     gmdate-format
 747 MNode*  ml_gmdate_format (MNode* cell, MlEnv* mlenv) {
 748     MNode*  arg = cell->cdr ();
 749     ustring  format;
 750     time_t  tm;
 751     struct tm  tmv;
 752
 753     if (! arg)
 754         throw (uErrorWrongNumber);
 755     format = eval_str (arg->car (), mlenv);
 756     nextNodeNonNil (arg);
 757     tm = eval_int (arg->car (), mlenv);
 758     nextNode (arg);
 759     if (arg)
 760         throw (uErrorWrongNumber);
 761
 762     gmtime_r (&tm, &tmv);
 763     return newMNode_str (new ustring (formatDateString (format, tmv)));
 764 }
 765
 766 /*DOC:
 767 ===to-string===
 768  (to-string OBJECT) -> STRING
 769
 770 */
 771 //#AFUNC        to-string       ml_to_string
 772 //#WIKIFUNC     to-string
 773 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv) {
 774     MNode*  arg = cell->cdr ();
 775     ustring  text;
 776
 777     if (! arg)
 778         throw (uErrorWrongNumber);
 779     text = eval_str (arg->car (), mlenv);
 780     nextNode (arg);
 781     if (arg)
 782         throw (uErrorWrongNumber);
 783
 784     return newMNode_str (new ustring (text));
 785 }
 786
 787 /*DOC:
 788 ===dump-to-sexp===
 789  (dump-to-sexp OBJECT...) -> STRING
 790
 791 */
 792 //#AFUNC        dump-to-sexp    ml_dump_to_sexp
 793 //#WIKIFUNC     dump-to-sexp
 794 MNode*  ml_dump_to_sexp (MNode* cell, MlEnv* mlenv) {
 795     MNode*  arg = cell->cdr ();
 796     MNodePtr  e;
 797     ustring  text;
 798
 799     while (arg) {
 800 //      text = eval_str (arg->car (), mlenv);
 801         e = eval (arg->car (), mlenv);
 802         nextNode (arg);
 803         if (text.length () > 0)
 804             text.append (CharConst (" "));
 805         text.append (dump_to_sexp (e ()));
 806     }
 807     return newMNode_str (new ustring (text));
 808 }
 809
 810 /*DOC:
 811 //===to-sexp===
 812 // (to-sexp STRING) -> OBJECT
 813 ===read-sexp===
 814  (read-sexp STRING) -> OBJECT
 815
 816 */
 817 //  //#AFUNC    to-sexp ml_to_sexp
 818 //  //#WIKIFUNC to-sexp
 819 //#AFUNC        read-sexp       ml_read_sexp
 820 //#WIKIFUNC     read-sexp
 821 //MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv) {
 822 MNode*  ml_read_sexp (MNode* cell, MlEnv* mlenv) {
 823     MNode*  arg = cell->cdr ();
 824     ustring  text;
 825     MotorSexp ml (NULL);
 826
 827     if (! arg)
 828         throw (uErrorWrongNumber);
 829     text = eval_str (arg->car (), mlenv);
 830     nextNode (arg);
 831     if (arg)
 832         throw (uErrorWrongNumber);
 833
 834     ml.scan (text);
 835
 836     if (ml.top.isCons () && ml.top.cdr ()->isCons ())
 837         return mlenv->retval = ml.top.cdr ()->car ();
 838     else
 839         return NULL;
 840 }
 841
 842 /*DOC:
 843 ===is-ascii63===
 844  (is-ascii63 STRING) -> BOOL
 845
 846 */
 847 //#AFUNC        is-ascii63      ml_is_ascii63
 848 //#WIKIFUNC     is-ascii63
 849 MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv) {
 850     MNode*  arg = cell->cdr ();
 851     ustring  text;
 852     bool  ans;
 853
 854     if (! arg)
 855         throw (uErrorWrongNumber);
 856     text = eval_str (arg->car (), mlenv);
 857     nextNode (arg);
 858     if (arg)
 859         throw (uErrorWrongNumber);
 860
 861     ans = checkASCII (text);
 862
 863     return newMNode_bool (ans);
 864 }
 865
 866 /*DOC:
 867 ===sort-string===
 868  (sort-string LIST [#asc] [#desc]) -> LIST
 869
 870 */
 871 //#AFUNC        sort-string     ml_sort_string
 872 //#WIKIFUNC     sort-string
 873 MNode*  ml_sort_string (MNode* cell, MlEnv* mlenv) {
 874     MNode*  arg = cell->cdr ();
 875     MNodePtr  h;
 876     bool  fdesc = false;
 877     MNode*  a;
 878     std::vector<MNode*>  list;
 879     MNodeList  ans;
 880     std::vector<MNode*>  params;
 881     std::vector<MNode*>  keywords;
 882     static paramList  kwlist[] = {
 883         {CharConst ("asc"), true},
 884         {CharConst ("desc"), true},
 885         {NULL, 0, 0}
 886     };
 887
 888     setParams (arg, 1, &params, kwlist, &keywords, NULL);
 889     h = eval (params[0], mlenv);
 890     if (eval_bool (keywords[0], mlenv))
 891         fdesc = false;
 892     if (eval_bool (keywords[1], mlenv))
 893         fdesc = true;
 894
 895     a = h ();
 896     while (a) {
 897         if (a->isCons ()) {
 898             if (a->car () && a->car ()->isStr ()) {
 899                 list.push_back (a->car ());
 900             } else {
 901                 list.push_back (NULL);
 902             }
 903             nextNode (a);
 904         } else {
 905             break;
 906         }
 907     }
 908
 909     int  s, i, j, k;
 910     int  n = list.size ();
 911     for (i = 1; i < n; i ++) {
 912         j = i;
 913         while (j > 0) {
 914             k = (j - 1) / 2;
 915             if (! list[k])
 916                 if (! list[j])
 917                     break;
 918                 else
 919                     if (fdesc)
 920                         break;
 921                     else ;
 922             else if (! list[j])
 923                 if (fdesc)
 924                     ;
 925                 else
 926                     break;
 927             else if (fdesc ^ (*list[k]->str >= *list[j]->str))
 928                 break;
 929 //          swap (v[k], v[j]);
 930             a = list[j]; list[j] = list[k]; list[k] = a;
 931             j = k;
 932         }
 933     }
 934     for (; n > 0; n --) {
 935 //      swap (v[0], v[n - 1]);
 936         a = list[n - 1]; list[n - 1] = list[0]; list[0] = a;
 937         for (i = 1; i < n - 1; i ++) {
 938             j = i;
 939             while (j > 0) {
 940                 k = (j - 1) / 2;
 941 //              if (! list[k] || ! list[j])
 942 //                  break;
 943                 if (! list[k])
 944                     if (! list[j])
 945                         break;
 946                     else
 947                         if (fdesc)
 948                             break;
 949                         else ;
 950                 else if (! list[j])
 951                     if (fdesc)
 952                         ;
 953                     else
 954                         break;
 955                 else if (fdesc ^ (*list[k]->str >= *list[j]->str))
 956                     break;
 957 //              swap (v[k], v[j]);
 958                 a = list[j]; list[j] = list[k]; list[k] = a;
 959                 j = k;
 960             }
 961         }
 962     }
 963
 964     n = list.size ();
 965     for (i = 0; i < n; i ++) {
 966         ans.append (list[i]);
 967     }
 968     return ans.release ();
 969 }
 970
 971 /*DOC:
 972 ===to-upper===
 973  (to-upper STRING) -> STRING
 974
 975 */
 976 //#AFUNC        to-upper        ml_to_upper
 977 //#WIKIFUNC     to-upper
 978 MNode*  ml_to_upper (MNode* cell, MlEnv* mlenv) {
 979     MNode*  arg = cell->cdr ();
 980     ustring  text;
 981
 982     if (! arg)
 983         throw (uErrorWrongNumber);
 984     text = eval_str (arg->car (), mlenv);
 985     nextNode (arg);
 986     if (arg)
 987         throw (uErrorWrongNumber);
 988
 989     return newMNode_str (new ustring (toUpper (text)));
 990 }
 991
 992 /*DOC:
 993 ===to-lower===
 994  (to-lower STRING) -> STRING
 995
 996 */
 997 //#AFUNC        to-lower        ml_to_lower
 998 //#WIKIFUNC     to-lower
 999 MNode*  ml_to_lower (MNode* cell, MlEnv* mlenv) {
1000     MNode*  arg = cell->cdr ();
1001     ustring  text;
1002
1003     if (! arg)
1004         throw (uErrorWrongNumber);
1005     text = eval_str (arg->car (), mlenv);
1006     nextNode (arg);
1007     if (arg)
1008         throw (uErrorWrongNumber);
1009
1010     return newMNode_str (new ustring (toLower (text)));
1011 }