SEDIT-COMMANDS: Shift-DELELETE is wordelete.backwards
This commit is contained in:
rmkaplan
parent
49dd3a2583
commit
486228d9ae
@ -1,14 +1,13 @@
|
||||
(DEFINE-FILE-INFO PACKAGE (DEFPACKAGE SEDIT ( USE LISP XCL)) READTABLE "XCL" BASE 10)
|
||||
(IL:FILECREATED "15-Aug-2021 21:22:22"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;7| 125181
|
||||
|
||||
IL:|changes| IL:|to:| (IL:VARS IL:SEDIT-COMMANDSCOMS)
|
||||
(IL:FILECREATED "13-Nov-2025 00:19:24" IL:|{WMEDLEY}<sources>SEDIT-COMMANDS.;5| 124301
|
||||
|
||||
IL:|previous| IL:|date:| "14-Aug-2021 12:59:29"
|
||||
IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
:EDIT-BY IL:|rmk|
|
||||
|
||||
:CHANGES-TO (IL:VARIABLES COMMAND-TABLE-SPEC)
|
||||
|
||||
:PREVIOUS-DATE "13-Nov-2025 00:14:31" IL:|{WMEDLEY}<sources>SEDIT-COMMANDS.;4|)
|
||||
|
||||
; Copyright (c) 1986-1988, 1990-1991, 2018, 2021 by Venue & Xerox Corporation.
|
||||
|
||||
(IL:PRETTYCOMPRINT IL:SEDIT-COMMANDSCOMS)
|
||||
|
||||
@ -30,18 +29,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
IL:\; < > IL:\.))))
|
||||
(IL:FUNCTIONS
|
||||
|
||||
(IL:* IL:|;;| "pseudo-selections")
|
||||
(IL:* IL:|;;| "pseudo-selections")
|
||||
|
||||
PSEUDO-SELECTION-FROM-SELECTION COMPOSE-PSEUDO-SELECTION DECOMPOSE-PSEUDO-SELECTION
|
||||
SELECTION-FROM-PSEUDO-SELECTION SELECT-PSEUDO-SEGMENT)
|
||||
|
||||
(IL:* IL:|;;| "user interface to adding new commands")
|
||||
(IL:* IL:|;;| "user interface to adding new commands")
|
||||
|
||||
(IL:FUNCTIONS ADD-COMMAND GET-SELECTION REPLACE-SELECTION RESET-COMMANDS DEFAULT-COMMANDS)
|
||||
(IL:VARIABLES DEFAULT-COMMAND-TABLE-SPEC FIRST-ADD-COMMAND FIRST-ADD-COMMAND-MENU-ENTRY)
|
||||
(IL:FUNCTIONS
|
||||
|
||||
(IL:* IL:|;;| "building help menu")
|
||||
(IL:* IL:|;;| "building help menu")
|
||||
|
||||
EQUALIZE-STRING-WIDTHS MINIMUM-STRING-WIDTH MAXIMUM-STRING-WIDTH)
|
||||
(IL:FUNCTIONS FIND-AND-DISPLAY-STRUCTURE FIND-AND-DISPLAY-STRUCTURE-BACKWARDS
|
||||
@ -65,8 +64,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(IL:PUTPROPS IL:SEDIT-COMMANDS IL:FILETYPE :COMPILE-FILE)
|
||||
|
||||
(IL:PUTPROPS IL:SEDIT-COMMANDS IL:MAKEFILE-ENVIRONMENT (:READTABLE "XCL" :PACKAGE
|
||||
(DEFPACKAGE IL:SEDIT
|
||||
(:USE IL:LISP IL:XCL))))
|
||||
(DEFPACKAGE IL:SEDIT (:USE IL:LISP
|
||||
IL:XCL))))
|
||||
(IL:DECLARE\: IL:DOEVAL@COMPILE IL:DONTCOPY
|
||||
|
||||
(IL:LOCALVARS . T)
|
||||
@ -78,10 +77,10 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFPARAMETER COMMAND-TABLE-SPEC
|
||||
|
||||
(IL:* IL:|;;;| "each entry in the COMMAND-TABLE-SPEC should be of the form: (<fn> <help menu entry> <normalize?> <key>+) where <fn> is an atom function name or a list whose car is the function name and the rest are the extra arguments (beyond context and charcode), <help menu entry> is a list of strings for the name, key-name, and help-string, <normalize?> is T if the caret should be normalized after this command, and <key>+ is one or more key specifier which can be passed to charcode (if non-list) or whose car is a termtable syntax (if a list).")
|
||||
(IL:* IL:|;;;| "each entry in the COMMAND-TABLE-SPEC should be of the form: (<fn> <help menu entry> <normalize?> <key>+) where <fn> is an atom function name or a list whose car is the function name and the rest are the extra arguments (beyond context and charcode), <help menu entry> is a list of strings for the name, key-name, and help-string, <normalize?> is T if the caret should be normalized after this command, and <key>+ is one or more key specifier which can be passed to charcode (if non-list) or whose car is a termtable syntax (if a list).")
|
||||
|
||||
'(
|
||||
(IL:* IL:|;;| "STRUCTURE CONTROL")
|
||||
(IL:* IL:|;;| "STRUCTURE CONTROL")
|
||||
|
||||
(INSERT-NULL-LIST NIL T (IL:LEFTPAREN))
|
||||
(CLOSE-LIST NIL NIL (IL:RIGHTPAREN))
|
||||
@ -104,7 +103,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
((INPUT-QUOTE COMMA-AT)
|
||||
NIL NIL "@")
|
||||
|
||||
(IL:* IL:|;;| "EDIT CONTROL")
|
||||
(IL:* IL:|;;| "EDIT CONTROL")
|
||||
|
||||
(DELETE-SELECTION NIL T IL:DEL)
|
||||
(BACKSPACE NIL T IL:BS "^A")
|
||||
@ -114,7 +113,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
((VERIFY-STRUCTURE NIL T NIL)
|
||||
NIL NIL "Meta,^L")
|
||||
|
||||
(IL:* IL:|;;| "COMPLETION")
|
||||
(IL:* IL:|;;| "COMPLETION")
|
||||
|
||||
((COMPLETE :ABORT NIL)
|
||||
("Abort" "M-A" "Complete this edit without installing changes.")
|
||||
@ -134,14 +133,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
("Done, Compile, & Close" "C-M-C" "Complete this edit, compile, and close the window.")
|
||||
NIL "Meta,^C")
|
||||
|
||||
(IL:* IL:|;;| "COMMANDS")
|
||||
(IL:* IL:|;;| "COMMANDS")
|
||||
|
||||
(NULL ("" "" "")
|
||||
NIL 0)
|
||||
(UNDO ("Undo" "M-U" "Undo the last change made.")
|
||||
NIL "Meta,U" "Meta,u" "Function,^D" (UNDO))
|
||||
NIL "Meta,U" "Meta,u" "Function,^D" (UNDO))
|
||||
(REDO ("Redo" "M-R" "Redo the last change undone.")
|
||||
NIL "Meta,R" "Meta,r" "Function,Bs" (REDO))
|
||||
NIL "Meta,R" "Meta,r" "Function,Bs" (REDO))
|
||||
(NULL ("" "" "")
|
||||
NIL 0)
|
||||
(FIND-OBJ ("Find" "M-F" "Find the current selection, or prompt for structure to Find.")
|
||||
@ -161,7 +160,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(EDIT-HELP ("Arglist" "M-H" "Show the argument list for the selected function.")
|
||||
NIL "Meta,H" "Meta,h" "Function,^A" (ARGLIST))
|
||||
(CONVERT-COMMENT ("Convert Comment" "M-;"
|
||||
"Convert the old style comments in the current selection.")
|
||||
"Convert the old style comments in the current selection.")
|
||||
NIL "Meta,;")
|
||||
(COMMENT-OUT-SELECTION NIL NIL "Meta,^;")
|
||||
(EDIT-SELECTION ("Edit" "M-O" "Edit the definition of the current selection.")
|
||||
@ -173,13 +172,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
NIL "Meta,E" "Meta,e" (EVAL))
|
||||
(EXPAND ("Expand" "M-X" "Replace the current selection with its definition.")
|
||||
NIL "Meta,X" "Meta,x" IL:ESC "Function,^T" (EXPAND))
|
||||
(EXTRACT-CURRENT-SELECTION ("Extract" "M-/"
|
||||
"Extract one level of structure: unquote or unlist.")
|
||||
(EXTRACT-CURRENT-SELECTION ("Extract" "M-/" "Extract one level of structure: unquote or unlist."
|
||||
)
|
||||
NIL "Meta,/" (EXTRACT))
|
||||
(INSPECT-SELECTION ("Inspect" "M-I" "Inspect the current selection.")
|
||||
NIL "Meta,I" "Meta,i" (INSPECT))
|
||||
(JOIN ("Join" "M-J" "Join selected items together.")
|
||||
NIL "Meta,J" "Meta,j" (JOIN))
|
||||
NIL "Meta,J" "Meta,j" (JOIN))
|
||||
(MUTATE ("Mutate" "M-Z" "Prompt for a function to operate on the current selection.")
|
||||
NIL "Meta,Z" "Meta,z")
|
||||
((PARENTHESIZE-CURRENT-SELECTION NIL)
|
||||
@ -209,7 +208,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(ADD-MENU ("Attach Menu" "M-M" "Attach a command menu.")
|
||||
NIL "Meta,M" "Meta,m")
|
||||
|
||||
(IL:* IL:|;;| "RANDOM: tells Meta-Space or Meta-Return to scroll to the selection, using the auto-scroller for free.")
|
||||
(IL:* IL:|;;| "RANDOM: tells Meta-Space or Meta-Return to scroll to the selection, using the auto-scroller for free.")
|
||||
|
||||
(TRUE NIL T "Meta, " "Meta,CR")))
|
||||
|
||||
@ -269,19 +268,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(IL:RPAQ? MENUS NIL)
|
||||
(IL:DECLARE\: IL:EVAL@COMPILE
|
||||
|
||||
(IL:RPAQ WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < >
|
||||
IL:\.)))
|
||||
(IL:RPAQ WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < > IL:\.)))
|
||||
|
||||
|
||||
(IL:CONSTANTS (WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; <
|
||||
> IL:\.))))
|
||||
(IL:CONSTANTS (WORD-DELIM-CHARS (IL:CHARCODE (IL:SPACE IL:CR IL:TAB - IL:{ IL:} IL:[ IL:] IL:\; < >
|
||||
IL:\.))))
|
||||
)
|
||||
|
||||
(DEFUN PSEUDO-SELECTION-FROM-SELECTION (SEL)
|
||||
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
|
||||
(IL:* IL:|;;;| "This function takes a selection and creates a pseudo selection from it.")
|
||||
(IL:* IL:|;;;| "This function takes a selection and creates a pseudo selection from it.")
|
||||
|
||||
(COMPOSE-PSEUDO-SELECTION (IL:FETCH SELECT-NODE IL:OF SEL)
|
||||
(IL:FETCH SELECT-START IL:OF SEL)
|
||||
@ -290,9 +288,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN COMPOSE-PSEUDO-SELECTION (NODE &OPTIONAL START END)
|
||||
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
|
||||
(IL:* IL:|;;;| "This function takes the fields of a pseudo selection and hands back one.")
|
||||
(IL:* IL:|;;;| "This function takes the fields of a pseudo selection and hands back one.")
|
||||
|
||||
(COND
|
||||
((LISTP NODE)
|
||||
@ -308,9 +306,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN DECOMPOSE-PSEUDO-SELECTION (PSEL)
|
||||
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
|
||||
(IL:* IL:|;;;| "This function takes a pseudo selection and hands its fields back as values.")
|
||||
(IL:* IL:|;;;| "This function takes a pseudo selection and hands its fields back as values.")
|
||||
|
||||
(IF (LISTP PSEL)
|
||||
(VALUES (FIRST PSEL)
|
||||
@ -322,9 +320,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN SELECTION-FROM-PSEUDO-SELECTION (PSEL &OPTIONAL SEL)
|
||||
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
(IL:* IL:|;;;| "A pseudo-selection is either a node or a list of a node and two integers. It's interpreted as the select-node, select-start, and select-end fields of a selection.")
|
||||
|
||||
(IL:* IL:|;;;| "This function takes a pseudo-selection and constructs the corresponding selection. If you don't hand it a selection structure, it conses one.")
|
||||
(IL:* IL:|;;;| "This function takes a pseudo-selection and constructs the corresponding selection. If you don't hand it a selection structure, it conses one.")
|
||||
|
||||
(UNLESS SEL
|
||||
(SETF SEL (IL:CREATE EDIT-SELECTION)))
|
||||
@ -350,13 +348,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(DEFUN ADD-COMMAND (KEY-CODE FORM &OPTIONAL SCROLL? KEY-NAME COMMAND-NAME HELP-STRING)
|
||||
(WHEN FIRST-ADD-COMMAND
|
||||
|
||||
(IL:* IL:|;;| "cache the command-table-spec so the user can undo this!")
|
||||
(IL:* IL:|;;| "cache the command-table-spec so the user can undo this!")
|
||||
|
||||
(SETQ DEFAULT-COMMAND-TABLE-SPEC (COPY-TREE COMMAND-TABLE-SPEC))
|
||||
(SETQ FIRST-ADD-COMMAND NIL))
|
||||
(WHEN (AND KEY-NAME COMMAND-NAME FIRST-ADD-COMMAND-MENU-ENTRY)
|
||||
|
||||
(IL:* IL:|;;| "add another separation line to the help menu.")
|
||||
(IL:* IL:|;;| "add another separation line to the help menu.")
|
||||
|
||||
(NCONC COMMAND-TABLE-SPEC (LIST (LIST 'NULL (LIST "-----" "" "")
|
||||
NIL 0)))
|
||||
@ -366,8 +364,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
SCROLL? KEY-CODE)))
|
||||
(OR COMMAND-NAME FORM))
|
||||
|
||||
(DEFUN GET-SELECTION (CONTEXT) (IL:* IL:\; "Edited 23-Apr-2018 18:11 by rmk:")
|
||||
(IL:* IL:\; "Edited 22-Apr-2018 16:48 by rmk:")
|
||||
(DEFUN GET-SELECTION (CONTEXT) (IL:* IL:\; "Edited 23-Apr-2018 18:11 by rmk:")
|
||||
(IL:* IL:\; "Edited 22-Apr-2018 16:48 by rmk:")
|
||||
(LET* ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT))
|
||||
(NODE (IL:FETCH SELECT-NODE IL:OF SELECTION))
|
||||
(CHARS (IL:FETCH STRUCTURE IL:OF NODE))
|
||||
@ -377,7 +375,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(TYPE (IL:FETCH SELECT-TYPE IL:OF SELECTION))
|
||||
NOT-ALL-SELECTED)
|
||||
|
||||
(IL:* IL:|;;| "All except NODE are needed for the atom/string cases")
|
||||
(IL:* IL:|;;| "All except NODE are needed for the atom/string cases")
|
||||
|
||||
(COND
|
||||
((NULL NODE)
|
||||
@ -388,7 +386,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(START :SUB-LIST)
|
||||
(T T))))
|
||||
(T
|
||||
(IL:* IL:|;;| "RMK: a single character-atom or a substring of characters in an atom or string. Full multicharacter atoms are structures. Code copies from COPY-SELECTION-LITATOM")
|
||||
(IL:* IL:|;;| "RMK: a single character-atom or a substring of characters in an atom or string. Full multicharacter atoms are structures. Code copies from COPY-SELECTION-LITATOM")
|
||||
|
||||
(WHEN (IL:TYPE? BROKEN-ATOM CHARS)
|
||||
(IL:SETQ CHARS (IL:FETCH ATOM-CHARS IL:OF CHARS)))
|
||||
@ -396,7 +394,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(IL:NCHARS STRING))
|
||||
(IL:NEQ START 1)))
|
||||
|
||||
(IL:* IL:|;;| "some subset of the atom/string has been selected")
|
||||
(IL:* IL:|;;| "some subset of the atom/string has been selected")
|
||||
|
||||
(IL:SETQ NOT-ALL-SELECTED T))
|
||||
(VALUES (IL:MKSTRING (IF NOT-ALL-SELECTED
|
||||
@ -428,16 +426,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(PENDING-DELETE POINT SELECTION)
|
||||
(INSERT POINT CONTEXT (COPY-LIST NEW-NODES))
|
||||
|
||||
(IL:* IL:|;;| "try to select the stuff that was just inserted.")
|
||||
(IL:* IL:|;;| "try to select the stuff that was just inserted.")
|
||||
|
||||
(SELECT-PSEUDO-SEGMENT CONTEXT (COMPOSE-PSEUDO-SELECTION NEW-NODES))))
|
||||
|
||||
(DEFUN RESET-COMMANDS ()
|
||||
(LET ((COMMANDS (CREATE-COMMAND-TABLE COMMAND-TABLE-SPEC)))
|
||||
(IL:REPLACE (EDIT-ENV COMMAND-TABLE) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH
|
||||
(FIRST COMMANDS))
|
||||
(IL:REPLACE (EDIT-ENV HELP-MENU) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (SECOND
|
||||
COMMANDS)))
|
||||
(IL:REPLACE (EDIT-ENV COMMAND-TABLE) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (FIRST COMMANDS))
|
||||
(IL:REPLACE (EDIT-ENV HELP-MENU) IL:OF LISP-EDIT-ENVIRONMENT IL:WITH (SECOND COMMANDS)))
|
||||
T)
|
||||
|
||||
(DEFUN DEFAULT-COMMANDS ()
|
||||
@ -456,13 +452,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
"Used in Add-Command to signal the first time a new command is added to the middle button menu, so that the user entries can be separated from the default entries"
|
||||
)
|
||||
|
||||
(DEFUN EQUALIZE-STRING-WIDTHS (STRING-LIST FONT &OPTIONAL PRIN2? (DESIRED-WIDTH (
|
||||
MAXIMUM-STRING-WIDTH
|
||||
STRING-LIST FONT
|
||||
PRIN2?))
|
||||
(PAD-CHAR #\Space))
|
||||
(DEFUN EQUALIZE-STRING-WIDTHS (STRING-LIST FONT &OPTIONAL PRIN2? (DESIRED-WIDTH (MAXIMUM-STRING-WIDTH
|
||||
STRING-LIST FONT
|
||||
PRIN2?))
|
||||
(PAD-CHAR #\Space))
|
||||
|
||||
(IL:* IL:|;;;| "Increase the width of all the strings in STRING-LIST to DESIRED-WIDTH by padding them on the right with PAD-CHAR.")
|
||||
(IL:* IL:|;;;| "Increase the width of all the strings in STRING-LIST to DESIRED-WIDTH by padding them on the right with PAD-CHAR.")
|
||||
|
||||
(DO ((PAD-CHAR-WIDTH (IL:CHARWIDTH (CHAR-CODE PAD-CHAR)
|
||||
FONT))
|
||||
@ -488,7 +483,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-AND-DISPLAY-STRUCTURE (CONTEXT STR &OPTIONAL SCOPE START WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Find structure and display it by selecting it (point after) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).")
|
||||
(IL:* IL:|;;;| "Find structure and display it by selecting it (point after) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
@ -503,7 +498,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (CONTEXT STR &OPTIONAL SCOPE END WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Like find-and-display-structure, but searches backwards")
|
||||
(IL:* IL:|;;;| "Like find-and-display-structure, but searches backwards")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
@ -518,7 +513,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-AND-DISPLAY-SUBSTRUCTURE (CONTEXT STR &OPTIONAL SCOPE START WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Find substructure and display it by selecting it (pending delete) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).")
|
||||
(IL:* IL:|;;;| "Find substructure and display it by selecting it (pending delete) and normalizing the selection in the window. SCOPE defaults to the root structure of the CONTEXT. The WRAP? flag says to wrap failing searches around and try them again (i.e., ignore start and try again).")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
@ -533,7 +528,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (CONTEXT STR &OPTIONAL SCOPE END WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Like find-and-display-substructure but searches backwards")
|
||||
(IL:* IL:|;;;| "Like find-and-display-substructure but searches backwards")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
@ -548,7 +543,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-NTH-STRUCTURE (CONTEXT CHARCODE STRUCTURE N)
|
||||
|
||||
(IL:* IL:|;;;| "Find the Nth occurance of Structure in this edit, always starting from the beginning. This function is used as an external command to set the selection to a desired structure. Find, select, and normalize.")
|
||||
(IL:* IL:|;;;| "Find the Nth occurance of Structure in this edit, always starting from the beginning. This function is used as an external command to set the selection to a desired structure. Find, select, and normalize.")
|
||||
|
||||
(LET ((TOP (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT))))
|
||||
(DO ((M 1 (+ M 1))
|
||||
@ -561,13 +556,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-NODE-SUBSTRUCTURE (STR STRLEN NODE &OPTIONAL START END CONTINUATION?)
|
||||
|
||||
(IL:* IL:|;;;| "STR is a list of structures of length STRLEN. NODE, together with START and END (which are subnode indices), is taken to indicate a subtree. We return a pseudo-selection which selects the first sequence of sibling nodes in that subtree whose successive structures match the successive elements of STR.")
|
||||
(IL:* IL:|;;;| "STR is a list of structures of length STRLEN. NODE, together with START and END (which are subnode indices), is taken to indicate a subtree. We return a pseudo-selection which selects the first sequence of sibling nodes in that subtree whose successive structures match the successive elements of STR.")
|
||||
|
||||
(IL:* IL:|;;;| "\"First\" here is taken to mean \"first in linearization order\", so we have to do a careful recursion which: (1a) recursively checks the subtree rooted at the START subnode of NODE (default the first), (1b) checks if the START subnode starts a matching sibling sequence, (2a) recursively checks the subtree rooted at the START+1 subnode of NODE, (2b) checks if the START+1 subnode starts a matching sibling sequence, . . ., (Na) recusively checks the subtree rooted at the END subnode of NODE (default the last), (Nb) checks if the END subnode starts a matching sibling sequence [note that such a sequence could be only 1 node long since END is the right end of the subtree being checked].")
|
||||
(IL:* IL:|;;;| "\"First\" here is taken to mean \"first in linearization order\", so we have to do a careful recursion which: (1a) recursively checks the subtree rooted at the START subnode of NODE (default the first), (1b) checks if the START subnode starts a matching sibling sequence, (2a) recursively checks the subtree rooted at the START+1 subnode of NODE, (2b) checks if the START+1 subnode starts a matching sibling sequence, . . ., (Na) recusively checks the subtree rooted at the END subnode of NODE (default the last), (Nb) checks if the END subnode starts a matching sibling sequence [note that such a sequence could be only 1 node long since END is the right end of the subtree being checked].")
|
||||
|
||||
(IL:* IL:|;;;| "N.B. It might seem that, to get true linearization order, we should check to see if a node starts a matching sibling sequence before we check its subtree. But since node structures can not be circular, we know that if a match is found in the subtree below a node then that node could not have started a matching sequence.")
|
||||
(IL:* IL:|;;;| "N.B. It might seem that, to get true linearization order, we should check to see if a node starts a matching sibling sequence before we check its subtree. But since node structures can not be circular, we know that if a match is found in the subtree below a node then that node could not have started a matching sequence.")
|
||||
|
||||
(IL:* IL:|;;;| "The CONTINUATION? flag means that we are continuing a search that has already recursively checked the START subnode, so we skip that particular recursion. This generally happens when we are working our way up and to the right in some subtree which has already been partially checked.")
|
||||
(IL:* IL:|;;;| "The CONTINUATION? flag means that we are continuing a search that has already recursively checked the START subnode, so we skip that particular recursion. This generally happens when we are working our way up and to the right in some subtree which has already been partially checked.")
|
||||
|
||||
(SETF START (OR START 1))
|
||||
(LET* ((SUBNODES (IL:FETCH SUB-NODES IL:OF NODE))
|
||||
@ -593,7 +588,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-NODE-SUBSTRUCTURE-BACKWARDS (STR STRLEN NODE &OPTIONAL START END CONTINUATION?)
|
||||
|
||||
(IL:* IL:|;;;| "Like find-node-substructure but searches in reverse linearization order.")
|
||||
(IL:* IL:|;;;| "Like find-node-substructure but searches in reverse linearization order.")
|
||||
|
||||
(LET* ((SUBNODES (IL:FETCH SUB-NODES IL:OF NODE))
|
||||
(SUBLENGTH (FIRST SUBNODES)))
|
||||
@ -610,8 +605,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
((OR (NULL SUBS)
|
||||
(AND START (< INDEX START)))
|
||||
NIL)
|
||||
(WHEN (AND DOSUBS? (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN
|
||||
(FIRST SUBS))))
|
||||
(WHEN (AND DOSUBS? (SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN (FIRST SUBS)))
|
||||
)
|
||||
(RETURN MATCH))
|
||||
(UNLESS (OR (< STARTINDEX 1)
|
||||
(MISMATCH STR SUBS :END2 STRLEN :TEST
|
||||
@ -621,7 +616,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-OBJ (CONTEXT &OPTIONAL CHARCODE FIND-STRING BACKWARDS?)
|
||||
|
||||
(IL:* IL:|;;;| "Find either the passed structure, the selected structure, or a prompted-for structure. The search direction is forward unless BACKWARDS? is specified.")
|
||||
(IL:* IL:|;;;| "Find either the passed structure, the selected structure, or a prompted-for structure. The search direction is forward unless BACKWARDS? is specified.")
|
||||
|
||||
(CLOSE-OPEN-NODE CONTEXT)
|
||||
(LET ((SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT))
|
||||
@ -632,7 +627,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(EQ (IL:|fetch| SELECT-TYPE IL:|of| SELECTION)
|
||||
'STRUCTURE))
|
||||
|
||||
(IL:* IL:|;;| "there is a non-string selection")
|
||||
(IL:* IL:|;;| "there is a non-string selection")
|
||||
|
||||
(IF BACKWARDS?
|
||||
(FIND-SELECTION-BACKWARDS CONTEXT WRAP?)
|
||||
@ -644,7 +639,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-SELECTION (CONTEXT &OPTIONAL WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Find the next match of the current selection and display it.")
|
||||
(IL:* IL:|;;;| "Find the next match of the current selection and display it.")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT))
|
||||
@ -652,32 +647,31 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(START (IL:|fetch| SELECT-START IL:|of| SELECTION)))
|
||||
(IF START
|
||||
|
||||
(IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence after it")
|
||||
(IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence after it")
|
||||
|
||||
(FIND-AND-DISPLAY-SUBSTRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)
|
||||
NIL
|
||||
(LIST NODE (1+ START))
|
||||
WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "a node is selected, look for a matching node ")
|
||||
(IL:* IL:|;;| "a node is selected, look for a matching node ")
|
||||
|
||||
(IF (SETF START (NEXT-NODE NODE T))
|
||||
|
||||
(IL:* IL:|;;| "start the search with the following node")
|
||||
(IL:* IL:|;;| "start the search with the following node")
|
||||
|
||||
(FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)
|
||||
NIL START WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "there are no more nodes, either wrap or give up")
|
||||
(IL:* IL:|;;| "there are no more nodes, either wrap or give up")
|
||||
|
||||
(IF WRAP?
|
||||
(FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)
|
||||
)
|
||||
(FIND-AND-DISPLAY-STRUCTURE CONTEXT (STRUCTURE-FROM-SELECTION SELECTION))
|
||||
(FORMAT PROMPTWINDOW "~%At end; no more structure to search."))))))
|
||||
|
||||
(DEFUN FIND-SELECTION-BACKWARDS (CONTEXT &OPTIONAL WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Find the previous match of the current selection and display it.")
|
||||
(IL:* IL:|;;;| "Find the previous match of the current selection and display it.")
|
||||
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
(SELECTION (IL:|fetch| SELECTION IL:|of| CONTEXT))
|
||||
@ -686,36 +680,34 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(IL:|fetch| SELECT-END IL:|of| SELECTION))))
|
||||
(IF END
|
||||
|
||||
(IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence before it")
|
||||
(IL:* IL:|;;| "a sibling sequence is selected, look for a matching sequence before it")
|
||||
|
||||
(FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION
|
||||
SELECTION)
|
||||
(FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)
|
||||
NIL
|
||||
(LIST NODE (1- END))
|
||||
WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "a node is selected, look for a matching node ")
|
||||
(IL:* IL:|;;| "a node is selected, look for a matching node ")
|
||||
|
||||
(IF (SETF END (PREV-NODE NODE T))
|
||||
|
||||
(IL:* IL:|;;| "start the search with the previous node")
|
||||
(IL:* IL:|;;| "start the search with the previous node")
|
||||
|
||||
(FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION
|
||||
SELECTION)
|
||||
(FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION SELECTION)
|
||||
NIL END WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "there are no more nodes, either wrap or give up")
|
||||
(IL:* IL:|;;| "there are no more nodes, either wrap or give up")
|
||||
|
||||
(IF WRAP?
|
||||
(FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION
|
||||
SELECTION))
|
||||
(FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (STRUCTURE-FROM-SELECTION
|
||||
SELECTION))
|
||||
(FORMAT PROMPTWINDOW "~%At beginning; no more structure to search."))))))
|
||||
|
||||
(DEFUN FIND-STRUCTURE (STR SCOPE &OPTIONAL START)
|
||||
|
||||
(IL:* IL:|;;;| "Search forward in linearization order for a node whose structure matches STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate its left-most node). START defaults to SCOPE. The return value is the first node in SCOPE at or after START whose structure is IL:EQUAL to STR.")
|
||||
(IL:* IL:|;;;| "Search forward in linearization order for a node whose structure matches STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate its left-most node). START defaults to SCOPE. The return value is the first node in SCOPE at or after START whose structure is IL:EQUAL to STR.")
|
||||
|
||||
(IL:* IL:|;;;| "N.B. Since node structures can not be circular, no subnode of a node can have structure matching that node. Thus looking for a matching node in pre-order is the same as looking for one in linearization order. So we do a pre-order search here.")
|
||||
(IL:* IL:|;;;| "N.B. Since node structures can not be circular, no subnode of a node can have structure matching that node. Thus looking for a matching node in pre-order is the same as looking for one in linearization order. So we do a pre-order search here.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
@ -727,11 +719,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(EQ START-NODE SCOPE-NODE)))
|
||||
(IL:EQUAL STR (IL:FETCH STRUCTURE IL:OF SCOPE-NODE)))
|
||||
|
||||
(IL:* IL:|;;| "special case: the scope includes its root node, we're starting at the root of the scope, and the root of the scope matches the passed structure.")
|
||||
(IL:* IL:|;;| "special case: the scope includes its root node, we're starting at the root of the scope, and the root of the scope matches the passed structure.")
|
||||
|
||||
(RETURN-FROM FIND-STRUCTURE SCOPE-NODE))
|
||||
|
||||
(IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in preorder.")
|
||||
(IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in preorder.")
|
||||
|
||||
(DO* ((MIN-DEPTH (1+ (IL:FETCH DEPTH IL:OF SCOPE-NODE)))
|
||||
(NODE (OR (IF START-START
|
||||
@ -755,7 +747,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-STRUCTURE-BACKWARDS (STR SCOPE &OPTIONAL END)
|
||||
|
||||
(IL:* IL:|;;;| "like find-structure but searches in reverse linearization order. Actually we search in postorder rather than reverse linearization order but this works just as well for the same reasons that preorder matches linearization order.")
|
||||
(IL:* IL:|;;;| "like find-structure but searches in reverse linearization order. Actually we search in postorder rather than reverse linearization order but this works just as well for the same reasons that preorder matches linearization order.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
@ -767,12 +759,11 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(EQ END-NODE SCOPE-NODE)))
|
||||
(IL:EQUAL STR (IL:FETCH STRUCTURE IL:OF SCOPE-NODE)))
|
||||
|
||||
(IL:* IL:|;;| "special case: the scope includes its root node, we're ending at the root of the scope, and the root of the scope matches the passed structure.")
|
||||
(IL:* IL:|;;| "special case: the scope includes its root node, we're ending at the root of the scope, and the root of the scope matches the passed structure.")
|
||||
|
||||
(RETURN-FROM FIND-STRUCTURE-BACKWARDS SCOPE-NODE))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"normal case: check all the nodes in the scope subtree in postorder.")
|
||||
(IL:* IL:|;;| "normal case: check all the nodes in the scope subtree in postorder.")
|
||||
|
||||
(DO* ((MIN-DEPTH (1+ (IL:FETCH DEPTH IL:OF SCOPE-NODE)))
|
||||
(NODE (OR (IF END-END
|
||||
@ -796,9 +787,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-SUBSTRUCTURE (STR SCOPE &OPTIONAL START)
|
||||
|
||||
(IL:* IL:|;;;| "Search forward in linearization order for a sequence of nodes whose successive structures match the successive elements of STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate the left edge of a subtree). START defauts to SCOPE. The return value is a pseudo-selection indicating the sibling sequence of nodes in SCOPE at or to the right of START whose successive node structures are IL:EQUAL to the successive members of STR.")
|
||||
(IL:* IL:|;;;| "Search forward in linearization order for a sequence of nodes whose successive structures match the successive elements of STR. The search is bounded by SCOPE (a pseudo-selection taken to indicate a subtree) and starts at START (a pseudo-selection taken to indicate the left edge of a subtree). START defauts to SCOPE. The return value is a pseudo-selection indicating the sibling sequence of nodes in SCOPE at or to the right of START whose successive node structures are IL:EQUAL to the successive members of STR.")
|
||||
|
||||
(IL:* IL:|;;;| "N.B. For a sequence of sibling nodes, first in linearization order can not be found by doing a preorder search. See find-node-substructure for details about the correct search method.")
|
||||
(IL:* IL:|;;;| "N.B. For a sequence of sibling nodes, first in linearization order can not be found by doing a preorder search. See find-node-substructure for details about the correct search method.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
@ -807,18 +798,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(COND
|
||||
((NULL START-NODE)
|
||||
|
||||
(IL:* IL:|;;| "just check the entire scope")
|
||||
(IL:* IL:|;;| "just check the entire scope")
|
||||
|
||||
(FIND-NODE-SUBSTRUCTURE STR (LENGTH STR)
|
||||
SCOPE-NODE SCOPE-START SCOPE-END))
|
||||
((EQ START-NODE SCOPE-NODE)
|
||||
|
||||
(IL:* IL:|;;| "just check a terminal subtree of the scope")
|
||||
(IL:* IL:|;;| "just check a terminal subtree of the scope")
|
||||
|
||||
(FIND-NODE-SUBSTRUCTURE STR (LENGTH STR)
|
||||
SCOPE-NODE START-START SCOPE-END))
|
||||
(T
|
||||
(IL:* IL:|;;| "check each node from the start subtree up and to the right in the scope subtree. We carefully resume the recursion that would have happened if we had started from the root of the subtree. This means checking remaining structure in super-nodes on our way from the start node back up the subtree.")
|
||||
(IL:* IL:|;;| "check each node from the start subtree up and to the right in the scope subtree. We carefully resume the recursion that would have happened if we had started from the root of the subtree. This means checking remaining structure in super-nodes on our way from the start node back up the subtree.")
|
||||
|
||||
(DO ((NODE START-NODE SUPER-NODE)
|
||||
(SUPER-NODE (IL:FETCH SUPER-NODE IL:OF START-NODE)
|
||||
@ -839,7 +830,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN FIND-SUBSTRUCTURE-BACKWARDS (STR SCOPE &OPTIONAL END)
|
||||
|
||||
(IL:* IL:|;;;| "Like find-substructure but searches in reverse linearization order.")
|
||||
(IL:* IL:|;;;| "Like find-substructure but searches in reverse linearization order.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
@ -848,18 +839,18 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(COND
|
||||
((NULL END-NODE)
|
||||
|
||||
(IL:* IL:|;;| "just check the entire scope")
|
||||
(IL:* IL:|;;| "just check the entire scope")
|
||||
|
||||
(FIND-NODE-SUBSTRUCTURE-BACKWARDS STR (LENGTH STR)
|
||||
SCOPE-NODE SCOPE-START SCOPE-END))
|
||||
((EQ END-NODE SCOPE-NODE)
|
||||
|
||||
(IL:* IL:|;;| "just check an initial subtree of the scope")
|
||||
(IL:* IL:|;;| "just check an initial subtree of the scope")
|
||||
|
||||
(FIND-NODE-SUBSTRUCTURE-BACKWARDS STR (LENGTH STR)
|
||||
SCOPE-NODE SCOPE-START END-END))
|
||||
(T
|
||||
(IL:* IL:|;;| "check each node in the initial subtree of scope terminated by the end subtree. We carefully resume the recursion that would have happened if we had started from the root of the scope subtree. This means checking remaining structure in super-nodes on our way from the end node back up the subtree.")
|
||||
(IL:* IL:|;;| "check each node in the initial subtree of scope terminated by the end subtree. We carefully resume the recursion that would have happened if we had started from the root of the scope subtree. This means checking remaining structure in super-nodes on our way from the end node back up the subtree.")
|
||||
|
||||
(DO ((NODE END-NODE SUPER-NODE)
|
||||
(SUPER-NODE (IL:FETCH SUPER-NODE IL:OF END-NODE)
|
||||
@ -873,8 +864,8 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(STRLEN (LENGTH STR))
|
||||
MATCH)
|
||||
((OR (NULL NODE)
|
||||
(SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN NODE
|
||||
START END CONTINUATION?))
|
||||
(SETF MATCH (FIND-NODE-SUBSTRUCTURE-BACKWARDS STR STRLEN NODE START
|
||||
END CONTINUATION?))
|
||||
(EQ NODE SCOPE-NODE))
|
||||
MATCH)))))))
|
||||
|
||||
@ -885,15 +876,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN SEARCH-OBJ (CONTEXT &OPTIONAL SEARCH-STRING WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Search for the the structure(s) in the string SEARCH-OBJ and display them. The search starts just after the current point or selection, if any.")
|
||||
(IL:* IL:|;;;| "Search for the the structure(s) in the string SEARCH-OBJ and display them. The search starts just after the current point or selection, if any.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (STR STRLEN)
|
||||
(STRUCTURE-FROM-STRING (OR SEARCH-STRING (SETF SEARCH-STRING
|
||||
(GET-USER-STRING CONTEXT "Find: "
|
||||
(OR (IL:|fetch|
|
||||
FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(GET-USER-STRING CONTEXT "Find: "
|
||||
(OR (IL:|fetch| FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(COND
|
||||
((< STRLEN 0)
|
||||
(FORMAT (GET-PROMPT-WINDOW CONTEXT)
|
||||
@ -904,12 +894,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
"-- aborted.")
|
||||
(RETURN-FROM SEARCH-OBJ)))
|
||||
|
||||
(IL:* IL:|;;| "update the remembered defaults")
|
||||
(IL:* IL:|;;| "update the remembered defaults")
|
||||
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE
|
||||
SEARCH-STRING))
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE
|
||||
SEARCH-STRING))
|
||||
|
||||
(IL:* IL:|;;| "figure out where to search and where to start")
|
||||
(IL:* IL:|;;| "figure out where to search and where to start")
|
||||
|
||||
(LET* ((SCOPE (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
(START (LET* ((POINT (IL:|fetch| CARET-POINT IL:|of| CONTEXT))
|
||||
@ -933,36 +923,35 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(T SCOPE)))))
|
||||
(UNLESS (OR WRAP? START)
|
||||
|
||||
(IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap")
|
||||
(IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap")
|
||||
|
||||
(FORMAT (GET-PROMPT-WINDOW CONTEXT)
|
||||
"~%At end; no more structure to search.")
|
||||
(RETURN-FROM SEARCH-OBJ))
|
||||
|
||||
(IL:* IL:|;;| "do the search")
|
||||
(IL:* IL:|;;| "do the search")
|
||||
|
||||
(IF (> STRLEN 1)
|
||||
|
||||
(IL:* IL:|;;| "substructure search")
|
||||
(IL:* IL:|;;| "substructure search")
|
||||
|
||||
(FIND-AND-DISPLAY-SUBSTRUCTURE CONTEXT STR SCOPE START WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "structure search")
|
||||
(IL:* IL:|;;| "structure search")
|
||||
|
||||
(FIND-AND-DISPLAY-STRUCTURE CONTEXT (FIRST STR)
|
||||
SCOPE START WRAP?)))))
|
||||
|
||||
(DEFUN SEARCH-OBJ-BACKWARDS (CONTEXT &OPTIONAL SEARCH-STRING WRAP?)
|
||||
|
||||
(IL:* IL:|;;;| "Like search-obj but searches backwards.")
|
||||
(IL:* IL:|;;;| "Like search-obj but searches backwards.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (STR STRLEN)
|
||||
(STRUCTURE-FROM-STRING (OR SEARCH-STRING (SETF SEARCH-STRING
|
||||
(GET-USER-STRING CONTEXT "Find: "
|
||||
(OR (IL:|fetch|
|
||||
FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(GET-USER-STRING CONTEXT "Find: "
|
||||
(OR (IL:|fetch| FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(COND
|
||||
((< STRLEN 0)
|
||||
(FORMAT (GET-PROMPT-WINDOW CONTEXT)
|
||||
@ -973,12 +962,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
"-- aborted.")
|
||||
(RETURN-FROM SEARCH-OBJ-BACKWARDS)))
|
||||
|
||||
(IL:* IL:|;;| "update the remembered defaults")
|
||||
(IL:* IL:|;;| "update the remembered defaults")
|
||||
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE
|
||||
SEARCH-STRING))
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE
|
||||
SEARCH-STRING))
|
||||
|
||||
(IL:* IL:|;;| "figure out where to search and where to start")
|
||||
(IL:* IL:|;;| "figure out where to search and where to start")
|
||||
|
||||
(LET* ((SCOPE (SUBNODE 1 (IL:FETCH ROOT IL:OF CONTEXT)))
|
||||
(END (LET* ((POINT (IL:|fetch| CARET-POINT IL:|of| CONTEXT))
|
||||
@ -1002,30 +991,30 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(T SCOPE)))))
|
||||
(UNLESS (OR WRAP? END)
|
||||
|
||||
(IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap")
|
||||
(IL:* IL:|;;| "Nothing left to search, and we're not supposed to wrap")
|
||||
|
||||
(FORMAT (GET-PROMPT-WINDOW CONTEXT)
|
||||
"~%At beginning; no more structure to search.")
|
||||
(RETURN-FROM SEARCH-OBJ-BACKWARDS))
|
||||
|
||||
(IL:* IL:|;;| "do the search")
|
||||
(IL:* IL:|;;| "do the search")
|
||||
|
||||
(IF (> STRLEN 1)
|
||||
|
||||
(IL:* IL:|;;| "substructure search")
|
||||
(IL:* IL:|;;| "substructure search")
|
||||
|
||||
(FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS CONTEXT STR SCOPE END WRAP?)
|
||||
|
||||
(IL:* IL:|;;| "structure search")
|
||||
(IL:* IL:|;;| "structure search")
|
||||
|
||||
(FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CONTEXT (FIRST STR)
|
||||
SCOPE END WRAP?)))))
|
||||
|
||||
(DEFUN SUBSTITUTE-OBJ (CONTEXT &OPTIONAL CHARCODE OLDSTR NEWSTR REMOVE?)
|
||||
|
||||
(IL:* IL:|;;;| "OLDSTR and NEWSTR are strings. In the scope of the selection, replace every occurence of structure matching OLDSTR by structure parsed from NEWSTR. If REMOVE? is specified, just remove structure matching OLD.")
|
||||
(IL:* IL:|;;;| "OLDSTR and NEWSTR are strings. In the scope of the selection, replace every occurence of structure matching OLDSTR by structure parsed from NEWSTR. If REMOVE? is specified, just remove structure matching OLD.")
|
||||
|
||||
(IL:* IL:|;;;| "We preserve the selection as best we can. Point gets thrown away.")
|
||||
(IL:* IL:|;;;| "We preserve the selection as best we can. Point gets thrown away.")
|
||||
|
||||
(CLOSE-OPEN-NODE CONTEXT)
|
||||
(LET* ((PROMPTWINDOW (GET-PROMPT-WINDOW CONTEXT))
|
||||
@ -1033,7 +1022,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(SCOPE NIL)
|
||||
(TYPE (IF REMOVE?
|
||||
"delet"
|
||||
"substitut"))) (IL:* IL:\; "hack!!!")
|
||||
"substitut"))) (IL:* IL:\; "hack!!!")
|
||||
(UNLESS (AND (IL:|fetch| SELECT-NODE IL:|of| SELECTION)
|
||||
(EQ (IL:|fetch| SELECT-TYPE IL:|of| SELECTION)
|
||||
'STRUCTURE))
|
||||
@ -1041,14 +1030,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(RETURN-FROM SUBSTITUTE-OBJ T))
|
||||
(SETQ SCOPE (PSEUDO-SELECTION-FROM-SELECTION SELECTION))
|
||||
(MULTIPLE-VALUE-BIND (OLD OLDLEN)
|
||||
(STRUCTURE-FROM-STRING (OR OLDSTR (SETF OLDSTR
|
||||
(GET-USER-STRING CONTEXT
|
||||
(IF REMOVE?
|
||||
"Delete form: "
|
||||
"Replace old form: ")
|
||||
(OR (IL:|fetch| FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(STRUCTURE-FROM-STRING (OR OLDSTR (SETF OLDSTR (GET-USER-STRING CONTEXT
|
||||
(IF REMOVE?
|
||||
"Delete form: "
|
||||
"Replace old form: ")
|
||||
(OR (IL:|fetch| FIND-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
FIND-CANDIDATE)))))
|
||||
(COND
|
||||
((< OLDLEN 0)
|
||||
(FORMAT PROMPTWINDOW " -- Invalid structure.")
|
||||
@ -1060,13 +1048,13 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(IF REMOVE?
|
||||
(VALUES NIL 0)
|
||||
(STRUCTURE-FROM-STRING (OR NEWSTR
|
||||
(SETF NEWSTR
|
||||
(GET-USER-STRING
|
||||
CONTEXT "with new form: "
|
||||
(OR (IL:|fetch|
|
||||
SUBSTITUTE-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
SUBSTITUTE-CANDIDATE))))))
|
||||
(SETF NEWSTR
|
||||
(GET-USER-STRING CONTEXT
|
||||
"with new form: "
|
||||
(OR (IL:|fetch|
|
||||
SUBSTITUTE-CANDIDATE
|
||||
IL:|of| CONTEXT)
|
||||
SUBSTITUTE-CANDIDATE))))))
|
||||
(COND
|
||||
((< NEWLEN 0)
|
||||
(FORMAT PROMPTWINDOW " -- Invalid structure.")
|
||||
@ -1076,16 +1064,16 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(FORMAT PROMPTWINDOW "-- aborted.")
|
||||
(RETURN-FROM SUBSTITUTE-OBJ T)))
|
||||
|
||||
(IL:* IL:|;;| "update defaults ")
|
||||
(IL:* IL:|;;| "update defaults ")
|
||||
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ
|
||||
FIND-CANDIDATE
|
||||
OLDSTR))
|
||||
(IL:|replace| FIND-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ FIND-CANDIDATE
|
||||
OLDSTR))
|
||||
(UNLESS REMOVE?
|
||||
(IL:|replace| SUBSTITUTE-CANDIDATE IL:|of| CONTEXT
|
||||
IL:|with| (IL:SETQ SUBSTITUTE-CANDIDATE NEWSTR)))
|
||||
(IL:|replace| SUBSTITUTE-CANDIDATE IL:|of| CONTEXT IL:|with| (IL:SETQ
|
||||
SUBSTITUTE-CANDIDATE
|
||||
NEWSTR)))
|
||||
|
||||
(IL:* IL:|;;| "do the substitution, report, and reselect.")
|
||||
(IL:* IL:|;;| "do the substitution, report, and reselect.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (NEW-SCOPE SUBCOUNT)
|
||||
(IF (> OLDLEN 1)
|
||||
@ -1101,14 +1089,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN SUBSTITUTE-STRUCTURE (CONTEXT OLD NEW SCOPE &OPTIONAL REMOVE?)
|
||||
|
||||
(IL:* IL:|;;;| "Inside SCOPE, replace any node with structure OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old nodes. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.")
|
||||
(IL:* IL:|;;;| "Inside SCOPE, replace any node with structure OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old nodes. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.")
|
||||
|
||||
(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.")
|
||||
(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
(LET* ((ROOT (IL:FETCH ROOT IL:OF CONTEXT))(IL:* IL:\;
|
||||
"substituting for root is special")
|
||||
(LET* ((ROOT (IL:FETCH ROOT IL:OF CONTEXT)) (IL:* IL:\;
|
||||
"substituting for root is special")
|
||||
(POINT (IL:FETCH CARET-POINT IL:OF CONTEXT))
|
||||
(SELECTION (IL:FETCH SELECTION IL:OF CONTEXT))
|
||||
(NEWLEN (IF REMOVE?
|
||||
@ -1139,14 +1127,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(SET-SELECTION-NOWHERE SELECTION)
|
||||
(VALUES SCOPE NUMSUBS))
|
||||
|
||||
(IL:* IL:|;;| "replace the target ")
|
||||
(IL:* IL:|;;| "replace the target ")
|
||||
|
||||
(SELECT-NODE CONTEXT TARGET)
|
||||
(COND
|
||||
(REMOVE? (COND
|
||||
((EQ TARGET-SUPER ROOT)
|
||||
|
||||
(IL:* IL:|;;| "\"delete\" the root structure by making it nil")
|
||||
(IL:* IL:|;;| "\"delete\" the root structure by making it nil")
|
||||
|
||||
(PENDING-DELETE POINT SELECTION)
|
||||
(INSERT-NULL-LIST CONTEXT))
|
||||
@ -1154,19 +1142,19 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(T (PENDING-DELETE POINT SELECTION)
|
||||
(INSERT POINT CONTEXT (COPY-LIST NEW-NODES))))
|
||||
|
||||
(IL:* IL:|;;| "fix up the scope, if necessary")
|
||||
(IL:* IL:|;;| "fix up the scope, if necessary")
|
||||
|
||||
(COND
|
||||
((EQ TARGET SCOPE-NODE)
|
||||
|
||||
(IL:* IL:|;;| "matched the scope, so we're done")
|
||||
(IL:* IL:|;;| "matched the scope, so we're done")
|
||||
|
||||
(COND
|
||||
(REMOVE? (SETF SCOPE NIL))
|
||||
((= NEWLEN 1)
|
||||
(SETF SCOPE (SUBNODE TARGET-INDEX TARGET-SUPER)))
|
||||
(T
|
||||
(IL:* IL:|;;| "replacing the root structure with multiple nodes inserts a new level of list between the root (target-super) and the multiple nodes inserted. In this case, make the scope node be the new list node instead of the root itself.")
|
||||
(IL:* IL:|;;| "replacing the root structure with multiple nodes inserts a new level of list between the root (target-super) and the multiple nodes inserted. In this case, make the scope node be the new list node instead of the root itself.")
|
||||
|
||||
(SETF SCOPE (LIST (IF (EQ TARGET-SUPER ROOT)
|
||||
(SUBNODE 1 ROOT)
|
||||
@ -1176,7 +1164,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(SETF RESUME NIL))
|
||||
((AND SCOPE-START (EQ TARGET-SUPER SCOPE-NODE))
|
||||
|
||||
(IL:* IL:|;;| "matched a direct subnode of an extended scope")
|
||||
(IL:* IL:|;;| "matched a direct subnode of an extended scope")
|
||||
|
||||
(WHEN (= TARGET-INDEX SCOPE-END)
|
||||
(SETF RESUME NIL))
|
||||
@ -1185,9 +1173,9 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN SUBSTITUTE-SUBSTRUCTURE (CONTEXT OLD NEW SCOPE &OPTIONAL REMOVE?)
|
||||
|
||||
(IL:* IL:|;;;| "Inside SCOPE, replace any sequences of nodes whose structures sequentially match the elements of OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old sequences. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.")
|
||||
(IL:* IL:|;;;| "Inside SCOPE, replace any sequences of nodes whose structures sequentially match the elements of OLD by nodes gotten from parsing NEW. If REMOVE? is given, just delete the old sequences. Returns two values: the final scope after all substitutions are made, and the number of substitutions/deletions made.")
|
||||
|
||||
(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.")
|
||||
(IL:* IL:|;;;| "The substitution is done as a single undoable operation, and the current selection and point are thrown away.")
|
||||
|
||||
(MULTIPLE-VALUE-BIND (SCOPE-NODE SCOPE-START SCOPE-END)
|
||||
(DECOMPOSE-PSEUDO-SELECTION SCOPE)
|
||||
@ -1218,7 +1206,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(MULTIPLE-VALUE-BIND (TNODE TSTART TEND)
|
||||
(DECOMPOSE-PSEUDO-SELECTION TARGET)
|
||||
|
||||
(IL:* IL:|;;| "replace the target ")
|
||||
(IL:* IL:|;;| "replace the target ")
|
||||
|
||||
(SELECT-PSEUDO-SEGMENT CONTEXT TARGET)
|
||||
(COND
|
||||
@ -1226,13 +1214,12 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(T (PENDING-DELETE POINT SELECTION)
|
||||
(INSERT POINT CONTEXT (COPY-LIST NEW-NODES))))
|
||||
|
||||
(IL:* IL:|;;|
|
||||
"fix up the scope, if necessary, and figure where to resume")
|
||||
(IL:* IL:|;;| "fix up the scope, if necessary, and figure where to resume")
|
||||
|
||||
(COND
|
||||
((AND SCOPE-START (EQ TNODE SCOPE-NODE))
|
||||
|
||||
(IL:* IL:|;;| "matched direct subnodes of an extended scope")
|
||||
(IL:* IL:|;;| "matched direct subnodes of an extended scope")
|
||||
|
||||
(IF (= TEND SCOPE-END)
|
||||
(SETF RESUME NIL)
|
||||
@ -1243,7 +1230,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN STRUCTURE-FROM-SELECTION (SELECTION)
|
||||
|
||||
(IL:* IL:|;;;| "selection must be a structure selection. Return the structure encompassed by selection, which if the selection is a node is the structure of that node, and if the selection is a segment a list of the structures of the nodes in that segment.")
|
||||
(IL:* IL:|;;;| "selection must be a structure selection. Return the structure encompassed by selection, which if the selection is a node is the structure of that node, and if the selection is a segment a list of the structures of the nodes in that segment.")
|
||||
|
||||
(LET* ((NODE (IL:FETCH SELECT-NODE IL:OF SELECTION))
|
||||
(START (IL:FETCH SELECT-START IL:OF SELECTION))
|
||||
@ -1263,7 +1250,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN STRUCTURE-FROM-STRING (STR)
|
||||
|
||||
(IL:* IL:|;;;| "return all the structures that can be read from string as a list. return a second value saying how many structures there were. If an error is encountered, a second value of -1 is returned. ")
|
||||
(IL:* IL:|;;;| "return all the structures that can be read from string as a list. return a second value saying how many structures there were. If an error is encountered, a second value of -1 is returned. ")
|
||||
|
||||
(COND
|
||||
((NULL STR)
|
||||
@ -1285,7 +1272,7 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
|
||||
(DEFUN COMMENT-OUT-SELECTION (CONTEXT CHARCODE)
|
||||
|
||||
(IL:* IL:|;;;| "given a sequence of whole structure selections, build a 5 level comment node and replace the nodes with the comment.")
|
||||
(IL:* IL:|;;;| "given a sequence of whole structure selections, build a 5 level comment node and replace the nodes with the comment.")
|
||||
|
||||
(LET* ((SELECTION (IL:FETCH SELECTION IL:OF CONTEXT))
|
||||
(POINT (IL:FETCH CARET-POINT IL:OF CONTEXT))
|
||||
@ -1301,14 +1288,14 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(START (WITH-OUTPUT-TO-STRING (S)
|
||||
(IL:BIND BLANK-BEFORE IL:FOR I IL:FROM START
|
||||
IL:TO (OR (IL:FETCH SELECT-END IL:OF SELECTION)
|
||||
START) IL:AS X
|
||||
START) IL:AS X
|
||||
IL:ON (CDR (IL:NTH (IL:FETCH SUB-NODES IL:OF NODE)
|
||||
START))
|
||||
IL:DO (IF BLANK-BEFORE
|
||||
(WRITE-CHAR #\Space S)
|
||||
(SETQ BLANK-BEFORE T))
|
||||
(PRIN1 (IL:FETCH STRUCTURE IL:OF (CAR X))
|
||||
S))))
|
||||
START)) IL:DO (IF BLANK-BEFORE
|
||||
(WRITE-CHAR #\Space S)
|
||||
(SETQ BLANK-BEFORE T))
|
||||
(PRIN1 (IL:FETCH STRUCTURE
|
||||
IL:OF (CAR X))
|
||||
S))))
|
||||
(T (FORMAT NIL "~S" (IL:FETCH STRUCTURE IL:OF NODE))))))
|
||||
(WHEN STR
|
||||
(LET ((NEW-NODE (PARSE-NEW (LIST 'IL:* 'IL:\| STR)
|
||||
@ -1585,42 +1572,40 @@ IL:|{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>SEDIT-COMMANDS.;6|)
|
||||
(il:lambda (context node subnodes) (il:* il:\; "Edited 7-Jul-87 09:39 by DCB") (il:* il:|;;;| "sticks subnodes back into node and revives them. ") (rplacd (il:fetch sub-nodes il:of node) subnodes) (il:for subnode il:in subnodes il:as index il:from 1 il:do (il:replace super-node il:of subnode il:with node) (il:replace sub-node-index il:of subnode il:with index) (detach-node subnode) (revive-node subnode (il:fetch depth il:of node))) (il:* il:|;;| "used to reparse here. now if we simply note the change, the format types, format values, and linear forms will be recomputed.") (note-change node context))
|
||||
)
|
||||
)
|
||||
(IL:PUTPROPS IL:SEDIT-COMMANDS IL:COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990 1991 2018
|
||||
2021))
|
||||
(IL:DECLARE\: IL:DONTCOPY
|
||||
(IL:FILEMAP (NIL (13643 14213 (PSEUDO-SELECTION-FROM-SELECTION 13643 . 14213)) (14215 14969 (
|
||||
COMPOSE-PSEUDO-SELECTION 14215 . 14969)) (14971 15510 (DECOMPOSE-PSEUDO-SELECTION 14971 . 15510)) (
|
||||
15512 16309 (SELECTION-FROM-PSEUDO-SELECTION 15512 . 16309)) (16311 16614 (SELECT-PSEUDO-SEGMENT 16311
|
||||
. 16614)) (16679 17569 (ADD-COMMAND 16679 . 17569)) (17571 19734 (GET-SELECTION 17571 . 19734)) (
|
||||
19736 20916 (REPLACE-SELECTION 19736 . 20916)) (20918 21410 (RESET-COMMANDS 20918 . 21410)) (21412
|
||||
21581 (DEFAULT-COMMANDS 21412 . 21581)) (22059 23162 (EQUALIZE-STRING-WIDTHS 22059 . 23162)) (23164
|
||||
23362 (MINIMUM-STRING-WIDTH 23164 . 23362)) (23364 23562 (MAXIMUM-STRING-WIDTH 23364 . 23562)) (23564
|
||||
24435 (FIND-AND-DISPLAY-STRUCTURE 23564 . 24435)) (24437 25121 (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS
|
||||
24437 . 25121)) (25123 26027 (FIND-AND-DISPLAY-SUBSTRUCTURE 25123 . 26027)) (26029 26732 (
|
||||
FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS 26029 . 26732)) (26734 27375 (FIND-NTH-STRUCTURE 26734 . 27375
|
||||
)) (27377 30107 (FIND-NODE-SUBSTRUCTURE 27377 . 30107)) (30109 31362 (FIND-NODE-SUBSTRUCTURE-BACKWARDS
|
||||
30109 . 31362)) (31364 32343 (FIND-OBJ 31364 . 32343)) (32345 33745 (FIND-SELECTION 32345 . 33745)) (
|
||||
33747 35439 (FIND-SELECTION-BACKWARDS 33747 . 35439)) (35441 38170 (FIND-STRUCTURE 35441 . 38170)) (
|
||||
38172 40519 (FIND-STRUCTURE-BACKWARDS 38172 . 40519)) (40521 43450 (FIND-SUBSTRUCTURE 40521 . 43450))
|
||||
(43452 45752 (FIND-SUBSTRUCTURE-BACKWARDS 43452 . 45752)) (45754 45990 (GET-USER-STRING 45754 . 45990)
|
||||
) (45992 49700 (SEARCH-OBJ 45992 . 49700)) (49702 53367 (SEARCH-OBJ-BACKWARDS 49702 . 53367)) (53369
|
||||
58195 (SUBSTITUTE-OBJ 53369 . 58195)) (58197 62853 (SUBSTITUTE-STRUCTURE 58197 . 62853)) (62855 66027
|
||||
(SUBSTITUTE-SUBSTRUCTURE 62855 . 66027)) (66029 67191 (STRUCTURE-FROM-SELECTION 66029 . 67191)) (67193
|
||||
68036 (STRUCTURE-FROM-STRING 67193 . 68036)) (68038 70179 (COMMENT-OUT-SELECTION 68038 . 70179)) (
|
||||
70180 125041 (ADD-MENU 70193 . 70856) (BACKSPACE 70858 . 71837) (CHANGE-PACKAGE 71839 . 74639) (
|
||||
CHANGE-PRINTBASE 74641 . 76823) (CHANGE-QUOTE 76825 . 77180) (CONVERT-COMMENT 77182 . 78942) (
|
||||
CONVERT-COMMENT-STRUCTURE 78944 . 80247) (CONVERT-COMMENT-TAIL 80249 . 81649) (CREATE-COMMAND-TABLE
|
||||
81651 . 83629) (DEFAULT-EDIT-FN 83631 . 83768) (DELETE-SELECTION 83770 . 84452) (DELETE-WORD 84454 .
|
||||
86555) (DO-MUTATION 86557 . 87105) (EDIT-SELECTION 87107 . 87555) (EVAL-SELECTION 87557 . 89426) (
|
||||
EXPAND 89428 . 90557) (EXTRACT-CURRENT-SELECTION 90559 . 92927) (FIND-COMMENT 92929 . 93623) (GET-MENU
|
||||
93625 . 94002) (EDIT-HELP 94004 . 95079) (HELPMENU 95081 . 97870) (INPUT-DOT 97872 . 100004) (
|
||||
INPUT-ESCAPE 100006 . 100254) (INPUT-NORMAL-CHAR 100256 . 102289) (INPUT-QUOTE 102291 . 105373) (
|
||||
INPUT-SQUARE-BRACKET 105375 . 105726) (INPUT-STRINGDELIM 105728 . 107127) (INPUT-TOKENDELIM 107129 .
|
||||
108109) (INSERT-MULTI-ESCAPE 108111 . 109239) (INSERT-SPECIAL-CHARACTER 109241 . 110501) (
|
||||
INSPECT-SELECTION 110503 . 111038) (JOIN 111040 . 114710) (MENU-CLOSEFN 114712 . 114930) (
|
||||
MENU-FIND-SELECTEDFN 114932 . 115632) (MENU-INIT-STATE 115634 . 116441) (MENU-PACKAGE-SELECTEDFN
|
||||
116443 . 117494) (MENU-PRINTBASE-SELECTEDFN 117496 . 118372) (MENU-SELECTEDFN 118374 . 118800) (
|
||||
MENU-SUBSTITUTE-SELECTEDFN 118802 . 119762) (MUTATE 119764 . 120874) (QUOTE-CURRENT-SELECTION 120876
|
||||
. 121643) (REDISPLAY 121645 . 121884) (REDO 121886 . 122380) (SELECTED-FN-NAME 122382 . 122827) (
|
||||
SKIP-TO-GAP 122829 . 123606) (UNDO 123608 . 124408) (UNDO-EXTRACT 124410 . 125039)))))
|
||||
(IL:FILEMAP (NIL (13440 14010 (PSEUDO-SELECTION-FROM-SELECTION 13440 . 14010)) (14012 14766 (
|
||||
COMPOSE-PSEUDO-SELECTION 14012 . 14766)) (14768 15307 (DECOMPOSE-PSEUDO-SELECTION 14768 . 15307)) (
|
||||
15309 16106 (SELECTION-FROM-PSEUDO-SELECTION 15309 . 16106)) (16108 16411 (SELECT-PSEUDO-SEGMENT 16108
|
||||
. 16411)) (16476 17366 (ADD-COMMAND 16476 . 17366)) (17368 19539 (GET-SELECTION 17368 . 19539)) (
|
||||
19541 20721 (REPLACE-SELECTION 19541 . 20721)) (20723 21044 (RESET-COMMANDS 20723 . 21044)) (21046
|
||||
21215 (DEFAULT-COMMANDS 21046 . 21215)) (21693 22701 (EQUALIZE-STRING-WIDTHS 21693 . 22701)) (22703
|
||||
22901 (MINIMUM-STRING-WIDTH 22703 . 22901)) (22903 23101 (MAXIMUM-STRING-WIDTH 22903 . 23101)) (23103
|
||||
23974 (FIND-AND-DISPLAY-STRUCTURE 23103 . 23974)) (23976 24660 (FIND-AND-DISPLAY-STRUCTURE-BACKWARDS
|
||||
23976 . 24660)) (24662 25566 (FIND-AND-DISPLAY-SUBSTRUCTURE 24662 . 25566)) (25568 26271 (
|
||||
FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS 25568 . 26271)) (26273 26914 (FIND-NTH-STRUCTURE 26273 . 26914
|
||||
)) (26916 29646 (FIND-NODE-SUBSTRUCTURE 26916 . 29646)) (29648 30875 (FIND-NODE-SUBSTRUCTURE-BACKWARDS
|
||||
29648 . 30875)) (30877 31856 (FIND-OBJ 30877 . 31856)) (31858 33229 (FIND-SELECTION 31858 . 33229)) (
|
||||
33231 34791 (FIND-SELECTION-BACKWARDS 33231 . 34791)) (34793 37522 (FIND-STRUCTURE 34793 . 37522)) (
|
||||
37524 39851 (FIND-STRUCTURE-BACKWARDS 37524 . 39851)) (39853 42782 (FIND-SUBSTRUCTURE 39853 . 42782))
|
||||
(42784 45084 (FIND-SUBSTRUCTURE-BACKWARDS 42784 . 45084)) (45086 45322 (GET-USER-STRING 45086 . 45322)
|
||||
) (45324 48925 (SEARCH-OBJ 45324 . 48925)) (48927 52485 (SEARCH-OBJ-BACKWARDS 48927 . 52485)) (52487
|
||||
57315 (SUBSTITUTE-OBJ 52487 . 57315)) (57317 61983 (SUBSTITUTE-STRUCTURE 57317 . 61983)) (61985 65128
|
||||
(SUBSTITUTE-SUBSTRUCTURE 61985 . 65128)) (65130 66292 (STRUCTURE-FROM-SELECTION 65130 . 66292)) (66294
|
||||
67137 (STRUCTURE-FROM-STRING 66294 . 67137)) (67139 69410 (COMMENT-OUT-SELECTION 67139 . 69410)) (
|
||||
69411 124272 (ADD-MENU 69424 . 70087) (BACKSPACE 70089 . 71068) (CHANGE-PACKAGE 71070 . 73870) (
|
||||
CHANGE-PRINTBASE 73872 . 76054) (CHANGE-QUOTE 76056 . 76411) (CONVERT-COMMENT 76413 . 78173) (
|
||||
CONVERT-COMMENT-STRUCTURE 78175 . 79478) (CONVERT-COMMENT-TAIL 79480 . 80880) (CREATE-COMMAND-TABLE
|
||||
80882 . 82860) (DEFAULT-EDIT-FN 82862 . 82999) (DELETE-SELECTION 83001 . 83683) (DELETE-WORD 83685 .
|
||||
85786) (DO-MUTATION 85788 . 86336) (EDIT-SELECTION 86338 . 86786) (EVAL-SELECTION 86788 . 88657) (
|
||||
EXPAND 88659 . 89788) (EXTRACT-CURRENT-SELECTION 89790 . 92158) (FIND-COMMENT 92160 . 92854) (GET-MENU
|
||||
92856 . 93233) (EDIT-HELP 93235 . 94310) (HELPMENU 94312 . 97101) (INPUT-DOT 97103 . 99235) (
|
||||
INPUT-ESCAPE 99237 . 99485) (INPUT-NORMAL-CHAR 99487 . 101520) (INPUT-QUOTE 101522 . 104604) (
|
||||
INPUT-SQUARE-BRACKET 104606 . 104957) (INPUT-STRINGDELIM 104959 . 106358) (INPUT-TOKENDELIM 106360 .
|
||||
107340) (INSERT-MULTI-ESCAPE 107342 . 108470) (INSERT-SPECIAL-CHARACTER 108472 . 109732) (
|
||||
INSPECT-SELECTION 109734 . 110269) (JOIN 110271 . 113941) (MENU-CLOSEFN 113943 . 114161) (
|
||||
MENU-FIND-SELECTEDFN 114163 . 114863) (MENU-INIT-STATE 114865 . 115672) (MENU-PACKAGE-SELECTEDFN
|
||||
115674 . 116725) (MENU-PRINTBASE-SELECTEDFN 116727 . 117603) (MENU-SELECTEDFN 117605 . 118031) (
|
||||
MENU-SUBSTITUTE-SELECTEDFN 118033 . 118993) (MUTATE 118995 . 120105) (QUOTE-CURRENT-SELECTION 120107
|
||||
. 120874) (REDISPLAY 120876 . 121115) (REDO 121117 . 121611) (SELECTED-FN-NAME 121613 . 122058) (
|
||||
SKIP-TO-GAP 122060 . 122837) (UNDO 122839 . 123639) (UNDO-EXTRACT 123641 . 124270)))))
|
||||
IL:STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user