editors/scel/el/sclang-help.el

   1 ;; copyright 2003 stefan kersten <steve@k-hornz.de>
   2 ;;
   3 ;; This program is free software; you can redistribute it and/or
   4 ;; modify it under the terms of the GNU General Public License as
   5 ;; published by the Free Software Foundation; either version 2 of the
   6 ;; License, or (at your option) any later version.
   7 ;;
   8 ;; This program is distributed in the hope that it will be useful, but
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;; General Public License for more details.
  12 ;;
  13 ;; You should have received a copy of the GNU General Public License
  14 ;; along with this program; if not, write to the Free Software
  15 ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
  16 ;; USA
  17
  18 (eval-when-compile
  19   (require 'cl)
  20   (require 'font-lock))
  21
  22 ;; (require 'w3m) ;; not needed during compilation
  23 (require 'sclang-util)
  24 (require 'sclang-interp)
  25 (require 'sclang-language)
  26 (require 'sclang-mode)
  27 (require 'sclang-vars)
  28 (require 'sclang-minor-mode)
  29
  30 (defcustom sclang-help-directory "~/SuperCollider/Help"
  31   "*Directory where the SuperCollider help files are kept. OBSOLETE."
  32   :group 'sclang-interface
  33   :version "21.3"
  34   :type 'directory
  35   :options '(:must-match))
  36
  37 (defcustom sclang-help-path (list sclang-system-help-dir
  38                                   "~/.local/share/SuperCollider/Help")
  39   "*List of directories where SuperCollider help files are kept."
  40   :group 'sclang-interface
  41   :version "21.4"
  42   :type '(repeat directory))
  43
  44 (defconst sclang-extension-path (list sclang-system-extension-dir
  45                                       "~/.local/share/SuperCollider/Extensions")
  46   "List of SuperCollider extension directories.")
  47
  48 (defcustom sclang-help-fill-column fill-column
  49   "*Column beyond which automatic line-wrapping in RTF help files should happen."
  50   :group 'sclang-interface
  51   :version "21.3"
  52   :type 'integer)
  53
  54 (defcustom sclang-rtf-editor-program "ted"
  55   "*Name of an RTF editor program used to edit SuperCollider help files."
  56   :group 'sclang-programs
  57   :version "21.3"
  58   :type 'string)
  59
  60 (defcustom sclang-html-editor-program "html"
  61   "*Name of an HTML editor program used to edit SuperCollider help files."
  62   :group 'sclang-programs
  63   :version "21.3"
  64   :type 'string)
  65
  66 ;; dynamically change certain html-tags when displaying in w3m-browser:
  67
  68 (defcustom sclang-help-filters
  69   '(("p\\.p\\([0-9]+\\)" . "#p\\1")
  70     ("<p class=\"\\(.*\\)\">\\(.*\\)</p>" . "<div id=\"\\1\">\\2</div>"))
  71   "list of pairs of (regexp . filter) defining html-tags to be replaced by the function sclang-help-substitute-for-filters"
  72   :group 'sclang-interface
  73   :type '(repeat (cons (string :tag "match") (string :tag "replacement"))))
  74
  75 (defun sclang-help-substitute-for-filters (&rest args)
  76   "substitute various tags in SCs html-docs"
  77   (mapcar #'(lambda (filter)
  78               (let ((regexp (car filter))
  79                     (to-string (cdr filter)))
  80                 (goto-char (point-min))
  81                 (while (re-search-forward regexp nil t)
  82                   (replace-match to-string nil nil))))
  83           sclang-help-filters))
  84
  85 ;; w3m's content-filtering system
  86 (setq w3m-use-filter t)
  87
  88 (eval-after-load "w3m-filter"
  89   '(add-to-list 'w3m-filter-rules
  90                 ;; run on all files read by w3m...
  91                 '(".*" sclang-help-substitute-for-filters)))
  92
  93
  94 (defvar sclang-help-topic-alist nil
  95   "Alist mapping help topics to file names.")
  96
  97 (defvar sclang-help-topic-history nil
  98   "List of recently invoked help topics.")
  99 ;; (defvar sclang-help-topic-ring-length 32)
 100 ;; (defvar sclang-help-topic-ring (make-ring sclang-help-topic-ring-length))
 101
 102 (defconst sclang-special-help-topics
 103   '(("/" . "division")
 104     ("-" . "subtraction"))
 105   "Alist of help topics with transcoded filenames.")
 106
 107 (defvar sclang-help-file nil)
 108 (defvar sclang-current-help-file nil)
 109 (make-variable-buffer-local 'sclang-help-file)
 110
 111 (defconst sclang-help-file-regexp
 112   "\\(\\(\\(\\.help\\)?\\.\\(rtf\\|scd\\|html\\|htm\\)\\)\\|\\(\\.help\\.sc\\.html\\.htm\\)\\|\\.rtfd/TXT\\.rtf\\.html\\.htm\\)$"
 113   "Regular expression matching help files.")
 114
 115 ;; =====================================================================
 116 ;; utilities
 117 ;; =====================================================================
 118
 119 (defun sclang-get-help-file (topic)
 120   (let ((topic (or (cdr (assoc topic sclang-special-help-topics)) topic)))
 121     (cdr (assoc topic sclang-help-topic-alist))))
 122
 123 (defun sclang-get-help-topic (file)
 124   (let ((topic (car (rassoc file sclang-help-topic-alist))))
 125     (or (car (rassoc topic sclang-special-help-topics)) topic)))
 126
 127 (defun sclang-help-buffer-name (topic)
 128   (sclang-make-buffer-name (concat "Help:" topic)))
 129
 130 (defun sclang-rtf-file-p (file)
 131   (let ((case-fold-search t))
 132     (string-match ".*\\.rtf$" file)))
 133
 134 ;; ========= ADDITION for HTML help files
 135 (defun sclang-html-file-p (file)
 136    (let ((case-fold-search t))
 137      (string-match ".*\\.html?$" file)))
 138
 139 (defun sclang-sc-file-p (file)
 140   (let ((case-fold-search t))
 141     (string-match ".*\\.sc$" file)))
 142
 143 (defun sclang-scd-file-p (file)
 144   (let ((case-fold-search t))
 145     (string-match ".*\\.scd$" file)))
 146
 147 (defun sclang-help-file-p (file)
 148   (string-match sclang-help-file-regexp file))
 149
 150 (defun sclang-help-topic-name (file)
 151   (if (string-match sclang-help-file-regexp file)
 152       (cons (file-name-nondirectory (replace-match "" nil nil file 1))
 153             file)))
 154
 155 ;; =====================================================================
 156 ;; rtf parsing
 157 ;; =====================================================================
 158
 159 (defconst sclang-rtf-face-change-token "\0")
 160
 161 (defun sclang-fill-rtf-syntax-table (table)
 162   ;; character quote
 163   (modify-syntax-entry ?\\ "/" table)
 164   (modify-syntax-entry ?\" "." table)
 165   (modify-syntax-entry ?\{ "(" table)
 166   (modify-syntax-entry ?\} ")" table)
 167   (modify-syntax-entry ?\( "." table)
 168   (modify-syntax-entry ?\) "." table)
 169   (modify-syntax-entry ?\[ "." table)
 170   (modify-syntax-entry ?\] "." table)
 171   table)
 172
 173 (defvar sclang-rtf-syntax-table (sclang-fill-rtf-syntax-table (make-syntax-table))
 174   "Syntax table used for RTF parsing.")
 175
 176 (defvar sclang-rtf-font-map '((Helvetica . variable-pitch)
 177                               (Helvetica-Bold . variable-pitch)
 178                               (Monaco . nil)))
 179
 180 (defstruct sclang-rtf-state
 181   output font-table font face pos)
 182
 183 (macrolet ((rtf-p (pos) `(plist-get (text-properties-at ,pos) 'rtf-p)))
 184   (defun sclang-rtf-p (pos) (rtf-p pos))
 185   (defun sclang-code-p (pos) (not (rtf-p pos))))
 186
 187 (defmacro with-sclang-rtf-state-output (state &rest body)
 188   `(with-current-buffer (sclang-rtf-state-output ,state)
 189      ,@body))
 190
 191 (defmacro sclang-rtf-state-add-font (state font-id font-name)
 192   `(push (cons ,font-id (intern ,font-name)) (sclang-rtf-state-font-table ,state)))
 193
 194 (defmacro sclang-rtf-state-apply (state)
 195   (let ((pos (gensym))
 196         (font (gensym))
 197         (face (gensym)))
 198     `(with-current-buffer (sclang-rtf-state-output ,state)
 199        (let ((,pos (or (sclang-rtf-state-pos ,state) (point-min)))
 200              (,font (cdr (assq
 201                           (cdr (assoc
 202                                 (sclang-rtf-state-font ,state)
 203                                 (sclang-rtf-state-font-table ,state)))
 204                           sclang-rtf-font-map)))
 205              (,face (sclang-rtf-state-face ,state)))
 206          (when (> (point) ,pos)
 207            (if ,font
 208                (add-text-properties
 209                 ,pos (point)
 210                 (list 'rtf-p t 'rtf-face (append (list ,font) ,face))))
 211            (setf (sclang-rtf-state-pos ,state) (point)))))))
 212
 213 (defmacro sclang-rtf-state-set-font (state font)
 214   `(progn
 215      (sclang-rtf-state-apply ,state)
 216      (setf (sclang-rtf-state-font ,state) ,font)))
 217
 218 (defmacro sclang-rtf-state-push-face (state face)
 219   (let ((list (gensym)))
 220     `(let ((,list (sclang-rtf-state-face state)))
 221        (sclang-rtf-state-apply ,state)
 222        (unless (memq ,face ,list)
 223          (setf (sclang-rtf-state-face ,state)
 224                (append ,list (list ,face)))))))
 225
 226 (defmacro sclang-rtf-state-pop-face (state face)
 227   (let ((list (gensym)))
 228     `(let* ((,list (sclang-rtf-state-face ,state)))
 229        (sclang-rtf-state-apply ,state)
 230        (setf (sclang-rtf-state-face ,state) (delq ,face ,list)))))
 231
 232 (defun sclang-parse-rtf (state)
 233   (while (not (eobp))
 234     (cond ((looking-at "{")
 235            ;; container
 236            (let ((beg (point)))
 237              (with-syntax-table sclang-rtf-syntax-table
 238                (forward-list 1))
 239              (save-excursion
 240                (save-restriction
 241                  (narrow-to-region (1+ beg) (1- (point)))
 242                  (goto-char (point-min))
 243                  (sclang-parse-rtf-container state)
 244                  (widen)))))
 245           ((or (looking-at "\\\\\\([{}\\\n]\\)")
 246                (looking-at "\\\\\\([^\\ \n]+\\) ?"))
 247            ;; control
 248            (let ((end (match-end 0)))
 249              (sclang-parse-rtf-control state (match-string 1))
 250              (goto-char end)))
 251           ((looking-at "\\([^{\\\n]+\\)")
 252            ;; normal text
 253            (let ((end (match-end 0))
 254                  (match (match-string 1)))
 255              (with-sclang-rtf-state-output state (insert match))
 256              (goto-char end)))
 257           (t
 258            ;; never reached (?)
 259            (forward-char 1)))))
 260
 261 (defun sclang-parse-rtf-container (state)
 262   (cond ((looking-at "\\\\rtf1")                ; document
 263          (goto-char (match-end 0))
 264          (sclang-parse-rtf state))
 265         ((looking-at "\\\\fonttbl")             ; font table
 266          (goto-char (match-end 0))
 267          (while (looking-at "\\\\\\(f[0-9]+\\)[^ ]* \\([^;]*\\);[^\\]*")
 268            (sclang-rtf-state-add-font state (match-string 1) (match-string 2))
 269            (goto-char (match-end 0))))
 270         ((looking-at "{\\\\NeXTGraphic \\([^\\]+\\.[a-z]+\\)") ; inline graphic
 271          (let* ((file (match-string 1))
 272                 (image (and file (create-image (expand-file-name file)))))
 273            (with-sclang-rtf-state-output
 274             state
 275             (if image
 276                 (insert-image image)
 277               (sclang-rtf-state-push-face state 'italic)
 278               (insert file)
 279               (sclang-rtf-state-pop-face state 'italic)))))
 280         ))
 281
 282 (defun sclang-parse-rtf-control (state ctrl)
 283   (let ((char (aref ctrl 0)))
 284     (cond ((memq char '(?{ ?} ?\\))
 285            (with-sclang-rtf-state-output state (insert char)))
 286           ((or (eq char ?\n)
 287                (string= ctrl "par"))
 288            (sclang-rtf-state-apply state)
 289            (with-sclang-rtf-state-output
 290             state
 291             (when (sclang-rtf-p (line-beginning-position))
 292               (fill-region (line-beginning-position) (line-end-position)
 293                            t t))
 294               (insert ?\n)))
 295           ((string= ctrl "tab")
 296            (with-sclang-rtf-state-output state (insert ?\t)))
 297           ((string= ctrl "b")
 298            (sclang-rtf-state-push-face state 'bold))
 299           ((string= ctrl "b0")
 300            (sclang-rtf-state-pop-face state 'bold))
 301           ((string-match "^f[0-9]+$" ctrl)
 302            (sclang-rtf-state-set-font state ctrl))
 303           )))
 304
 305 (defun sclang-convert-rtf-buffer (output)
 306   (let ((case-fold-search nil)
 307         (fill-column sclang-help-fill-column))
 308     (save-excursion
 309       (goto-char (point-min))
 310       (when (looking-at "{\\\\rtf1")
 311         (let ((state (make-sclang-rtf-state)))
 312           (setf (sclang-rtf-state-output state) output)
 313           (sclang-parse-rtf state)
 314           (sclang-rtf-state-apply state))))))
 315
 316 ;; =====================================================================
 317 ;; help mode
 318 ;; =====================================================================
 319
 320 (defun sclang-fill-help-syntax-table (table)
 321   ;; make ?- be part of symbols for selection and sclang-symbol-at-point
 322   (modify-syntax-entry ?- "_" table))
 323
 324 (defun sclang-fill-help-mode-map (map)
 325   (define-key map "\C-c}" 'bury-buffer)
 326   (define-key map "\C-c\C-v" 'sclang-edit-help-file))
 327
 328 (defmacro sclang-help-mode-limit-point-to-code (&rest body)
 329   (let ((min (gensym))
 330         (max (gensym))
 331         (res (gensym)))
 332     `(if (and (sclang-code-p (point))
 333               (not (or (bobp) (eobp)))
 334               (sclang-code-p (1- (point)))
 335               (sclang-code-p (1+ (point))))
 336          (let ((,min (previous-single-property-change (point) 'rtf-p (current-buffer) (point-min)))
 337                (,max (next-single-property-change (point) 'rtf-p (current-buffer) (point-max))))
 338            (let ((,res (progn ,@body)))
 339              (cond ((< (point) ,min) (goto-char ,min) nil)
 340                    ((> (point) ,max) (goto-char ,max) nil)
 341                    (t ,res)))))))
 342
 343 (defun sclang-help-mode-beginning-of-defun (&optional arg)
 344   (interactive "p")
 345   (sclang-help-mode-limit-point-to-code (sclang-beginning-of-defun arg)))
 346
 347 (defun sclang-help-mode-end-of-defun (&optional arg)
 348   (interactive "p")
 349   (sclang-help-mode-limit-point-to-code (sclang-end-of-defun arg)))
 350
 351 (defun sclang-help-mode-fontify-region (start end loudly)
 352   (flet ((fontify-code
 353           (start end loudly)
 354           (funcall 'font-lock-default-fontify-region start end loudly))
 355          (fontify-non-code
 356           (start end loudly)
 357           (while (< start end)
 358             (let ((value (plist-get (text-properties-at start) 'rtf-face))
 359                   (end (next-single-property-change start 'rtf-face (current-buffer) end)))
 360                 (add-text-properties start end (list 'face (append '(variable-pitch) (list value))))
 361                 (setq start end)))))
 362     (let ((modified (buffer-modified-p)) (buffer-undo-list t)
 363           (inhibit-read-only t) (inhibit-point-motion-hooks t)
 364           (inhibit-modification-hooks t)
 365           deactivate-mark buffer-file-name buffer-file-truename
 366           (pos start))
 367       (unwind-protect
 368           (while (< pos end)
 369             (let ((end (next-single-property-change pos 'rtf-p (current-buffer) end)))
 370               (if (sclang-rtf-p pos)
 371                   (fontify-non-code pos end loudly)
 372                 (fontify-code pos end loudly))
 373               (setq pos end)))
 374         (when (and (not modified) (buffer-modified-p))
 375           (set-buffer-modified-p nil))))))
 376
 377
 378 (defun sclang-help-mode-indent-line ()
 379   (if (sclang-code-p (point))
 380       (sclang-indent-line)
 381     (insert "\t")))
 382
 383 (define-derived-mode sclang-help-mode sclang-mode "SCLangHelp"
 384   "Major mode for displaying SuperCollider help files.
 385 \\{sclang-help-mode-map}"
 386   (let ((file (or (buffer-file-name)
 387                   (and (boundp 'sclang-current-help-file)
 388                        sclang-current-help-file))))
 389     (when file
 390       (set-visited-file-name nil)
 391       (setq buffer-auto-save-file-name nil)
 392       (save-excursion
 393         (when (sclang-rtf-file-p file)
 394           (let ((tmp-buffer (generate-new-buffer " *RTF*"))
 395                 (modified-p (buffer-modified-p)))
 396             (unwind-protect
 397                 (progn
 398                   (sclang-convert-rtf-buffer tmp-buffer)
 399                   (toggle-read-only 0)
 400                   (erase-buffer)
 401                   (insert-buffer-substring tmp-buffer))
 402               (and (buffer-modified-p) (not modified-p) (set-buffer-modified-p nil))
 403               (kill-buffer tmp-buffer))))))
 404     (set (make-local-variable 'sclang-help-file) file)
 405     (setq font-lock-defaults
 406           (append font-lock-defaults
 407                   '((font-lock-fontify-region-function . sclang-help-mode-fontify-region))))
 408     (set (make-local-variable 'beginning-of-defun-function) 'sclang-help-mode-beginning-of-defun)
 409     (set (make-local-variable 'indent-line-function) 'sclang-help-mode-indent-line)
 410     ))
 411
 412 ;; =====================================================================
 413 ;; help file access
 414 ;; =====================================================================
 415
 416 (defun sclang-skip-help-directory-p (path)
 417   "Answer t if PATH should be skipped during help file indexing."
 418   (let ((directory (file-name-nondirectory path)))
 419     (reduce (lambda (a b) (or a b))
 420             (mapcar (lambda (regexp) (string-match regexp directory))
 421                     '("^\.$" "^\.\.$" "^CVS$" "^\.svn$" "^_darcs$")))))
 422
 423 (defun sclang-filter-help-directories (list)
 424   "Remove paths to be skipped from LIST of directories."
 425   (remove-if (lambda (x)
 426                (or (not (file-directory-p x))
 427                    (sclang-skip-help-directory-p x)))
 428              list))
 429
 430 (defun sclang-directory-files-save (directory &optional full match nosort)
 431   "Return a list of names of files in DIRECTORY, or nil on error."
 432   (condition-case nil
 433       (directory-files directory full match nosort)
 434     (error nil)))
 435
 436 ;; (defun sclang-extension-help-directories ()
 437 ;;   "Build a list of help directories for extensions."
 438 ;;   (flet ((flatten (seq)
 439 ;;                (if (null seq)
 440 ;;                    seq
 441 ;;                  (if (listp seq)
 442 ;;                      (reduce 'append (mapcar #'flatten seq))
 443 ;;                    (list seq)))))
 444 ;;     (flatten
 445 ;;      (mapcar
 446 ;;       (lambda (dir)
 447 ;;      (mapcar
 448 ;;       (lambda (dir)
 449 ;;         (remove-if-not
 450 ;;          'file-directory-p
 451 ;;          (sclang-directory-files-save dir t "^[Hh][Ee][Ll][Pp]$" t)))
 452 ;;       (sclang-filter-help-directories (sclang-directory-files-save dir t))))
 453 ;;       sclang-extension-path))))
 454
 455 ;; (defun sclang-help-directories ()
 456 ;;   "Answer list of help directories to be indexed."
 457 ;;   (append sclang-help-path (sclang-extension-help-directories)))
 458
 459 (defun sclang-help-directories ()
 460   "Answer list of help directories to be indexed."
 461   (append sclang-help-path sclang-extension-path))
 462
 463 (defun sclang-make-help-topic-alist (dirs result)
 464   "Build a help topic alist from directories in DIRS, with initial RESULT."
 465   (if dirs
 466       (let* ((files (sclang-directory-files-save (car dirs) t))
 467              (topics (remove-if 'null (mapcar 'sclang-help-topic-name files)))
 468              (new-dirs  (sclang-filter-help-directories files)))
 469         (sclang-make-help-topic-alist
 470          (append new-dirs (cdr dirs))
 471          (append topics result)))
 472     (sort result (lambda (a b) (string< (car a) (car b))))))
 473
 474 (defun sclang-index-help-topics ()
 475   "Build an index of help topics searching in the various help file locations."
 476   (interactive)
 477   (setq sclang-help-topic-alist nil)
 478   (let ((case-fold-search nil)
 479         (max-specpdl-size 10000)
 480         (max-lisp-eval-depth 10000))
 481     (sclang-message "Indexing help topics ...")
 482     (setq sclang-help-topic-alist
 483           (sclang-make-help-topic-alist (sclang-help-directories) nil))
 484     (sclang-message "Indexing help topics ... Done")))
 485
 486 (defun sclang-edit-html-help-file ()
 487   "Edit the help file associated with the current buffer.
 488 Switches w3m to edit mode (actually HTML mode)."
 489   (interactive)
 490   (w3m-edit-current-url)
 491   )
 492
 493 (defun sclang-edit-help-code ()
 494   "Edit the help file to make code variations.
 495 Switches to text mode with sclang-minor-mode."
 496   (interactive)
 497   (w3m-copy-buffer)
 498 ;;  (text-mode)
 499   (sclang-mode)
 500   (toggle-read-only)
 501   (rename-buffer "*SC_Help:CodeEdit*")
 502   )
 503
 504
 505 (defun sclang-edit-help-file ()
 506   "Edit the help file associated with the current buffer.
 507 Either visit file internally (.sc) or start external editor (.rtf)."
 508   (interactive)
 509   (if (and (boundp 'sclang-help-file) sclang-help-file)
 510       (let ((file sclang-help-file))
 511         (if (file-exists-p file)
 512             (if (sclang-rtf-file-p file)
 513                 (start-process (sclang-make-buffer-name (format "HelpEditor:%s" file))
 514                                nil sclang-rtf-editor-program file)
 515               (find-file file))
 516           (if (sclang-html-file-p file)
 517               (w3m-edit-current-url)
 518            ;; (find-file file)
 519            )
 520           (sclang-message "Help file not found")))
 521     (sclang-message "Buffer has no associated help file")))
 522
 523 (defun sclang-help-topic-at-point ()
 524   "Answer the help topic at point, or nil if not found."
 525   (save-excursion
 526     (with-syntax-table sclang-help-mode-syntax-table
 527       (let (beg end)
 528         (skip-syntax-backward "w_")
 529         (setq beg (point))
 530         (skip-syntax-forward "w_")
 531         (setq end (point))
 532         (goto-char beg)
 533         (car (assoc (buffer-substring-no-properties beg end)
 534                     sclang-help-topic-alist))))))
 535
 536 (defun sclang-goto-help-browser ()
 537   "Switch to the *w3m* buffer to browse help files"
 538   (interactive)
 539   (let* ((buffer-name "*w3m*")
 540          (buffer (get-buffer buffer-name)))
 541     (if buffer
 542       (switch-to-buffer buffer)
 543       ;; else
 544       (let* ((buffer-name "*SC_Help:w3m*")
 545              (buffer2 (get-buffer buffer-name)))
 546         (if buffer2
 547             (switch-to-buffer buffer2)
 548           ;; else
 549           (sclang-find-help "Help")
 550           )
 551         )
 552       )
 553     (if buffer
 554         (with-current-buffer buffer
 555           (rename-buffer "*SC_Help:w3m*")
 556           (sclang-help-minor-mode)
 557           ;;(setq buffer-read-only false)
 558           )
 559       )
 560 ;    (if buffer
 561 ;
 562 ;      )
 563     )
 564   )
 565
 566 (defun sclang-find-help (topic)
 567   (interactive
 568    (list
 569     (let ((topic (or (and mark-active (buffer-substring-no-properties (region-beginning) (region-end)))
 570                      (sclang-help-topic-at-point)
 571                      "Help")))
 572       (completing-read (format "Help topic%s: " (if (sclang-get-help-file topic)
 573                                                     (format " (default %s)" topic) ""))
 574                        sclang-help-topic-alist nil t nil 'sclang-help-topic-history topic))))
 575   (let ((file (sclang-get-help-file topic)))
 576     (if file
 577         (if (file-exists-p file)
 578             (let* ((buffer-name (sclang-help-buffer-name topic))
 579                    (buffer (get-buffer buffer-name)))
 580               (unless buffer
 581                 (if (sclang-html-file-p file)
 582                     (w3m-find-file file)
 583                   ;;  (sclang-goto-help-browser)
 584                   ;; not a sclang-html file
 585                   (setq buffer (get-buffer-create buffer-name))
 586                   (with-current-buffer buffer
 587                     (insert-file-contents file)
 588                     (let ((sclang-current-help-file file)
 589                           (default-directory (file-name-directory file)))
 590                       (sclang-help-mode))
 591                     (set-buffer-modified-p nil)))
 592                 (switch-to-buffer buffer))
 593               (if (sclang-html-file-p file)
 594                   (sclang-goto-help-browser))
 595               )
 596           (sclang-message "Help file not found") nil)
 597       (sclang-message "No help for \"%s\"" topic) nil)))
 598
 599
 600 (defun sclang-open-help-gui ()
 601   "Open SCDoc Help Browser"
 602   (interactive)
 603   (sclang-eval-string (sclang-format "Help.gui"))
 604   )
 605
 606 (defvar sclang-scdoc-topics (make-hash-table :size 16385)
 607   "List of all scdoc topics.")
 608
 609 (sclang-set-command-handler
 610  'helpSymbols
 611  (lambda (list-of-symbols)
 612    (mapcar (lambda (arg)
 613              (puthash arg nil sclang-scdoc-topics))
 614            list-of-symbols)
 615    ))
 616
 617 (defun sclang-find-help-in-gui (topic)
 618   "Search for topic in SCDoc Help Browser"
 619   (interactive
 620    (list
 621     (let ((topic (sclang-symbol-at-point)))
 622       (completing-read (format "Help topic%s: " (if topic
 623                                                     (format " (default %s)" topic)
 624                                                   ""))
 625                        sclang-scdoc-topics nil nil nil 'sclang-help-topic-history topic)))
 626    )
 627   (if topic
 628       (sclang-eval-string (sclang-format "HelpBrowser.openHelpFor(%o)" topic))
 629     (sclang-eval-string (sclang-format "Help.gui"))
 630     )
 631   )
 632
 633
 634 ;; =====================================================================
 635 ;; module setup
 636 ;; =====================================================================
 637
 638 (add-hook 'sclang-library-startup-hook
 639           (lambda ()
 640             (sclang-perform-command 'helpSymbols)
 641             (condition-case nil
 642                 (sclang-index-help-topics)
 643               (error nil))))
 644
 645 (add-hook 'sclang-library-shutdown-hook
 646           (lambda ()
 647             (clrhash sclang-scdoc-topics)))
 648
 649 (add-to-list 'auto-mode-alist '("\\.rtf$" . sclang-help-mode))
 650 ;; ========= ADDITION for HTML help files?? ============
 651 ;; (add-to-list 'auto-mode-alist '("\\.html$" . sclang-help-mode))
 652 ;; (setq mm-text-html-renderer 'w3m)
 653 ;;  (setq mm-inline-text-html-with-images t)
 654 ;;  (setq mm-inline-text-html-with-w3m-keymap nil)
 655 ;; =====================================================
 656 (sclang-fill-help-syntax-table sclang-help-mode-syntax-table)
 657 (sclang-fill-help-mode-map sclang-help-mode-map)
 658
 659 (provide 'sclang-help)
 660
 661 ;; EOF