Return to clman.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi

Annotation of 43BSDReno/contrib/emacs-18.55/dist-1.3/fi/clman.el, revision 1.1

1.1     ! root        1: ;;
        !             2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca.
        !             3: ;;
        !             4: ;; The software, data and information contained herein are the property 
        !             5: ;; of Franz, Inc.  
        !             6: ;;
        !             7: ;; This file (or any derivation of it) may be distributed without 
        !             8: ;; further permission from Franz Inc. as long as:
        !             9: ;;
        !            10: ;;     * it is not part of a product for sale,
        !            11: ;;     * no charge is made for the distribution, other than a tape
        !            12: ;;       fee, and
        !            13: ;;     * all copyright notices and this notice are preserved.
        !            14: ;;
        !            15: ;; If you have any comments or questions on this interface, please feel
        !            16: ;; free to contact Franz Inc. at
        !            17: ;;     Franz Inc.
        !            18: ;;     Attn: Kevin Layer
        !            19: ;;     1995 University Ave
        !            20: ;;     Suite 275
        !            21: ;;     Berkeley, CA 94704
        !            22: ;;     (415) 548-3600
        !            23: ;; or
        !            24: ;;     emacs-info%[email protected]
        !            25: ;;     ucbvax!franz!emacs-info
        !            26: 
        !            27: ;; $Header: clman.el,v 1.4 89/02/15 23:19:01 layer Exp $
        !            28: 
        !            29: (defconst clman:doc-directory
        !            30:   (let ((p load-path)
        !            31:        (string "fi/manual/")
        !            32:        (done nil) res)
        !            33:     (while (and (not done) p)
        !            34:       (if (file-exists-p (setq res (concat (car p) "/" string)))
        !            35:          (setq done t)
        !            36:        (setq res nil))
        !            37:       (setq p (cdr p)))
        !            38:     res))
        !            39: 
        !            40: (defconst clman:package-info
        !            41:   (list 
        !            42:    (list "xcw-pilot"
        !            43:         (concat clman:doc-directory "winman/pages/x-specific/new-pilot/"))
        !            44:    (list "xcw" (concat clman:doc-directory "winman/pages/x-specific/"))
        !            45:    (list "cw" (concat clman:doc-directory "winman/pages/"))
        !            46:    (list "math" (concat clman:doc-directory "mathpack/pages/"))
        !            47:    (list "lisp" (concat clman:doc-directory "refman/pages/"))))
        !            48: 
        !            49: (if (not (boundp 'clman::oblist)) (load "fi/clman-oblist.el"))
        !            50: 
        !            51: (defvar clman:mode-map nil)
        !            52: 
        !            53: (defvar clman:displaying-function 'clman:find-file
        !            54:   "This function will be funcalled with two arguments, the .doc file to be
        !            55: displayed, and the buffer which is the value of clman:displaying-buffer.
        !            56: If you wish, you can set this variable to your own displaying function.")
        !            57: 
        !            58: (defvar clman:displaying-buffer "*CLMan*"
        !            59:   "Either nil or a string naming the buffer that the system will use for
        !            60: displaying documentation pages.  If nil, then the system will not try to
        !            61: reuse the same buffer.")
        !            62: 
        !            63: (defvar clman::window-configuration nil)
        !            64: 
        !            65: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !            66: ;;;; Interactive Functions
        !            67: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !            68: 
        !            69: (defun fi:clman (&optional symbol)
        !            70:   (interactive)
        !            71:   (setq clman::window-configuration (current-window-configuration))
        !            72:   (let* ((temp-info clman:package-info)(package nil)
        !            73:          (doc-page nil)(syn nil)
        !            74:          (done nil))
        !            75:     (setq sym (or symbol (clman::get-sym-to-lookup)))
        !            76:     (while (not done) 
        !            77:       (setq package (car temp-info))
        !            78:       (if (not package)
        !            79:           (progn (setq done t)
        !            80:                  (message "Couldn't find the doc page for %s " sym))
        !            81:        (progn
        !            82:          (setq doc-page
        !            83:            (concat (car (cdr package))
        !            84:                    (clman::file-nameify sym))))
        !            85:        (if (file-exists-p doc-page)
        !            86:            (progn
        !            87:              (setq done t)
        !            88:              (clman::display-file doc-page clman:displaying-buffer))
        !            89:          (setq temp-info (cdr temp-info)))))))
        !            90: 
        !            91: (defun fi:clman-apropos ()
        !            92:   (interactive)
        !            93:   (let* ((oblist-buffer-name "*clman-oblist*")
        !            94:         (oblist-buffer (get-buffer-create oblist-buffer-name))
        !            95:         (string (read-string "clman apropos: ")))
        !            96:     (set-buffer oblist-buffer)
        !            97:     (let ((done nil) (lis clman::oblist))
        !            98:       (while (not done)
        !            99:         (insert-string (car (car lis)))
        !           100:         (newline 1)
        !           101:         (setq lis (cdr lis))
        !           102:         (if (null lis) (setq done t))))
        !           103:     (beginning-of-buffer)
        !           104:     (with-output-to-temp-buffer "*clman-apropos*"
        !           105:       (while (re-search-forward string nil t)
        !           106:        (beginning-of-line)
        !           107:        (princ (buffer-substring (point) (progn (end-of-line) (point))))
        !           108:        (terpri)
        !           109:        (forward-line 1)))
        !           110:     (fi:clman-mode)
        !           111: 
        !           112:     ;;why was the following here?
        !           113:     ;;(beginning-of-buffer)
        !           114:     ;;(replace-string "\"" "")
        !           115:     ;;(beginning-of-buffer)
        !           116:     ;;(replace-string "(" "")
        !           117:     ;;(beginning-of-buffer)
        !           118:     ;;(replace-string ")" "")
        !           119:     ;;(beginning-of-buffer)
        !           120:     ;;(while (search-forward "if assoc" nil t)
        !           121:     ;;  (beginning-of-line)
        !           122:     ;;  (kill-line 1))
        !           123:     ;;(beginning-of-buffer)
        !           124:     ))
        !           125: 
        !           126: (defun fi:clman-mode ()
        !           127:   "Major mode for getting around
        !           128: Like Text Mode but with these additional comands:\n\\{clman:mode-map}\n"
        !           129:   (interactive)
        !           130:   (set-syntax-table text-mode-syntax-table)
        !           131:   (use-local-map clman:mode-map)
        !           132:   (setq local-abbrev-table text-mode-abbrev-table)
        !           133:   (setq major-mode 'fi:clman-mode)
        !           134:   (setq mode-name "CLMAN")
        !           135:   (run-hooks 'text-mode-hook))
        !           136: 
        !           137: (defun clman:search-forward-see-alsos ()
        !           138:   (interactive)
        !           139:   (if (search-forward "SEE ALSO" nil t)
        !           140:       (beginning-of-line)
        !           141:     (if (search-backward "SEE ALSO" nil t)
        !           142:        (beginning-of-line))))
        !           143: 
        !           144: (defun clman:flush-doc ()
        !           145:   (interactive)
        !           146:   (kill-buffer (current-buffer))
        !           147:   (set-window-configuration clman::window-configuration))
        !           148: 
        !           149: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !           150: ;;;; Internal stuff
        !           151: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        !           152: 
        !           153: (defun clman::get-sym-to-lookup ()
        !           154:   (interactive)                   
        !           155:   (let* ((str nil)(sym nil)(ans nil))
        !           156:     ;; make sure we have a symbol table
        !           157:     ;; get a symbol to look up, if the user did not provide one
        !           158:     (setq str (clman::backward-copy-sexp-as-kill))
        !           159:     (setq sym (if (or (string= str "")
        !           160:                      (string= (substring str 0 1) "(")
        !           161:                      (string= (substring str 0 1) "."))
        !           162:                  nil (read-from-string str)))
        !           163:     (if (listp (car sym))(setq str nil))
        !           164:           
        !           165:     (setq ans (completing-read  
        !           166:               (concat "Symbol (" str "): ") clman::oblist))
        !           167:     (if (string=  ans "")(setq ans str))
        !           168:     (setq ans (clman::strip-leading-package-name ans))
        !           169:     ans))
        !           170: 
        !           171: (defun clman::strip-leading-package-name (str)
        !           172:   (interactive)
        !           173:   (let ((pos (string-match ":" str)))
        !           174:     (if (and pos (not (= pos 0)))
        !           175:        (substring str (+ 1 pos) (length str))
        !           176:       str)))
        !           177: 
        !           178: (defun clman::retrieve-doc-page (str table doc-dir)
        !           179:   "Retrieve the documentation page for the string argument, which is 
        !           180: the name of a symbol that we want to look up. If the symbol is 
        !           181: not found, you will be prompted for an alternate package. If you just
        !           182: hit return, this function returns nil."
        !           183:   (let ((name
        !           184:         (clman::man-page-lookup str table doc-dir)))
        !           185:     ;; name is the full pathname of the doc page we want
        !           186:     (bury-buffer)
        !           187:     (if name name nil)))
        !           188:                       
        !           189: (defun clman::display-file (name buf)
        !           190:   "Display name, which is an clman .doc file according to a displaying style.
        !           191: The displaying style is the value of the global var clman:displaying-function.
        !           192: The two built in displaying functions are 'clman:view-file, which uses 'view,
        !           193: and clman:find-file, which inserts the .doc file into the buffer named
        !           194: by the value of the variable clman:displaying-buffer"
        !           195:   ;; If buf is non-nil then we want to reuse the displaying buffer,
        !           196:   ;; so have to erase it first
        !           197:   (if buf
        !           198:       (if (get-buffer buf)
        !           199:          (save-excursion 
        !           200:            (switch-to-buffer buf)
        !           201:            (erase-buffer))))
        !           202:   (funcall clman:displaying-function name buf)
        !           203:   (fi:clman-mode))
        !           204: 
        !           205: (defun clman:view-file (name buf)
        !           206:   "A built-in function that you may use for the value of
        !           207: clman:displaying-function.  This function uses the function 'view-file."
        !           208:   (view-file name))
        !           209: 
        !           210: (defun clman:find-file (name buf)
        !           211:   "A built-in function that you may use for the value of
        !           212: clman:displaying-function.  This function uses the function 'insert-file to
        !           213: insert the file that is named by the first argument into the buffer named
        !           214: by the second argument."
        !           215:   (if (not (string=  buf (buffer-name(current-buffer))))
        !           216:       (switch-to-buffer-other-window buf))
        !           217:   (insert-file name))
        !           218: 
        !           219: (defun clman::man-page-lookup (str table doc-dir)
        !           220:   "Lookup  a string in the filename/symbol table.  The system used the
        !           221: buffer which is named by the third element in clman-current-package-info.
        !           222: Return the full pathname of the file the symbol is in. "
        !           223:   (interactive)
        !           224:   (switch-to-buffer table)
        !           225:   (let ((buf (current-buffer))
        !           226:        (new-str (concat " " str " "))
        !           227:        (success nil))
        !           228:     (beginning-of-buffer)
        !           229:     (setq success (search-forward new-str (point-max) t))
        !           230:     (if (not success) 
        !           231:        nil
        !           232:       (beginning-of-line)
        !           233:       (setq begin (point))
        !           234:       (search-forward " ")
        !           235:       (backward-char)
        !           236:       (concat doc-dir "/" (buffer-substring begin (point))))))
        !           237: 
        !           238: (defun clman::backward-copy-sexp-as-kill ()
        !           239:   "Low level function."
        !           240:   (backward-sexp)
        !           241:   (let* ((begin (point)) end sym)
        !           242:     (forward-sexp)
        !           243:     (clman::remove-chars-from-string '(?\ ?\n)
        !           244:                                    (buffer-substring begin (point)))))
        !           245: 
        !           246: (defun clman::escape-funny-chars (sym)
        !           247:   ;; the shell requires that certain chars be preceded by \
        !           248:   ;; and that entire command be surrounded by '  '
        !           249:   (let ((temp sym)
        !           250:        (star "*")
        !           251:         (circumflex "^")
        !           252:         (dollar "$")
        !           253:        (result "")
        !           254:         (leftbrack "\[")
        !           255:         (rightbrack "\]")
        !           256:         (quote "'")
        !           257:         (backquote "`")
        !           258:         (counter 1))
        !           259:     (while (not (string= temp ""))
        !           260:       (setq ch (substring temp 0 1))
        !           261:       (if (or (string= ch star)
        !           262:               (string= ch circumflex)
        !           263:               (string= ch dollar)
        !           264:               (string= ch leftbrack)
        !           265:               (string= ch rightbrack)
        !           266:               (string= ch quote)
        !           267:               (string= ch backquote))
        !           268:          (setq result (concat result "\\" ch))
        !           269:        (setq result (concat result ch)))
        !           270:       (setq temp (substring temp 1)))
        !           271:     (setq result (concat "\"" result "\""))))
        !           272: 
        !           273: (defun clman::sub-chars-in-string (char-assoc-list string)
        !           274:   "Substitute character pairs of CHAR-ASSOC-LIST in STRING."
        !           275:   (let (pair)
        !           276:     (mapconcat '(lambda (char)
        !           277:                 (if (setq pair (assq char char-assoc-list))
        !           278:                     (char-to-string (cdr pair))
        !           279:                   (char-to-string char)))
        !           280:               string
        !           281:               nil)))
        !           282: 
        !           283: (defun clman::remove-chars-from-string (char-list string)
        !           284:   "Remove characters in CHAR-LIST from string STRING and return the result."
        !           285:   (mapconcat '(lambda (char)
        !           286:               (if (memq char char-list)
        !           287:                   nil
        !           288:                 (char-to-string char)))
        !           289:             string
        !           290:             nil))
        !           291: 
        !           292: (defun clman::file-nameify (str)
        !           293:   (let ((result
        !           294:          (clman::sub-chars-in-string '((?* . ?S)(?~ . ?T)
        !           295:                                      (?< . ?L)(?> . ?G)
        !           296:                                      (?/ . ?D)(?& . ?A) (?: . ?C)
        !           297:                                      (?= . ?E)(?\\ . ?B)
        !           298:                                      (?$ . ?d)(?% . ?p)
        !           299:                                      (?\? . ?Q) (?\( . ?o)
        !           300:                                      (?\) . ?c)(?| . ?V)
        !           301:                                      (?^ . ?K)(?\[ . ?b)
        !           302:                                      (?\' . ?q)(?\" . ?Z)
        !           303:                                      (?\# . ?h)(?\` . ?b)
        !           304:                                      (?\; . ?s)(?- . ?H)
        !           305:                                      (?, . ?k)(?+ . ?a)(?\. . ?e)(?\  . ?B)
        !           306:                                      )
        !           307:                                    str)))
        !           308:     ;;   (setq result (clman::remove-chars-from-string 
        !           309:     ;;                  '(?\  ) result))
        !           310:     (concat result ".doc")))
        !           311: 
        !           312: (if clman:mode-map
        !           313:     nil
        !           314:   (setq clman:mode-map (make-sparse-keymap))
        !           315:   (define-key clman:mode-map "\C-C\C-C" 'clman:flush-doc)
        !           316:   (define-key clman:mode-map "a" 'fi:clman-apropos)
        !           317:   (define-key clman:mode-map "m" 'fi:clman)
        !           318:   (define-key clman:mode-map "s" 'clman:search-forward-see-alsos))

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.