'From Squeak6.0 of 23 January 2023 [latest update: #22121] on 25 February 2023 at 6:41:13 pm'!
Object subclass: #See
	instanceVariableNames: ''
	classVariableNames: 'Store'
	poolDictionaries: ''
	category: 'Category-Edrx'!
!See commentStamp: 'Edrx 1/28/2023 23:59' prior: 0!
Elisp hyperlinks reimplemented as Squeak Hyperlinks.!


"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

See class
	instanceVariableNames: ''!

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'!
fileList
  "Same as: Tools -> File List.
   Test:
    See fileList.
  "
  ^ StandardToolSet openFileList.! !

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'!
helpBrowser
  "Same as Apps -> Help Browser.
   Test:
    See helpBrowser.
  "
  ^ HelpBrowser open.! !

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'!
messageNames
  "Same as World -> open -> message names.
   Test:
     See messageNames.
  "
  ^ ECToolSet openMessageNames.! !

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 1/29/2023 00:10'!
methodFinder
  "Same as World -> open -> method finder.
   Test:
     See methodFinder.
  "
  ^ ECToolSet openSelectorBrowser.! !

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 2/25/2023 18:39'!
terseGuide
  "Test:
    See terseGuide.
  "
  ^ HelpBrowser openOn: TerseGuideHelp.
! !

!See class methodsFor: 'menu items - detached' stamp: 'Edrx 2/25/2023 18:38'!
terseGuide: topicTitle
  "This is an ugly hack!!
   A test:
    See terseGuide: 'Method Call'.
  "
  | hb topics tt oc treem |
  hb := HelpBrowser openOn: TerseGuideHelp.
  treem := hb model dependents at: 3.
  topics := hb model toplevelTopics.
  tt := topics detect: [ :topic | topic title = topicTitle ] ifNone: [].
  oc := OrderedCollection new.
  oc add: tt.
  treem selectPath: oc.
  ^ hb.
! !


!See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:09'!
class: className
  "Same as: Tools -> Browser -> (select class: className).
   Test:
     See class: See.
  "
  ^ className browse.! !

!See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:09'!
class: class classMethod: method
  "Same as: Tools -> Browser
     -> (select class: className)
     -> (show class methods instead of instance methods)
     -> (select method: className).
   Test:
     See class: See classMethod: #class:. 
  "
  ^ self class: (class class) method: method.
! !

!See class methodsFor: 'other links' stamp: 'Edrx 1/29/2023 00:10'!
class: className method: method
  "Same as: Tools -> Browser
     -> (select class: className)
     -> (select method: className).
    Test:
      See class: foo
  "
  ^ SystemBrowser default fullOnClass: className selector: method.! !

!See class methodsFor: 'other links' stamp: 'Edrx 2/21/2023 18:48'!
cm: compiledMethod
  | class method |
  "The 'cm:' here is an abbreviation for both 'class:method:'
    and 'compiledMethod:'.
    Tests:
     See class: Browser class method: #fullOnClass:selector:.
     See cm: (Browser class >> #fullOnClass:selector:).
  "
  class := compiledMethod methodClass.
  method := compiledMethod searchForSelector.
  See class: class method: method.! !


!See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 12:05'!
item1ctsa: menu
  "Return the contents, the target, the selector, and the
   arguments of the item 1 of a MenuMorph object. To use
   this, create a menu with just one item with halo/duplicate,
   then on that new menu do halo/debug -> explore morph,
   and in its lower window run this:
    See item1ctsa: self.
  "
  | item |
  item := See item1of: menu.
  ^ { item contents .
        item target .
        item selector .
        item arguments }.! !

!See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 00:07'!
item1of: menu
  "Return the item 1 of a MenuMorph object.
   This method is very hard to explain!!!!!!
   See the comments here:
    See class: See classMethod: #item1tsa:
  "
  ^ menu submorphs at: 1.! !

!See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 00:09'!
item1tsa: menu
  "Return the target, the selector, and the arguments
   of the item 1 of a MenuMorph object. To use this,
   create a menu with just one item with halo/duplicate,
   then on that new menu do halo/debug -> explore morph,
   and in its lower window run this:
    See item1tsa: self.
  "
  | item |
  item := See item1of: menu.
  ^ { item target . item selector . item arguments }.! !

!See class methodsFor: 'menu items - inspect' stamp: 'Edrx 1/29/2023 12:07'!
show: menu
  Transcript show: (See item1ctsa: menu); cr.! !


!See class methodsFor: 'emacs' stamp: 'Edrx 1/29/2023 00:08'!
emacsClientEval: string
  | cmd |
  "Run `emacsclient --eval string'.
    Run `M-x find-emacsclient-links' in Emacs
    to make sure that the emacsserver is running."
  cmd := 'emacsclient --eval ''' , string , ''''.
  ^ OSProcess waitForCommand: cmd.! !

!See class methodsFor: 'emacs' stamp: 'Edrx 1/29/2023 00:11'!
findSqueakByEx: page
  "Open the book Squeak by Example on a certain page
    using emacsclient. Run `M-x find-emacsclient-links' in Emacs
    to make sure that the emacsserver is running.
    Test:
      See findSqueakByEx: (16 + 30).
    This will do roughly the same as this sexp:
      (find-squeakbyexpage (+ 16 30))
   "
  ^ self emacsClientEval: '(find-squeakbyexpage ' , page , ')'.! !


!See class methodsFor: 'accessing' stamp: 'Edrx 2/19/2023 13:19'!
at: key
  ^ Store at: key.
! !

!See class methodsFor: 'accessing' stamp: 'Edrx 2/19/2023 13:19'!
at: key put: value
  ^ Store at: key put: value.

! !

!See class methodsFor: 'accessing' stamp: 'Edrx 2/19/2023 13:16'!
store
  ^ Store.
! !

!See class methodsFor: 'accessing' stamp: 'Edrx 2/19/2023 13:18'!
store: s
  Store := s.
! !


!See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 15:54'!
keyboardFocus
  ^ self currentHand keyboardFocus.
! !

!See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 15:53'!
keyboardFocus: aMorphOrNil
  self currentHand newKeyboardFocus: aMorphOrNil.
! !

!See class methodsFor: 'morphic' stamp: 'Edrx 2/22/2023 02:54'!
run: aBlock after: ms
| aButton |
aButton := SimpleButtonMorph new.
aButton openInWorld;
        hide;
        target: aBlock;
        actionSelector: #value;
        addAlarm: #doButtonAction after: ms.
! !

!See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 16:34'!
sendEvent: evt to: morph
  evt resetHandlerFields.
  morph handleEvent: evt.
! !

!See class methodsFor: 'morphic' stamp: 'Edrx 2/24/2023 16:40'!
sendEventDebug: evt to: morph
  evt resetHandlerFields.
  self halt.
  morph handleEvent: evt.
! !