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 ===eq===
  26  (eq STRING STRING...) -> 1 or NIL
  27  (string-eq STRING STRING...) -> 1 or NIL
  28
  29 全てのSTRINGが同じ時、1を返す。
  30
  31 */
  32 //#AFUNC        eq      ml_string_eq
  33 //#AFUNC        string-eq       ml_string_eq
  34 //#WIKIFUNC     eq
  35 //#WIKIFUNC     string-eq
  36 MNode*  ml_string_eq (MNode* cell, MlEnv* mlenv) {
  37     MNode*  arg = cell->cdr ();
  38     ustring  v1, v2;
  39
  40     if (! arg)
  41         throw (uErrorWrongNumber);
  42
  43     v1 = eval_str (arg->car (), mlenv);
  44     nextNode (arg);
  45     while (arg) {
  46         v2 = eval_str (arg->car (), mlenv);
  47         if (v1 == v2) {
  48         } else {
  49             return newMNode_bool (false);
  50         }
  51         nextNode (arg);
  52     }
  53     return newMNode_bool (true);
  54 }
  55
  56 /*DOC:
  57 ===ne===
  58  (ne STRING STRING) -> 1 or NIL
  59  (string-ne STRING STRING) -> 1 or NIL
  60
  61 STRINGが異なる時、1を返す。
  62
  63 */
  64 //#AFUNC        ne      ml_string_ne
  65 //#AFUNC        string-ne       ml_string_ne
  66 //#WIKIFUNC     ne
  67 //#WIKIFUNC     string-ne
  68 MNode*  ml_string_ne (MNode* cell, MlEnv* mlenv) {
  69     MNode*  arg = cell->cdr ();
  70     ustring  v1, v2;
  71
  72     if (! arg)
  73         throw (uErrorWrongNumber);
  74
  75     v1 = eval_str (arg->car (), mlenv);
  76     nextNode (arg);
  77     if (! arg)
  78         throw (uErrorWrongNumber);
  79     v2 = eval_str (arg->car (), mlenv);
  80     nextNode (arg);
  81     if (arg)
  82         throw (uErrorWrongNumber);
  83
  84     return newMNode_bool (v1 != v2);
  85 }
  86
  87 //#AFUNC        lt      ml_string_lt
  88 //#AFUNC        string-lt       ml_string_lt
  89 //#WIKIFUNC     lt
  90 //#WIKIFUNC     string-lt
  91 MNode*  ml_string_lt (MNode* cell, MlEnv* mlenv) {
  92     MNode*  arg = cell->cdr ();
  93     ustring  v1, v2;
  94
  95     if (! arg)
  96         throw (uErrorWrongNumber);
  97     v1 = eval_str (arg->car (), mlenv);
  98     nextNodeNonNil (arg);
  99     v2 = eval_str (arg->car (), mlenv);
 100     nextNode (arg);
 101     if (arg)
 102         throw (uErrorWrongNumber);
 103
 104     return newMNode_bool (v1 < v2);
 105 }
 106
 107 //#AFUNC        le      ml_string_le
 108 //#AFUNC        string-le       ml_string_le
 109 //#WIKIFUNC     le
 110 //#WIKIFUNC     string-le
 111 MNode*  ml_string_le (MNode* cell, MlEnv* mlenv) {
 112     MNode*  arg = cell->cdr ();
 113     ustring  v1, v2;
 114
 115     if (! arg)
 116         throw (uErrorWrongNumber);
 117     v1 = eval_str (arg->car (), mlenv);
 118     nextNodeNonNil (arg);
 119     v2 = eval_str (arg->car (), mlenv);
 120     nextNode (arg);
 121     if (arg)
 122         throw (uErrorWrongNumber);
 123
 124     return newMNode_bool (v1 <= v2);
 125 }
 126
 127 //#AFUNC        gt      ml_string_gt
 128 //#AFUNC        string-gt       ml_string_gt
 129 //#WIKIFUNC     gt
 130 //#WIKIFUNC     string-gt
 131 MNode*  ml_string_gt (MNode* cell, MlEnv* mlenv) {
 132     MNode*  arg = cell->cdr ();
 133     ustring  v1, v2;
 134
 135     if (! arg)
 136         throw (uErrorWrongNumber);
 137     v1 = eval_str (arg->car (), mlenv);
 138     nextNodeNonNil (arg);
 139     v2 = eval_str (arg->car (), mlenv);
 140     nextNode (arg);
 141     if (arg)
 142         throw (uErrorWrongNumber);
 143
 144     return newMNode_bool (v1 > v2);
 145 }
 146
 147 //#AFUNC        ge      ml_string_ge
 148 //#AFUNC        string-ge       ml_string_ge
 149 //#WIKIFUNC     ge
 150 //#WIKIFUNC     string-ge
 151 MNode*  ml_string_ge (MNode* cell, MlEnv* mlenv) {
 152     MNode*  arg = cell->cdr ();
 153     ustring  v1, v2;
 154
 155     if (! arg)
 156         throw (uErrorWrongNumber);
 157     v1 = eval_str (arg->car (), mlenv);
 158     nextNodeNonNil (arg);
 159     v2 = eval_str (arg->car (), mlenv);
 160     nextNode (arg);
 161     if (arg)
 162         throw (uErrorWrongNumber);
 163
 164     return newMNode_bool (v1 >= v2);
 165 }
 166
 167 /*DOC:
 168 ===emptyp===
 169  (emptyp TEXT...) -> 1 or NIL
 170
 171 文字列TEXTの長さが0の時、1を返す。
 172
 173 */
 174 //#AFUNC        emptyp  ml_emptyp
 175 //#WIKIFUNC     emptyp
 176 MNode*  ml_emptyp (MNode* cell, MlEnv* mlenv) {
 177     MNode*  arg = cell->cdr ();
 178     ustring  u;
 179
 180     if (! arg)
 181         throw (uErrorWrongNumber);
 182
 183     while (arg) {
 184         u = eval_str (arg->car (), mlenv);
 185         nextNode (arg);
 186         if (u.size () > 0)
 187             return newMNode_bool (false);
 188     }
 189     return newMNode_bool (true);
 190 }
 191
 192 /*DOC:
 193 ===not-emptyp===
 194  (not-emptyp TEXT...) -> 1 or NIL
 195
 196 文字列TEXTの長さが0でない時、1を返す。
 197
 198 */
 199 //#AFUNC        not-emptyp      ml_not_emptyp
 200 //#WIKIFUNC     not-emptyp
 201 MNode*  ml_not_emptyp (MNode* cell, MlEnv* mlenv) {
 202     MNode*  arg = cell->cdr ();
 203     ustring  u;
 204
 205     if (! arg)
 206         throw (uErrorWrongNumber);
 207
 208     while (arg) {
 209         u = eval_str (arg->car (), mlenv);
 210         nextNode (arg);
 211         if (u.size () == 0)
 212             return newMNode_bool (false);
 213     }
 214     return newMNode_bool (true);
 215 }
 216
 217 /*DOC:
 218 ===concat===
 219  (concat STRING...) -> STRING
 220 パラメータの文字列STRINGを連結して一つの文字列を返す。
 221
 222 */
 223 //#AFUNC        concat  ml_concat
 224 //#WIKIFUNC     concat
 225 MNode*  ml_concat (MNode* cell, MlEnv* mlenv) {
 226     MNode*  arg = cell->cdr ();
 227     AutoDelete<ustring>  a1;
 228
 229     a1 = new ustring;
 230 //    a1 ()->reserve (256);
 231
 232     while (arg) {
 233         a1 ()->append (eval_str (arg->car (), mlenv));
 234         nextNode (arg);
 235     }
 236     return newMNode_str (a1.release ());
 237 }
 238
 239 /*DOC:
 240 ===megabyte===
 241  (megabyte NUMBER) -> STRING
 242
 243 数値NUMBERをK、M、G、T、P単位（1024の倍数）の文字列に変換する。
 244
 245 */
 246 //#AFUNC        megabyte        ml_megabyte
 247 //#WIKIFUNC     megabyte
 248 MNode*  ml_megabyte (MNode* cell, MlEnv* mlenv) {
 249     MNode*  arg = cell->cdr ();
 250     double  val;
 251     ustring  u;
 252
 253     if (! arg)
 254         throw (uErrorWrongNumber);
 255
 256     val = eval_double (arg->car (), mlenv);
 257     nextNode (arg);
 258     if (arg)
 259         throw (uErrorWrongNumber);
 260
 261     if (val < 900) {
 262         u = to_ustring (val);
 263         return newMNode_str (new ustring (u));
 264     }
 265     val = floor (val / 1024. * 10.) / 10.;
 266     if (val < 900) {
 267         u = to_ustring (val);
 268         u.append (CharConst ("K"));
 269         return newMNode_str (new ustring (u));
 270     }
 271     val = floor (val / 1024. * 10. ) / 10.;
 272     if (val < 900) {
 273         u = to_ustring (val);
 274         u.append (CharConst ("M"));
 275         return newMNode_str (new ustring (u));
 276     }
 277     val = floor (val / 1024. * 10.) / 10.;
 278     if (val < 900) {
 279         u = to_ustring (val);
 280         u.append (CharConst ("G"));
 281         return newMNode_str (new ustring (u));
 282     }
 283     val = floor (val / 1024. * 10.) / 10.;
 284     if (val < 900) {
 285         u = to_ustring (val);
 286         u.append (CharConst ("T"));
 287         return newMNode_str (new ustring (u));
 288     }
 289     val = floor (val / 1024. * 10.) / 10.;
 290     u = to_ustring (val);
 291     u.append (CharConst ("P"));
 292     return newMNode_str (new ustring (u));
 293 }
 294
 295 /*DOC:
 296 ===c3===
 297  (c3 INTEGER) -> STRING
 298
 299 数値INTEGERを3桁ごとにカンマ区切りの文字列に変換する。
 300
 301 */
 302 //#AFUNC        c3      ml_c3
 303 //#WIKIFUNC     c3
 304 MNode*  ml_c3 (MNode* cell, MlEnv* mlenv) {
 305     MNode*  arg = cell->cdr ();
 306     ustring  u;
 307
 308     if (! arg)
 309         throw (uErrorWrongNumber);
 310
 311     u = eval_str (arg->car (), mlenv);
 312     nextNode (arg);
 313     if (arg)
 314         throw (uErrorWrongNumber);
 315
 316     return newMNode_str (new ustring (c3 (u)));
 317 }
 318
 319 /*DOC:
 320 ===regexp-match===
 321  (regexp-match REGEX TEXT [#i | :i BOOL]) -> BOOL
 322
 323 */
 324 //#AFUNC        regexp-match    ml_regexp_match
 325 //#WIKIFUNC     regexp-match
 326 MNode*  ml_regexp_match (MNode* cell, MlEnv* mlenv) {
 327     MNode*  arg = cell->cdr ();
 328     ustring  reg;
 329     ustring  text;
 330     boost::wregex::flag_type  f = boost::regex_constants::normal;
 331     bool  ans;
 332     std::vector<MNode*>  params;
 333     std::vector<MNode*>  keywords;
 334     static paramList  kwlist[] = {
 335         {CharConst ("i"), true},
 336         {NULL, 0, 0}
 337     };
 338
 339     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 340     reg = eval_str (params[0], mlenv);
 341     text = eval_str (params[1], mlenv);
 342     if (keywords[0] && eval_bool (keywords[0], mlenv))
 343         f |= boost::regex_constants::icase;
 344
 345     ans = wsearch_env (mlenv, text, reg, f);
 346
 347     return newMNode_bool (ans);
 348 }
 349
 350 /*DOC:
 351 ===match-string===
 352  (match-string NUM) -> STRING
 353
 354 */
 355 //#AFUNC        match-string    ml_match_string
 356 //#WIKIFUNC     match-string
 357 MNode*  ml_match_string (MNode* cell, MlEnv* mlenv) {
 358     MNode*  arg = cell->cdr ();
 359     int  n;
 360     MNode*  ans = NULL;
 361
 362     if (! arg)
 363         throw (uErrorWrongNumber);
 364     n = eval_int (arg->car (), mlenv);
 365     nextNode (arg);
 366     if (arg)
 367         throw (uErrorWrongNumber);
 368
 369     if (0 <= n && n < mlenv->regmatch.size ()) {
 370         ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[n].first, mlenv->regmatch[n].second))));
 371     }
 372
 373     return ans;
 374 }
 375
 376 /*DOC:
 377 ===prematch===
 378  (prematch) -> STRING
 379
 380 */
 381 //#AFUNC        prematch        ml_prematch
 382 //#WIKIFUNC     prematch
 383 MNode*  ml_prematch (MNode* cell, MlEnv* mlenv) {
 384     MNode*  arg = cell->cdr ();
 385     MNode*  ans = NULL;
 386     std::wstring::const_iterator  b = mlenv->regtext.begin ();
 387
 388     if (arg)
 389         throw (uErrorWrongNumber);
 390
 391     ans = newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regmatch[0].first))));
 392
 393     return ans;
 394 }
 395
 396 /*DOC:
 397 ===postmatch===
 398  (postmatch) -> STRING
 399
 400 */
 401 //#AFUNC        postmatch       ml_postmatch
 402 //#WIKIFUNC     postmatch
 403 MNode*  ml_postmatch (MNode* cell, MlEnv* mlenv) {
 404     MNode*  arg = cell->cdr ();
 405     MNode*  ans = NULL;
 406     std::wstring::const_iterator  e = mlenv->regtext.end ();
 407
 408     if (arg)
 409         throw (uErrorWrongNumber);
 410
 411     ans = newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[0].second, e))));
 412
 413     return ans;
 414 }
 415
 416 /*DOC:
 417 ===string-filter===
 418  (string-filter REGEX STRING [#i | :i BOOL] [:max NUM]) -> STRING
 419
 420 */
 421 //#AFUNC        string-filter   ml_string_filter
 422 //#WIKIFUNC     string-filter
 423 MNode*  ml_string_filter (MNode* cell, MlEnv* mlenv) {
 424     MNode*  arg = cell->cdr ();
 425     ustring  reg;
 426     ustring  text;
 427     boost::wregex::flag_type  f = boost::regex_constants::normal;
 428     size_t  max = 0;
 429     MNodePtr  t;
 430     std::vector<MNode*>  params;
 431     std::vector<MNode*>  keywords;
 432     static paramList  kwlist[] = {
 433         {CharConst ("i"), true},
 434         {CharConst ("max"), false},
 435         {NULL, 0, 0}
 436     };
 437
 438     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 439     reg = eval_str (params[0], mlenv);
 440     text = eval_str (params[1], mlenv);
 441     if (keywords[0] && eval_bool (keywords[0], mlenv))
 442         f |= boost::regex_constants::icase;
 443     if (evkw (1, t)) {
 444         max = to_int (t ());
 445         if (max < 0)
 446             max = 0;
 447     }
 448
 449     if (wsearch_env (mlenv, text, reg, f)) {
 450         ustring  ans = wtou (std::wstring (mlenv->regmatch[0].first, mlenv->regmatch[0].second));
 451         if (max > 0) {
 452             substring (ans, 0, max, true, ans);
 453         }
 454         return newMNode_str (new ustring (ans));
 455     } else {
 456         return NULL;            // unmatched
 457     }
 458 }
 459
 460 /*DOC:
 461 ===regexp-replace===
 462  (regexp-replace REGEX TO_TEXT TEXT [#i | :i BOOL] [#g | #global | :g BOOL | :global BOOL]) -> TEXT
 463
 464 */
 465 //#AFUNC        regexp-replace  ml_regexp_replace
 466 //#WIKIFUNC     regexp-replace
 467 MNode*  ml_regexp_replace (MNode* cell, MlEnv* mlenv) {
 468     MNode*  arg = cell->cdr ();
 469     ustring  reg;
 470     ustring  to;
 471     ustring  text;
 472     boost::wregex::flag_type  f = boost::regex_constants::normal;
 473     boost::match_flag_type  mf = boost::regex_constants::match_default;
 474     bool  fglobal = false;
 475     ustring  ans;
 476     std::vector<MNode*>  params;
 477     std::vector<MNode*>  keywords;
 478     static paramList  kwlist[] = {
 479         {CharConst ("i"), true},
 480         {CharConst ("g"), true},
 481         {CharConst ("global"), true},
 482         {NULL, 0, 0}
 483     };
 484
 485     setParams (arg, 3, &params, kwlist, &keywords, NULL);
 486     reg = eval_str (params[0], mlenv);
 487     to = eval_str (params[1], mlenv);
 488     text = eval_str (params[2], mlenv);
 489     if (keywords[0] && eval_bool (keywords[0], mlenv))
 490         f |= boost::regex_constants::icase;
 491     if (keywords[1] && eval_bool (keywords[1], mlenv))
 492         fglobal = true;
 493     if (keywords[2] && eval_bool (keywords[2], mlenv))
 494         fglobal = true;
 495
 496     if (! fglobal)
 497         mf |= boost::regex_constants::format_first_only;
 498     ans = wreplace (text, reg, to, f, mf);
 499
 500     return newMNode_str (new ustring (ans));
 501 }
 502
 503 /*DOC:
 504 ===regexp-split===
 505  (regexp-split REGEX STRING [#i | :i BOOL]) -> (PREMATCH_STRING POSTMATCH_STRING)
 506
 507 */
 508 //#AFUNC        regexp-split    ml_regexp_split
 509 //#WIKIFUNC     regexp-split
 510 MNode*  ml_regexp_split (MNode* cell, MlEnv* mlenv) {
 511     MNode*  arg = cell->cdr ();
 512     ustring  reg;
 513     ustring  text;
 514     boost::wregex::flag_type  f = boost::regex_constants::normal;
 515     MNodeList  ans;
 516     std::vector<MNode*>  params;
 517     std::vector<MNode*>  keywords;
 518     static paramList  kwlist[] = {
 519         {CharConst ("i"), true},
 520         {NULL, 0, 0}
 521     };
 522
 523     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 524     reg = eval_str (params[0], mlenv);
 525     text = eval_str (params[1], mlenv);
 526     if (keywords[0] && eval_bool (keywords[0], mlenv))
 527         f |= boost::regex_constants::icase;
 528
 529     if (wsearch_env (mlenv, text, reg, f)) {
 530         std::wstring::const_iterator  b = mlenv->regtext.begin ();
 531         std::wstring::const_iterator  e = mlenv->regtext.end ();
 532         ans.append (newMNode_str (new ustring (wtou (std::wstring (b, mlenv->regmatch[0].first)))));
 533         ans.append (newMNode_str (new ustring (wtou (std::wstring (mlenv->regmatch[0].second, e)))));
 534     } else {
 535         ans.append (newMNode_str (new ustring (text)));
 536         ans.append (NULL);
 537     }
 538
 539     return ans.release ();
 540 }
 541
 542 /*DOC:
 543 ===split===
 544  (split REGEX STRING) -> STRING_LIST
 545
 546 */
 547 //#AFUNC        split   ml_split
 548 //#WIKIFUNC     split
 549 MNode*  ml_split (MNode* cell, MlEnv* mlenv) {
 550     MNode*  arg = cell->cdr ();
 551     ustring  reg;
 552     ustring  text;
 553     bool  keep = false;
 554     MNodeList  ans;
 555     std::vector<MNode*>  params;
 556     std::vector<MNode*>  keywords;
 557     static paramList  kwlist[] = {
 558         {CharConst ("keep"), true}, // 空フィールドの削除をしない
 559         {NULL, 0, 0}
 560     };
 561
 562     setParams (arg, 2, &params, kwlist, &keywords, NULL);
 563     reg = eval_str (params[0], mlenv);
 564     text = eval_str (params[1], mlenv);
 565     if (keywords[0] && eval_bool (keywords[0], mlenv))
 566         keep = true;
 567
 568     try {
 569         std::wstring  wt = utow (text);
 570         std::wstring  wreg = utow (reg);
 571         boost::wregex  wre (wreg);
 572         WSplitter  sp (wt, wre);
 573         size_t  m = wt.length () + 1;
 574
 575         bool  (WSplitter::*nfn)();
 576         if (keep)
 577             nfn = &WSplitter::nextSep;
 578         else
 579             nfn = &WSplitter::next;
 580         while ((sp.*nfn) ()) {
 581             ans.append (newMNode_str (new ustring (sp.cur ())));
 582             m --;
 583             if (m == 0)
 584                 throw (uErrorRegexp);
 585         }
 586         if (keep)
 587             ans.append (newMNode_str (new ustring (sp.cur ())));
 588     } catch (boost::regex_error& err) {
 589         throw (uErrorRegexp);
 590     }
 591     return ans.release ();
 592 }
 593
 594 /*DOC:
 595 ===string-join===
 596  (string-join TEXT [STRING | ARRAY | LIST]...) -> STRING
 597
 598 */
 599 //#AFUNC        string-join     ml_string_join
 600 //#WIKIFUNC     string-join
 601 MNode*  ml_string_join (MNode* cell, MlEnv* mlenv) {
 602     MNode*  arg = cell->cdr ();
 603     ustring  sep;
 604     MNodePtr  val;
 605     ustring  var;
 606     ustring  u;
 607     ustring  ans;
 608     int  i, n, c;
 609     MNode*  v;
 610
 611     if (! arg)
 612         throw (uErrorWrongNumber);
 613
 614     sep = eval_str (arg->car (), mlenv);
 615     nextNodeNonNil (arg);
 616     c = 0;
 617     while (arg) {
 618         val = eval (arg->car (), mlenv);
 619         nextNode (arg);
 620
 621         if (val ()) {
 622             if (val ()->isSym ()) {
 623                 var = val ()->to_string ();
 624                 checkAry (var, var);
 625                 n = mlenv->getArySize (var);
 626                 for (i = 1; i <= n; i ++) {
 627                     if (c == 0)
 628                         c ++;
 629                     else
 630                         ans.append (sep);
 631                     v = mlenv->getAry (var, i);
 632                     if (v)
 633                         ans.append (v->to_string ());
 634                 }
 635             } else if (val ()->isCons ()) {
 636                 MNode*  a = val ();
 637                 for (; a && a->isCons (); a = a->cdr ()) {
 638                     if (c == 0)
 639                         c ++;
 640                     else
 641                         ans.append (sep);
 642                     if (! isNil (a->car ()))
 643                         ans.append (a->car ()->to_string ());
 644                 }
 645             } else {
 646                 var = val ()->to_string ();
 647                 if (c == 0)
 648                     c ++;
 649                 else
 650                     ans.append (sep);
 651                 ans.append (var);
 652             }
 653         }
 654     }
 655     return newMNode_str (new ustring (ans));
 656 }
 657
 658 /*DOC:
 659 ===password-match===
 660  (password-match PASSWORD CRYPT) -> BOOL
 661
 662 */
 663 //#AFUNC        password-match  ml_password_match
 664 //#WIKIFUNC     password-match
 665 MNode*  ml_password_match (MNode* cell, MlEnv* mlenv) {
 666     MNode*  arg = cell->cdr ();
 667     ustring  pass;
 668     ustring  cpass;
 669
 670     if (! arg)
 671         throw (uErrorWrongNumber);
 672     pass = eval_str (arg->car (), mlenv);
 673     nextNodeNonNil (arg);
 674     cpass = eval_str (arg->car (), mlenv);
 675     nextNode (arg);
 676     if (arg)
 677         throw (uErrorWrongNumber);
 678
 679     return newMNode_bool (passMatch (pass, cpass));
 680 }
 681
 682 /*DOC:
 683 ===password-crypt===
 684  (password-crypt PASSWORD) -> STRING
 685
 686 */
 687 //#AFUNC        password-crypt  ml_password_crypt
 688 //#WIKIFUNC     password-crypt
 689 MNode*  ml_password_crypt (MNode* cell, MlEnv* mlenv) {
 690     MNode*  arg = cell->cdr ();
 691     ustring  pass;
 692
 693     if (! arg)
 694         throw (uErrorWrongNumber);
 695     pass = eval_str (arg->car (), mlenv);
 696     nextNode (arg);
 697     if (arg)
 698         throw (uErrorWrongNumber);
 699
 700     return newMNode_str (new ustring (passCrypt (pass)));
 701 }
 702
 703 /*DOC:
 704 ===substring===
 705  (substring STR INDEX LENGTH) -> STRING
 706  (substring STR INDEX) -> STRING
 707
 708 */
 709 //#AFUNC        substring       ml_substring
 710 //#WIKIFUNC     substring
 711 MNode*  ml_substring (MNode* cell, MlEnv* mlenv) {
 712     MNode*  arg = cell->cdr ();
 713     ustring  str;
 714     size_t  index;
 715     size_t  length;
 716     int  mode;
 717     ustring  ans;
 718
 719     if (! arg)
 720         throw (uErrorWrongNumber);
 721     str = eval_str (arg->car (), mlenv);
 722     nextNodeNonNil (arg);
 723     index = eval_int (arg->car (), mlenv);
 724     nextNode (arg);
 725     if (arg) {
 726         mode = 3;
 727         length = eval_int (arg->car (), mlenv);
 728         nextNode (arg);
 729     } else {
 730         mode = 2;
 731     }
 732     if (arg)
 733         throw (uErrorWrongNumber);
 734
 735     substring (str, index, length, mode == 3, ans);
 736     return newMNode_str (new ustring (ans));
 737 }
 738
 739 /*DOC:
 740 ===length===
 741  (length STRING) -> NUMBER
 742
 743 */
 744 //#AFUNC        length  ml_length
 745 //#WIKIFUNC     length
 746 MNode*  ml_length (MNode* cell, MlEnv* mlenv) {
 747     MNode*  arg = cell->cdr ();
 748     ustring  str;
 749     size_t  ans;
 750
 751     if (! arg)
 752         throw (uErrorWrongNumber);
 753     str = eval_str (arg->car (), mlenv);
 754     nextNode (arg);
 755     if (arg)
 756         throw (uErrorWrongNumber);
 757
 758     ans = strLength (str);
 759     return newMNode_num (ans);
 760 }
 761
 762 /*DOC:
 763 ===pad0===
 764  (pad0 NUMBER STRING) -> STRING
 765  (pad0 NUMBER STRING_LIST) -> STRING_LIST
 766  (pad0 NUMBER_LIST STRING_LIST) -> STRING_LIST
 767
 768 */
 769 //#AFUNC        pad0    ml_pad0
 770 //#WIKIFUNC     pad0
 771 MNode*  ml_pad0 (MNode* cell, MlEnv* mlenv) {
 772     MNode*  arg = cell->cdr ();
 773     MNodePtr  num;
 774     MNodePtr  val;
 775     int  n;
 776     MNode*  np;
 777     MNode*  vp;
 778     MNodeList  ans;
 779
 780     if (! arg)
 781         throw (uErrorWrongNumber);
 782     num = np = eval (arg->car (), mlenv);
 783     nextNodeNonNil (arg);
 784     val = vp = eval (arg->car (), mlenv);
 785     nextNode (arg);
 786     if (arg)
 787         throw (uErrorWrongNumber);
 788
 789     n = 0;
 790     if (vp) {
 791         if (vp->isCons ()) {
 792             while (vp) {
 793                 if (np) {
 794                     if (np->isCons ()) {
 795                         n = to_int (np->car ());
 796                         np = np->cdr ();
 797                     } else {
 798                         n = to_int (np);
 799                     }
 800                 }
 801                 ans.append (newMNode_str (new ustring (zeroPad (n, to_string (vp->car ())))));
 802                 vp = vp->cdr ();
 803                 if (vp && ! vp->isCons ())
 804                     vp = NULL;
 805             }
 806             return ans.release ();
 807         } else {
 808             if (np) {
 809                 if (np->isCons ())
 810                     n = to_int (np->car ());
 811                 else
 812                     n = to_int (np);
 813             }
 814             return newMNode_str (new ustring (zeroPad (n, to_string (vp))));
 815         }
 816     }
 817
 818     return NULL;
 819 }
 820
 821 /*DOC:
 822 ===ellipsis===
 823  (ellipsis NUM STRING) -> STRING
 824
 825 */
 826 //#AFUNC        ellipsis        ml_ellipsis
 827 //#WIKIFUNC     ellipsis
 828 MNode*  ml_ellipsis (MNode* cell, MlEnv* mlenv) {
 829     MNode*  arg = cell->cdr ();
 830     int  num;
 831     ustring  str;
 832
 833     if (! arg)
 834         throw (uErrorWrongNumber);
 835     num = eval_int (arg->car (), mlenv);
 836     nextNodeNonNil (arg);
 837     str = eval_str (arg->car (), mlenv);
 838     nextNode (arg);
 839     if (arg)
 840         throw (uErrorWrongNumber);
 841
 842     str = ellipsis (str, num);
 843     return newMNode_str (new ustring (str));
 844 }
 845
 846 /*DOC:
 847 ===string-format===
 848  (string-format FORMAT LIST-OF-ARGS) -> STRING
 849  (string-format FORMAT ARGS...) -> STRING
 850
 851 |h:format|h:sample|h:note|
 852 |${''NUM''}|${1}||
 853 |${''NUM'':hex:''NUM''}|${1:hex:4}||
 854 |${''NUM'':HEX:''NUM''}|${1:HEX:4}||
 855 |${''NUM'':int:''NUM''}|${1:int:5}||
 856 |${''NUM'':int:''NUM'':c}|${1:int:5:c}||
 857 |${''NUM'':int:''NUM'':comma}|${1:int:5:comma}||
 858 |${''NUM'':int:''NUM'':clip}|${1:int:5:clip}||
 859 |${''NUM'':int:''NUM'':0}|${1:int:5:0}||
 860 |${''NUM'':float:''NUM'':''NUM''}|${1:float:4:3}||
 861 |${''NUM'':string:''NUM''}|${1:string:20}||
 862 |${''NUM'':string:''NUM'':right}|${1:string:20:right}||
 863 |${''NUM'':month}|${1:month}|Jan, Feb,...|
 864 |${''NUM'':Month}|${1:Month}|January, February,...|
 865 |${''NUM'':week}|${1:week}|Sun, Mon,...|
 866 |${''NUM'':Week}|${1:Week}|Sunday, Monday,...|
 867
 868 */
 869 //#AFUNC        string-format   ml_string_format
 870 //#WIKIFUNC     string-format
 871 MNode*  ml_string_format (MNode* cell, MlEnv* mlenv) {
 872     MNode*  arg = cell->cdr ();
 873     ustring  format;
 874     boost::ptr_vector<MNodePtr>  par;
 875     MNode*  a;
 876
 877     if (! arg)
 878         throw (uErrorWrongNumber);
 879     format = eval_str (arg->car (), mlenv);
 880     nextNode (arg);
 881     while (arg) {
 882         a = eval (arg->car (), mlenv);
 883         if (a && a->isCons ()) {
 884             MNodePtr  h;
 885             h = a;
 886             while (a) {
 887                 par.push_back (new MNodePtr);
 888                 par.back () = a->car ();
 889                 nextNode (a);
 890             }
 891         } else {
 892             par.push_back (new MNodePtr);
 893             par.back () = a;
 894         }
 895         nextNode (arg);
 896     }
 897
 898     return newMNode_str (new ustring (formatString (format, par)));
 899 }
 900
 901 /*DOC:
 902 ===random-key===
 903  (random-key) -> STRING
 904
 905 */
 906 //#AFUNC        random-key      ml_random_key
 907 //#WIKIFUNC     random-key
 908 MNode*  ml_random_key (MNode* cell, MlEnv* mlenv) {
 909     MNode*  arg = cell->cdr ();
 910
 911     if (arg)
 912         throw (uErrorWrongNumber);
 913
 914     return newMNode_str (new ustring (randomKey ()));
 915 }
 916
 917 /*DOC:
 918 ===date-format, gmdate-format===
 919  (date-format FORMAT INTEGER) -> STRING
 920  (gmdate-format FORMAT INTEGER) -> STRING
 921
 922  ${Y:4}, ${Y:2}
 923  ${M:2}, ${M}
 924  ${D:2}, ${D}
 925  ${h:2}, ${h}
 926  ${m:2}, ${m}
 927  ${s:2}, ${s}
 928  ${W}, ${w}
 929
 930 */
 931 //#AFUNC        date-format     ml_date_format
 932 //#WIKIFUNC     date-format
 933 MNode*  ml_date_format (MNode* cell, MlEnv* mlenv) {
 934     MNode*  arg = cell->cdr ();
 935     ustring  format;
 936     time_t  tm;
 937     struct tm  tmv;
 938
 939     if (! arg)
 940         throw (uErrorWrongNumber);
 941     format = eval_str (arg->car (), mlenv);
 942     nextNodeNonNil (arg);
 943     tm = eval_int (arg->car (), mlenv);
 944     nextNode (arg);
 945     if (arg)
 946         throw (uErrorWrongNumber);
 947
 948     localtime_r (&tm, &tmv);
 949     return newMNode_str (new ustring (formatDateString (format, tmv)));
 950 }
 951
 952 //#AFUNC        gmdate-format   ml_gmdate_format
 953 //#WIKIFUNC     gmdate-format
 954 MNode*  ml_gmdate_format (MNode* cell, MlEnv* mlenv) {
 955     MNode*  arg = cell->cdr ();
 956     ustring  format;
 957     time_t  tm;
 958     struct tm  tmv;
 959
 960     if (! arg)
 961         throw (uErrorWrongNumber);
 962     format = eval_str (arg->car (), mlenv);
 963     nextNodeNonNil (arg);
 964     tm = eval_int (arg->car (), mlenv);
 965     nextNode (arg);
 966     if (arg)
 967         throw (uErrorWrongNumber);
 968
 969     gmtime_r (&tm, &tmv);
 970     return newMNode_str (new ustring (formatDateString (format, tmv)));
 971 }
 972
 973 /*DOC:
 974 ===to-string===
 975  (to-string OBJECT) -> STRING
 976
 977 */
 978 //#AFUNC        to-string       ml_to_string
 979 //#WIKIFUNC     to-string
 980 MNode*  ml_to_string (MNode* cell, MlEnv* mlenv) {
 981     MNode*  arg = cell->cdr ();
 982     ustring  text;
 983
 984     if (! arg)
 985         throw (uErrorWrongNumber);
 986     text = eval_str (arg->car (), mlenv);
 987     nextNode (arg);
 988     if (arg)
 989         throw (uErrorWrongNumber);
 990
 991     return newMNode_str (new ustring (text));
 992 }
 993
 994 /*DOC:
 995 ===to-symbol===
 996  (to-symbol STRING) -> SYMBOL
 997
 998 */
 999 //#AFUNC        to-symbol       ml_to_symbol
1000 //#WIKIFUNC     to-symbol
1001 MNode*  ml_to_symbol (MNode* cell, MlEnv* mlenv) {
1002     MNode*  arg = cell->cdr ();
1003     MNodePtr  text;
1004
1005     if (! arg)
1006         throw (uErrorWrongNumber);
1007     text = eval (arg->car (), mlenv);
1008     nextNode (arg);
1009     if (arg)
1010         throw (uErrorWrongNumber);
1011
1012     if (text ()) {
1013         if (text ()->isSym ()) {
1014             return text.release ();
1015         } else {
1016             return newMNode_sym (new ustring (text ()->to_string ()));
1017         }
1018     } else {
1019         return NULL;
1020     }
1021 //    return newMNode_str (new ustring (text));
1022 }
1023
1024 /*DOC:
1025 ===dump-to-sexp===
1026  (dump-to-sexp OBJECT...) -> STRING
1027
1028 */
1029 //#AFUNC        dump-to-sexp    ml_dump_to_sexp
1030 //#WIKIFUNC     dump-to-sexp
1031 MNode*  ml_dump_to_sexp (MNode* cell, MlEnv* mlenv) {
1032     MNode*  arg = cell->cdr ();
1033     MNodePtr  e;
1034     ustring  text;
1035
1036     while (arg) {
1037 //      text = eval_str (arg->car (), mlenv);
1038         e = eval (arg->car (), mlenv);
1039         nextNode (arg);
1040         if (text.length () > 0)
1041             text.append (CharConst (" "));
1042         text.append (dump_to_sexp (e ()));
1043     }
1044     return newMNode_str (new ustring (text));
1045 }
1046
1047 /*DOC:
1048 //===to-sexp===
1049 // (to-sexp STRING) -> OBJECT
1050 ===read-sexp===
1051  (read-sexp STRING) -> OBJECT
1052
1053 */
1054 //  //#AFUNC    to-sexp ml_to_sexp
1055 //  //#WIKIFUNC to-sexp
1056 //#AFUNC        read-sexp       ml_read_sexp
1057 //#WIKIFUNC     read-sexp
1058 //MNode*  ml_to_sexp (MNode* cell, MlEnv* mlenv) {
1059 MNode*  ml_read_sexp (MNode* cell, MlEnv* mlenv) {
1060     MNode*  arg = cell->cdr ();
1061     ustring  text;
1062     MotorSexp ml (NULL);
1063
1064     if (! arg)
1065         throw (uErrorWrongNumber);
1066     text = eval_str (arg->car (), mlenv);
1067     nextNode (arg);
1068     if (arg)
1069         throw (uErrorWrongNumber);
1070
1071     ml.scan (text);
1072
1073     if (ml.top.isCons () && ml.top.cdr ()->isCons ())
1074         return mlenv->retval = ml.top.cdr ()->car ();
1075     else
1076         return NULL;
1077 }
1078
1079 /*DOC:
1080 ===is-ascii63===
1081  (is-ascii63 STRING) -> BOOL
1082
1083 */
1084 //#AFUNC        is-ascii63      ml_is_ascii63
1085 //#WIKIFUNC     is-ascii63
1086 MNode*  ml_is_ascii63 (MNode* cell, MlEnv* mlenv) {
1087     MNode*  arg = cell->cdr ();
1088     ustring  text;
1089     bool  ans;
1090
1091     if (! arg)
1092         throw (uErrorWrongNumber);
1093     text = eval_str (arg->car (), mlenv);
1094     nextNode (arg);
1095     if (arg)
1096         throw (uErrorWrongNumber);
1097
1098     ans = checkASCII (text);
1099
1100     return newMNode_bool (ans);
1101 }
1102
1103 /*DOC:
1104 ===sort-string===
1105  (sort-string LIST [#asc] [#desc]) -> LIST
1106
1107 */
1108 //#AFUNC        sort-string     ml_sort_string
1109 //#WIKIFUNC     sort-string
1110 MNode*  ml_sort_string (MNode* cell, MlEnv* mlenv) {
1111     MNode*  arg = cell->cdr ();
1112     MNodePtr  h;
1113     bool  fdesc = false;
1114     MNode*  a;
1115     std::vector<MNode*>  list;
1116     MNodeList  ans;
1117     std::vector<MNode*>  params;
1118     std::vector<MNode*>  keywords;
1119     static paramList  kwlist[] = {
1120         {CharConst ("asc"), true},
1121         {CharConst ("desc"), true},
1122         {NULL, 0, 0}
1123     };
1124
1125     setParams (arg, 1, &params, kwlist, &keywords, NULL);
1126     h = eval (params[0], mlenv);
1127     if (keywords[0] && eval_bool (keywords[0], mlenv))
1128         fdesc = false;
1129     if (keywords[1] && eval_bool (keywords[1], mlenv))
1130         fdesc = true;
1131
1132     a = h ();
1133     while (a) {
1134         if (a->isCons ()) {
1135             if (a->car () && a->car ()->isStr ()) {
1136                 list.push_back (a->car ());
1137             } else {
1138                 list.push_back (NULL);
1139             }
1140             nextNode (a);
1141         } else {
1142             break;
1143         }
1144     }
1145
1146     int  s, i, j, k;
1147     int  n = list.size ();
1148     for (i = 1; i < n; i ++) {
1149         j = i;
1150         while (j > 0) {
1151             k = (j - 1) / 2;
1152             if (! list[k])
1153                 if (! list[j])
1154                     break;
1155                 else
1156                     if (fdesc)
1157                         break;
1158                     else ;
1159             else if (! list[j])
1160                 if (fdesc)
1161                     ;
1162                 else
1163                     break;
1164             else if (fdesc ^ (*list[k]->str >= *list[j]->str))
1165                 break;
1166 //          swap (v[k], v[j]);
1167             a = list[j]; list[j] = list[k]; list[k] = a;
1168             j = k;
1169         }
1170     }
1171     for (; n > 0; n --) {
1172 //      swap (v[0], v[n - 1]);
1173         a = list[n - 1]; list[n - 1] = list[0]; list[0] = a;
1174         for (i = 1; i < n - 1; i ++) {
1175             j = i;
1176             while (j > 0) {
1177                 k = (j - 1) / 2;
1178 //              if (! list[k] || ! list[j])
1179 //                  break;
1180                 if (! list[k])
1181                     if (! list[j])
1182                         break;
1183                     else
1184                         if (fdesc)
1185                             break;
1186                         else ;
1187                 else if (! list[j])
1188                     if (fdesc)
1189                         ;
1190                     else
1191                         break;
1192                 else if (fdesc ^ (*list[k]->str >= *list[j]->str))
1193                     break;
1194 //              swap (v[k], v[j]);
1195                 a = list[j]; list[j] = list[k]; list[k] = a;
1196                 j = k;
1197             }
1198         }
1199     }
1200
1201     n = list.size ();
1202     for (i = 0; i < n; i ++) {
1203         ans.append (list[i]);
1204     }
1205     return ans.release ();
1206 }
1207
1208 /*DOC:
1209 ===to-upper===
1210  (to-upper STRING) -> STRING
1211
1212 */
1213 //#AFUNC        to-upper        ml_to_upper
1214 //#WIKIFUNC     to-upper
1215 MNode*  ml_to_upper (MNode* cell, MlEnv* mlenv) {
1216     MNode*  arg = cell->cdr ();
1217     ustring  text;
1218
1219     if (! arg)
1220         throw (uErrorWrongNumber);
1221     text = eval_str (arg->car (), mlenv);
1222     nextNode (arg);
1223     if (arg)
1224         throw (uErrorWrongNumber);
1225
1226     return newMNode_str (new ustring (toUpper (text)));
1227 }
1228
1229 /*DOC:
1230 ===to-lower===
1231  (to-lower STRING) -> STRING
1232
1233 */
1234 //#AFUNC        to-lower        ml_to_lower
1235 //#WIKIFUNC     to-lower
1236 MNode*  ml_to_lower (MNode* cell, MlEnv* mlenv) {
1237     MNode*  arg = cell->cdr ();
1238     ustring  text;
1239
1240     if (! arg)
1241         throw (uErrorWrongNumber);
1242     text = eval_str (arg->car (), mlenv);
1243     nextNode (arg);
1244     if (arg)
1245         throw (uErrorWrongNumber);
1246
1247     return newMNode_str (new ustring (toLower (text)));
1248 }