{ Unidad con declaraciones globales del proyecto Creado por Tito Hinostroza - 01/08/2014 } unit Globales; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, SynEdit, SynEditKeyCmds, MisUtils, SynEditTypes, StrUtils, lclType, FileUtil, types, LazLogger, LazUTF8, Menus, ComCtrls ; const NOM_PROG ='Tito''s Terminal'; //nombre de programa {$I ../version.txt} //versión del programa type //Tipos de conexiones TTipCon = ( TCON_TELNET, //Conexión telnet común TCON_SSH, //Conexión ssh TCON_SERIAL, //Serial TCON_OTHER //Otro proceso ); var //Variables globales MsjError : String; // Bandera - Mensaje de error. patApp : string; // Ruta de la aplicación. patMacros : string; // Ruta de la carpeta de macros. patTemp : string; // Ruta de la carpeta temporal patSyntax : string; // Ruta para guardar las sintaxis. patSessions : string; // Ruta para guardar las sesiones. inputFile : string; // Archivo de entrada. showError : Boolean; // Bandera para mostrar mensajesde error. //Funciones para control del editor function IdFromTTreeNode(node: TTreeNode): string; function TTreeNodeFromId(Id: string; tree: TTreeView): TTreeNode; procedure SubirCursorBloque(ed: TSynEdit; Shift: TShiftState); procedure BajarCursorBloque(ed: TSynEdit; Shift: TShiftState); procedure InsertaColumnasBloque(ed: TsynEdit; var key: TUTF8Char); function LeerParametros: boolean; function NombDifArc(nomBase: String): String; procedure LeeArchEnMenu(arc: string; mn: TMenuItem; accion: TNotifyEvent); procedure CopiarMemu(menOrig, menDest: TMenuItem); procedure Init; implementation function IdFromTTreeNode(node: TTreeNode): string; //Returns an ID with indication of the position of a TTreeNode'. //It has the form: 1, 1.1, 1.2. Only works for two levels. var nivel: Integer; begin nivel := node.Level; if nivel = 1 then //de dos niveles Result := IntToStr(node.Parent.Index+1) + '.' + IntToStr(node.Index+1) else //de un nivel Result := IntToStr(node.Index+1); end; function TTreeNodeFromId(Id: string; tree: TTreeView): TTreeNode; //Returns a TreeNode, given the ID position. If not found, returns NIL. //Only works for two levels. var list: TStringList; it: TTreeNode; Padre: TTreeNode; i: Integer; begin Result := nil; //por defecto if Id='' then exit; list := TStringList.Create; list.Delimiter:='.'; list.DelimitedText:=Id; if list.Count = 1 then begin //de un solo nivel //ubica el nodo for it in Tree.Items do if it.Level=0 then begin if IntToStr(it.Index+1) = list[0] then Result := it; end; end else begin //de dos o más niveles //ubica al nodo padre Padre := nil; for it in Tree.Items do begin if it.Level=0 then begin if IntToStr(it.Index+1) = list[0] then Padre := it; end; end; if Padre = nil then begin list.Destroy; exit; //no lo ubica end; //ubica al nodo hijo for i := 0 to Padre.Count-1 do begin it := Padre.Items[i]; if it.Level=1 then begin if IntToStr(it.Index+1) = list[1] then Result := it; end; end; end; list.Destroy; end; //Funciones para control del editor procedure EdSubirCursor(ed: TSynEdit; Shift: TShiftState); //Sube el cursor del SynEdit, una psoición, considerando el estado de { TODO : Es muy lento para varias líneas (>100) } begin if ed.SelectionMode = smColumn then //en modo columna ed.ExecuteCommand(ecColSelUp, #0, nil) //solo se puede mover con selección else //en modo normal if ssShift in Shift then ed.ExecuteCommand(ecSelUp, #0, nil) //sube else ed.ExecuteCommand(ecUp, #0, nil); //sube end; procedure EdBajarCursor(ed: TSynEdit; Shift: TShiftState); //Baja el cursor del SynEdit, una psoición, considerando el estado de begin if ed.SelectionMode = smColumn then //en modo columna ed.ExecuteCommand(ecColSelDown, #0, nil) //solo se puede mover con selección else //en modo normal if ssShift in Shift then ed.ExecuteCommand(ecSelDown, #0, nil) //sube else ed.ExecuteCommand(ecDown, #0, nil); //sube end; procedure SubirCursorBloque(ed: TSynEdit; Shift: TShiftState); //Sube el cursor hasta encontrar una línea en blanco (si estaba en una diferente de blanco) //o hasta encontrar una línea diferente de blanco (si estaba en una línea en blanco) var curY : longint; begin CurY := ed.CaretY; //Lee posición de cursor if CurY = 1 then exit; //no se puede subir más if CurY = 2 then begin EdSubirCursor(ed, Shift); //solo puede subir una posición. exit; end; if trim(ed.lines[CurY-2]) = '' then begin //busca línea diferente de blanco while CurY > 1 do begin if trim(ed.lines[Cury-2]) <> '' then Exit; //pone y sale Dec(CurY); EdSubirCursor(ed, Shift); end; end else begin //busca línea en blanco hacia abajo while CurY > 1 do begin if trim(ed.lines[CurY-2]) = '' then Exit; //pone y sale Dec(CurY); EdSubirCursor(ed, Shift); end; end; end; procedure BajarCursorBloque(ed: TSynEdit; Shift: TShiftState); //Baja el cursor hasta encontrar una línea en blanco (si estaba en una diferente de blanco) //o hasta encontrar una línea diferente de blanco (si estaba en una línea en blanco) var curY : longint; begin CurY := ed.CaretY; //Lee posición de cursor if CurY = ed.Lines.Count then exit; //no se puede bajar más if CurY = ed.Lines.Count - 1 then begin EdBajarCursor(ed, Shift); //solo puede bajar una posición. exit; end; if trim(ed.lines[CurY-1]) = '' then begin //busca línea diferente de blanco while CurY < ed.Lines.Count do begin if trim(ed.lines[CurY-1]) <> '' then Exit; //pone y sale Inc(CurY); EdBajarCursor(ed, Shift); end; end else begin //busca línea en blanco hacia abajo while CurY < ed.Lines.Count do begin if trim(ed.lines[CurY-1]) = '' then Exit; //pone y sale Inc(CurY); EdBajarCursor(ed, Shift); end; end; end; procedure InsertaColumnasBloque(ed: TsynEdit; var key: TUTF8Char); //Inserta un caracter en un bloque de selección en modo columna. //El editor debe estar en modo columna con un bloque de selección activo. //El texto se insertará en todas las filas de la selección. { TODO : Verificar funcionamiento en líneas con tabulaciones.} var curX,curY : longint; p1,p2:TPoint; tmp: pchar; begin (*Verifica el caso particular en que se tiene solo una fila de selección en modo columna*) if ed.BlockBegin.y = ed.BlockEnd.y then begin //no hay mucho que procesar en modo columna ed.ExecuteCommand(ecChar,key,nil); //cancela procesamiento, para que no procese de nuevo el caracter key := #0; Exit; end; (*Verifica ancho de selección. Debe dejarse en ancho nulo, antes de pegar el caracter en la selección *) if ed.SelAvail then begin //se podría haber usado "if BlockBegin.x <> BlockEnd.x", pero se //se tendría problemas porque las posiciones físicas pueden //coincidir aún cuando las posiciones lógcas, no. p2 := ed.BlockEnd; //Lee final de selección //hay selección de por lo menos un caracter de ancho ed.ExecuteCommand(ecDeleteChar, #0, nil); //limpia selección //Ahora el bloque de selección tiene ancho cero, alto 1 y el cursor está dentro. //Ahora se debe restaurar la altura del bloque, modificando BlockEnd. //Se usa la posición horizontal del cursor, que coincide con el bloque //Se usa transformación, porque BlockEnd, trabaja en coordenada lógica p2.x:=ed.PhysicalToLogicalCol(ed.Lines[p2.y-1],p2.y-1,ed.CaretX); ed.BlockEnd:=p2; //restaura también, la altura original del bloque ed.SelectionMode := smColumn; //restaura el modo columna end; //El bloque de selección tiene ahora ancho cero y alto original. (* la idea aquí es poner en el portapapeles, una estructura con varias filas (tantas cono haya seleccionada) del caracter que se quiera insertar. *) //Guarda cursor curX := ed.CaretX; curY := ed.CaretY; //Lee coordenadas del bloque nulo p1 := ed.BlockBegin; p2 := ed.BlockEnd; tmp := PChar(DupeString(key+#13#10,p2.y-p1.y)+key); //construye texto ed.DoCopyToClipboard(tmp,''); //pone en portapapeles (*Aquí ya se tiene en el portapapeles, la estructura repetida del caracter a insertar*) //pega la selección modificada ed.CaretY := p1.y; //pone cursor arriba para pegar // ed.SelectionMode := smNormal; //debería poder trabajar en Normal //Si la estructura en el portapapeles, es correcta, se copiará correctamente en columnas. ed.ExecuteCommand(ecPaste,#0,nil); //desplaza Cursor y bloque, para escribir siguiente caracter a la derecha curX += 1; // p1.x += 1; // p2.x += 1; p1.x := ed.PhysicalToLogicalCol(ed.Lines[p1.y-1],p1.y-1,curX); p2.x := ed.PhysicalToLogicalCol(ed.Lines[p2.y-1],p2.y-1,curX); //calcula nuevamente la posición física del cursor, para evitar que el cursor //pueda caer en medio de una tabulación. CurX := ed.LogicalToPhysicalCol(ed.Lines[p1.y-1],p1.y-1,p1.x); //restaura posición de cursor ed.CaretX := curX; ed.CaretY := curY; //restaura bloque de selección, debe hacerse después de posicionar el cursor ed.BlockBegin := p1; ed.BlockEnd := p2; ed.SelectionMode := smColumn; //mantiene modo de columna key := #0; //cancela procesamiento de teclado end; function LeerParametros: boolean; {lee la linea de comandos Si hay error devuelve TRUE} var par : String; i : Integer; begin Result := false; //valor por defecto //valores por defecto inputFile := ''; showError := True; //Lee parámetros de entrada par := ParamStr(1); if par = '' then begin MsgErr('Nombre de archivo vacío.'); Result := true; exit; //sale con error end; if par[1] = '/' then begin //es parámetro i := 1; //para que explore desde el principio end else begin //es archivo inputFile := par; //el primer elemento es el archivo de entrada i := 2; //explora siguientes end; while i <= ParamCount do begin par := ParamStr(i); If par[1] = '/' Then begin Case UpCase(par) of '/NOERROR': showError := False; '/ERROR': showError := True; Else begin MsgErr('Error. Parámetro desconocido: ' + par); Result := true; exit; //sale con error End End end Else begin // archivoSal := par; End; inc(i); //pasa al siguiente end; End; function NombDifArc(nomBase: String): String; {Genera un nombre diferente de archivo, tomando el nombre dado como raiz.} const MAX_ARCH = 10; var i : Integer; //Número de intentos con el nombre de archivo de salida cadBase : String; //Cadena base del nombre base extArc: string; //extensión function NombArchivo(i: integer): string; begin Result := cadBase + '-' + IntToStr(i) + extArc; end; begin Result := nomBase; //nombre por defecto extArc := ExtractFileExt(nomBase); if ExtractFilePath(nomBase) = '' then exit; //protección //quita ruta y cambia extensión cadBase := ChangeFileExt(nomBase,''); //busca archivo libre for i := 0 to MAX_ARCH-1 do begin If not FileExists(NombArchivo(i)) then begin //Se encontró nombre libre Exit(NombArchivo(i)); //Sale con nombre end; end; //todos los nombres estaban ocupados. Sale con el mismo nombre End; procedure LeeArchEnMenu(arc: string; mn: TMenuItem; accion: TNotifyEvent); {Lee la carpeta de macros y actualiza un menú con el nombre de los archivos Devuelve la cantidad de ítems leidos. } var Hay: Boolean; SR: TSearchRec; item: TMenuItem; n : integer; begin // mn.Clear; // Crear la lista de ficheos en el dir. StartDir (no directorios!) n := 0; //contador Hay := FindFirst(arc,faAnyFile - faDirectory, SR) = 0; while Hay do begin //encontró. Crea entrada item := TMenuItem.Create(nil); item.Caption:= SysToUTF8(SR.Name); //nombre item.OnClick:=accion; mn.Add(item); //busca siguiente Hay := FindNext(SR) = 0; inc(n); end; if n = 0 then begin //no encontró //encontró. Crea entrada item := TMenuItem.Create(nil); item.Caption:= 'vacío'; //nombre item.Enabled := false; mn.Add(item); end; // Result := n; end; procedure CopiarMemu(menOrig, menDest: TMenuItem); //Copìa los ítems de un menú a otro var it: TMenuItem; i: Integer; begin menDest.Caption:=menOrig.Caption; menDest.Clear; for i := 0 To menOrig.Count - 1 do begin it := TMenuItem.Create(nil); it.Caption:= menOrig[i].Caption; it.OnClick:=menOrig[i].OnClick; it.Checked:=menOrig[i].Checked; menDest.Add(it); end; end; procedure Init; {Inicializa variables de la aplicación. Inicialmente, se teníe este código en la sección INITIALIZATION, pero como se generan mensajes GUI, en algunos casos se producían errores. } begin //Inicia directorios de la aplicación patApp := ExtractFilePath(Application.ExeName); //incluye el '\' final patSyntax := patApp + 'languages'; patMacros := patApp + 'macros'; patTemp := patApp + 'temp'; patSessions:= patApp + 'sessions'; inputFile := ''; //Archivo de entrada //Verifica existencia de carpetas de trabajo try if not DirectoryExists(patTemp) then begin msgexc('Folder /temp doesn''t exist. It will be created.'); CreateDir(patTemp); end; if not DirectoryExists(patMacros) then begin msgexc('Folder /macros doesn''t exist. It will be created.'); CreateDir(patMacros); end; if not DirectoryExists(patSyntax) then begin msgexc('Folder /lenguages doesn''t exist. It will be created.'); CreateDir(patSyntax); end; if not DirectoryExists(patSessions) then begin msgexc('Folder /sessions doesn''t exist. It will be created.'); CreateDir(patSessions); end; if not FileExists(patApp+'plink.exe') then begin msgErr('No se encuentra archivo plink.exe'); end; except msgErr('Error. No se puede leer o crear directorios.'); end; end; initialization finalization // {Por algún motivo, la unidad HeapTrc indica que hay gotera de memoria si no se liberan // estas cadenas: } // patApp := ''; // patMacros := ''; // patTemp := ''; // patSyntax := ''; // patSessions := ''; end.