source: trunk/SRC/Utilities/routine_name.pro @ 386

;+
;
; @file_comments
; Give us the name of the routine (procedure or function) where we are.
;
; @categories
; Utilities
;
; @param PILINGNUM {in}{optional}
; A whole number which give us how many level we have to reascend
; in the piling up of routines and subroutines to find the looked for routine.
;
; @returns
; a string giving either the full name of the routine (with the path) or
; '$MAIN$'
;
; @restrictions
; This function use the keyword OUTPUT in <proidl>HELP</proidl> and 
; it is specified
; in the on-line help that the return syntax of this word can change in
; function of the version of the code. This version works with IDL 5.2.
;
; @examples
;
;   IDL> print, routine_name()
;  /usr1/com/smasson/IDL_RD/UTILITAIRE/report.pro
;   IDL> print, routine_name(1)
;  /usr1/com/smasson/IDL_RD/PLOTS/DIVERS/determineminmax.pro
;   IDL> print, routine_name(2)
;  /usr1/com/smasson/IDL_RD/PLOTS/DESSINE/plt.pro
;   IDL> print, routine_name(3)
;  $MAIN$
;   IDL> print, routine_name(4)
;  $MAIN$
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                      21/10/1999
;
; @version
; $Id$
;
;-
FUNCTION routine_name,  pilingnum
;
  compile_opt idl2, strictarrsubs
;
  help,  /traceback, output = name

  IF !d.name EQ 'WIN' THEN BEGIN
    name[0] = '% ' + name[0]
    FOR i = 1, n_elements(name)-1 DO BEGIN
      IF strmid(name[i], 0, 1) EQ ' ' THEN name[i] = '%' + name[i]
    ENDFOR
  ENDIF

  name = strtrim(name, 1)       ; we remove blanks at the beginning of lines and
;                               we put elements of the vector stuck ones with
;                               each others to make an unique string.
  allnames = ''
  for i = 0, n_elements(name)-1 do allnames = allnames+name[i]
;
  name = str_sep(allnames, '%') ; we cut it out again.
  name = strtrim(name, 2)     ; we remove blanks in front of and behind
  name = strcompress(name)      ; we compress blanks
; we do not hold back the two first elements who are a blanck  and the line concerning
; routine_name.
  name = name[2: n_elements(name)-1]
; we choose the line which concern us.
  if NOT keyword_set(pilingnum) then pilingnum = 0
  if pilingnum GE n_elements(name) then return,  '$MAIN$'
  name = name[pilingnum]
  if strpos(name, '$MAIN$') NE -1 then return,  '$MAIN$'
  name = str_sep(name, ' ')
  if n_elements(name) LT 3  then name = name[0] ELSE name = 'L.'+name[1]+' '+name[2]
;
  return, name
end