function dix_edit_des(control,file,des,newname,where,err_arg) implicit none c include 'dix_def.inc' record /control/ control !:io: control structure record /file_info/ file record /des_info/ des !:io: description structure character*(*) newname !:i: create new file? integer*4 where !:i: if a new file where to put it character*(*) err_arg !:o: error argument integer*4 dix_edit_des c integer*4 istat,loca logical file_link integer*4 dix_edit_use_edt integer*4 dix_edit_use_int integer*4 dix_edit_use_tpu c external dix_msg_notsupp external dix_msg_noupdate external dix_msg_notchanged external dix_msg_notvtterm external dix_msg_setedt external dix_msg_libnotopen c record /des_info/ newdes pointer (p_newdes,newdes) c loca = where if(newname .ne. ' ') then loca = where else loca = des.in_library endif c c Check if write access c istat = %loc(dix_msg_noupdate) if(loca .eq. des_in_userlib) then err_arg = 'user-library' if(control.nk_userlib .eq. 0) goto 80 if(.not. control.may_write_to_userlib) goto 90 endif if(loca .eq. des_in_syslib) then err_arg = 'system-library' if(control.nk_syslib .eq. 0) goto 80 if(.not. control.may_write_to_syslib) goto 90 endif c if(control.got_pasteboard) then call smg$erase_pasteboard(control.paste_id) else if(control.editor .ne. dix_edit_edt) then call dix_message(control,dix_msg_setedt) control.editor = dix_edit_edt endif endif istat = 1 err_arg = ' ' c if(newname .ne. ' ') then call get_vm(sizeof(newdes),p_newdes,control.zone_descr) call dix_des_init_des(newdes) newdes.fnam = newname newdes.nk_fnam = len(newname) newdes.in_library = where endif c if( control.editor .eq. dix_edit_edt) then istat = dix_edit_use_edt(control,des,newname,newdes) elseif(control.editor .eq. dix_edit_internal) then if(control.got_pasteboard) then istat = dix_edit_use_int(control,des,newname,newdes) else istat = %loc(dix_msg_notvtterm) endif elseif(control.editor .eq. dix_edit_tpu) then if(control.got_pasteboard) then istat = dix_edit_use_tpu(control,des,newname,newdes) else istat = %loc(dix_msg_notvtterm) endif else istat = 0 endif if(newname .ne. ' ') then if(istat) then file_link = %loc(file) .ne. 0 call dix_des_link_in(control,file,newdes,.true.,file_link) else call free_vm(sizeof(newdes),p_newdes,control.zone_descr) endif endif c if(istat .eq. 0) then call dix_message(control,dix_msg_notchanged) istat = 1 endif goto 90 80 istat = %loc(dix_msg_libnotopen) c 90 dix_edit_des = istat return end function dix_edit_use_edt(control,des,newname,newdes) implicit none c include 'dix_def.inc' record /control/ control record /des_info/ des character*(*) newname record /des_info/ newdes integer*4 dix_edit_use_edt c integer*4 istat,ctx,nk_edt,nk,nk_mod character*(max_filename_length) edtini_file,fnam,module c integer*4 dix_edit_get_file integer*4 dix_edit_put_file integer*4 dix_util_get_len_fu integer*4 lib$find_file integer*4 edt$edit c c Try to locate edtini c if(lib$find_file('EDTINI',edtini_file,ctx,'sys$login:.edt')) then nk_edt = dix_util_get_len_fu(edtini_file) else nk_edt = 0 endif call lib$find_file_end(ctx) c c If module is in library, extract it to scratch file c and edit that one. If the edit is done replace the module c istat = dix_edit_get_file(control,des,fnam,nk,module,nk_mod, 1 newname) c c and edit it c if(istat) then istat = edt$edit(fnam(1:nk),,edtini_file(1:nk_edt)) call smg$repaint_screen(control.paste_id) c c Now replace it, and reread it c if(istat) istat = dix_edit_put_file(control,des,fnam(1:nk), 1 module(1:nk_mod),.true.,newname,newdes) endif dix_edit_use_edt = istat return end function dix_edit_use_tpu(control,des,newname,newdes) implicit none c include 'dix_def.inc' record /control/ control record /des_info/ des character*(*) newname record /des_info/ newdes integer*4 dix_edit_use_tpu c integer*4 istat,nk,nk_mod character*(max_filename_length) fnam,module c integer*4 dix_edit_get_file integer*4 dix_edit_put_file integer*4 tpu$edit c c get the file (otr module) c istat = dix_edit_get_file(control,des,fnam,nk,module,nk_mod,newname) c c and edit it c if(istat) then istat = tpu$edit(fnam(1:nk),fnam(1:nk)) call smg$repaint_screen(control.paste_id) c call dix_message(control,%val(istat)) c c Now replace it, and reread it c if(istat) istat = dix_edit_put_file(control,des,fnam(1:nk), 1 module(1:nk_mod),.true.,newname,newdes) endif dix_edit_use_tpu = istat return end function dix_edit_use_int(control,des,newname,newdes) implicit none c include 'dix_def.inc' record /control/ control record /des_info/ des character*(*) newname record /des_info/ newdes integer*4 dix_edit_use_int c integer*4 nk,lun,k,bpos,epos,l,istat,nk_dm,lun_f character*(max_filename_length) dmodule,fnam character*(max_line_length) line integer*4 dix_lbr_get_module integer*4 dix_edit logical memtab_read integer*4 dix_edit_new_file c external dix_msg_notedit external dix_msg_notinlib c c First get the file to a memtab structure c if(newname .eq. ' ') then if(des.in_library .ne. des_in_file) then c c In library, Extract the module c if(.not. dix_lbr_get_module(control,des.fnam(1:des.nk_fnam), 1 lun,nk,des.in_library)) then istat = %loc(dix_msg_notedit) endif else c c Module was in file c call memtab_open(des.fnam(1:des.nk_fnam),lun,k) call dix_util_file_parse(des.fnam,'N',bpos,epos) endif call dix_des_display(control,des,dmodule,nk_dm,.false.) if(nk_dm .gt. control.ncols-10) 1 call dix_des_display(control,des,dmodule,nk_dm,.true.) else call dix_des_display(control,newdes,dmodule,nk_dm,.false.) if(nk_dm .gt. control.ncols-10) 1 call dix_des_display(control,newdes,dmodule,nk_dm,.true.) call memtab_init(lun,'EDITOR') endif c c and edit it c istat = dix_edit(control,lun,dmodule(1:nk_dm)) if(istat) then if(newname .eq. ' ') then if(des.in_library .ne. des_in_file) then c c In library c call dix_lbr_replace_module(control,lun, 1 des.fnam(1:des.nk_fnam),des.in_library) else call dix_util_file_parse(des.fnam,'V',k,l) fnam = des.fnam(1:k-1) des.in_library = des_in_file c c Create a new file c call lib$get_lun(lun_f) open(lun_f,file=fnam,carriagecontrol='list',status='new') call memtab_rewind(lun) do while(memtab_read(lun,nk,line)) write(lun_f,'(a)') line(1:nk) end do inquire(lun_f,name=des.fnam) close(lun_f) call lib$free_lun(lun_f) call memtab_close(lun) endif call dix_des_reget(control,des) else c c Newname <> blankd, so create new c istat = dix_edit_new_file(control,lun,newdes) end if endif dix_edit_use_int = istat end c function dix_edit_get_file(control,des,fnam,nk,module,nk_mod,newname) implicit none c include 'dix_def.inc' record /control/ control record /des_info/ des !:i: description character*(*) fnam !:o: filename integer*4 nk !:o: length of filename character*(*) module !:o: module name (if in lib) integer*4 nk_mod !:o: length of modnam character*(*) newname !:i: new file/module name integer*4 dix_edit_get_file c integer*4 istat,lun,l,lun_mem character*(max_line_length) line c logical dix_lbr_get_module logical memtab_read c external dix_msg_modnotf c c call lib$get_lun(lun) istat = 1 if(newname .ne. ' ') then open(lun,file='sys$scratch:dix_edit_'//newname//'.des', 1 carriagecontrol='list',status='new') inquire(lun,name=fnam) close(lun) nk_mod = 0 else if(des.in_library .ne. des_in_file) then c c In library c module = des.fnam nk_mod = des.nk_fnam open(lun,file='sys$scratch:dix_edit_'//module(1:nk_mod)//'.tmp', 1 carriagecontrol='list',status='new') c c Extract the module c if(.not. dix_lbr_get_module(control,module(1:nk_mod), 1 lun_mem,nk,des.in_library)) then istat = %loc(dix_msg_modnotf) else call memtab_rewind(lun_mem) do while(memtab_read(lun_mem,nk,line)) write(lun,'(a)') line(1:nk) end do call memtab_close(lun_mem) inquire(lun,name=fnam) close(lun) endif else fnam = des.fnam nk_mod = 0 endif endif call dix_util_file_parse(fnam,'V',nk,l) call lib$free_lun(lun) dix_edit_get_file = istat return end function dix_edit_put_file(control,des,fnam,module,changed, 1 newname,newdes) implicit none c include 'dix_def.inc' record /control/ control record /des_info/ des character*(*) fnam character*(*) module logical changed character*(*) newname record /des_info/ newdes integer*4 dix_edit_put_file c integer*4 lun,istat,nlines logical dix_edit_new_file c call lib$get_lun(lun) istat = 1 if(newname .ne. ' ') then call memtab_open(lun,fnam,nlines) istat = dix_edit_new_file(control,lun,newdes) else if(len(module) .gt. 0) then if(changed) then call memtab_open(lun,fnam,nlines) call dix_lbr_replace_module(control,lun,module, 1 des.in_library .eq. des_in_userlib) c c And delete it c call memtab_close(lun) endif c c Delete all version of the scratch file c 20 open(lun,file=fnam,carriagecontrol='list',status='old',err=90) close(lun,dispose='delete') goto 20 endif if(changed) call dix_des_reget(control,des) endif 90 dix_edit_put_file = istat call lib$free_lun(lun) return end function dix_edit(control,lun_memtab,name) implicit none c c Edit some lines on text c the source lines are in a memtable c the result will be in a new memtable, but the contents can be changed c if dix_edit returns 0, data is not changed, c 1, the data is changed c all others, errors to be signalled c include 'dix_def.inc' include '($smgdef)' record /control/ control character*(*) name integer*4 lun_memtab integer*4 dix_edit c integer*4 dis_id,k,nk,nk1,key,istat,err_linenr,l integer*4 nlines,nl_dis,org_nlines,lun,lun_temp,undo_nkl,undo_nkw integer*4 nrows_v,ncols_v,lun_save integer*4 row,col,row_v,col_v,sel_video integer*4 sel_row,sel_col,prev_row,prev_col integer*4 find_row,find_col,find_video logical insert_mode,sel_mode c record /des_info/ des record /dyn_help/ help_des c character undo_char character*(max_line_length) line,line_w character*(max_line_length) undo_line,undo_word c integer*4 memtab_init integer*4 memtab_add_record integer*4 dix_des_read_it external dix_msg_general logical dix_smg_find_string c insert_mode = .true. sel_mode = .false. sel_video = smg$m_bold .or. smg$m_reverse find_video = smg$m_bold lun_save = 0 c call help_init_std(control,help_des,'Edit descriptions',20,31) call help_key(control.key_table,help_des,key_delete_line, 1 'Delete line') call help_key(control.key_table,help_des,key_undelete_line, 1 'Undelete line') call help_key(control.key_table,help_des,key_delete_word, 1 'Delete word') call help_key(control.key_table,help_des,key_undelete_word, 1 'Undelete word') call help_key(control.key_table,help_des,key_abort,'Abort editting') call help_key(control.key_table,help_des,key_exit,'Abort editting') call help_key(control.key_table,help_des,key_do,'Apply changes') call help_key(control.key_table,help_des,key_next_line, 1 'Goto beginning of next line') call help_key(control.key_table,help_des,key_select, 1 'Start/cancel selection') call help_key(control.key_table,help_des,key_remove, 1 'Cut selected area to paste buffer') call help_key(control.key_table,help_des,key_put, 1 'Insert paste buffer') call dix_smg_stack_help(control,help_des) c call memtab_get_nlines(lun_memtab,org_nlines) nlines = org_nlines nl_dis = max(nlines*2,control.nrows)*2 call smg$create_virtual_display(nl_dis,max_line_length,dis_id) call smg$label_border(dis_id,'Edit '//name) nrows_v = control.nrows-2 ncols_v = control.ncols call smg$create_viewport(dis_id,1,1,nrows_v,ncols_v) call memtab_rewind(lun_memtab) c c Build a temp file for original text c smg untabs lines, and this is not easy to check at the end c call memtab_init(lun_temp,'EDIT_TEMP') do k=1,nlines call memtab_read(lun_memtab,nk,line) call dix_edit_write_line(dis_id,k,line(1:nk)) c c Read the line back, and remember for later check on changes c call dix_edit_read_from_display(dis_id,k,line,nk) call memtab_add_record(lun_temp,line(1:nk)) end do call smg$paste_virtual_display(dis_id,control.paste_id,2,1) c row_v = 0 col_v = 0 row = 1 col = 1 find_row = 0 c istat = 0 c c First be sure the cursor is in the text and on the screen c 10 call dix_edit_clip(control,dis_id,nlines, 1 row ,col, 1 row_v ,col_v, 1 nrows_v,ncols_v) c c Now set cursor and read key c call smg$set_cursor_abs(dis_id,row,col) c c Handle select mode c call dix_edit_sel(dis_id, 1 sel_row,sel_col, 1 prev_row,prev_col, 1 row,col,sel_mode,sel_video) c call dix_get_key(control,key) if(find_row .ne .0) then call smg$change_rendition(dis_id,find_row,find_col,1, 1 control.nk_sear,0) find_row = 0 find_col = 0 endif c c Process the character, First the cursor move keys c if(key .eq. key_down) then row = row + 1 elseif(key .eq. key_next) then row = row + control.nrows-2 elseif(key .eq. key_bot) then row = nlines col = len(line) elseif(key .eq. key_up) then row = row - 1 elseif(key .eq. key_prev) then row = row - control.nrows-2 elseif(key .eq. key_top) then row = 1 elseif(key .eq. key_right) then col = col + 1 elseif(key .eq. key_left) then col = col - 1 elseif(key .eq. key_first) then col = 1 elseif(key .eq. key_select) then if(sel_row .ne. 0) then sel_mode = .false. else sel_mode = .true. endif elseif(key .eq. key_last) then col = len(line) elseif(key .eq. key_toggle) then insert_mode = .not. insert_mode elseif(key .eq. key_exit) then goto 99 elseif(key .eq. key_abort) then goto 99 elseif(key .eq. key_set_forw) then control.forward = .true. elseif(key .eq. key_set_backw) then control.forward = .false. elseif(key .eq. key_help) then call dix_smg_help(control) elseif(key .eq. key_remove) then if(sel_mode) then call dix_edit_cut(dis_id,sel_row,sel_col,row,col,lun_save,nlines) sel_mode = .false. else call dix_message(dix_msg_general,%descr('Nothing selected')) endif elseif(key .eq. key_put) then if(lun_save .ne. 0) then call dix_edit_paste(dis_id,row,col,lun_save,nlines,nl_dis) else call dix_message(dix_msg_general,%descr('Nothing selected')) endif elseif(key .eq. key_find .or. key .eq. key_find1) then if(nlines .eq. 0) goto 10 if(key .eq. key_find1) control.nk_Sear = 0 find_row = row find_col = col if(dix_smg_find_string(control,dis_id, 1 control.nk_sear,control.sear, 1 find_row,find_col, 1 nlines,control.forward)) then row = find_row col = find_col call smg$change_rendition(dis_id,row,col,1, 1 control.nk_sear,find_video) else find_col = 0 find_row = 0 goto 10 end if elseif(key .eq. key_do) then goto 90 elseif(key .eq. key_delete_line) then call dix_edit_read_from_display(dis_id,row,line,nk) if(row .le. nlines) then call dix_edit_read_from_display(dis_id,row+1,line_w,nk1) else nk1 = 0 endif undo_line = line(col:nk) undo_nkl = nk - col+1 line(col:) = line_w(1:nk1) nk = col-1+nk1 call dix_edit_write_line(dis_id,row,line(1:nk)) if(row .lt. nlines) then call smg$delete_line(dis_id,row+1) nlines = nlines - 1 endif elseif(key .eq. key_undelete_line) then c if(nlines .eq. nl_dis) call dix_edit_enlarge(dis_id,nl_dis,10) call dix_edit_read_from_display(dis_id,row,line,nk) line_w = line(1:col-1)//undo_line(1:undo_nkl) nk1 = col -1 + undo_nkl call dix_edit_write_line(dis_id,row,line_w(1:nk1)) c call smg$insert_line(dis_id,row+1,,smg$m_down) call dix_edit_write_line(dis_id,row+1,line(col:nk)) c nlines = nlines + 1 elseif(key .eq. key_delete_word) then call dix_edit_read_from_display(dis_id,row,line,nk) do k=col,nk if(line(k:k) .eq. ' ') goto 12 end do k = nk + 1 12 do l=k,nk if(line(l:l) .ne. ' ') goto 14 end do l = nk + 1 c c Now l points to the first char we must keep c 14 nk = l - col undo_word = line(col:l-1) undo_nkw = nk call smg$delete_chars(dis_id,nk,row,col) elseif(key .eq. key_undelete_word) then call dix_edit_read_from_display(dis_id,row,line,nk) line = line(1:col-1)//undo_word(1:undo_nkw)//line(col:nk) nk = nk + undo_nkw call dix_edit_write_line(dis_id,row,line(1:nk)) elseif(key .eq. key_next_line) then col = 1 row = row + 1 elseif(key .eq. key_delete) then if(col .eq. 1) then if(row .gt. 1) then c c Merge the line with the previous one c call dix_edit_read_from_display(dis_id,row-1,line,nk) call dix_edit_read_from_display(dis_id,row,line_w,nk1) line(nk+1:) = line_w(1:nk1) nk1 = nk + nk1 call dix_edit_write_line(dis_id,row-1,line(1:nk1)) call smg$delete_line(dis_id,row) nlines = nlines - 1 undo_char = char(13) col = nk + 1 row = row - 1 endif else c c Just delete one char c call dix_edit_read_from_display(dis_id,row,line,nk) undo_char = line(col-1:col-1) if(insert_mode) then call smg$delete_chars(dis_id,1,row,col-1) else callsmg$put_chars(dis_id,' ',row,col-1) endif col = col - 1 endif c c Character insert keys c elseif(key .eq. key_enter) then c c Split line c if(nlines .eq. nl_dis) call dix_edit_enlarge(dis_id,nl_dis,10) call dix_edit_read_from_display(dis_id,row,line,nk) call dix_edit_write_line(dis_id,row,line(1:col-1)) call smg$insert_line(dis_id,row+1,,smg$m_down) call dix_edit_write_line(dis_id,row+1,line(col:nk)) nlines = nlines + 1 row = row + 1 col = 1 elseif(key .ge. ichar(' ') .and. key .le. 126) then if(insert_mode) then if(nlines .eq. 0) then nlines = 1 call dix_edit_write_line(dis_id,row,char(key)) else call smg$insert_chars(dis_id,char(key),row,col) endif else call smg$put_chars(dis_id,char(key),row,col) endif col = col + 1 else call dix_mes_invkey(control) endif goto 10 c c normal exit, See if different since beginning c lun_temp contains a copy of the data after being displayed c so the tab expansion of smg is included in lun_temp c 90 if(org_nlines .ne. nlines) goto 92 call memtab_rewind(lun_temp) do k=1,nlines call memtab_read(lun_temp ,nk,line) call dix_edit_read_from_display(dis_id,k,line_w,nk1) if(nk .ne. nk1) goto 92 if(line(1:nk) .ne. line_w(1:nk1)) goto 92 end do c c Now something changed c goto 99 92 istat = 1 istat = memtab_init(lun,'MEMTAB_TMP') if(istat) then do k=1,nlines call dix_edit_read_from_display(dis_id,k,line,nk) istat = memtab_add_record(lun,line(1:nk)) if(.not. istat) then call memtab_close(lun) goto 99 endif end do c c Check if this memfile contains a valid syntax c istat = dix_des_read_it(control,lun,des,err_linenr) call dix_des_remove(control,des) if(.not. istat) then call memtab_close(lun) row = err_linenr goto 10 endif c c Now we have a new memtab file c call memtab_close(lun_memtab) lun_memtab = lun istat = 1 end if c 99 call memtab_close(lun_temp) call smg$delete_virtual_display(dis_id) c call dix_smg_unstack_help(control) call help_exit(help_des) c dix_edit = istat return end subroutine dix_edit_clip(control,dis_id,nlines, 1 row ,col, 1 row_v ,col_v, 1 nrows_v,ncols_v) implicit none c include 'dix_def.inc' include '($smgdef)' c record /control/ control integer*4 dis_id integer*4 nlines integer*4 row integer*4 col integer*4 row_v integer*4 col_v integer*4 nrows_v integer*4 ncols_v c character*(max_line_length) line integer*4 nk,nl,k c c First make sure row, col are in range c row = min(max(1,row),nlines) c call dix_edit_read_from_display(dis_id,row,line,nk) col = min(max(1,col),nk+1) c c Now make sure its on the screen c if(row .le. row_v) then nl = row_v - row + 1 if(nl .lt. control.nrows) then do k=1,nl call smg$scroll_viewport(dis_id,smg$m_down,1) enddo else call smg$scroll_viewport(dis_id,smg$m_down,nl) endif row_v = row_v - nl endif c if(row-row_v .gt. nrows_v) then nl = row-row_v-nrows_v if(nl .lt. control.nrows) then do k=1,nl call smg$scroll_viewport(dis_id,smg$m_up,1) end do else call smg$scroll_viewport(dis_id,smg$m_up,nl) endif row_v = row_v + nl endif c if(col .le. col_v) then nl = col_v - col + 1 call smg$scroll_viewport(dis_id,smg$m_right,nl) col_v = col_v - nl endif c if (col-col_v .gt. ncols_v) then nl = col-col_v - ncols_v call smg$scroll_viewport(dis_id,smg$m_left,nl) col_v = col_v + nl endif return end subroutine dix_edit_enlarge(dis_id,nl_dis,nlin_extra) implicit none c cEnlarge virtual display c integer*4 dis_id integer*4 nl_dis integer*4 nlin_extra c nl_dis = nl_dis + nlin_extra call smg$change_virtual_display(dis_id,nl_dis) return end subroutine dix_edit_read_from_display(dis_id,row,line,nk) implicit none c c return the index of the line on row 'row' c integer*4 dis_id integer*4 row character*(*) line integer*4 nk c include 'dix_def.inc' include '($smgdef)' c integer*4 dix_util_get_len_fu c character*(max_line_length) rend_string c call smg$read_from_display(dis_id,line,,row,rend_string) nk = index(rend_string,char(smg$m_invisible)) - 1 if(nk .lt. 0) nk = dix_util_get_len_fu(line) return end subroutine dix_edit_write_line(dis_id,row,line) implicit none c c Draw a line to the display and terminate with a c invisible blank. This blank is used as a marker to remember the c linelength c integer*4 dis_id integer*4 row character*(*) line c include 'dix_def.inc' include '($smgdef)' c character*(max_line_length) renditions integer*4 nk,k c nk = len(line) do k=1,nk renditions(k:k) = char(0) end do renditions(nk+1:nk+1) = char(smg$m_invisible) call smg$put_chars_multi(dis_id,line//' ',row,1, 1 smg$m_erase_to_eol,renditions) return end subroutine dix_edit_sel(dis_id, 1 sel_row,sel_col, 1 prev_row,prev_col, 1 row,col,sel_mode,sel_video) implicit none integer*4 dis_id integer*4 sel_row integer*4 sel_col integer*4 prev_row integer*4 prev_col integer*4 row integer*4 col logical sel_mode integer*4 sel_video c logical dix_edit_less c if(sel_row .eq. 0) then c c Nothing selected c if(sel_mode) then c c We want to start to select c call dix_edit_set_vid(dis_id,row,col,row,col,sel_video) sel_row = row sel_col = col else c c nothing selected, and sel_mode = .false. c do nothing c goto 90 endif else c c We have something selected c if(sel_mode) then c c Still in sel_mode, mark the pieces from prev upto cur c 4 possibilities c 1. prevprev : c a: cursel : unmark prev:sel and mark sel:cur c 3. prev>sel and cur sel : unmark cur:prev c 4. prev>sel and cur >prev : mark prev:cur c if(dix_edit_less(prev_row,prev_col,sel_row,sel_col)) then if(dix_edit_less(row,col,prev_row,prev_col)) then c c Case 1, enlarge the selected field c 1. prevprev : c a: cursel : unmark prev:sel and mark sel:cur c if(dix_edit_less(row,col,sel_row,sel_col)) then call dix_edit_set_vid(dis_id,prev_row,prev_col, 1 row,col,0) else call dix_edit_set_vid(dis_id,sel_row,sel_col, 1 row,col,sel_video) call dix_edit_set_vid(dis_id,prev_row,prev_col, 1 row,col,0) endif endif else if(dix_edit_less(row,col,prev_row,prev_col)) then c c Case 3 c 3. prev>sel and cur sel : unmark cur:prev c if(dix_edit_less(row,col,sel_row,sel_col)) then call dix_edit_set_vid(dis_id,sel_row,sel_col, 1 row,col,0) call dix_edit_set_vid(dis_id,row,col, 1 sel_row,sel_col,sel_video) else call dix_edit_set_vid(dis_id,row,col, 1 prev_row,prev_col,0) endif else c c Case 4 c 4. prev>sel and cur >prev : mark prev:cur c call dix_edit_set_vid(dis_id,prev_row,prev_col, 1 row,col,sel_video) endif endif else c c We have a selection, but now no more c unmark sel upto cur, and turn off selection c if(dix_edit_less(row,col,sel_row,sel_col)) then call dix_edit_set_vid(dis_id,row,col,sel_row,sel_col,0) else call dix_edit_set_vid(dis_id,sel_row,sel_col,row,col,0) endif sel_row = 0 sel_col = 0 endif endif 90 prev_row = row prev_col = col return end function dix_edit_less(row1,col1,row2,col2) implicit none c c Return true if row1,col1 is before row2,col2 c integer*4 row1 integer*4 col1 integer*4 row2 integer*4 col2 logical dix_edit_less c dix_edit_less = (1000*row1+col1) .lt. (1000*row2+col2) return end function dix_edit_equal(row1,col1,row2,col2) implicit none c c Return true if row1,col1 is equal to row2,col2 c integer*4 row1 integer*4 col1 integer*4 row2 integer*4 col2 logical dix_edit_equal c dix_edit_equal = (1000*row1+col1) .eq. (1000*row2+col2) return end subroutine dix_edit_set_vid(dis_id,row1,col1,row2,col2,video) implicit none c include 'dix_def.inc' c integer*4 dis_id integer*4 row1 integer*4 col1 integer*4 row2 integer*4 col2 integer*4 video c character*(max_line_length) line integer*4 nk,k c c first the first row c call dix_edit_read_from_display(dis_id,row1,line,nk) if(row2 .le. row1) then if(nk .gt. col2) nk = col2 endif call smg$change_rendition(dis_id,row1,col1,1,nk-col1+1,video) c c now the middle lines c do k=row1+1,row2-1 call dix_edit_read_from_display(dis_id,k,line,nk) call smg$change_rendition(dis_id,k,1,1,nk,video) end do c c Now the last line c if(row2 .gt. row1) then call smg$change_rendition(dis_id,row2,1,1,col2,video) end if return end subroutine dix_edit_cut(dis_id,sel_row,sel_col,row,col,lun_save,nlines) implicit none c include 'dix_def.inc' c integer*4 dis_id integer*4 sel_row integer*4 sel_col integer*4 row integer*4 col integer*4 lun_save integer*4 nlines c character*(max_line_length) line,line2 c integer*4 brow,bcol,erow,ecol,nk,k,epos,nk2 logical dix_edit_less c if(lun_save .ne. 0) call memtab_close(lun_save) call memtab_init(lun_save,'MEMTAB_CUT') c if(dix_edit_less(sel_row,sel_col,row,col)) then brow = sel_row bcol = sel_col erow = row ecol = col-1 else brow = row bcol = col erow = sel_row ecol = sel_col-1 endif c c First row c call dix_edit_read_from_display(dis_id,brow,line,nk) epos = nk if(erow .eq. brow) epos = ecol call memtab_add_record(lun_save,line(bcol:epos)) line2 = line(1:bcol-1)//line(epos+1:nk) nk2 = bcol - 1 + nk-epos c if(erow .gt. brow) then do k=brow+1,erow-1 call dix_edit_read_from_display(dis_id,k,line,nk) call memtab_add_record(lun_save,line(1:nk)) end do call dix_edit_read_from_display(dis_id,erow,line,nk) call memtab_add_record(lun_save,line(1:ecol)) line2(nk2+1:) = line(ecol+1:nk) nk2 = nk2 + nk-ecol c c Now delete the intermediate lines c call smg$delete_line(dis_id,brow+1,erow-brow) nlines = nlines -(erow-brow) end if call dix_edit_write_line(dis_id,brow,line2(1:nk2)) row = brow col = bcol c return end subroutine dix_edit_paste(dis_id,row,col,lun_save,nlines,nl_dis) implicit none c include 'dix_def.inc' include '($smgdef)' c integer*4 dis_id integer*4 row integer*4 col integer*4 lun_save integer*4 nlines integer*4 nl_dis c integer*4 k,nl,nk,nk2 character*(max_line_length) line,line2 c call memtab_rewind(lun_save) c call memtab_get_nlines(lun_save,nl) if(nlines+nl+2 .gt. nl_dis) call dix_edit_enlarge(dis_id,nl_dis,nl+2) c do k=1,nl call memtab_read(lun_save,nk,line) if(k .eq. 1) then call dix_edit_read_from_display(dis_id,row,line2,nk2) if(k .eq. nl) then line = line2(1:col-1)//line(1:nk)//line2(col:nk2) nk = nk + nk2 else line = line2(1:col-1)//line(1:nk) !make new line nk = nk + col -1 c line2 = line2(col:nk2) !remember rest nk2 = nk2 - col + 1 endif else call smg$insert_line(dis_id,row+k-1,,smg$m_down) nlines = nlines + 1 if(k .eq. nl) then line = line(1:nk)//line2(1:nk2) nk = nk + nk2 endif endif call dix_edit_write_line(dis_id,row+k-1,line(1:nk)) end do return end function dix_edit_new_file(control,lun,des) implicit none c include 'dix_def.inc' record /control/ control integer*4 lun record /des_info/ des integer*4 dix_edit_new_file c character*(max_line_length) line integer*4 istat,nlun,nk,k logical signal c external dix_msg_notinlib integer*4 dix_lbr_insert_module integer*4 memtab_read c istat = 0 signal = .false. c if(des.in_library .ne. des_in_file) then istat = dix_lbr_insert_module(control,lun, 1 des.fnam(1:des.nk_fnam),des.in_library) signal = .true. endif if(.not. istat) then call lib$get_lun(nlun) open(nlun,file=des.fnam(1:des.nk_fnam),defaultfile='.des', 1 carriagecontrol='list',status='new') call memtab_rewind(lun) c do while(memtab_read(lun,nk,line)) write(nlun,'(a)') line(1:nk) end do inquire(nlun,name=line) close(nlun) call lib$free_lun(nlun) if(signal) then call dix_util_file_parse(line,'V',k,nk) call dix_message(control,dix_msg_notinlib,line(1:nk)) endif istat = 1 endif call memtab_close(lun) c dix_edit_new_file = istat return end