Function: idlwave-insert-source-location

idlwave-insert-source-location is a byte-compiled function defined in idlwave.el.gz.

Signature

(idlwave-insert-source-location PREFIX ENTRY &optional FILE-PROPS)

Documentation

Insert a source location into the routine info buffer.

Start line with PREFIX. If a file name is inserted, add FILE-PROPS to it.

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/idlwave.el.gz
(defun idlwave-insert-source-location (prefix entry &optional file-props)
  "Insert a source location into the routine info buffer.
Start line with PREFIX.  If a file name is inserted, add FILE-PROPS
to it."
  (let* ((key (car entry))
	 (file (nth 1 entry))
	 (types (nth 2 entry))
	 (shell-flag (assq 'compiled types))
	 (buffer-flag (assq 'buffer types))
	 (user-flag (assq 'user types))
	 (lib-flag (assq 'lib types))
	 (ndupl (or (and buffer-flag (idlwave-count-memq 'buffer types))
		    (and user-flag (idlwave-count-memq 'user types))
		    (and lib-flag (idlwave-count-memq 'lib types))
		    1))
	 (doflags t)
	 beg special)

    (insert prefix)

    (cond
     ((eq key 'system)
      (setq doflags nil)
      (insert "System    "))

     ((eq key 'builtin)
      (setq doflags nil)
      (insert "Builtin   "))

     ((and (not file) shell-flag)
      (insert "Unresolved"))

     ((null file)
      (insert "ERROR"))

     ((idlwave-syslib-p file)
      (if (string-match "obsolete" (file-name-directory file))
	  (insert "Obsolete  ")
	(insert "SystemLib ")))

     ;; New special syntax: taken directly from routine-info for
     ;; library catalog routines
     ((setq special (or (cdr lib-flag) (cdr user-flag)))
      (insert (format "%-10s" special)))

     ;; Old special syntax: a matching regexp
     ((setq special (idlwave-special-lib-test file))
      (insert (format "%-10s" special)))

     ;; Catch-all with file
     ((idlwave-lib-p file)      (insert "Library   "))

     ;; Sanity catch all
     (t                         (insert "Other     ")))

    (when doflags
      (insert (concat
	       "  ["
	       (if lib-flag "L" "-")
	       (if user-flag "C" "-")
	       (if shell-flag "S" "-")
	       (if buffer-flag "B" "-")
	       "] ")))
    (when (> ndupl 1)
      (setq beg (point))
      (insert (format "(%dx) " ndupl))
      (add-text-properties beg (point) (list 'face 'bold)))
    (when (and file (not (equal file "")))
      (setq beg (point))
      (insert (apply #'abbreviate-file-name (list file)))
      (if file-props
	  (add-text-properties beg (point) file-props)))))