1: /*
2: * $Id: cmd_ksubscripts.c,v 1.3 2025/03/09 19:14:24 snw Exp $
3: * Implementation of the KSUBSCRIPTS command
4: *
5: *
6: * Author: Serena Willis <snw@coherent-logic.com>
7: * Copyright (C) 1998 MUG Deutschland
8: * Copyright (C) 2023 Coherent Logic Development LLC
9: *
10: *
11: * This file is part of FreeM.
12: *
13: * FreeM is free software: you can redistribute it and/or modify
14: * it under the terms of the GNU Affero Public License as published by
15: * the Free Software Foundation, either version 3 of the License, or
16: * (at your option) any later version.
17: *
18: * FreeM is distributed in the hope that it will be useful,
19: * but WITHOUT ANY WARRANTY; without even the implied warranty of
20: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21: * GNU Affero Public License for more details.
22: *
23: * You should have received a copy of the GNU Affero Public License
24: * along with FreeM. If not, see <https://www.gnu.org/licenses/>.
25: *
26: * $Log: cmd_ksubscripts.c,v $
27: * Revision 1.3 2025/03/09 19:14:24 snw
28: * First phase of REUSE compliance and header reformat
29: *
30: *
31: * SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
32: * SPDX-License-Identifier: AGPL-3.0-or-later
33: **/
34:
35: #include <string.h>
36: #include <stdlib.h>
37: #include "mpsdef.h"
38: #include "mcommand.h"
39: #include "consttbl.h"
40:
41: MRESULT cmd_ksubscripts(MACTION *ra)
42: {
43: register char ch;
44: char vn[255];
45: char *old_value;
46:
47: if ((rtn_dialect () != D_FREEM) &&
48: (rtn_dialect () != D_MDS)) {
49: return NOSTAND;
50: }
51:
52: if ((old_value = (char *) malloc (STRLEN * sizeof (char))) == NULL) {
53: return MEMOV;
54: }
55:
56: /* argumentless: KSUBSCRIPTS nukleurrr winturr */
57: if (((ch = *codptr) == SP) || ch == EOL) {
58: write_m ("Argumentless KSUBSCRIPTS not yet implemented.\201");
59:
60: free (old_value);
61:
62: *ra = RA_NEXTCMND;
63: return OK;
64: }
65:
66:
67: if (ch != '(') { /* inclusive KSUBSCRIPTS */
68:
69: for (;;) {
70: expr (NAME); /* try to interpret an mname */
71:
72: if (merr ()) return merr ();
73:
74: stcpy (vn, varnam);
75:
76: if (vn[0] != '^') {
77: symtab (get_sym, vn, old_value);
78: symtab (kill_sym, vn, NULL);
79: symtab (set_sym, vn, old_value);
80: }
81: else {
82: if (vn[1] == '$') {
83: ssvn (get_sym, vn, old_value);
84: ssvn (kill_sym, vn, NULL);
85: ssvn (set_sym, vn, old_value);
86: }
87: else {
88: global (get_sym, vn, old_value);
89: global (kill_sym, vn, NULL);
90: global (set_sym, vn, old_value);
91: }
92: }
93:
94: free (old_value);
95:
96: if (merr ()) return merr ();
97:
98: if ((ch = *(codptr + 1)) == EOL) {
99: codptr++;
100: break;
101: }
102: else if (ch == ',') {
103: codptr += 2;
104: }
105: else {
106: return CMMND;
107: }
108: }
109:
110: }
111: else { /* exclusive KSUBSCRIPTS */
112:
113: write_m ("Exclusive KSUBSCRIPTS not yet implemented.\201");
114:
115: while ((ch = *(codptr++)) != SP && ch != EOL) ; /* skip to the end of the command */
116:
117: }
118:
119: *ra = RA_NEXTCMND;
120: return OK;
121:
122: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>