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 (keywords[0] && 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  text;
 230     boost::wregex::flag_type  f = boost::regex_constants::normal;
 231     size_t  max = 0;
 232     MNodePtr  t;
 233     std::vector<MNode*>  params;
 234     std::vector<MNode*>  keywords;
 235     static paramList  kwlist[] = {
 236         {CharConst ("i"), true},
 237         {CharConst ("max"), false},
 238         {NULL, 0, 0}
 239     };
 240
 241     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 242     reg = eval_str (params[0], mlenv);
 243     text = eval_str (params[1], mlenv);
 244     if (keywords[0] && eval_bool (keywords[0], mlenv))
 245         f |= boost::regex_constants::icase;
 246     if (evkw (1, t)) {
 247         max = to_int (t ());
 248         if (max < 0)
 249             max = 0;
 250     }
 251
 252     if (wsearch_env (mlenv, text, reg, f)) {
 253         ustring  ans = wtou (std::wstring (mlenv->regmatch[0].first, mlenv->regmatch[0].second));
 254         if (max > 0) {
 255             substring (ans, 0, max, true, ans);
 256         }
 257         return newMNode_str (new ustring (ans));
 258     } else {
 259         return NULL;            // unmatched
 260     }
 261 }
 262
 263 /*DOC:
 264 ===regexp-replace===
 265  (regexp-replace REGEX TO_TEXT TEXT [#i | :i BOOL] [#g | #global | :g BOOL | :global BOOL]) -> TEXT
 266
 267 */
 268 //#AFUNC        regexp-replace  ml_regexp_replace
 269 //#WIKIFUNC     regexp-replace
 270 MNode*  ml_regexp_replace (MNode* cell, MlEnv* mlenv) {
 271     MNode*  arg = cell->cdr ();
 272     ustring  reg;
 273     ustring  to;
 274     ustring  text;
 275     boost::wregex::flag_type  f = boost::regex_constants::normal;
 276     boost::match_flag_type  mf = boost::regex_constants::match_default;
 277     bool  fglobal = false;
 278     ustring  ans;
 279     std::vector<MNode*>  params;
 280     std::vector<MNode*>  keywords;
 281     static paramList  kwlist[] = {
 282         {CharConst ("i"), true},
 283         {CharConst ("g"), true},
 284         {CharConst ("global"), true},
 285         {NULL, 0, 0}
 286     };
 287
 288     setParams (arg, 3, &params, kwlist, &keywords, NULL);
 289     reg = eval_str (params[0], mlenv);
 290     to = eval_str (params[1], mlenv);
 291     text = eval_str (params[2], mlenv);
 292     if (keywords[0] && eval_bool (keywords[0], mlenv))
 293         f |= boost::regex_constants::icase;
 294     if (keywords[1] && eval_bool (keywords[1], mlenv))
 295         fglobal = true;
 296     if (keywords[2] && eval_bool (keywords[2], mlenv))
 297         fglobal = true;
 298
 299     if (! fglobal)
 300         mf |= boost::regex_constants::format_first_only;
 301     ans = wreplace (text, reg, to, f, mf);
 302
 303     return newMNode_str (new ustring (ans));
 304 }
 305
 306 /*DOC:
 307 ===regexp-split===
 308  (regexp-split REGEX STRING [#i | :i BOOL]) -> (PREMATCH_STRING POSTMATCH_STRING)
 309
 310 */
 311 //#AFUNC        regexp-split    ml_regexp_split
 312 //#WIKIFUNC     regexp-split
 313 MNode*  ml_regexp_split (MNode* cell, MlEnv* mlenv) {
 314     MNode*  arg = cell->cdr ();
 315     ustring  reg;
 316     ustring  text;
 317     boost::wregex::flag_type  f = boost::regex_constants::normal;
 318     MNodeList  ans;
 319     std::vector<MNode*>  params;
 320     std::vector<MNode*>  keywords;
 321     static paramList  kwlist[] = {
 322         {CharConst ("i"), true},
 323         {NULL, 0, 0}
 324     };
 325
 326     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 327     reg = eval_str (params[0], mlenv);
 328     text = eval_str (params[1], mlenv);
 329     if (keywords[0] && eval_bool (keywords[0], mlenv))
 330         f |= boost::regex_constants::icase;
 331
 332     if (wsearch_env (mlenv, text, reg, f)) {
 333         std::wstring::const_iterator  b = mlenv->regtext.begin ();
 334         std::wstring::const_iterator  e = mlenv->regtext.end ();
 335         ans.append (newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regmatch[0].first)))));
 336         ans.append (newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[0].second, e)))));
 337     } else {
 338         ans.append (newMNode_str (new ustring (text)));
 339         ans.append (NULL);
 340     }
 341
 342     return ans.release ();
 343 }
 344
 345 /*DOC:
 346 ===split===
 347  (split REGEX STRING) -> STRING_LIST
 348
 349 */
 350 //#AFUNC        split   ml_split
 351 //#WIKIFUNC     split
 352 MNode*  ml_split (MNode* cell, MlEnv* mlenv) {
 353     MNode*  arg = cell->cdr ();
 354     ustring  reg;
 355     ustring  t;
 356     MNodeList  ans;
 357
 358     if (! arg)
 359         throw (uErrorWrongNumber);
 360
 361     reg = eval_str (arg->car (), mlenv);
 362     nextNodeNonNil (arg);
 363     t = eval_str (arg->car (), mlenv);
 364     nextNode (arg);
 365
 366     if (arg)
 367         throw (uErrorWrongNumber);
 368
 369     try {
 370         std::wstring  wt = utow (t);
 371         std::wstring  wreg = utow (reg);
 372         boost::wregex  wre (wreg);
 373         WSplitter  sp (wt, wre);
 374         size_t  m = wt.length () + 1;
 375
 376         while (sp.next ()) {
 377             ans.append (newMNode_str (new ustring (sp.cur ())));
 378             m --;
 379             if (m == 0)
 380                 throw (uErrorRegexp);
 381         }
 382     } catch (boost::regex_error& err) {
 383         throw (uErrorRegexp);
 384     }
 385     return ans.release ();
 386 }
 387
 388 /*DOC:
 389 ===string-join===
 390  (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
 391
 392 */
 393 //#AFUNC        string-join     ml_string_join
 394 //#WIKIFUNC     string-join
 395 MNode*  ml_string_join (MNode* cell, MlEnv* mlenv) {
 396     MNode*  arg = cell->cdr ();
 397     ustring  sep;
 398     MNodePtr  val;
 399     ustring  var;
 400     ustring  u;
 401     ustring  ans;
 402     int  i, n, c;
 403     MNode*  v;
 404
 405     if (! arg)
 406         throw (uErrorWrongNumber);
 407
 408     sep = eval_str (arg->car (), mlenv);
 409     nextNodeNonNil (arg);
 410     c = 0;
 411     while (arg) {
 412         val = eval (arg->car (), mlenv);
 413         nextNode (arg);
 414
 415         if (val ()) {
 416             if (val ()->isSym ()) {
 417                 var = val ()->to_string ();
 418                 checkAry (var, var);
 419                 n = mlenv->getArySize (var);
 420                 for (i = 1; i <= n; i ++) {
 421                     if (c == 0)
 422                         c ++;
 423                     else
 424                         ans.append (sep);
 425                     v = mlenv->getAry (var, i);
 426                     if (v)
 427                         ans.append (v->to_string ());
 428                 }
 429             } else if (val ()->isCons ()) {
 430                 MNode*  a = val ();
 431                 for (; a && a->isCons (); a = a->cdr ()) {
 432                     if (c == 0)
 433                         c ++;
 434                     else
 435                         ans.append (sep);
 436                     if (! isNil (a->car ()))
 437                         ans.append (a->car ()->to_string ());
 438                 }
 439             } else {
 440                 var = val ()->to_string ();
 441                 if (c == 0)
 442                     c ++;
 443                 else
 444                     ans.append (sep);
 445                 ans.append (var);
 446             }
 447         }
 448     }
 449     return newMNode_str (new ustring (ans));
 450 }
 451
 452 /*DOC:
 453 ===password-match===
 454  (password-match PASSWORD CRYPT) -> BOOL
 455
 456 */
 457 //#AFUNC        password-match  ml_password_match
 458 //#WIKIFUNC     password-match
 459 MNode*  ml_password_match (MNode* cell, MlEnv* mlenv) {
 460     MNode*  arg = cell->cdr ();
 461     ustring  pass;
 462     ustring  cpass;
 463
 464     if (! arg)
 465         throw (uErrorWrongNumber);
 466     pass = eval_str (arg->car (), mlenv);
 467     nextNodeNonNil (arg);
 468     cpass = eval_str (arg->car (), mlenv);
 469     nextNode (arg);
 470     if (arg)
 471         throw (uErrorWrongNumber);
 472
 473     return newMNode_bool (passMatch (pass, cpass));
 474 }
 475
 476 /*DOC:
 477 ===password-crypt===
 478  (password-crypt PASSWORD) -> STRING
 479
 480 */
 481 //#AFUNC        password-crypt  ml_password_crypt
 482 //#WIKIFUNC     password-crypt
 483 MNode*  ml_password_crypt (MNode* cell, MlEnv* mlenv) {
 484     MNode*  arg = cell->cdr ();
 485     ustring  pass;
 486
 487     if (! arg)
 488         throw (uErrorWrongNumber);
 489     pass = eval_str (arg->car (), mlenv);
 490     nextNode (arg);
 491     if (arg)
 492         throw (uErrorWrongNumber);
 493
 494     return newMNode_str (new ustring (passCrypt (pass)));
 495 }
 496
 497 /*DOC:
 498 ===substring===
 499  (substring STR INDEX LENGTH) -> STRING
 500  (substring STR INDEX) -> STRING
 501
 502 */
 503 //#AFUNC        substring       ml_substring
 504 //#WIKIFUNC     substring
 505 MNode*  ml_substring (MNode* cell, MlEnv* mlenv) {
 506     MNode*  arg = cell->cdr ();
 507     ustring  str;
 508     size_t  index;
 509     size_t  length;
 510     int  mode;
 511     ustring  ans;
 512
 513     if (! arg)
 514         throw (uErrorWrongNumber);
 515     str = eval_str (arg->car (), mlenv);
 516     nextNodeNonNil (arg);
 517     index = eval_int (arg->car (), mlenv);
 518     nextNode (arg);
 519     if (arg) {
 520         mode = 3;
 521         length = eval_int (arg->car (), mlenv);
 522         nextNode (arg);
 523     } else {
 524         mode = 2;
 525     }
 526     if (arg)
 527         throw (uErrorWrongNumber);
 528
 529     substring (str, index, length, mode == 3, ans);
 530     return newMNode_str (new ustring (ans));
 531 }
 532
 533 /*DOC:
 534 ===length===
 535  (length STRING) -> NUMBER
 536
 537 */
 538 //#AFUNC        length  ml_length
 539 //#WIKIFUNC     length
 540 MNode*  ml_length (MNode* cell, MlEnv* mlenv) {
 541     MNode*  arg = cell->cdr ();
 542     ustring  str;
 543     size_t  ans;
 544
 545     if (! arg)
 546         throw (uErrorWrongNumber);
 547     str = eval_str (arg->car (), mlenv);
 548     nextNode (arg);
 549     if (arg)
 550         throw (uErrorWrongNumber);
 551
 552     ans = strLength (str);
 553     return newMNode_num (ans);
 554 }
 555
 556 /*DOC:
 557 ===pad0===
 558  (pad0 NUMBER STRING) -> STRING
 559  (pad0 NUMBER STRING_LIST) -> STRING_LIST
 560  (pad0 NUMBER_LIST STRING_LIST) -> STRING_LIST
 561
 562 */
 563 //#AFUNC        pad0    ml_pad0
 564 //#WIKIFUNC     pad0
 565 MNode*  ml_pad0 (MNode* cell, MlEnv* mlenv) {
 566     MNode*  arg = cell->cdr ();
 567     MNodePtr  num;
 568     MNodePtr  val;
 569     int  n;
 570     MNode*  np;
 571     MNode*  vp;
 572     MNodeList  ans;
 573
 574     if (! arg)
 575         throw (uErrorWrongNumber);
 576     num = np = eval (arg->car (), mlenv);
 577     nextNodeNonNil (arg);
 578     val = vp = eval (arg->car (), mlenv);
 579     nextNode (arg);
 580     if (arg)
 581         throw (uErrorWrongNumber);
 582
 583     n = 0;
 584     if (vp) {
 585         if (vp->isCons ()) {
 586             while (vp) {
 587                 if (np) {
 588                     if (np->isCons ()) {
 589                         n = to_int (np->car ());
 590                         np = np->cdr ();
 591                     } else {
 592                         n = to_int (np);
 593                     }
 594                 }
 595                 ans.append (newMNode_str (new ustring (zeroPad (n, to_string (vp->car ())))));
 596                 vp = vp->cdr ();
 597                 if (vp && ! vp->isCons ())
 598                     vp = NULL;
 599             }
 600             return ans.release ();
 601         } else {
 602             if (np) {
 603                 if (np->isCons ())
 604                     n = to_int (np->car ());
 605                 else
 606                     n = to_int (np);
 607             }
 608             return newMNode_str (new ustring (zeroPad (n, to_string (vp))));
 609         }
 610     }
 611
 612     return NULL;
 613 }
 614
 615 /*DOC:
 616 ===ellipsis===
 617  (ellipsis NUM STRING) -> STRING
 618
 619 */
 620 //#AFUNC        ellipsis        ml_ellipsis
 621 //#WIKIFUNC     ellipsis
 622 MNode*  ml_ellipsis (MNode* cell, MlEnv* mlenv) {
 623     MNode*  arg = cell->cdr ();
 624     int  num;
 625     ustring  str;
 626
 627     if (! arg)
 628         throw (uErrorWrongNumber);
 629     num = eval_int (arg->car (), mlenv);
 630     nextNodeNonNil (arg);
 631     str = eval_str (arg->car (), mlenv);
 632     nextNode (arg);
 633     if (arg)
 634         throw (uErrorWrongNumber);
 635
 636     str = ellipsis (str, num);
 637     return newMNode_str (new ustring (str));
 638 }
 639
 640 /*DOC:
 641 ===string-format===
 642  (string-format FORMAT LIST-OF-ARGS) -> STRING
 643  (string-format FORMAT ARGS...) -> STRING
 644
 645 |h:format|h:sample|h:note|
 646 |${''NUM''}|${1}||
 647 |${''NUM'':hex:''NUM''}|${1:hex:4}||
 648 |${''NUM'':HEX:''NUM''}|${1:HEX:4}||
 649 |${''NUM'':int:''NUM''}|${1:int:5}||
 650 |${''NUM'':int:''NUM'':c}|${1:int:5:c}||
 651 |${''NUM'':int:''NUM'':comma}|${1:int:5:comma}||
 652 |${''NUM'':int:''NUM'':clip}|${1:int:5:clip}||
 653 |${''NUM'':int:''NUM'':0}|${1:int:5:0}||
 654 |${''NUM'':float:''NUM'':''NUM''}|${1:float:4:3}||
 655 |${''NUM'':string:''NUM''}|${1:string:20}||
 656 |${''NUM'':string:''NUM'':right}|${1:string:20:right}||
 657 |${''NUM'':month}|${1:month}|Jan, Feb,...|
 658 |${''NUM'':Month}|${1:Month}|January, February,...|
 659 |${''NUM'':week}|${1:week}|Sun, Mon,...|
 660 |${''NUM'':Week}|${1:Week}|Sunday, Monday,...|
 661
 662 */
 663 //#AFUNC        string-format   ml_string_format
 664 //#WIKIFUNC     string-format
 665 MNode*  ml_string_format (MNode* cell, MlEnv* mlenv) {
 666     MNode*  arg = cell->cdr ();
 667     ustring  format;
 668     boost::ptr_vector<MNodePtr>  par;
 669     MNode*  a;
 670
 671     if (! arg)
 672         throw (uErrorWrongNumber);
 673     format = eval_str (arg->car (), mlenv);
 674     nextNode (arg);
 675     while (arg) {
 676         a = eval (arg->car (), mlenv);
 677         if (a && a->isCons ()) {
 678             MNodePtr  h;
 679             h = a;
 680             while (a) {
 681                 par.push_back (new MNodePtr);
 682                 par.back () = a->car ();
 683                 nextNode (a);
 684             }
 685         } else {
 686             par.push_back (new MNodePtr);
 687             par.back () = a;
 688         }
 689         nextNode (arg);
 690     }
 691
 692     return newMNode_str (new ustring (formatString (format, par)));
 693 }
 694
 695 /*DOC:
 696 ===random-key===
 697  (random-key) -> STRING
 698
 699 */
 700 //#AFUNC        random-key      ml_random_key
 701 //#WIKIFUNC     random-key
 702 MNode*  ml_random_key (MNode* cell, MlEnv* mlenv) {
 703     MNode*  arg = cell->cdr ();
 704
 705     if (arg)
 706         throw (uErrorWrongNumber);
 707
 708     return newMNode_str (new ustring (randomKey ()));
 709 }
 710
 711 /*DOC:
 712 ===date-format, gmdate-format===
 713  (date-format FORMAT INTEGER) -> STRING
 714  (gmdate-format FORMAT INTEGER) -> STRING
 715
 716  ${Y:4}, ${Y:2}
 717  ${M:2}, ${M}
 718  ${D:2}, ${D}
 719  ${h:2}, ${h}
 720  ${m:2}, ${m}
 721  ${s:2}, ${s}
 722  ${W}, ${w}
 723
 724 */
 725 //#AFUNC        date-format     ml_date_format
 726 //#WIKIFUNC     date-format
 727 MNode*  ml_date_format (MNode* cell, MlEnv* mlenv) {
 728     MNode*  arg = cell->cdr ();
 729     ustring  format;
 730     time_t  tm;
 731     struct tm  tmv;
 732
 733     if (! arg)
 734         throw (uErrorWrongNumber);
 735     format = eval_str (arg->car (), mlenv);
 736     nextNodeNonNil (arg);
 737     tm = eval_int (arg->car (), mlenv);
 738     nextNode (arg);
 739     if (arg)
 740         throw (uErrorWrongNumber);
 741
 742     localtime_r (&tm, &tmv);
 743     return newMNode_str (new ustring (formatDateString (format, tmv)));
 744 }
 745
 746 //#AFUNC        gmdate-format   ml_gmdate_format
 747 //#WIKIFUNC     gmdate-format
 748 MNode*  ml_gmdate_format (MNode* cell, MlEnv* mlenv) {
 749     MNode*  arg = cell->cdr ();
 750     ustring  format;
 751     time_t  tm;
 752     struct tm  tmv;
 753
 754     if (! arg)
 755         throw (uErrorWrongNumber);
 756     format = eval_str (arg->car (), mlenv);
 757     nextNodeNonNil (arg);
 758     tm = eval_int (arg->car (), mlenv);
 759     nextNode (arg);
 760     if (arg)
 761         throw (uErrorWrongNumber);
 762
 763     gmtime_r (&tm, &tmv);
 764     return newMNode_str (new ustring (formatDateString (format, tmv)));
 765 }
 766
 767 /*DOC:
 768 ===to-string===
 769  (to-string OBJECT) -> STRING
 770
 771 */
 772 //#AFUNC        to-string       ml_to_string
 773 //#WIKIFUNC     to-string
 774 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv) {
 775     MNode*  arg = cell->cdr ();
 776     ustring  text;
 777
 778     if (! arg)
 779         throw (uErrorWrongNumber);
 780     text = eval_str (arg->car (), mlenv);
 781     nextNode (arg);
 782     if (arg)
 783         throw (uErrorWrongNumber);
 784
 785     return newMNode_str (new ustring (text));
 786 }
 787
 788 /*DOC:
 789 ===dump-to-sexp===
 790  (dump-to-sexp OBJECT...) -> STRING
 791
 792 */
 793 //#AFUNC        dump-to-sexp    ml_dump_to_sexp
 794 //#WIKIFUNC     dump-to-sexp
 795 MNode*  ml_dump_to_sexp (MNode* cell, MlEnv* mlenv) {
 796     MNode*  arg = cell->cdr ();
 797     MNodePtr  e;
 798     ustring  text;
 799
 800     while (arg) {
 801 //      text = eval_str (arg->car (), mlenv);
 802         e = eval (arg->car (), mlenv);
 803         nextNode (arg);
 804         if (text.length () > 0)
 805             text.append (CharConst (" "));
 806         text.append (dump_to_sexp (e ()));
 807     }
 808     return newMNode_str (new ustring (text));
 809 }
 810
 811 /*DOC:
 812 //===to-sexp===
 813 // (to-sexp STRING) -> OBJECT
 814 ===read-sexp===
 815  (read-sexp STRING) -> OBJECT
 816
 817 */
 818 //  //#AFUNC    to-sexp ml_to_sexp
 819 //  //#WIKIFUNC to-sexp
 820 //#AFUNC        read-sexp       ml_read_sexp
 821 //#WIKIFUNC     read-sexp
 822 //MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv) {
 823 MNode*  ml_read_sexp (MNode* cell, MlEnv* mlenv) {
 824     MNode*  arg = cell->cdr ();
 825     ustring  text;
 826     MotorSexp ml (NULL);
 827
 828     if (! arg)
 829         throw (uErrorWrongNumber);
 830     text = eval_str (arg->car (), mlenv);
 831     nextNode (arg);
 832     if (arg)
 833         throw (uErrorWrongNumber);
 834
 835     ml.scan (text);
 836
 837     if (ml.top.isCons () && ml.top.cdr ()->isCons ())
 838         return mlenv->retval = ml.top.cdr ()->car ();
 839     else
 840         return NULL;
 841 }
 842
 843 /*DOC:
 844 ===is-ascii63===
 845  (is-ascii63 STRING) -> BOOL
 846
 847 */
 848 //#AFUNC        is-ascii63      ml_is_ascii63
 849 //#WIKIFUNC     is-ascii63
 850 MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv) {
 851     MNode*  arg = cell->cdr ();
 852     ustring  text;
 853     bool  ans;
 854
 855     if (! arg)
 856         throw (uErrorWrongNumber);
 857     text = eval_str (arg->car (), mlenv);
 858     nextNode (arg);
 859     if (arg)
 860         throw (uErrorWrongNumber);
 861
 862     ans = checkASCII (text);
 863
 864     return newMNode_bool (ans);
 865 }
 866
 867 /*DOC:
 868 ===sort-string===
 869  (sort-string LIST [#asc] [#desc]) -> LIST
 870
 871 */
 872 //#AFUNC        sort-string     ml_sort_string
 873 //#WIKIFUNC     sort-string
 874 MNode*  ml_sort_string (MNode* cell, MlEnv* mlenv) {
 875     MNode*  arg = cell->cdr ();
 876     MNodePtr  h;
 877     bool  fdesc = false;
 878     MNode*  a;
 879     std::vector<MNode*>  list;
 880     MNodeList  ans;
 881     std::vector<MNode*>  params;
 882     std::vector<MNode*>  keywords;
 883     static paramList  kwlist[] = {
 884         {CharConst ("asc"), true},
 885         {CharConst ("desc"), true},
 886         {NULL, 0, 0}
 887     };
 888
 889     setParams (arg, 1, &params, kwlist, &keywords, NULL);
 890     h = eval (params[0], mlenv);
 891     if (keywords[0] && eval_bool (keywords[0], mlenv))
 892         fdesc = false;
 893     if (keywords[1] && eval_bool (keywords[1], mlenv))
 894         fdesc = true;
 895
 896     a = h ();
 897     while (a) {
 898         if (a->isCons ()) {
 899             if (a->car () && a->car ()->isStr ()) {
 900                 list.push_back (a->car ());
 901             } else {
 902                 list.push_back (NULL);
 903             }
 904             nextNode (a);
 905         } else {
 906             break;
 907         }
 908     }
 909
 910     int  s, i, j, k;
 911     int  n = list.size ();
 912     for (i = 1; i < n; i ++) {
 913         j = i;
 914         while (j > 0) {
 915             k = (j - 1) / 2;
 916             if (! list[k])
 917                 if (! list[j])
 918                     break;
 919                 else
 920                     if (fdesc)
 921                         break;
 922                     else ;
 923             else if (! list[j])
 924                 if (fdesc)
 925                     ;
 926                 else
 927                     break;
 928             else if (fdesc ^ (*list[k]->str >= *list[j]->str))
 929                 break;
 930 //          swap (v[k], v[j]);
 931             a = list[j]; list[j] = list[k]; list[k] = a;
 932             j = k;
 933         }
 934     }
 935     for (; n > 0; n --) {
 936 //      swap (v[0], v[n - 1]);
 937         a = list[n - 1]; list[n - 1] = list[0]; list[0] = a;
 938         for (i = 1; i < n - 1; i ++) {
 939             j = i;
 940             while (j > 0) {
 941                 k = (j - 1) / 2;
 942 //              if (! list[k] || ! list[j])
 943 //                  break;
 944                 if (! list[k])
 945                     if (! list[j])
 946                         break;
 947                     else
 948                         if (fdesc)
 949                             break;
 950                         else ;
 951                 else if (! list[j])
 952                     if (fdesc)
 953                         ;
 954                     else
 955                         break;
 956                 else if (fdesc ^ (*list[k]->str >= *list[j]->str))
 957                     break;
 958 //              swap (v[k], v[j]);
 959                 a = list[j]; list[j] = list[k]; list[k] = a;
 960                 j = k;
 961             }
 962         }
 963     }
 964
 965     n = list.size ();
 966     for (i = 0; i < n; i ++) {
 967         ans.append (list[i]);
 968     }
 969     return ans.release ();
 970 }
 971
 972 /*DOC:
 973 ===to-upper===
 974  (to-upper STRING) -> STRING
 975
 976 */
 977 //#AFUNC        to-upper        ml_to_upper
 978 //#WIKIFUNC     to-upper
 979 MNode*  ml_to_upper (MNode* cell, MlEnv* mlenv) {
 980     MNode*  arg = cell->cdr ();
 981     ustring  text;
 982
 983     if (! arg)
 984         throw (uErrorWrongNumber);
 985     text = eval_str (arg->car (), mlenv);
 986     nextNode (arg);
 987     if (arg)
 988         throw (uErrorWrongNumber);
 989
 990     return newMNode_str (new ustring (toUpper (text)));
 991 }
 992
 993 /*DOC:
 994 ===to-lower===
 995  (to-lower STRING) -> STRING
 996
 997 */
 998 //#AFUNC        to-lower        ml_to_lower
 999 //#WIKIFUNC     to-lower
1000 MNode*  ml_to_lower (MNode* cell, MlEnv* mlenv) {
1001     MNode*  arg = cell->cdr ();
1002     ustring  text;
1003
1004     if (! arg)
1005         throw (uErrorWrongNumber);
1006     text = eval_str (arg->car (), mlenv);
1007     nextNode (arg);
1008     if (arg)
1009         throw (uErrorWrongNumber);
1010
1011     return newMNode_str (new ustring (toLower (text)));
1012 }