-;;; ebrowse.el --- Emacs C++ class browser & tags facility
+;;; ebrowse.el --- Emacs C++ class browser & tags facility -*- lexical-binding:t -*-
;; Copyright (C) 1992-2019 Free Software Foundation, Inc.
found))
-(defmacro ebrowse-output (&rest body)
- "Eval BODY with a writable current buffer.
-Preserve buffer's modified state."
- (declare (indent 0) (debug t))
- (let ((modified (make-symbol "--ebrowse-output--")))
- `(let (buffer-read-only (,modified (buffer-modified-p)))
- (unwind-protect
- (progn ,@body)
- (set-buffer-modified-p ,modified)))))
-
-
(defmacro ebrowse-ignoring-completion-case (&rest body)
"Eval BODY with `completion-ignore-case' bound to t."
(declare (indent 0) (debug t))
`(let ((completion-ignore-case t))
,@body))
-(defmacro ebrowse-save-selective (&rest body)
- "Eval BODY with `selective-display' restored at the end."
- (declare (indent 0) (debug t))
- ;; FIXME: Don't use selective-display.
- `(let ((selective-display selective-display))
- ,@body))
-
(defmacro ebrowse-for-all-trees (spec &rest body)
"For all trees in SPEC, eval BODY."
(declare (indent 1) (debug ((sexp form) body)))
(defun ebrowse-trim-string (string)
"Return a copy of STRING with leading white space removed.
Replace sequences of newlines with a single space."
- (when (string-match "^[ \t\n\r]+" string)
+ (when (string-match "^[ \t\n]+" string)
(setq string (substring string (match-end 0))))
(cl-loop while (string-match "[\n]+" string)
finally return string do
"Return a list containing all files mentioned in a tree.
MARKED-ONLY non-nil means include marked classes only."
(let (list)
- (maphash (lambda (file _dummy) (setq list (cons file list)))
+ (maphash (lambda (file _dummy) (push file list))
(ebrowse-files-table marked-only))
list))
;; Read Lisp objects. Temporarily increase `gc-cons-threshold' to
;; prevent a GC that would not free any memory.
(let ((gc-cons-threshold 2000000))
- (while (not (progn (skip-chars-forward " \t\n\r") (eobp)))
+ (while (not (progn (skip-chars-forward " \t\n") (eobp)))
(let* ((root (read (current-buffer)))
(old-root-ptr (ebrowse-class-in-tree root tree)))
(ebrowse-show-progress "Reading data" (null tree))
(ebrowse-qualified-class-name
(ebrowse-ts-class (car subclass)))
classes)
- as next = nil
do
;; Replace the subclass tree with the one found in
;; CLASSES if there is already an entry for that class
(set (make-local-variable 'ebrowse--frozen-flag) nil)
(setq mode-line-buffer-identification ident)
(setq buffer-read-only t)
- (setq selective-display t)
- (setq selective-display-ellipses t)
+ (add-to-invisibility-spec '(ebrowse . t))
(set (make-local-variable 'revert-buffer-function)
#'ebrowse-revert-tree-buffer-from-file)
(set (make-local-variable 'ebrowse--header) header)
(and tree (ebrowse-build-tree-obarray tree)))
(set (make-local-variable 'ebrowse--frozen-flag) nil)
- (add-hook 'write-file-functions 'ebrowse-write-file-hook-fn nil t)
+ (add-hook 'write-file-functions #'ebrowse-write-file-hook-fn nil t)
(modify-syntax-entry ?_ (char-to-string (char-syntax ?a)))
(when tree
(ebrowse-redraw-tree)
;; by a regexp replace over the whole buffer. The reason for this
;; is that classes might have multiple base classes. If this is
;; the case, they are displayed more than once in the tree.
- (ebrowse-output
+ (with-silent-modifications
(cl-loop
for tree in to-change
as regexp = (concat "^.*\\b"
"Display class marker signs in the tree between START and END."
(interactive)
(save-excursion
- (ebrowse-output
+ (with-silent-modifications
(catch 'end
(goto-char (point-min))
(dolist (root ebrowse--tree)
With PREFIX, insert that many filenames."
(interactive "p")
(unless ebrowse--show-file-names-flag
- (ebrowse-output
- (dotimes (i prefix)
+ (with-silent-modifications
+ (dotimes (_ prefix)
(let ((tree (ebrowse-tree-at-point))
start
file-name-existing)
\f
+;;; Functions to hide/unhide text
+
+(defun ebrowse--hidden-p (&optional pos)
+ (eq (get-char-property (or pos (point)) 'invisible) 'ebrowse))
+
+(defun ebrowse--hide (start end)
+ (put-text-property start end 'invisible 'ebrowse))
+
+(defun ebrowse--unhide (start end)
+ ;; FIXME: This also removes other invisible properties!
+ (remove-text-properties start end '(invisible)))
+
;;; Misc tree buffer commands
(defun ebrowse-set-tree-indentation ()
(setf class
(completing-read "Goto class: "
(ebrowse-tree-obarray-as-alist) nil t)))
- (ebrowse-save-selective
- (goto-char (point-min))
- (widen)
- (setf selective-display nil)
- (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
- (if (re-search-forward ebrowse--last-regexp nil t)
- (progn
- (goto-char (match-beginning 0))
- (ebrowse-unhide-base-classes))
- (error "Not found")))))
+ (goto-char (point-min))
+ (widen)
+ (setq ebrowse--last-regexp (concat "\\b" class "\\b"))
+ (if (re-search-forward ebrowse--last-regexp nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (ebrowse-unhide-base-classes))
+ (error "Not found"))))
\f
(setq original-frame-configuration ebrowse--frame-configuration
exit-action ebrowse--view-exit-action))
;; Delete the frame in which we viewed.
- (mapc 'delete-frame
+ (mapc #'delete-frame
(cl-loop for frame in (frame-list)
when (not (assq frame original-frame-configuration))
collect frame))
(cond (view
(setf ebrowse-temp-position-to-view struc
ebrowse-temp-info-to-view info)
- (unless (boundp 'view-mode-hook)
- (setq view-mode-hook nil))
- (push 'ebrowse-find-pattern view-mode-hook)
+ (add-hook 'view-mode-hook #'ebrowse-find-pattern)
(pcase where
('other-window (view-file-other-window file))
('other-frame (ebrowse-view-file-other-frame file))
INFO is a list (TREE-HEADER TREE-OR-MEMBER MEMBER-LIST)."
(unless position
- (pop view-mode-hook)
+ (remove-hook 'view-mode-hook #'ebrowse-find-pattern)
(setf viewing t
position ebrowse-temp-position-to-view
info ebrowse-temp-info-to-view))
(start (ebrowse-bs-point position))
(offset 100)
found)
- (pcase-let ((`(,header ,class-or-member ,member-list) info))
+ (pcase-let ((`(,_header ,class-or-member ,member-list) info))
;; If no pattern is specified, construct one from the member name.
(when (stringp pattern)
(setq pattern (concat "^.*" (regexp-quote pattern))))
(interactive)
(or quietly (message "Displaying..."))
(save-excursion
- (ebrowse-output
+ (with-silent-modifications
(erase-buffer)
(ebrowse-draw-tree-fn)))
(ebrowse-update-tree-buffer-mode-line)
(nconc (copy-sequence (ebrowse-ts-subclasses tree)) stack2)
stack1
(nconc (make-list (length (ebrowse-ts-subclasses tree))
- (1+ level)) stack1)))))
+ (1+ level))
+ stack1)))))
\f
"Expand or fold all trees in the buffer.
COLLAPSE non-nil means fold them."
(interactive "P")
- (let ((line-end (if collapse "^\n" "^\r"))
- (insertion (if collapse "\r" "\n")))
- (ebrowse-output
+ (with-silent-modifications
+ (if (not collapse)
+ (ebrowse--unhide (point-min) (point-max))
(save-excursion
(goto-char (point-min))
- (while (not (progn (skip-chars-forward line-end) (eobp)))
- (when (or (not collapse)
- (looking-at "\n "))
- (delete-char 1)
- (insert insertion))
- (when collapse
- (skip-chars-forward "\n ")))))))
+ (while (progn (end-of-line) (not (eobp)))
+ (when (looking-at "\n ")
+ (ebrowse--hide (point) (line-end-position 2)))
+ (skip-chars-forward "\n "))))))
(defun ebrowse-unhide-base-classes ()
"Unhide the line the cursor is on and all base classes."
- (ebrowse-output
+ (with-silent-modifications
(save-excursion
(let (indent last-indent)
- (skip-chars-backward "^\r\n")
- (when (not (looking-at "[\r\n][^ \t]"))
- (skip-chars-forward "\r\n \t")
+ (forward-line 0)
+ (when (not (looking-at "\n[^ \t]"))
+ (skip-chars-forward "\n \t")
(while (and (or (null last-indent) ;first time
(> indent 1)) ;not root class
- (re-search-backward "[\r\n][ \t]*" nil t))
+ (re-search-backward "\n[ \t]*" nil t))
(setf indent (- (match-end 0)
(match-beginning 0)))
(when (or (null last-indent)
(< indent last-indent))
(setf last-indent indent)
- (when (looking-at "\r")
- (delete-char 1)
- (insert 10)))
- (backward-char 1)))))))
+ (when (ebrowse--hidden-p)
+ (ebrowse--unhide (point) (line-end-position 2))))))))))
(defun ebrowse-hide-line (collapse)
"Hide/show a single line in the tree.
COLLAPSE non-nil means hide."
- (save-excursion
- (ebrowse-output
- (skip-chars-forward "^\r\n")
- (delete-char 1)
- (insert (if collapse 13 10)))))
+ (with-silent-modifications
+ (funcall (if collapse #'ebrowse--hide #'ebrowse--unhide)
+ (line-end-position) (line-end-position 2))))
(defun ebrowse-collapse-fn (collapse)
"Collapse or expand a branch of the tree.
COLLAPSE non-nil means collapse the branch."
- (ebrowse-output
+ (with-silent-modifications
(save-excursion
(beginning-of-line)
(skip-chars-forward "> \t")
(let ((indentation (current-column)))
(while (and (not (eobp))
(save-excursion
- (skip-chars-forward "^\r\n")
- (goto-char (1+ (point)))
+ (forward-line 1)
(skip-chars-forward "> \t")
(> (current-column) indentation)))
(ebrowse-hide-line collapse)
- (skip-chars-forward "^\r\n")
- (goto-char (1+ (point))))))))
+ (forward-line 1))))))
\f
;;; Electric tree selection
;;;###autoload
(define-derived-mode ebrowse-member-mode special-mode "Ebrowse-Members"
"Major mode for Ebrowse member buffers."
- (mapc 'make-local-variable
+ (mapc #'make-local-variable
'(ebrowse--decl-column ;display column
ebrowse--n-columns ;number of short columns
ebrowse--column-width ;width of columns above
(let ((display-fn (if ebrowse--long-display-flag
'ebrowse-draw-member-long-fn
'ebrowse-draw-member-short-fn)))
- (ebrowse-output
+ (with-silent-modifications
(erase-buffer)
;; Show this class
(ebrowse-draw-member-buffer-class-line)
(defun ebrowse-draw-member-long-fn (member-list tree)
"Display member buffer for MEMBER-LIST in long form.
TREE is the class tree of MEMBER-LIST."
- (dolist (member-struc (mapcar 'ebrowse-member-display-p member-list))
+ (dolist (member-struc (mapcar #'ebrowse-member-display-p member-list))
(when member-struc
(let ((name (ebrowse-ms-name member-struc))
(start (point)))
(if members
(let* ((name (ebrowse-ignoring-completion-case
(completing-read prompt members nil nil member-name)))
- (completion-result (try-completion name members)))
+ ;; (completion-result (try-completion name members))
+ )
;; Cannot rely on `try-completion' returning t for exact
;; matches! It returns the name as a string.
(unless (gethash name members)
;; Get the member name NAME (class-name is ignored).
(let ((name fix-name) class-name regexp)
(unless name
+ (ignore class-name) ;Can't use an underscore to silence the warning :-(!
(cl-multiple-value-setq (class-name name)
(cl-values-list (ebrowse-tags-read-name header "Find calls of: "))))
;; Set tags loop form to search for member and begin loop.
(find-file (ebrowse-position-file-name position))
(goto-char (ebrowse-position-point position)))
(t
- (unwind-protect
- (progn
- (push (function
- (lambda ()
- (goto-char (ebrowse-position-point position))))
- view-mode-hook)
- (view-file (ebrowse-position-file-name position)))
- (pop view-mode-hook)))))
+ (let ((fn (lambda ()
+ (goto-char (ebrowse-position-point position)))))
+ (unwind-protect
+ (progn
+ (add-hook 'view-mode-hook fn)
+ (view-file (ebrowse-position-file-name position)))
+ (remove-hook 'view-mode-hook fn))))))
(defun ebrowse-push-position (marker info &optional target)
(setq mode-line-buffer-identification "Electric Position Menu")
(when (memq 'mode-name mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
+ ;; FIXME: Why not set `mode-name' to "Positions"?
(setcar (memq 'mode-name mode-line-format) "Positions"))
(set (make-local-variable 'Helper-return-blurb) "return to buffer editing")
(setq truncate-lines t
(erase-buffer)
(setf (ebrowse-hs-member-table header) nil)
(insert (prin1-to-string header) " ")
- (mapc 'ebrowse-save-class tree)
+ (mapc #'ebrowse-save-class tree)
(write-file file-name)
(message "Tree written to file `%s'" file-name))
(kill-buffer temp-buffer)
(insert "[ebrowse-ts ")
(prin1 (ebrowse-ts-class class)) ;class name
(insert "(") ;list of subclasses
- (mapc 'ebrowse-save-class (ebrowse-ts-subclasses class))
+ (mapc #'ebrowse-save-class (ebrowse-ts-subclasses class))
(insert ")")
(dolist (func ebrowse-member-list-accessors)
(prin1 (funcall func class))
(unwind-protect
(progn
(add-hook 'electric-buffer-menu-mode-hook
- 'ebrowse-hack-electric-buffer-menu)
+ #'ebrowse-hack-electric-buffer-menu)
(add-hook 'electric-buffer-menu-mode-hook
- 'ebrowse-install-1-to-9-keys)
+ #'ebrowse-install-1-to-9-keys)
(call-interactively 'electric-buffer-list))
(remove-hook 'electric-buffer-menu-mode-hook
- 'ebrowse-hack-electric-buffer-menu)))
+ #'ebrowse-hack-electric-buffer-menu)))
\f
;;; Mouse support
(pcase (event-click-count event)
(2 (pcase property
('class-name
- (let ((collapsed (save-excursion (skip-chars-forward "^\r\n")
- (looking-at "\r"))))
+ (let ((collapsed (ebrowse--hidden-p (line-end-position))))
(ebrowse-collapse-fn (not collapsed))))
('mark
(ebrowse-toggle-mark-at-point 1)))))))
(provide 'ebrowse)
;; Local variables:
-;; eval:(put 'ebrowse-output 'lisp-indent-hook 0)
;; eval:(put 'ebrowse-ignoring-completion-case 'lisp-indent-hook 0)
-;; eval:(put 'ebrowse-save-selective 'lisp-indent-hook 0)
;; eval:(put 'ebrowse-for-all-trees 'lisp-indent-hook 1)
;; End:
projects / emacs.git / commitdiff